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

! This file was ported from Lean 3 source module category_theory.category.preorder
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Equivalence
import Mathbin.Order.Hom.Basic

/-!

# Preorders as categories

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

We install a category instance on any preorder. This is not to be confused with the category _of_
preorders, defined in `order/category/Preorder`.

We show that monotone functions between preorders correspond to functors of the associated
categories.

## Main definitions

* `hom_of_le` and `le_of_hom` provide translations between inequalities in the preorder, and
  morphisms in the associated category.
* `monotone.functor` is the functor associated to a monotone function.

-/

universe u v

namespace Preorder

open CategoryTheory

#print Preorder.smallCategory /-
-- see Note [lower instance priority]
/--
The category structure coming from a preorder. There is a morphism `X ⟶ Y` if and only if `X ≤ Y`.

Because we don't allow morphisms to live in `Prop`,
we have to define `X ⟶ Y` as `ulift (plift (X ≤ Y))`.
See `category_theory.hom_of_le` and `category_theory.le_of_hom`.

See <https://stacks.math.columbia.edu/tag/00D3>.
-/
instance (priority := 100) smallCategory (α : Type u) [Preorder α] : SmallCategory α
    where
  Hom U V := ULift (PLift (U ≤ V))
  id X := ⟨⟨le_refl X⟩⟩
  comp X Y Z f g := ⟨⟨le_trans _ _ _ f.down.down g.down.down⟩⟩
#align preorder.small_category Preorder.smallCategory
-/

end Preorder

namespace CategoryTheory

open Opposite

variable {X : Type u} [Preorder X]

#print CategoryTheory.homOfLE /-
/-- Express an inequality as a morphism in the corresponding preorder category.
-/
def homOfLE {x y : X} (h : x ≤ y) : x ⟶ y :=
  ULift.up (PLift.up h)
#align category_theory.hom_of_le CategoryTheory.homOfLE
-/

alias hom_of_le ← _root_.has_le.le.hom
#align has_le.le.hom LE.le.hom

#print CategoryTheory.homOfLE_refl /-
@[simp]
theorem homOfLE_refl {x : X} : (le_refl x).Hom = 𝟙 x :=
  rfl
#align category_theory.hom_of_le_refl CategoryTheory.homOfLE_refl
-/

#print CategoryTheory.homOfLE_comp /-
@[simp]
theorem homOfLE_comp {x y z : X} (h : x ≤ y) (k : y ≤ z) : h.Hom ≫ k.Hom = (h.trans k).Hom :=
  rfl
#align category_theory.hom_of_le_comp CategoryTheory.homOfLE_comp
-/

#print CategoryTheory.leOfHom /-
/-- Extract the underlying inequality from a morphism in a preorder category.
-/
theorem leOfHom {x y : X} (h : x ⟶ y) : x ≤ y :=
  h.down.down
#align category_theory.le_of_hom CategoryTheory.leOfHom
-/

alias le_of_hom ← _root_.quiver.hom.le
#align quiver.hom.le Quiver.Hom.le

#print CategoryTheory.leOfHom_homOfLE /-
@[simp]
theorem leOfHom_homOfLE {x y : X} (h : x ≤ y) : h.Hom.le = h :=
  rfl
#align category_theory.le_of_hom_hom_of_le CategoryTheory.leOfHom_homOfLE
-/

#print CategoryTheory.homOfLE_leOfHom /-
@[simp]
theorem homOfLE_leOfHom {x y : X} (h : x ⟶ y) : h.le.Hom = h :=
  by
  cases h
  cases h
  rfl
#align category_theory.hom_of_le_le_of_hom CategoryTheory.homOfLE_leOfHom
-/

#print CategoryTheory.opHomOfLe /-
/-- Construct a morphism in the opposite of a preorder category from an inequality. -/
def opHomOfLe {x y : Xᵒᵖ} (h : unop x ≤ unop y) : y ⟶ x :=
  h.Hom.op
#align category_theory.op_hom_of_le CategoryTheory.opHomOfLe
-/

#print CategoryTheory.le_of_op_hom /-
theorem le_of_op_hom {x y : Xᵒᵖ} (h : x ⟶ y) : unop y ≤ unop x :=
  h.unop.le
#align category_theory.le_of_op_hom CategoryTheory.le_of_op_hom
-/

/- warning: category_theory.unique_to_top -> CategoryTheory.uniqueToTop is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} [_inst_1 : Preorder.{u1} X] [_inst_2 : OrderTop.{u1} X (Preorder.toLE.{u1} X _inst_1)] {x : X}, Unique.{succ u1} (Quiver.Hom.{succ u1, u1} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) x (Top.top.{u1} X (OrderTop.toHasTop.{u1} X (Preorder.toLE.{u1} X _inst_1) _inst_2)))
but is expected to have type
  forall {X : Type.{u1}} [_inst_1 : Preorder.{u1} X] [_inst_2 : OrderTop.{u1} X (Preorder.toLE.{u1} X _inst_1)] {x : X}, Unique.{succ u1} (Quiver.Hom.{succ u1, u1} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) x (Top.top.{u1} X (OrderTop.toTop.{u1} X (Preorder.toLE.{u1} X _inst_1) _inst_2)))
Case conversion may be inaccurate. Consider using '#align category_theory.unique_to_top CategoryTheory.uniqueToTopₓ'. -/
instance uniqueToTop [OrderTop X] {x : X} : Unique (x ⟶ ⊤) := by tidy
#align category_theory.unique_to_top CategoryTheory.uniqueToTop

/- warning: category_theory.unique_from_bot -> CategoryTheory.uniqueFromBot is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} [_inst_1 : Preorder.{u1} X] [_inst_2 : OrderBot.{u1} X (Preorder.toLE.{u1} X _inst_1)] {x : X}, Unique.{succ u1} (Quiver.Hom.{succ u1, u1} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) (Bot.bot.{u1} X (OrderBot.toHasBot.{u1} X (Preorder.toLE.{u1} X _inst_1) _inst_2)) x)
but is expected to have type
  forall {X : Type.{u1}} [_inst_1 : Preorder.{u1} X] [_inst_2 : OrderBot.{u1} X (Preorder.toLE.{u1} X _inst_1)] {x : X}, Unique.{succ u1} (Quiver.Hom.{succ u1, u1} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) (Bot.bot.{u1} X (OrderBot.toBot.{u1} X (Preorder.toLE.{u1} X _inst_1) _inst_2)) x)
Case conversion may be inaccurate. Consider using '#align category_theory.unique_from_bot CategoryTheory.uniqueFromBotₓ'. -/
instance uniqueFromBot [OrderBot X] {x : X} : Unique (⊥ ⟶ x) := by tidy
#align category_theory.unique_from_bot CategoryTheory.uniqueFromBot

end CategoryTheory

section

variable {X : Type u} {Y : Type v} [Preorder X] [Preorder Y]

#print Monotone.functor /-
/-- A monotone function between preorders induces a functor between the associated categories.
-/
def Monotone.functor {f : X → Y} (h : Monotone f) : X ⥤ Y
    where
  obj := f
  map x₁ x₂ g := (h g.le).Hom
#align monotone.functor Monotone.functor
-/

/- warning: monotone.functor_obj -> Monotone.functor_obj is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] {f : X -> Y} (h : Monotone.{u1, u2} X Y _inst_1 _inst_2 f), Eq.{max (succ u1) (succ u2)} (X -> Y) (CategoryTheory.Functor.obj.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) (Monotone.functor.{u1, u2} X Y _inst_1 _inst_2 f h)) f
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] {f : X -> Y} (h : Monotone.{u1, u2} X Y _inst_1 _inst_2 f), Eq.{max (succ u1) (succ u2)} (X -> Y) (Prefunctor.obj.{succ u1, succ u2, u1, u2} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) (Monotone.functor.{u1, u2} X Y _inst_1 _inst_2 f h))) f
Case conversion may be inaccurate. Consider using '#align monotone.functor_obj Monotone.functor_objₓ'. -/
@[simp]
theorem Monotone.functor_obj {f : X → Y} (h : Monotone f) : h.Functor.obj = f :=
  rfl
#align monotone.functor_obj Monotone.functor_obj

end

namespace CategoryTheory

section Preorder

variable {X : Type u} {Y : Type v} [Preorder X] [Preorder Y]

/- warning: category_theory.functor.monotone -> CategoryTheory.Functor.monotone is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] (f : CategoryTheory.Functor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2)), Monotone.{u1, u2} X Y _inst_1 _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) f)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] (f : CategoryTheory.Functor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2)), Monotone.{u1, u2} X Y _inst_1 _inst_2 (Prefunctor.obj.{succ u1, succ u2, u1, u2} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) f))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.monotone CategoryTheory.Functor.monotoneₓ'. -/
/-- A functor between preorder categories is monotone.
-/
@[mono]
theorem Functor.monotone (f : X ⥤ Y) : Monotone f.obj := fun x y hxy => (f.map hxy.Hom).le
#align category_theory.functor.monotone CategoryTheory.Functor.monotone

end Preorder

section PartialOrder

variable {X : Type u} {Y : Type v} [PartialOrder X] [PartialOrder Y]

#print CategoryTheory.Iso.to_eq /-
theorem Iso.to_eq {x y : X} (f : x ≅ y) : x = y :=
  le_antisymm f.Hom.le f.inv.le
#align category_theory.iso.to_eq CategoryTheory.Iso.to_eq
-/

/- warning: category_theory.equivalence.to_order_iso -> CategoryTheory.Equivalence.toOrderIso is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y], (CategoryTheory.Equivalence.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) -> (OrderIso.{u1, u2} X Y (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y], (CategoryTheory.Equivalence.{u1, u2, u1, u2} X Y (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) -> (OrderIso.{u1, u2} X Y (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))
Case conversion may be inaccurate. Consider using '#align category_theory.equivalence.to_order_iso CategoryTheory.Equivalence.toOrderIsoₓ'. -/
/-- A categorical equivalence between partial orders is just an order isomorphism.
-/
def Equivalence.toOrderIso (e : X ≌ Y) : X ≃o Y
    where
  toFun := e.Functor.obj
  invFun := e.inverse.obj
  left_inv a := (e.unitIso.app a).to_eq.symm
  right_inv b := (e.counitIso.app b).to_eq
  map_rel_iff' a a' :=
    ⟨fun h =>
      ((Equivalence.unit e).app a ≫ e.inverse.map h.Hom ≫ (Equivalence.unitInv e).app a').le,
      fun h : a ≤ a' => (e.Functor.map h.Hom).le⟩
#align category_theory.equivalence.to_order_iso CategoryTheory.Equivalence.toOrderIso

/- warning: category_theory.equivalence.to_order_iso_apply -> CategoryTheory.Equivalence.toOrderIso_apply is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y] (e : CategoryTheory.Equivalence.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (x : X), Eq.{succ u2} Y (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} X Y (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (fun (_x : RelIso.{u1, u2} X Y (LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1))) (LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))) => X -> Y) (RelIso.hasCoeToFun.{u1, u2} X Y (LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1))) (LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))) (CategoryTheory.Equivalence.toOrderIso.{u1, u2} X Y _inst_1 _inst_2 e) x) (CategoryTheory.Functor.obj.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) (CategoryTheory.Equivalence.functor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) e) x)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y] (e : CategoryTheory.Equivalence.{u1, u2, u1, u2} X Y (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (x : X), Eq.{succ u2} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : X) => Y) x) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (Function.Embedding.{succ u1, succ u2} X Y) X (fun (_x : X) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : X) => Y) _x) (EmbeddingLike.toFunLike.{max (succ u1) (succ u2), succ u1, succ u2} (Function.Embedding.{succ u1, succ u2} X Y) X Y (Function.instEmbeddingLikeEmbedding.{succ u1, succ u2} X Y)) (RelEmbedding.toEmbedding.{u1, u2} X Y (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : X) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : X) => LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : Y) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : Y) => LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u1, u2} X Y (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : X) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : X) => LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : Y) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : Y) => LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (CategoryTheory.Equivalence.toOrderIso.{u1, u2} X Y _inst_1 _inst_2 e))) x) (Prefunctor.obj.{succ u1, succ u2, u1, u2} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)))) Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) (CategoryTheory.Equivalence.functor.{u1, u2, u1, u2} X Y (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) e)) x)
Case conversion may be inaccurate. Consider using '#align category_theory.equivalence.to_order_iso_apply CategoryTheory.Equivalence.toOrderIso_applyₓ'. -/
-- `@[simps]` on `equivalence.to_order_iso` produces lemmas that fail the `simp_nf` linter,
-- so we provide them by hand:
@[simp]
theorem Equivalence.toOrderIso_apply (e : X ≌ Y) (x : X) : e.toOrderIso x = e.Functor.obj x :=
  rfl
#align category_theory.equivalence.to_order_iso_apply CategoryTheory.Equivalence.toOrderIso_apply

/- warning: category_theory.equivalence.to_order_iso_symm_apply -> CategoryTheory.Equivalence.toOrderIso_symm_apply is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y] (e : CategoryTheory.Equivalence.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (y : Y), Eq.{succ u1} X (coeFn.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (OrderIso.{u2, u1} Y X (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1))) (fun (_x : RelIso.{u2, u1} Y X (LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)))) => Y -> X) (RelIso.hasCoeToFun.{u2, u1} Y X (LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)))) (OrderIso.symm.{u1, u2} X Y (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) (CategoryTheory.Equivalence.toOrderIso.{u1, u2} X Y _inst_1 _inst_2 e)) y) (CategoryTheory.Functor.obj.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (CategoryTheory.Equivalence.inverse.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) e) y)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : PartialOrder.{u1} X] [_inst_2 : PartialOrder.{u2} Y] (e : CategoryTheory.Equivalence.{u1, u2, u1, u2} X Y (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2))) (y : Y), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : Y) => X) y) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} Y X) Y (fun (_x : Y) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : Y) => X) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} Y X) Y X (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} Y X)) (RelEmbedding.toEmbedding.{u2, u1} Y X (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : Y) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : Y) => LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : X) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : X) => LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} Y X (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : Y) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : Y) => LE.le.{u2} Y (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : X) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : X) => LE.le.{u1} X (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (OrderIso.symm.{u1, u2} X Y (Preorder.toLE.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.toLE.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) (CategoryTheory.Equivalence.toOrderIso.{u1, u2} X Y _inst_1 _inst_2 e)))) y) (Prefunctor.obj.{succ u2, succ u1, u2, u1} Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)))) X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)))) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) X (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (CategoryTheory.Equivalence.inverse.{u1, u2, u1, u2} X Y (Preorder.smallCategory.{u1} X (PartialOrder.toPreorder.{u1} X _inst_1)) (Preorder.smallCategory.{u2} Y (PartialOrder.toPreorder.{u2} Y _inst_2)) e)) y)
Case conversion may be inaccurate. Consider using '#align category_theory.equivalence.to_order_iso_symm_apply CategoryTheory.Equivalence.toOrderIso_symm_applyₓ'. -/
@[simp]
theorem Equivalence.toOrderIso_symm_apply (e : X ≌ Y) (y : Y) :
    e.toOrderIso.symm y = e.inverse.obj y :=
  rfl
#align category_theory.equivalence.to_order_iso_symm_apply CategoryTheory.Equivalence.toOrderIso_symm_apply

end PartialOrder

end CategoryTheory


import data.nat.basic
import data.list.basic

@[simp]
def concat_pair {α β : Type} : list α × list β → list α × list β → list α × list β
| ⟨xs, ys⟩ ⟨xs', ys'⟩ := (xs ++ xs', ys ++ ys')

local infix ` <> ` : 65 := concat_pair

lemma A {α β : Type} (xs : list α × list β) : xs <> ([], []) = xs ∧ ([], []) <> xs = xs :=
  let ⟨xs₁, ys₂⟩ := xs in ⟨by simp, rfl⟩

lemma B {α β : Type} (xs ys zs : list α × list β) : (xs <> ys) <> zs = xs <> (ys <> zs) := by
  { rcases xs with ⟨xs₁, xs₂⟩,
    rcases ys with ⟨ys₁, ys₂⟩,
    rcases zs with ⟨zs₁, zs₂⟩,
    simp }

-- a)

def split {α β : Type} : list (α × β) → list α × list β
| []             := ([], [])
| ((x, y) :: zs) := ([x], [y]) <> (split zs)

#eval split [(1, 'a'), (2, 'b')]

-- b)

def splitTR {α β : Type} : list (α × β) → list α → list β → list α × list β
| []             xs ys := (xs, ys)
| ((x, y) :: zs) xs ys := splitTR zs (xs ++ [x]) (ys ++ [y])

#eval splitTR [(5, 'e'), (2, 'b')] [3, 6] ['c', 'f']

-- c)

lemma C {α β : Type} (zs : list (α × β)) (xs : list α) (ys : list β) :
  splitTR zs xs ys = (xs, ys) <> split zs := by
  { induction zs with hzs tzs ih generalizing xs ys,
    { unfold split, rw (A _).left, refl },
    { cases hzs with x y,
      unfold split, rw ← B,
      unfold splitTR, rw ih,
      refl } }

-- d)

lemma D {α β : Type} (zs : list (α × β)) :
  splitTR zs [] [] = split zs := by
  { suffices : splitTR zs [] [] = ([], []) <> split zs,
    { rw (A _).right at this, exact this },
    { exact C _ _ _ } }


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.pure

namespace affine
open set
variables {m n k : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E]
  {S : simplicial_complex E} {X Y : finset E} {A : set (finset E)}

/--
The k-skeleton of a simplicial complex is the simplicial complex made of its simplices of dimension
less than k.
-/
def simplicial_complex.skeleton (S : simplicial_complex E) (k : ℕ) :
  simplicial_complex E :=
simplicial_complex.of_surcomplex
  {X ∈ S.faces | finset.card X ≤ k + 1}
  (λ X ⟨hX, _⟩, hX)
  (λ X Y hX hY, ⟨S.down_closed hX.1 hY, le_trans (finset.card_le_of_subset hY) hX.2⟩)

lemma skeleton_subcomplex :
  (S.skeleton k).faces ⊆ S.faces :=
λ X ⟨hX, _⟩, hX

lemma skeleton_nonempty_iff :
  (S.skeleton k).faces.nonempty ↔ S.faces.nonempty :=
begin
  split,
  { apply nonempty.mono skeleton_subcomplex },
  { rintro ⟨X, hX⟩,
    exact ⟨∅, S.down_closed hX X.empty_subset, nat.zero_le _⟩ }
end

lemma pure_skeleton_of_pure [finite_dimensional ℝ E] (hS : S.pure_of n) :
  (S.skeleton k).pure_of (min n (k + 1)) :=
begin
  cases le_or_gt n (k + 1) with hmin hmin,
  { rw min_eq_left hmin,
    rintro X hXskel,
    obtain ⟨Y, hY, hXY⟩ := subfacet (skeleton_subcomplex (facets_subset hXskel)),
    have hYskel : Y ∈ (S.skeleton k).faces,
    { use facets_subset hY,
      simp,
      rw hS hY,
      exact hmin, },
    rw hXskel.2 hYskel hXY,
    exact hS hY },
  { rw min_eq_right (le_of_lt hmin),
    rintro X ⟨⟨hX, hXcard⟩, hXmax⟩,
    obtain ⟨Y, hY, hXY⟩ := subfacet hX,
    have : k + 1 - X.card + X.card ≤ Y.card,
    { rw hS hY,
      rw nat.sub_add_cancel hXcard,
      exact le_of_lt hmin, },
    obtain ⟨Z, hXZ, hZY, hZcard⟩ := finset.exists_intermediate_set (k + 1 - X.card) this hXY,
      rw nat.sub_add_cancel hXcard at hZcard,
    rw hXmax ⟨S.down_closed (facets_subset hY) hZY, le_of_eq hZcard⟩ hXZ,
    exact hZcard, }
end

lemma skeleton_pureness_eq_min_pureness_dimension [finite_dimensional ℝ E] (hS : S.pure)
  (hS' : S.faces.nonempty) :
  (S.skeleton k).pureness = min S.pureness (k + 1) :=
begin
  rcases hS with ⟨n, hn⟩,
  rw [pureness_def' hS' hn, pureness_def'],
  { rwa skeleton_nonempty_iff },
  { apply pure_skeleton_of_pure hn },
end

end affine


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Michael Howes

! This file was ported from Lean 3 source module group_theory.abelianization
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finite.Card
import Mathlib.GroupTheory.Commutator
import Mathlib.GroupTheory.Finiteness

/-!
# The abelianization of a group

This file defines the commutator and the abelianization of a group. It furthermore prepares for the
result that the abelianization is left adjoint to the forgetful functor from abelian groups to
groups, which can be found in `Algebra/Category/Group/Adjunctions`.

## Main definitions

* `commutator`: defines the commutator of a group `G` as a subgroup of `G`.
* `Abelianization`: defines the abelianization of a group `G` as the quotient of a group by its
  commutator subgroup.
* `Abelianization.map`: lifts a group homomorphism to a homomorphism between the abelianizations
* `MulEquiv.abelianizationCongr`: Equivalent groups have equivalent abelianizations

-/

universe u v w

-- Let G be a group.
variable (G : Type u) [Group G]

/-- The commutator subgroup of a group G is the normal subgroup
  generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹`. -/
def commutator : Subgroup G := ⁅(⊤ : Subgroup G), ⊤⁆
#align commutator commutator

-- Porting note: this instance should come from `deriving Subgroup.Normal`
instance : Subgroup.Normal (commutator G) := Subgroup.commutator_normal ⊤ ⊤

theorem commutator_def : commutator G = ⁅(⊤ : Subgroup G), ⊤⁆ :=
  rfl
#align commutator_def commutator_def

theorem commutator_eq_closure : commutator G = Subgroup.closure (commutatorSet G) := by
  simp [commutator, Subgroup.commutator_def, commutatorSet]
#align commutator_eq_closure commutator_eq_closure

theorem commutator_eq_normalClosure : commutator G = Subgroup.normalClosure (commutatorSet G) := by
  simp [commutator, Subgroup.commutator_def', commutatorSet]
#align commutator_eq_normal_closure commutator_eq_normalClosure

instance commutator_characteristic : (commutator G).Characteristic :=
  Subgroup.commutator_characteristic ⊤ ⊤
#align commutator_characteristic commutator_characteristic

instance [Finite (commutatorSet G)] : Group.Fg (commutator G) := by
  rw [commutator_eq_closure]
  apply Group.closure_finite_fg

theorem rank_commutator_le_card [Finite (commutatorSet G)] :
    Group.rank (commutator G) ≤ Nat.card (commutatorSet G) := by
  rw [Subgroup.rank_congr (commutator_eq_closure G)]
  apply Subgroup.rank_closure_finite_le_nat_card
#align rank_commutator_le_card rank_commutator_le_card

theorem commutator_centralizer_commutator_le_center :
    ⁅(commutator G).centralizer, (commutator G).centralizer⁆ ≤ Subgroup.center G := by
  rw [← Subgroup.centralizer_top, ← Subgroup.commutator_eq_bot_iff_le_centralizer]
  suffices ⁅⁅⊤, (commutator G).centralizer⁆, (commutator G).centralizer⁆ = ⊥
    by
    refine' Subgroup.commutator_commutator_eq_bot_of_rotate _ this
    rwa [Subgroup.commutator_comm (commutator G).centralizer]
  rw [Subgroup.commutator_comm, Subgroup.commutator_eq_bot_iff_le_centralizer]
  exact Set.centralizer_subset (Subgroup.commutator_mono le_top le_top)
#align commutator_centralizer_commutator_le_center commutator_centralizer_commutator_le_center

/-- The abelianization of G is the quotient of G by its commutator subgroup. -/
def Abelianization : Type u :=
  G ⧸ commutator G
#align abelianization Abelianization

namespace Abelianization

attribute [local instance] QuotientGroup.leftRel

instance commGroup : CommGroup (Abelianization G) :=
  { QuotientGroup.Quotient.group _ with
    mul_comm := fun x y =>
      Quotient.inductionOn₂' x y fun a b =>
        Quotient.sound' <|
          QuotientGroup.leftRel_apply.mpr <|
            Subgroup.subset_closure
              ⟨b⁻¹, Subgroup.mem_top b⁻¹, a⁻¹, Subgroup.mem_top a⁻¹, by group⟩ }

instance : Inhabited (Abelianization G) :=
  ⟨1⟩

instance [Fintype G] [DecidablePred (· ∈ commutator G)] : Fintype (Abelianization G) :=
  QuotientGroup.fintype (commutator G)

instance [Finite G] : Finite (Abelianization G) :=
  Quotient.finite _

variable {G}

/-- `of` is the canonical projection from G to its abelianization. -/
def of : G →* Abelianization G where
  toFun := QuotientGroup.mk
  map_one' := rfl
  map_mul' _ _ := rfl
#align abelianization.of Abelianization.of

@[simp]
theorem mk_eq_of (a : G) : Quot.mk _ a = of a :=
  rfl
#align abelianization.mk_eq_of Abelianization.mk_eq_of

section lift

-- So far we have built Gᵃᵇ and proved it's an abelian group.
-- Furthremore we defined the canonical projection `of : G → Gᵃᵇ`
-- Let `A` be an abelian group and let `f` be a group homomorphism from `G` to `A`.
variable {A : Type v} [CommGroup A] (f : G →* A)

theorem commutator_subset_ker : commutator G ≤ f.ker := by
  rw [commutator_eq_closure, Subgroup.closure_le]
  rintro x ⟨p, q, rfl⟩
  simp [MonoidHom.mem_ker, mul_right_comm (f p) (f q), commutatorElement_def]
#align abelianization.commutator_subset_ker Abelianization.commutator_subset_ker

/-- If `f : G → A` is a group homomorphism to an abelian group, then `lift f` is the unique map
  from the abelianization of a `G` to `A` that factors through `f`. -/
def lift : (G →* A) ≃ (Abelianization G →* A) where
  toFun f := QuotientGroup.lift _ f fun _ h => f.mem_ker.2 <| commutator_subset_ker _ h
  invFun F := F.comp of
  left_inv _ := MonoidHom.ext fun _ => rfl
  right_inv _ := MonoidHom.ext fun x => QuotientGroup.induction_on x fun _ => rfl
#align abelianization.lift Abelianization.lift

@[simp]
theorem lift.of (x : G) : lift f (of x) = f x :=
  rfl
#align abelianization.lift.of Abelianization.lift.of

theorem lift.unique (φ : Abelianization G →* A)
    -- hφ : φ agrees with f on the image of G in Gᵃᵇ
    (hφ : ∀ x : G, φ (Abelianization.of x) = f x)
    {x : Abelianization G} : φ x = lift f x :=
  QuotientGroup.induction_on x hφ
#align abelianization.lift.unique Abelianization.lift.unique

@[simp]
theorem lift_of : lift of = MonoidHom.id (Abelianization G) :=
  lift.apply_symm_apply <| MonoidHom.id _
#align abelianization.lift_of Abelianization.lift_of

end lift

variable {A : Type v} [Monoid A]

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext (φ ψ : Abelianization G →* A) (h : φ.comp of = ψ.comp of) : φ = ψ :=
  MonoidHom.ext fun x => QuotientGroup.induction_on x <| FunLike.congr_fun h
#align abelianization.hom_ext Abelianization.hom_ext

section Map

variable {H : Type v} [Group H] (f : G →* H)

/-- The map operation of the `Abelianization` functor -/
def map : Abelianization G →* Abelianization H :=
  lift (of.comp f)
#align abelianization.map Abelianization.map

@[simp]
theorem map_of (x : G) : map f (of x) = of (f x) :=
  rfl
#align abelianization.map_of Abelianization.map_of

@[simp]
theorem map_id : map (MonoidHom.id G) = MonoidHom.id (Abelianization G) :=
  hom_ext _ _ rfl
#align abelianization.map_id Abelianization.map_id

@[simp]
theorem map_comp {I : Type w} [Group I] (g : H →* I) : (map g).comp (map f) = map (g.comp f) :=
  hom_ext _ _ rfl
#align abelianization.map_comp Abelianization.map_comp

@[simp]
theorem map_map_apply {I : Type w} [Group I] {g : H →* I} {x : Abelianization G} :
    map g (map f x) = map (g.comp f) x :=
  FunLike.congr_fun (map_comp _ _) x
#align abelianization.map_map_apply Abelianization.map_map_apply

end Map

end Abelianization

section AbelianizationCongr

-- Porting note: `[Group G]` should not be necessary here
variable {G} [Group G] {H : Type v} [Group H] (e : G ≃* H)

/-- Equivalent groups have equivalent abelianizations -/
def MulEquiv.abelianizationCongr : Abelianization G ≃* Abelianization H where
  toFun := Abelianization.map e.toMonoidHom
  invFun := Abelianization.map e.symm.toMonoidHom
  left_inv := by
    rintro ⟨a⟩
    simp
  right_inv := by
    rintro ⟨a⟩
    simp
  map_mul' := MonoidHom.map_mul _
#align mul_equiv.abelianization_congr MulEquiv.abelianizationCongr

@[simp]
theorem abelianizationCongr_of (x : G) :
    e.abelianizationCongr (Abelianization.of x) = Abelianization.of (e x) :=
  rfl
#align abelianization_congr_of abelianizationCongr_of

@[simp]
theorem abelianizationCongr_refl :
    (MulEquiv.refl G).abelianizationCongr = MulEquiv.refl (Abelianization G) :=
  MulEquiv.toMonoidHom_injective Abelianization.lift_of
#align abelianization_congr_refl abelianizationCongr_refl

@[simp]
theorem abelianizationCongr_symm : e.abelianizationCongr.symm = e.symm.abelianizationCongr :=
  rfl
#align abelianization_congr_symm abelianizationCongr_symm

@[simp]
theorem abelianizationCongr_trans {I : Type v} [Group I] (e₂ : H ≃* I) :
    e.abelianizationCongr.trans e₂.abelianizationCongr = (e.trans e₂).abelianizationCongr :=
  MulEquiv.toMonoidHom_injective (Abelianization.hom_ext _ _ rfl)
#align abelianization_congr_trans abelianizationCongr_trans

end AbelianizationCongr

/-- An Abelian group is equivalent to its own abelianization. -/
@[simps]
def Abelianization.equivOfComm {H : Type _} [CommGroup H] : H ≃* Abelianization H :=
  { Abelianization.of with
    toFun := Abelianization.of
    invFun := Abelianization.lift (MonoidHom.id H)
    left_inv := fun a => rfl
    right_inv := by
      rintro ⟨a⟩
      rfl }
#align abelianization.equiv_of_comm Abelianization.equivOfComm

section commutatorRepresentatives

open Subgroup

/-- Representatives `(g₁, g₂) : G × G` of commutators `⁅g₁, g₂⁆ ∈ G`. -/
def commutatorRepresentatives : Set (G × G) :=
  Set.range fun g : commutatorSet G => (g.2.choose, g.2.choose_spec.choose)
#align commutator_representatives commutatorRepresentatives

instance [Finite (commutatorSet G)] : Finite (commutatorRepresentatives G) :=
  Set.finite_coe_iff.mpr (Set.finite_range _)

/-- Subgroup generated by representatives `g₁ g₂ : G` of commutators `⁅g₁, g₂⁆ ∈ G`. -/
def closureCommutatorRepresentatives : Subgroup G :=
  closure (Prod.fst '' commutatorRepresentatives G ∪ Prod.snd '' commutatorRepresentatives G)
#align closure_commutator_representatives closureCommutatorRepresentatives

instance closureCommutatorRepresentatives_fg [Finite (commutatorSet G)] :
    Group.Fg (closureCommutatorRepresentatives G) :=
  Group.closure_finite_fg _
#align closure_commutator_representatives_fg closureCommutatorRepresentatives_fg

theorem rank_closureCommutatorRepresentatives_le [Finite (commutatorSet G)] :
    Group.rank (closureCommutatorRepresentatives G) ≤ 2 * Nat.card (commutatorSet G) := by
  rw [two_mul]
  exact
    (Subgroup.rank_closure_finite_le_nat_card _).trans
      ((Set.card_union_le _ _).trans
        (add_le_add ((Finite.card_image_le _).trans (Finite.card_range_le _))
          ((Finite.card_image_le _).trans (Finite.card_range_le _))))
#align rank_closure_commutator_representations_le rank_closureCommutatorRepresentatives_le

theorem image_commutatorSet_closureCommutatorRepresentatives :
    (closureCommutatorRepresentatives G).subtype ''
        commutatorSet (closureCommutatorRepresentatives G) =
      commutatorSet G := by
  apply Set.Subset.antisymm
  · rintro - ⟨-, ⟨g₁, g₂, rfl⟩, rfl⟩
    exact ⟨g₁, g₂, rfl⟩
  · exact fun g hg =>
      ⟨_,
        ⟨⟨_, subset_closure (Or.inl ⟨_, ⟨⟨g, hg⟩, rfl⟩, rfl⟩)⟩,
          ⟨_, subset_closure (Or.inr ⟨_, ⟨⟨g, hg⟩, rfl⟩, rfl⟩)⟩, rfl⟩,
        hg.choose_spec.choose_spec⟩
#align image_commutator_set_closure_commutator_representatives image_commutatorSet_closureCommutatorRepresentatives

theorem card_commutatorSet_closureCommutatorRepresentatives :
    Nat.card (commutatorSet (closureCommutatorRepresentatives G)) = Nat.card (commutatorSet G) := by
  rw [← image_commutatorSet_closureCommutatorRepresentatives G]
  exact Nat.card_congr (Equiv.Set.image _ _ (subtype_injective _))
#align card_commutator_set_closure_commutator_representatives card_commutatorSet_closureCommutatorRepresentatives

theorem card_commutator_closureCommutatorRepresentatives :
    Nat.card (commutator (closureCommutatorRepresentatives G)) = Nat.card (commutator G) := by
  rw [commutator_eq_closure G, ← image_commutatorSet_closureCommutatorRepresentatives, ←
    MonoidHom.map_closure, ← commutator_eq_closure]
  exact Nat.card_congr (Equiv.Set.image _ _ (subtype_injective _))
#align card_commutator_closure_commutator_representatives card_commutator_closureCommutatorRepresentatives

instance [Finite (commutatorSet G)] :
    Finite (commutatorSet (closureCommutatorRepresentatives G)) := by
  apply Nat.finite_of_card_ne_zero
  rw [card_commutatorSet_closureCommutatorRepresentatives]
  exact Finite.card_pos.ne'

end commutatorRepresentatives


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

import data.nat.cast_field
import data.fintype.basic

/-!
# Characteristic zero (additional theorems)

A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered
as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R`
except for the existence of `1` in this file characteristic zero is defined for additive monoids
with `1`.

## Main statements

* Characteristic zero implies that the additive monoid is infinite.
-/

namespace nat
variables {R : Type*} [add_monoid_with_one R] [char_zero R]

/-- `nat.cast` as an embedding into monoids of characteristic `0`. -/
@[simps]
def cast_embedding : ℕ ↪ R := ⟨coe, cast_injective⟩

@[simp] lemma cast_pow_eq_one {R : Type*} [semiring R] [char_zero R] (q : ℕ) (n : ℕ) (hn : n ≠ 0) :
  (q : R) ^ n = 1 ↔ q = 1 :=
by { rw [←cast_pow, cast_eq_one], exact pow_eq_one_iff hn }

@[simp, norm_cast]
theorem cast_div_char_zero {k : Type*} [field k] [char_zero k] {m n : ℕ}
  (n_dvd : n ∣ m) : ((m / n : ℕ) : k) = m / n :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  { exact cast_div n_dvd (cast_ne_zero.2 hn), },
end

end nat

section

variables (M : Type*) [add_monoid_with_one M] [char_zero M]

@[priority 100] -- see Note [lower instance priority]
instance char_zero.infinite : infinite M :=
infinite.of_injective coe nat.cast_injective

variable {M}

@[field_simps] lemma two_ne_zero' : (2:M) ≠ 0 :=
have ((2:ℕ):M) ≠ 0, from nat.cast_ne_zero.2 dec_trivial,
by rwa [nat.cast_two] at this

end

section
variables {R : Type*} [non_assoc_semiring R] [no_zero_divisors R] [char_zero R]

@[simp]
lemma add_self_eq_zero {a : R} : a + a = 0 ↔ a = 0 :=
by simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero', false_or]

@[simp]
lemma bit0_eq_zero {a : R} : bit0 a = 0 ↔ a = 0 := add_self_eq_zero
@[simp]
lemma zero_eq_bit0 {a : R} : 0 = bit0 a ↔ a = 0 :=
by { rw [eq_comm], exact bit0_eq_zero }
end

section
variables {R : Type*} [non_assoc_ring R] [no_zero_divisors R] [char_zero R]

lemma neg_eq_self_iff {a : R} : -a = a ↔ a = 0 :=
neg_eq_iff_add_eq_zero.trans add_self_eq_zero

lemma eq_neg_self_iff {a : R} : a = -a ↔ a = 0 :=
eq_neg_iff_add_eq_zero.trans add_self_eq_zero

lemma nat_mul_inj {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) : n = 0 ∨ a = b :=
begin
  rw [←sub_eq_zero, ←mul_sub, mul_eq_zero, sub_eq_zero] at h,
  exact_mod_cast h,
end

lemma nat_mul_inj' {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) (w : n ≠ 0) : a = b :=
by simpa [w] using nat_mul_inj h

lemma bit0_injective : function.injective (bit0 : R → R) :=
λ a b h, begin
  dsimp [bit0] at h,
  simp only [(two_mul a).symm, (two_mul b).symm] at h,
  refine nat_mul_inj' _ two_ne_zero,
  exact_mod_cast h,
end

lemma bit1_injective : function.injective (bit1 : R → R) :=
λ a b h, begin
  simp only [bit1, add_left_inj] at h,
  exact bit0_injective h,
end

@[simp] lemma bit0_eq_bit0 {a b : R} : bit0 a = bit0 b ↔ a = b :=
bit0_injective.eq_iff

@[simp] lemma bit1_eq_bit1 {a b : R} : bit1 a = bit1 b ↔ a = b :=
bit1_injective.eq_iff

@[simp]
lemma bit1_eq_one {a : R} : bit1 a = 1 ↔ a = 0 :=
by rw [show (1 : R) = bit1 0, by simp, bit1_eq_bit1]

@[simp]
lemma one_eq_bit1 {a : R} : 1 = bit1 a ↔ a = 0 :=
by { rw [eq_comm], exact bit1_eq_one }

end

section
variables {R : Type*} [division_ring R] [char_zero R]

@[simp] lemma half_add_self (a : R) : (a + a) / 2 = a :=
by rw [← mul_two, mul_div_cancel a two_ne_zero']

@[simp] lemma add_halves' (a : R) : a / 2 + a / 2 = a :=
by rw [← add_div, half_add_self]

lemma sub_half (a : R) : a - a / 2 = a / 2 :=
by rw [sub_eq_iff_eq_add, add_halves']

lemma half_sub (a : R) : a / 2 - a = - (a / 2) :=
by rw [← neg_sub, sub_half]

end

namespace with_top

instance {R : Type*} [add_monoid_with_one R] [char_zero R] : char_zero (with_top R) :=
{ cast_injective := λ m n h, by rwa [← coe_nat, ← coe_nat n, coe_eq_coe, nat.cast_inj] at h }

end with_top

section ring_hom

variables {R S : Type*} [non_assoc_semiring R] [non_assoc_semiring S]

lemma ring_hom.char_zero (ϕ : R →+* S) [hS : char_zero S] : char_zero R :=
⟨λ a b h, char_zero.cast_injective (by rw [←map_nat_cast ϕ, ←map_nat_cast ϕ, h])⟩

lemma ring_hom.char_zero_iff {ϕ : R →+* S} (hϕ : function.injective ϕ) :
  char_zero R ↔ char_zero S :=
⟨λ hR, ⟨by introsI a b h; rwa [← @nat.cast_inj R, ← hϕ.eq_iff, map_nat_cast ϕ, map_nat_cast ϕ]⟩,
  λ hS, by exactI ϕ.char_zero⟩

lemma ring_hom.injective_nat (f : ℕ →+* R) [char_zero R] :
  function.injective f :=
subsingleton.elim (nat.cast_ring_hom _) f ▸ nat.cast_injective

end ring_hom


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import geometry.euclidean.basic

/-!
# Inversion in an affine space

In this file we define inversion in a sphere in an affine space. This map sends each point `x` to
the point `y` such that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center
and the radius the sphere.

In many applications, it is convenient to assume that the inversions swaps the center and the point
at infinity. In order to stay in the original affine space, we define the map so that it sends
center to itself.

Currently, we prove only a few basic lemmas needed to prove Ptolemy's inequality, see
`euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist`.
-/

noncomputable theory
open metric real function

namespace euclidean_geometry

variables {V P : Type*} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
  {a b c d x y z : P} {R : ℝ}

include V

/-- Inversion in a sphere in an affine space. This map sends each point `x` to the point `y` such
that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center and the radius the
sphere. -/
def inversion (c : P) (R : ℝ) (x : P) : P := (R / dist x c) ^ 2 • (x -ᵥ c) +ᵥ c

lemma inversion_vsub_center (c : P) (R : ℝ) (x : P) :
  inversion c R x -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c) :=
vadd_vsub _ _

@[simp] lemma inversion_self (c : P) (R : ℝ) : inversion c R c = c := by simp [inversion]

@[simp] lemma inversion_dist_center (c x : P) : inversion c (dist x c) x = x :=
begin
  rcases eq_or_ne x c with rfl|hne,
  { apply inversion_self },
  { rw [inversion, div_self, one_pow, one_smul, vsub_vadd],
    rwa [dist_ne_zero] }
end

lemma inversion_of_mem_sphere (h : x ∈ sphere c R) : inversion c R x = x :=
h.out ▸ inversion_dist_center c x

/-- Distance from the image of a point under inversion to the center. This formula accidentally
works for `x = c`. -/
lemma dist_inversion_center (c x : P) (R : ℝ) : dist (inversion c R x) c = R ^ 2 / dist x c :=
begin
  rcases eq_or_ne x c with (rfl|hx), { simp },
  have : dist x c ≠ 0, from dist_ne_zero.2 hx,
  field_simp [inversion, norm_smul, norm_eq_abs, abs_div, ← dist_eq_norm_vsub, sq, mul_assoc]
end

/-- Distance from the center of an inversion to the image of a point under the inversion. This
formula accidentally works for `x = c`. -/
lemma dist_center_inversion (c x : P) (R : ℝ) : dist c (inversion c R x) = R ^ 2 / dist c x :=
by rw [dist_comm c, dist_comm c, dist_inversion_center]

@[simp] lemma inversion_inversion (c : P) {R : ℝ} (hR : R ≠ 0) (x : P) :
  inversion c R (inversion c R x) = x :=
begin
  rcases eq_or_ne x c with rfl|hne,
  { rw [inversion_self, inversion_self] },
  { rw [inversion, dist_inversion_center, inversion_vsub_center, smul_smul, ← mul_pow,
      div_mul_div_comm, div_mul_cancel _ (dist_ne_zero.2 hne), ← sq, div_self, one_pow, one_smul,
      vsub_vadd],
    exact pow_ne_zero _ hR }
end

lemma inversion_involutive (c : P) {R : ℝ} (hR : R ≠ 0) : involutive (inversion c R) :=
inversion_inversion c hR

lemma inversion_surjective (c : P) {R : ℝ} (hR : R ≠ 0) : surjective (inversion c R) :=
(inversion_involutive c hR).surjective

lemma inversion_injective (c : P) {R : ℝ} (hR : R ≠ 0) : injective (inversion c R) :=
(inversion_involutive c hR).injective

lemma inversion_bijective (c : P) {R : ℝ} (hR : R ≠ 0) : bijective (inversion c R) :=
(inversion_involutive c hR).bijective

/-- Distance between the images of two points under an inversion. -/
lemma dist_inversion_inversion (hx : x ≠ c) (hy : y ≠ c) (R : ℝ) :
  dist (inversion c R x) (inversion c R y) = (R ^ 2 / (dist x c * dist y c)) * dist x y :=
begin
  dunfold inversion,
  simp_rw [dist_vadd_cancel_right, dist_eq_norm_vsub V _ c],
  simpa only [dist_vsub_cancel_right]
    using dist_div_norm_sq_smul (vsub_ne_zero.2 hx) (vsub_ne_zero.2 hy) R
end

/-- **Ptolemy's inequality**: in a quadrangle `ABCD`, `|AC| * |BD| ≤ |AB| * |CD| + |BC| * |AD|`. If
`ABCD` is a convex cyclic polygon, then this inequality becomes an equality, see
`euclidean_geometry.mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`.  -/
lemma mul_dist_le_mul_dist_add_mul_dist (a b c d : P) :
  dist a c * dist b d ≤ dist a b * dist c d + dist b c * dist a d :=
begin
  -- If one of the points `b`, `c`, `d` is equal to `a`, then the inequality is trivial.
  rcases eq_or_ne b a with rfl|hb,
  { rw [dist_self, zero_mul, zero_add] },
  rcases eq_or_ne c a with rfl|hc,
  { rw [dist_self, zero_mul],
    apply_rules [add_nonneg, mul_nonneg, dist_nonneg] },
  rcases eq_or_ne d a with rfl|hd,
  { rw [dist_self, mul_zero, add_zero, dist_comm d, dist_comm d, mul_comm] },
  /- Otherwise, we apply the triangle inequality to `euclidean_geometry.inversion a 1 b`,
  `euclidean_geometry.inversion a 1 c`, and `euclidean_geometry.inversion a 1 d`. -/
  have H := dist_triangle (inversion a 1 b) (inversion a 1 c) (inversion a 1 d),
  rw [dist_inversion_inversion hb hd, dist_inversion_inversion hb hc,
    dist_inversion_inversion hc hd, one_pow] at H,
  rw [← dist_pos] at hb hc hd,
  rw [← div_le_div_right (mul_pos hb (mul_pos hc hd))],
  convert H; { field_simp [hb.ne', hc.ne', hd.ne', dist_comm a], ring }
end

end euclidean_geometry


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

/-!
# Sets in sigma types

This file defines `set.sigma`, the indexed sum of sets.
-/

namespace set
variables {ι ι' : Type*} {α β : ι → Type*} {s s₁ s₂ : set ι} {t t₁ t₂ : Π i, set (α i)}
  {u : set (Σ i, α i)} {x : Σ i, α i} {i : ι} {a : α i}

/-- Indexed sum of sets. `s.sigma t` is the set of dependent pairs `⟨i, a⟩` such that `i ∈ s` and
`a ∈ t i`.-/
protected def sigma (s : set ι) (t : Π i, set (α i)) : set (Σ i, α i) := {x | x.1 ∈ s ∧ x.2 ∈ t x.1}

@[simp] lemma mem_sigma_iff : x ∈ s.sigma t ↔ x.1 ∈ s ∧ x.2 ∈ t x.1 := iff.rfl
@[simp] lemma mk_sigma_iff : (⟨i, a⟩ : Σ i, α i) ∈ s.sigma t ↔ i ∈ s ∧ a ∈ t i := iff.rfl

lemma mk_mem_sigma (hi : i ∈ s) (ha : a ∈ t i) : (⟨i, a⟩ : Σ i, α i) ∈ s.sigma t := ⟨hi, ha⟩

lemma sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.sigma t₁ ⊆ s₂.sigma t₂ :=
λ x hx, ⟨hs hx.1, ht _ hx.2⟩

lemma sigma_subset_iff : s.sigma t ⊆ u ↔ ∀ ⦃i⦄, i ∈ s → ∀ ⦃a⦄, a ∈ t i → (⟨i, a⟩ : Σ i, α i) ∈ u :=
⟨λ h i hi a ha, h $ mk_mem_sigma hi ha, λ h ⟨i, a⟩ ha, h ha.1 ha.2⟩

lemma forall_sigma_iff {p : (Σ i, α i) → Prop} :
  (∀ x ∈ s.sigma t, p x) ↔ ∀ ⦃i⦄, i ∈ s → ∀ ⦃a⦄, a ∈ t i → p ⟨i, a⟩ :=
sigma_subset_iff

lemma exists_sigma_iff {p : (Σ i, α i) → Prop} :
  (∃ x ∈ s.sigma t, p x) ↔ ∃ (i ∈ s) (a ∈ t i), p ⟨i, a⟩ :=
⟨λ ⟨⟨i, a⟩, ha, h⟩, ⟨i, ha.1, a, ha.2, h⟩, λ ⟨i, hi, a, ha, h⟩, ⟨⟨i, a⟩, ⟨hi, ha⟩, h⟩⟩

@[simp] lemma sigma_empty : s.sigma (λ _, (∅ : set (α i))) = ∅ := ext $ λ _, and_false _
@[simp] lemma empty_sigma : (∅ : set ι).sigma t = ∅ := ext $ λ _, false_and _
lemma univ_sigma_univ : (@univ ι).sigma (λ _, @univ (α i)) = univ := ext $ λ _, true_and _
@[simp] lemma sigma_univ : s.sigma (λ _, univ : Π i, set (α i)) = sigma.fst ⁻¹' s :=
ext $ λ _, and_true _

@[simp] lemma singleton_sigma : ({i} : set ι).sigma t = sigma.mk i '' t i :=
ext $ λ x, begin
  split,
  { obtain ⟨j, a⟩ := x,
    rintro ⟨(rfl : j = i), ha⟩,
    exact mem_image_of_mem _ ha },
  { rintro ⟨b, hb, rfl⟩,
    exact ⟨rfl, hb⟩ }
end

@[simp] lemma sigma_singleton {a : Π i, α i} :
  s.sigma (λ i, ({a i} : set (α i))) = (λ i, sigma.mk i $ a i) '' s :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

lemma singleton_sigma_singleton {a : Π i, α i} :
  ({i} : set ι).sigma (λ i, ({a i} : set (α i))) = {⟨i, a i⟩} :=
by rw [sigma_singleton, image_singleton]

@[simp] lemma union_sigma : (s₁ ∪ s₂).sigma t = s₁.sigma t ∪ s₂.sigma t :=
ext $ λ _, or_and_distrib_right

@[simp] lemma sigma_union : s.sigma (λ i, t₁ i ∪ t₂ i) = s.sigma t₁ ∪ s.sigma t₂ :=
ext $ λ _, and_or_distrib_left

lemma sigma_inter_sigma : s₁.sigma t₁ ∩ s₂.sigma t₂ = (s₁ ∩ s₂).sigma (λ i, t₁ i ∩ t₂ i) :=
by { ext ⟨x, y⟩, simp [and_assoc, and.left_comm] }

lemma insert_sigma : (insert i s).sigma t = (sigma.mk i '' t i) ∪ s.sigma t :=
by rw [insert_eq, union_sigma, singleton_sigma]

lemma sigma_insert {a : Π i, α i} :
  s.sigma (λ i, insert (a i) (t i)) = ((λ i, ⟨i, a i⟩) '' s) ∪ s.sigma t :=
by simp_rw [insert_eq, sigma_union, sigma_singleton]

lemma sigma_preimage_eq {f : ι' → ι} {g : Π i, β i → α i} :
  (f ⁻¹' s).sigma (λ i, g (f i) ⁻¹' t (f i)) =
    (λ p : Σ i, β (f i), sigma.mk _ (g _ p.2)) ⁻¹' (s.sigma t) := rfl

lemma sigma_preimage_left {f : ι' → ι} :
  (f ⁻¹' s).sigma (λ i, t (f i)) = (λ p : Σ i, α (f i), sigma.mk _ p.2) ⁻¹' (s.sigma t) := rfl

lemma sigma_preimage_right {g : Π i, β i → α i} :
  s.sigma (λ i, g i ⁻¹' t i) = (λ p : Σ i, β i, sigma.mk p.1 (g _ p.2)) ⁻¹' (s.sigma t) := rfl

lemma preimage_sigma_map_sigma {α' : ι' → Type*} (f : ι → ι') (g : Π i, α i → α' (f i)) (s : set ι')
  (t : Π i, set (α' i)) :
  sigma.map f g ⁻¹' (s.sigma t) = (f ⁻¹' s).sigma (λ i, g i ⁻¹' t (f i)) := rfl

@[simp] lemma mk_preimage_sigma (hi : i ∈ s) : sigma.mk i ⁻¹' s.sigma t = t i :=
ext $ λ _, and_iff_right hi

@[simp] lemma mk_preimage_sigma_eq_empty (hi : i ∉ s) : sigma.mk i ⁻¹' s.sigma t = ∅ :=
ext $ λ _, iff_of_false (hi ∘ and.left) id

lemma mk_preimage_sigma_eq_if [decidable_pred (∈ s)] :
  sigma.mk i ⁻¹' s.sigma t = if i ∈ s then t i else ∅ :=
by split_ifs; simp [h]

lemma mk_preimage_sigma_fn_eq_if {β : Type*} [decidable_pred (∈ s)] (g : β → α i) :
  (λ b, sigma.mk i (g b)) ⁻¹' s.sigma t = if i ∈ s then g ⁻¹' t i else ∅ :=
ext $ λ _, by split_ifs; simp [h]

lemma sigma_univ_range_eq {f : Π i, α i → β i} :
  (univ : set ι).sigma (λ i, range (f i)) = range (λ x : Σ i, α i, ⟨x.1, f _ x.2⟩) :=
ext $ by simp [range]

protected lemma nonempty.sigma :
  s.nonempty → (∀ i, (t i).nonempty) → (s.sigma t : set _).nonempty :=
λ ⟨i, hi⟩ h, let ⟨a, ha⟩ := h i in ⟨⟨i, a⟩, hi, ha⟩

lemma nonempty.sigma_fst : (s.sigma t : set _).nonempty → s.nonempty := λ ⟨x, hx⟩, ⟨x.1, hx.1⟩
lemma nonempty.sigma_snd : (s.sigma t : set _).nonempty → ∃ i ∈ s, (t i).nonempty :=
λ ⟨x, hx⟩, ⟨x.1, hx.1, x.2, hx.2⟩

lemma sigma_nonempty_iff : (s.sigma t : set _).nonempty ↔ ∃ i ∈ s, (t i).nonempty :=
⟨nonempty.sigma_snd, λ ⟨i, hi, a, ha⟩, ⟨⟨i, a⟩, hi, ha⟩⟩

lemma sigma_eq_empty_iff : s.sigma t = ∅ ↔ ∀ i ∈ s, t i = ∅ :=
not_nonempty_iff_eq_empty.symm.trans $ sigma_nonempty_iff.not.trans $
  by simp only [not_nonempty_iff_eq_empty, not_exists]

lemma image_sigma_mk_subset_sigma_left {a : Π i, α i} (ha : ∀ i, a i ∈ t i) :
  (λ i, sigma.mk i (a i)) '' s ⊆ s.sigma t :=
image_subset_iff.2 $ λ i hi, ⟨hi, ha _⟩

lemma image_sigma_mk_subset_sigma_right (hi : i ∈ s) : sigma.mk i '' t i ⊆ s.sigma t :=
image_subset_iff.2 $ λ a, and.intro hi

lemma sigma_subset_preimage_fst (s : set ι) (t : Π i, set (α i)) : s.sigma t ⊆ sigma.fst ⁻¹' s :=
λ a, and.left

lemma fst_image_sigma_subset (s : set ι) (t : Π i, set (α i)) : sigma.fst '' s.sigma t ⊆ s :=
image_subset_iff.2 $ λ a, and.left

lemma fst_image_sigma (s : set ι) (ht : ∀ i, (t i).nonempty) : sigma.fst '' s.sigma t = s :=
(fst_image_sigma_subset _ _).antisymm $ λ i hi, let ⟨a, ha⟩ := ht i in ⟨⟨i, a⟩, ⟨hi, ha⟩, rfl⟩

lemma sigma_diff_sigma : s₁.sigma t₁ \ s₂.sigma t₂ = s₁.sigma (t₁ \ t₂) ∪ (s₁ \ s₂).sigma t₁ :=
ext $ λ x, by by_cases h₁ : x.1 ∈ s₁; by_cases h₂ : x.2 ∈ t₁ x.1; simp [*, ←imp_iff_or_not]

end set


/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import field_theory.abel_ruffini
import analysis.calculus.local_extr
import ring_theory.eisenstein_criterion
/-!
Construction of an algebraic number that is not solvable by radicals.

The main ingredients are:
 * `solvable_by_rad.is_solvable'` in `field_theory/abel_ruffini` :
  an irreducible polynomial with an `is_solvable_by_rad` root has solvable Galois group
 * `gal_action_hom_bijective_of_prime_degree'` in `field_theory/polynomial_galois_group` :
  an irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group
 * `equiv.perm.not_solvable` in `group_theory/solvable` : the symmetric group is not solvable

Then all that remains is the construction of a specific polynomial satisfying the conditions of
`gal_action_hom_bijective_of_prime_degree'`, which is done in this file.

-/

namespace abel_ruffini

open function polynomial polynomial.gal ideal

local attribute [instance] splits_ℚ_ℂ

variables (R : Type*) [comm_ring R] (a b : ℕ)

/-- A quintic polynomial that we will show is irreducible -/
noncomputable def Φ : polynomial R := X ^ 5 - C ↑a * X + C ↑b

variables {R}

@[simp] lemma map_Phi {S : Type*} [comm_ring S] (f : R →+* S) : (Φ R a b).map f = Φ S a b :=
by simp [Φ]

@[simp] lemma coeff_zero_Phi : (Φ R a b).coeff 0 = ↑b :=
by simp [Φ, coeff_X_pow]

@[simp] lemma coeff_five_Phi : (Φ R a b).coeff 5 = 1 :=
by simp [Φ, coeff_X, coeff_C, -C_eq_nat_cast, -ring_hom.map_nat_cast]

variables [nontrivial R]

lemma degree_Phi : (Φ R a b).degree = ↑5 :=
begin
  suffices : degree (X ^ 5 - C ↑a * X) = ↑5,
  { rwa [Φ, degree_add_eq_left_of_degree_lt],
    convert degree_C_le.trans_lt (with_bot.coe_lt_coe.mpr (nat.zero_lt_bit1 2)) },
  rw degree_sub_eq_left_of_degree_lt; rw degree_X_pow,
  exact (degree_C_mul_X_le _).trans_lt (with_bot.coe_lt_coe.mpr (nat.one_lt_bit1 two_ne_zero)),
end

lemma nat_degree_Phi : (Φ R a b).nat_degree = 5 :=
nat_degree_eq_of_degree_eq_some (degree_Phi a b)

lemma leading_coeff_Phi : (Φ R a b).leading_coeff = 1 :=
by rw [polynomial.leading_coeff, nat_degree_Phi, coeff_five_Phi]

lemma monic_Phi : (Φ R a b).monic :=
leading_coeff_Phi a b

lemma irreducible_Phi (p : ℕ) (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) :
  irreducible (Φ ℚ a b) :=
begin
  rw [←map_Phi a b (int.cast_ring_hom ℚ), ←is_primitive.int.irreducible_iff_irreducible_map_cast],
  apply irreducible_of_eisenstein_criterion,
  { rwa [span_singleton_prime (int.coe_nat_ne_zero.mpr hp.ne_zero), int.prime_iff_nat_abs_prime] },
  { rw [leading_coeff_Phi, mem_span_singleton],
    exact_mod_cast mt nat.dvd_one.mp (hp.ne_one) },
  { intros n hn,
    rw mem_span_singleton,
    rw [degree_Phi, with_bot.coe_lt_coe] at hn,
    interval_cases n with hn;
    simp only [Φ, coeff_X_pow, coeff_C, int.coe_nat_dvd.mpr, hpb, if_true, coeff_C_mul, if_false,
      nat.zero_ne_bit1, eq_self_iff_true, coeff_X_zero, hpa, coeff_add, zero_add, mul_zero,
      int.nat_cast_eq_coe_nat, coeff_sub, sub_self, nat.one_ne_zero, add_zero, coeff_X_one, mul_one,
      zero_sub, dvd_neg, nat.one_eq_bit1, bit0_eq_zero, neg_zero, nat.bit0_ne_bit1,
      dvd_mul_of_dvd_left, nat.bit1_eq_bit1, nat.one_ne_bit0, nat.bit1_ne_zero], },
  { simp only [degree_Phi, ←with_bot.coe_zero, with_bot.coe_lt_coe, nat.succ_pos'] },
  { rw [coeff_zero_Phi, span_singleton_pow, mem_span_singleton, int.nat_cast_eq_coe_nat],
    exact mt int.coe_nat_dvd.mp hp2b },
  all_goals { exact monic.is_primitive (monic_Phi a b) },
end

lemma real_roots_Phi_le : fintype.card ((Φ ℚ a b).root_set ℝ) ≤ 3 :=
begin
  rw [←map_Phi a b (algebra_map ℤ ℚ), Φ, ←one_mul (X ^ 5), ←C_1],
  refine (card_root_set_le_derivative _).trans
    (nat.succ_le_succ ((card_root_set_le_derivative _).trans (nat.succ_le_succ _))),
  suffices : ((C ((algebra_map ℤ ℚ) 20) * X ^ 3).root_set ℝ).subsingleton,
  { norm_num [fintype.card_le_one_iff_subsingleton, ← mul_assoc, *] at * },
  rw root_set_C_mul_X_pow; norm_num,
end

lemma real_roots_Phi_ge_aux (hab : b < a) :
  ∃ x y : ℝ, x ≠ y ∧ aeval x (Φ ℚ a b) = 0 ∧ aeval y (Φ ℚ a b) = 0 :=
begin
  let f := λ x : ℝ, aeval x (Φ ℚ a b),
  have hf : f = λ x, x ^ 5 - a * x + b := by simp [f, Φ],
  have hc : ∀ s : set ℝ, continuous_on f s := λ s, (Φ ℚ a b).continuous_on_aeval,
  have ha : (1 : ℝ) ≤ a := nat.one_le_cast.mpr (nat.one_le_of_lt hab),
  have hle : (0 : ℝ) ≤ 1 := zero_le_one,
  have hf0 : 0 ≤ f 0 := by norm_num [hf],
  by_cases hb : (1 : ℝ) - a + b < 0,
  { have hf1 : f 1 < 0 := by norm_num [hf, hb],
    have hfa : 0 ≤ f a,
    { simp_rw [hf, ←sq],
      refine add_nonneg (sub_nonneg.mpr (pow_le_pow ha _)) _; norm_num },
    obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Ico' hle (hc _) (set.mem_Ioc.mpr ⟨hf1, hf0⟩),
    obtain ⟨y, ⟨hy1, -⟩, hy2⟩ := intermediate_value_Ioc ha (hc _) (set.mem_Ioc.mpr ⟨hf1, hfa⟩),
    exact ⟨x, y, (hx1.trans hy1).ne, hx2, hy2⟩ },
  { replace hb : (b : ℝ) = a - 1 := by linarith [show (b : ℝ) + 1 ≤ a, by exact_mod_cast hab],
    have hf1 : f 1 = 0 := by norm_num [hf, hb],
    have hfa := calc f (-a) = a ^ 2 - a ^ 5 + b       : by norm_num [hf, ← sq]
                        ... ≤ a ^ 2 - a ^ 3 + (a - 1) : by refine add_le_add (sub_le_sub_left
                                                            (pow_le_pow ha _) _) _; linarith
                        ... = -(a - 1) ^ 2 * (a + 1)  : by ring
                        ... ≤ 0                       : by nlinarith,
    have ha' := neg_nonpos.mpr (hle.trans ha),
    obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Icc ha' (hc _) (set.mem_Icc.mpr ⟨hfa, hf0⟩),
    exact ⟨x, 1, (hx1.trans_lt zero_lt_one).ne, hx2, hf1⟩ },
end

lemma real_roots_Phi_ge (hab : b < a) : 2 ≤ fintype.card ((Φ ℚ a b).root_set ℝ) :=
begin
  have q_ne_zero : Φ ℚ a b ≠ 0 := (monic_Phi a b).ne_zero,
  obtain ⟨x, y, hxy, hx, hy⟩ := real_roots_Phi_ge_aux a b hab,
  have key : ↑({x, y} : finset ℝ) ⊆ (Φ ℚ a b).root_set ℝ,
  { simp [set.insert_subset, mem_root_set q_ne_zero, hx, hy] },
  convert fintype.card_le_of_embedding (set.embedding_of_subset _ _ key),
  simp only [finset.coe_sort_coe, fintype.card_coe, finset.card_singleton,
             finset.card_insert_of_not_mem (mt finset.mem_singleton.mp hxy)]
end

lemma complex_roots_Phi (h : (Φ ℚ a b).separable) : fintype.card ((Φ ℚ a b).root_set ℂ) = 5 :=
(card_root_set_eq_nat_degree h (is_alg_closed.splits_codomain _)).trans (nat_degree_Phi a b)

lemma gal_Phi (hab : b < a) (h_irred : irreducible (Φ ℚ a b)) :
  bijective (gal_action_hom (Φ ℚ a b) ℂ) :=
begin
  apply gal_action_hom_bijective_of_prime_degree' h_irred,
  { norm_num [nat_degree_Phi] },
  { rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff],
    exact (real_roots_Phi_le a b).trans (nat.le_succ 3) },
  { simp_rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff],
    exact real_roots_Phi_ge a b hab },
end

theorem not_solvable_by_rad (p : ℕ) (x : ℂ) (hx : aeval x (Φ ℚ a b) = 0) (hab : b < a)
  (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) :
  ¬ is_solvable_by_rad ℚ x :=
begin
  have h_irred := irreducible_Phi a b p hp hpa hpb hp2b,
  apply mt (solvable_by_rad.is_solvable' h_irred hx),
  introI h,
  refine equiv.perm.not_solvable _ (le_of_eq _)
    (solvable_of_surjective (gal_Phi a b hab h_irred).2),
  rw_mod_cast [cardinal.mk_fintype, complex_roots_Phi a b h_irred.separable],
end

theorem not_solvable_by_rad' (x : ℂ) (hx : aeval x (Φ ℚ 4 2) = 0) :
  ¬ is_solvable_by_rad ℚ x :=
by apply not_solvable_by_rad 4 2 2 x hx; norm_num

/-- **Abel-Ruffini Theorem** -/
theorem exists_not_solvable_by_rad : ∃ x : ℂ, is_algebraic ℚ x ∧ ¬ is_solvable_by_rad ℚ x :=
begin
  obtain ⟨x, hx⟩ := exists_root_of_splits (algebra_map ℚ ℂ)
    (is_alg_closed.splits_codomain (Φ ℚ 4 2))
    (ne_of_eq_of_ne (degree_Phi 4 2) (mt with_bot.coe_eq_coe.mp (nat.bit1_ne_zero 2))),
  exact ⟨x, ⟨Φ ℚ 4 2, (monic_Phi 4 2).ne_zero, hx⟩, not_solvable_by_rad' x hx⟩,
end

end abel_ruffini


/-
Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz

! This file was ported from Lean 3 source module field_theory.polynomial_galois_group
! leanprover-community/mathlib commit 117e93f82b5f959f8193857370109935291f0cc4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.Polynomial
import Mathbin.FieldTheory.Galois
import Mathbin.GroupTheory.Perm.Cycle.Type

/-!
# Galois Groups of Polynomials

In this file, we introduce the Galois group of a polynomial `p` over a field `F`,
defined as the automorphism group of its splitting field. We also provide
some results about some extension `E` above `p.splitting_field`, and some specific
results about the Galois groups of ℚ-polynomials with specific numbers of non-real roots.

## Main definitions

- `polynomial.gal p`: the Galois group of a polynomial p.
- `polynomial.gal.restrict p E`: the restriction homomorphism `(E ≃ₐ[F] E) → gal p`.
- `polynomial.gal.gal_action p E`: the action of `gal p` on the roots of `p` in `E`.

## Main results

- `polynomial.gal.restrict_smul`: `restrict p E` is compatible with `gal_action p E`.
- `polynomial.gal.gal_action_hom_injective`: `gal p` acting on the roots of `p` in `E` is faithful.
- `polynomial.gal.restrict_prod_injective`: `gal (p * q)` embeds as a subgroup of `gal p × gal q`.
- `polynomial.gal.card_of_separable`: For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`.
- `polynomial.gal.gal_action_hom_bijective_of_prime_degree`:
An irreducible polynomial of prime degree with two non-real roots has full Galois group.

## Other results
- `polynomial.gal.card_complex_roots_eq_card_real_add_card_not_gal_inv`: The number of complex roots
equals the number of real roots plus the number of roots not fixed by complex conjugation
(i.e. with some imaginary component).

-/

noncomputable section

open Classical Polynomial

open FiniteDimensional

namespace Polynomial

variable {F : Type _} [Field F] (p q : F[X]) (E : Type _) [Field E] [Algebra F E]

/-- The Galois group of a polynomial. -/
def Gal :=
  p.SplittingField ≃ₐ[F] p.SplittingField deriving Group, Fintype
#align polynomial.gal Polynomial.Gal

namespace Gal

instance : CoeFun p.Gal fun _ => p.SplittingField → p.SplittingField :=
  AlgEquiv.hasCoeToFun

instance applyMulSemiringAction : MulSemiringAction p.Gal p.SplittingField :=
  AlgEquiv.applyMulSemiringAction
#align polynomial.gal.apply_mul_semiring_action Polynomial.Gal.applyMulSemiringAction

@[ext]
theorem ext {σ τ : p.Gal} (h : ∀ x ∈ p.rootSet p.SplittingField, σ x = τ x) : σ = τ :=
  by
  refine'
    AlgEquiv.ext fun x =>
      (AlgHom.mem_equalizer σ.to_alg_hom τ.to_alg_hom x).mp
        ((set_like.ext_iff.mp _ x).mpr Algebra.mem_top)
  rwa [eq_top_iff, ← splitting_field.adjoin_roots, Algebra.adjoin_le_iff]
#align polynomial.gal.ext Polynomial.Gal.ext

/-- If `p` splits in `F` then the `p.gal` is trivial. -/
def uniqueGalOfSplits (h : p.Splits (RingHom.id F)) : Unique p.Gal
    where
  default := 1
  uniq f :=
    AlgEquiv.ext fun x =>
      by
      obtain ⟨y, rfl⟩ :=
        algebra.mem_bot.mp
          ((set_like.ext_iff.mp ((is_splitting_field.splits_iff _ p).mp h) x).mp Algebra.mem_top)
      rw [AlgEquiv.commutes, AlgEquiv.commutes]
#align polynomial.gal.unique_gal_of_splits Polynomial.Gal.uniqueGalOfSplits

instance [h : Fact (p.Splits (RingHom.id F))] : Unique p.Gal :=
  uniqueGalOfSplits _ h.1

instance uniqueGalZero : Unique (0 : F[X]).Gal :=
  uniqueGalOfSplits _ (splits_zero _)
#align polynomial.gal.unique_gal_zero Polynomial.Gal.uniqueGalZero

instance uniqueGalOne : Unique (1 : F[X]).Gal :=
  uniqueGalOfSplits _ (splits_one _)
#align polynomial.gal.unique_gal_one Polynomial.Gal.uniqueGalOne

instance uniqueGalC (x : F) : Unique (C x).Gal :=
  uniqueGalOfSplits _ (splits_C _ _)
#align polynomial.gal.unique_gal_C Polynomial.Gal.uniqueGalC

instance uniqueGalX : Unique (X : F[X]).Gal :=
  uniqueGalOfSplits _ (splits_X _)
#align polynomial.gal.unique_gal_X Polynomial.Gal.uniqueGalX

instance uniqueGalXSubC (x : F) : Unique (X - C x).Gal :=
  uniqueGalOfSplits _ (splits_X_sub_C _)
#align polynomial.gal.unique_gal_X_sub_C Polynomial.Gal.uniqueGalXSubC

instance uniqueGalXPow (n : ℕ) : Unique (X ^ n : F[X]).Gal :=
  uniqueGalOfSplits _ (splits_X_pow _ _)
#align polynomial.gal.unique_gal_X_pow Polynomial.Gal.uniqueGalXPow

instance [h : Fact (p.Splits (algebraMap F E))] : Algebra p.SplittingField E :=
  (IsSplittingField.lift p.SplittingField p h.1).toRingHom.toAlgebra

instance [h : Fact (p.Splits (algebraMap F E))] : IsScalarTower F p.SplittingField E :=
  IsScalarTower.of_algebraMap_eq fun x =>
    ((IsSplittingField.lift p.SplittingField p h.1).commutes x).symm

-- The `algebra p.splitting_field E` instance above behaves badly when
-- `E := p.splitting_field`, since it may result in a unification problem
-- `is_splitting_field.lift.to_ring_hom.to_algebra =?= algebra.id`,
-- which takes an extremely long time to resolve, causing timeouts.
-- Since we don't really care about this definition, marking it as irreducible
-- causes that unification to error out early.
/-- Restrict from a superfield automorphism into a member of `gal p`. -/
def restrict [Fact (p.Splits (algebraMap F E))] : (E ≃ₐ[F] E) →* p.Gal :=
  AlgEquiv.restrictNormalHom p.SplittingField
#align polynomial.gal.restrict Polynomial.Gal.restrict

theorem restrict_surjective [Fact (p.Splits (algebraMap F E))] [Normal F E] :
    Function.Surjective (restrict p E) :=
  AlgEquiv.restrictNormalHom_surjective E
#align polynomial.gal.restrict_surjective Polynomial.Gal.restrict_surjective

section RootsAction

/-- The function taking `roots p p.splitting_field` to `roots p E`. This is actually a bijection,
see `polynomial.gal.map_roots_bijective`. -/
def mapRoots [Fact (p.Splits (algebraMap F E))] : rootSet p p.SplittingField → rootSet p E :=
  Set.MapsTo.restrict (IsScalarTower.toAlgHom F p.SplittingField E) _ _ <| rootSet_mapsTo _
#align polynomial.gal.map_roots Polynomial.Gal.mapRoots

theorem mapRoots_bijective [h : Fact (p.Splits (algebraMap F E))] :
    Function.Bijective (mapRoots p E) := by
  constructor
  · exact fun _ _ h => Subtype.ext (RingHom.injective _ (subtype.ext_iff.mp h))
  · intro y
    -- this is just an equality of two different ways to write the roots of `p` as an `E`-polynomial
    have key :=
      roots_map (IsScalarTower.toAlgHom F p.splitting_field E : p.splitting_field →+* E)
        ((splits_id_iff_splits _).mpr (is_splitting_field.splits p.splitting_field p))
    rw [map_map, AlgHom.comp_algebraMap] at key
    have hy := Subtype.mem y
    simp only [root_set, Finset.mem_coe, Multiset.mem_toFinset, key, Multiset.mem_map] at hy
    rcases hy with ⟨x, hx1, hx2⟩
    exact ⟨⟨x, multiset.mem_to_finset.mpr hx1⟩, Subtype.ext hx2⟩
#align polynomial.gal.map_roots_bijective Polynomial.Gal.mapRoots_bijective

/-- The bijection between `root_set p p.splitting_field` and `root_set p E`. -/
def rootsEquivRoots [Fact (p.Splits (algebraMap F E))] : rootSet p p.SplittingField ≃ rootSet p E :=
  Equiv.ofBijective (mapRoots p E) (mapRoots_bijective p E)
#align polynomial.gal.roots_equiv_roots Polynomial.Gal.rootsEquivRoots

instance galActionAux : MulAction p.Gal (rootSet p p.SplittingField)
    where
  smul ϕ := Set.MapsTo.restrict ϕ _ _ <| rootSet_mapsTo ϕ.toAlgHom
  one_smul _ := by
    ext
    rfl
  mul_smul _ _ _ := by
    ext
    rfl
#align polynomial.gal.gal_action_aux Polynomial.Gal.galActionAux

/-- The action of `gal p` on the roots of `p` in `E`. -/
instance galAction [Fact (p.Splits (algebraMap F E))] : MulAction p.Gal (rootSet p E)
    where
  smul ϕ x := rootsEquivRoots p E (ϕ • (rootsEquivRoots p E).symm x)
  one_smul _ := by simp only [Equiv.apply_symm_apply, one_smul]
  mul_smul _ _ _ := by simp only [Equiv.apply_symm_apply, Equiv.symm_apply_apply, mul_smul]
#align polynomial.gal.gal_action Polynomial.Gal.galAction

variable {p E}

/-- `polynomial.gal.restrict p E` is compatible with `polynomial.gal.gal_action p E`. -/
@[simp]
theorem restrict_smul [Fact (p.Splits (algebraMap F E))] (ϕ : E ≃ₐ[F] E) (x : rootSet p E) :
    ↑(restrict p E ϕ • x) = ϕ x :=
  by
  let ψ := AlgEquiv.ofInjectiveField (IsScalarTower.toAlgHom F p.splitting_field E)
  change ↑(ψ (ψ.symm _)) = ϕ x
  rw [AlgEquiv.apply_symm_apply ψ]
  change ϕ (roots_equiv_roots p E ((roots_equiv_roots p E).symm x)) = ϕ x
  rw [Equiv.apply_symm_apply (roots_equiv_roots p E)]
#align polynomial.gal.restrict_smul Polynomial.Gal.restrict_smul

variable (p E)

/-- `polynomial.gal.gal_action` as a permutation representation -/
def galActionHom [Fact (p.Splits (algebraMap F E))] : p.Gal →* Equiv.Perm (rootSet p E) :=
  MulAction.toPermHom _ _
#align polynomial.gal.gal_action_hom Polynomial.Gal.galActionHom

theorem galActionHom_restrict [Fact (p.Splits (algebraMap F E))] (ϕ : E ≃ₐ[F] E) (x : rootSet p E) :
    ↑(galActionHom p E (restrict p E ϕ) x) = ϕ x :=
  restrict_smul ϕ x
#align polynomial.gal.gal_action_hom_restrict Polynomial.Gal.galActionHom_restrict

/-- `gal p` embeds as a subgroup of permutations of the roots of `p` in `E`. -/
theorem galActionHom_injective [Fact (p.Splits (algebraMap F E))] :
    Function.Injective (galActionHom p E) :=
  by
  rw [injective_iff_map_eq_one]
  intro ϕ hϕ
  ext (x hx)
  have key := equiv.perm.ext_iff.mp hϕ (roots_equiv_roots p E ⟨x, hx⟩)
  change
    roots_equiv_roots p E (ϕ • (roots_equiv_roots p E).symm (roots_equiv_roots p E ⟨x, hx⟩)) =
      roots_equiv_roots p E ⟨x, hx⟩ at
    key
  rw [Equiv.symm_apply_apply] at key
  exact subtype.ext_iff.mp (Equiv.injective (roots_equiv_roots p E) key)
#align polynomial.gal.gal_action_hom_injective Polynomial.Gal.galActionHom_injective

end RootsAction

variable {p q}

/-- `polynomial.gal.restrict`, when both fields are splitting fields of polynomials. -/
def restrictDvd (hpq : p ∣ q) : q.Gal →* p.Gal :=
  if hq : q = 0 then 1
  else
    @restrict F _ p _ _ _
      ⟨splits_of_splits_of_dvd (algebraMap F q.SplittingField) hq (SplittingField.splits q) hpq⟩
#align polynomial.gal.restrict_dvd Polynomial.Gal.restrictDvd

theorem restrictDvd_surjective (hpq : p ∣ q) (hq : q ≠ 0) : Function.Surjective (restrictDvd hpq) :=
  by simp only [restrict_dvd, dif_neg hq, restrict_surjective]
#align polynomial.gal.restrict_dvd_surjective Polynomial.Gal.restrictDvd_surjective

variable (p q)

/-- The Galois group of a product maps into the product of the Galois groups.  -/
def restrictProd : (p * q).Gal →* p.Gal × q.Gal :=
  MonoidHom.prod (restrictDvd (dvd_mul_right p q)) (restrictDvd (dvd_mul_left q p))
#align polynomial.gal.restrict_prod Polynomial.Gal.restrictProd

/-- `polynomial.gal.restrict_prod` is actually a subgroup embedding. -/
theorem restrictProd_injective : Function.Injective (restrictProd p q) :=
  by
  by_cases hpq : p * q = 0
  · have : Unique (p * q).Gal := by
      rw [hpq]
      infer_instance
    exact fun f g h => Eq.trans (Unique.eq_default f) (Unique.eq_default g).symm
  intro f g hfg
  dsimp only [restrict_prod, restrict_dvd] at hfg
  simp only [dif_neg hpq, MonoidHom.prod_apply, Prod.mk.inj_iff] at hfg
  ext (x hx)
  rw [root_set, Polynomial.map_mul, Polynomial.roots_mul] at hx
  cases' multiset.mem_add.mp (multiset.mem_to_finset.mp hx) with h h
  · haveI : Fact (p.splits (algebraMap F (p * q).SplittingField)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_right p q)⟩
    have key :
      x =
        algebraMap p.splitting_field (p * q).SplittingField
          ((roots_equiv_roots p _).invFun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (Equiv.apply_symm_apply (roots_equiv_roots p _) ⟨x, _⟩).symm
    rw [key, ← AlgEquiv.restrictNormal_commutes, ← AlgEquiv.restrictNormal_commutes]
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.1 _)
  · haveI : Fact (q.splits (algebraMap F (p * q).SplittingField)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_left q p)⟩
    have key :
      x =
        algebraMap q.splitting_field (p * q).SplittingField
          ((roots_equiv_roots q _).invFun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (Equiv.apply_symm_apply (roots_equiv_roots q _) ⟨x, _⟩).symm
    rw [key, ← AlgEquiv.restrictNormal_commutes, ← AlgEquiv.restrictNormal_commutes]
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.2 _)
  · rwa [Ne.def, mul_eq_zero, map_eq_zero, map_eq_zero, ← mul_eq_zero]
#align polynomial.gal.restrict_prod_injective Polynomial.Gal.restrictProd_injective

theorem mul_splits_in_splittingField_of_mul {p₁ q₁ p₂ q₂ : F[X]} (hq₁ : q₁ ≠ 0) (hq₂ : q₂ ≠ 0)
    (h₁ : p₁.Splits (algebraMap F q₁.SplittingField))
    (h₂ : p₂.Splits (algebraMap F q₂.SplittingField)) :
    (p₁ * p₂).Splits (algebraMap F (q₁ * q₂).SplittingField) :=
  by
  apply splits_mul
  · rw [←
      (splitting_field.lift q₁
          (splits_of_splits_of_dvd _ (mul_ne_zero hq₁ hq₂) (splitting_field.splits _)
            (dvd_mul_right q₁ q₂))).comp_algebraMap]
    exact splits_comp_of_splits _ _ h₁
  · rw [←
      (splitting_field.lift q₂
          (splits_of_splits_of_dvd _ (mul_ne_zero hq₁ hq₂) (splitting_field.splits _)
            (dvd_mul_left q₂ q₁))).comp_algebraMap]
    exact splits_comp_of_splits _ _ h₂
#align polynomial.gal.mul_splits_in_splitting_field_of_mul Polynomial.Gal.mul_splits_in_splittingField_of_mul

/-- `p` splits in the splitting field of `p ∘ q`, for `q` non-constant. -/
theorem splits_in_splittingField_of_comp (hq : q.natDegree ≠ 0) :
    p.Splits (algebraMap F (p.comp q).SplittingField) :=
  by
  let P : F[X] → Prop := fun r => r.Splits (algebraMap F (r.comp q).SplittingField)
  have key1 : ∀ {r : F[X]}, Irreducible r → P r :=
    by
    intro r hr
    by_cases hr' : nat_degree r = 0
    · exact splits_of_nat_degree_le_one _ (le_trans (le_of_eq hr') zero_le_one)
    obtain ⟨x, hx⟩ :=
      exists_root_of_splits _ (splitting_field.splits (r.comp q)) fun h =>
        hr'
          ((mul_eq_zero.mp
                (nat_degree_comp.symm.trans (nat_degree_eq_of_degree_eq_some h))).resolve_right
            hq)
    rw [← aeval_def, aeval_comp] at hx
    have h_normal : Normal F (r.comp q).SplittingField := splitting_field.normal (r.comp q)
    have qx_int := Normal.isIntegral h_normal (aeval x q)
    exact
      splits_of_splits_of_dvd _ (minpoly.ne_zero qx_int) (Normal.splits h_normal _)
        ((minpoly.irreducible qx_int).dvd_symm hr (minpoly.dvd F _ hx))
  have key2 : ∀ {p₁ p₂ : F[X]}, P p₁ → P p₂ → P (p₁ * p₂) :=
    by
    intro p₁ p₂ hp₁ hp₂
    by_cases h₁ : p₁.comp q = 0
    · cases' comp_eq_zero_iff.mp h₁ with h h
      · rw [h, MulZeroClass.zero_mul]
        exact splits_zero _
      · exact False.ndrec _ (hq (by rw [h.2, nat_degree_C]))
    by_cases h₂ : p₂.comp q = 0
    · cases' comp_eq_zero_iff.mp h₂ with h h
      · rw [h, MulZeroClass.mul_zero]
        exact splits_zero _
      · exact False.ndrec _ (hq (by rw [h.2, nat_degree_C]))
    have key := mul_splits_in_splitting_field_of_mul h₁ h₂ hp₁ hp₂
    rwa [← mul_comp] at key
  exact
    WfDvdMonoid.induction_on_irreducible p (splits_zero _) (fun _ => splits_of_is_unit _)
      fun _ _ _ h => key2 (key1 h)
#align polynomial.gal.splits_in_splitting_field_of_comp Polynomial.Gal.splits_in_splittingField_of_comp

/-- `polynomial.gal.restrict` for the composition of polynomials. -/
def restrictComp (hq : q.natDegree ≠ 0) : (p.comp q).Gal →* p.Gal :=
  @restrict F _ p _ _ _ ⟨splits_in_splittingField_of_comp p q hq⟩
#align polynomial.gal.restrict_comp Polynomial.Gal.restrictComp

theorem restrictComp_surjective (hq : q.natDegree ≠ 0) :
    Function.Surjective (restrictComp p q hq) := by simp only [restrict_comp, restrict_surjective]
#align polynomial.gal.restrict_comp_surjective Polynomial.Gal.restrictComp_surjective

variable {p q}

/-- For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`. -/
theorem card_of_separable (hp : p.Separable) : Fintype.card p.Gal = finrank F p.SplittingField :=
  haveI : IsGalois F p.splitting_field := IsGalois.of_separable_splitting_field hp
  IsGalois.card_aut_eq_finrank F p.splitting_field
#align polynomial.gal.card_of_separable Polynomial.Gal.card_of_separable

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem prime_degree_dvd_card [CharZero F] (p_irr : Irreducible p) (p_deg : p.natDegree.Prime) :
    p.natDegree ∣ Fintype.card p.Gal :=
  by
  rw [gal.card_of_separable p_irr.separable]
  have hp : p.degree ≠ 0 := fun h =>
    Nat.Prime.ne_zero p_deg (nat_degree_eq_zero_iff_degree_le_zero.mpr (le_of_eq h))
  let α : p.splitting_field :=
    root_of_splits (algebraMap F p.splitting_field) (splitting_field.splits p) hp
  have hα : IsIntegral F α := Algebra.isIntegral_of_finite _ _ α
  use FiniteDimensional.finrank F⟮⟯ p.splitting_field
  suffices (minpoly F α).natDegree = p.nat_degree by
    rw [← FiniteDimensional.finrank_mul_finrank F F⟮⟯ p.splitting_field,
      IntermediateField.adjoin.finrank hα, this]
  suffices minpoly F α ∣ p
    by
    have key := (minpoly.irreducible hα).dvd_symm p_irr this
    apply le_antisymm
    · exact nat_degree_le_of_dvd this p_irr.ne_zero
    · exact nat_degree_le_of_dvd key (minpoly.ne_zero hα)
  apply minpoly.dvd F α
  rw [aeval_def, map_root_of_splits _ (splitting_field.splits p) hp]
#align polynomial.gal.prime_degree_dvd_card Polynomial.Gal.prime_degree_dvd_card

section Rationals

theorem splits_ℚ_ℂ {p : ℚ[X]} : Fact (p.Splits (algebraMap ℚ ℂ)) :=
  ⟨IsAlgClosed.splits_codomain p⟩
#align polynomial.gal.splits_ℚ_ℂ Polynomial.Gal.splits_ℚ_ℂ

attribute [local instance] splits_ℚ_ℂ

/-- The number of complex roots equals the number of real roots plus
    the number of roots not fixed by complex conjugation (i.e. with some imaginary component). -/
theorem card_complex_roots_eq_card_real_add_card_not_gal_inv (p : ℚ[X]) :
    (p.rootSet ℂ).toFinset.card =
      (p.rootSet ℝ).toFinset.card +
        (galActionHom p ℂ (restrict p ℂ (Complex.conjAe.restrictScalars ℚ))).support.card :=
  by
  by_cases hp : p = 0
  · haveI : IsEmpty (p.root_set ℂ) := by
      rw [hp, root_set_zero]
      infer_instance
    simp_rw [(gal_action_hom p ℂ _).support.eq_empty_of_isEmpty, hp, root_set_zero,
      Set.toFinset_empty, Finset.card_empty]
  have inj : Function.Injective (IsScalarTower.toAlgHom ℚ ℝ ℂ) := (algebraMap ℝ ℂ).Injective
  rw [← Finset.card_image_of_injective _ Subtype.coe_injective, ←
    Finset.card_image_of_injective _ inj]
  let a : Finset ℂ := _
  let b : Finset ℂ := _
  let c : Finset ℂ := _
  change a.card = b.card + c.card
  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0 := by
    intro z
    rw [Set.mem_toFinset, mem_root_set_of_ne hp]
    infer_instance
  have hb : ∀ z : ℂ, z ∈ b ↔ aeval z p = 0 ∧ z.im = 0 :=
    by
    intro z
    simp_rw [Finset.mem_image, exists_prop, Set.mem_toFinset, mem_root_set_of_ne hp]
    constructor
    · rintro ⟨w, hw, rfl⟩
      exact ⟨by rw [aeval_alg_hom_apply, hw, AlgHom.map_zero], rfl⟩
    · rintro ⟨hz1, hz2⟩
      have key : IsScalarTower.toAlgHom ℚ ℝ ℂ z.re = z :=
        by
        ext
        rfl
        rw [hz2]
        rfl
      exact ⟨z.re, inj (by rwa [← aeval_alg_hom_apply, key, AlgHom.map_zero]), key⟩
  have hc0 :
    ∀ w : p.root_set ℂ,
      gal_action_hom p ℂ (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ)) w = w ↔ w.val.im = 0 :=
    by
    intro w
    rw [Subtype.ext_iff, gal_action_hom_restrict]
    exact Complex.eq_conj_iff_im
  have hc : ∀ z : ℂ, z ∈ c ↔ aeval z p = 0 ∧ z.im ≠ 0 :=
    by
    intro z
    simp_rw [Finset.mem_image, exists_prop]
    constructor
    · rintro ⟨w, hw, rfl⟩
      exact ⟨(mem_root_set.mp w.2).2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩
    · rintro ⟨hz1, hz2⟩
      exact ⟨⟨z, mem_root_set.mpr ⟨hp, hz1⟩⟩, equiv.perm.mem_support.mpr (mt (hc0 _).mp hz2), rfl⟩
  rw [← Finset.card_disjoint_union]
  · apply congr_arg Finset.card
    simp_rw [Finset.ext_iff, Finset.mem_union, ha, hb, hc]
    tauto
  · rw [Finset.disjoint_left]
    intro z
    rw [hb, hc]
    tauto
  · infer_instance
#align polynomial.gal.card_complex_roots_eq_card_real_add_card_not_gal_inv Polynomial.Gal.card_complex_roots_eq_card_real_add_card_not_gal_inv

/-- An irreducible polynomial of prime degree with two non-real roots has full Galois group. -/
theorem galActionHom_bijective_of_prime_degree {p : ℚ[X]} (p_irr : Irreducible p)
    (p_deg : p.natDegree.Prime)
    (p_roots : Fintype.card (p.rootSet ℂ) = Fintype.card (p.rootSet ℝ) + 2) :
    Function.Bijective (galActionHom p ℂ) :=
  by
  have h1 : Fintype.card (p.root_set ℂ) = p.nat_degree :=
    by
    simp_rw [root_set_def, Finset.coe_sort_coe, Fintype.card_coe]
    rw [Multiset.toFinset_card_of_nodup, ← nat_degree_eq_card_roots]
    · exact IsAlgClosed.splits_codomain p
    · exact nodup_roots ((separable_map (algebraMap ℚ ℂ)).mpr p_irr.separable)
  have h2 : Fintype.card p.gal = Fintype.card (gal_action_hom p ℂ).range :=
    Fintype.card_congr (MonoidHom.ofInjective (gal_action_hom_injective p ℂ)).toEquiv
  let conj := restrict p ℂ (complex.conj_ae.restrict_scalars ℚ)
  refine'
    ⟨gal_action_hom_injective p ℂ, fun x =>
      (congr_arg (Membership.Mem x) (show (gal_action_hom p ℂ).range = ⊤ from _)).mpr
        (Subgroup.mem_top x)⟩
  apply Equiv.Perm.subgroup_eq_top_of_swap_mem
  · rwa [h1]
  · rw [h1]
    convert prime_degree_dvd_card p_irr p_deg using 1
    convert h2.symm
  · exact ⟨conj, rfl⟩
  · rw [← Equiv.Perm.card_support_eq_two]
    apply Nat.add_left_cancel
    rw [← p_roots, ← Set.toFinset_card (root_set p ℝ), ← Set.toFinset_card (root_set p ℂ)]
    exact (card_complex_roots_eq_card_real_add_card_not_gal_inv p).symm
#align polynomial.gal.gal_action_hom_bijective_of_prime_degree Polynomial.Gal.galActionHom_bijective_of_prime_degree

/-- An irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group. -/
theorem galActionHom_bijective_of_prime_degree' {p : ℚ[X]} (p_irr : Irreducible p)
    (p_deg : p.natDegree.Prime)
    (p_roots1 : Fintype.card (p.rootSet ℝ) + 1 ≤ Fintype.card (p.rootSet ℂ))
    (p_roots2 : Fintype.card (p.rootSet ℂ) ≤ Fintype.card (p.rootSet ℝ) + 3) :
    Function.Bijective (galActionHom p ℂ) :=
  by
  apply gal_action_hom_bijective_of_prime_degree p_irr p_deg
  let n := (gal_action_hom p ℂ (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ))).support.card
  have hn : 2 ∣ n :=
    Equiv.Perm.two_dvd_card_support
      (by
        rw [← MonoidHom.map_pow, ← MonoidHom.map_pow,
          show AlgEquiv.restrictScalars ℚ Complex.conjAe ^ 2 = 1 from
            AlgEquiv.ext Complex.conj_conj,
          MonoidHom.map_one, MonoidHom.map_one])
  have key := card_complex_roots_eq_card_real_add_card_not_gal_inv p
  simp_rw [Set.toFinset_card] at key
  rw [key, add_le_add_iff_left] at p_roots1 p_roots2
  rw [key, add_right_inj]
  suffices ∀ m : ℕ, 2 ∣ m → 1 ≤ m → m ≤ 3 → m = 2 by exact this n hn p_roots1 p_roots2
  rintro m ⟨k, rfl⟩ h2 h3
  exact
    le_antisymm
      (nat.lt_succ_iff.mp
        (lt_of_le_of_ne h3 (show 2 * k ≠ 2 * 1 + 1 from Nat.two_mul_ne_two_mul_add_one)))
      (nat.succ_le_iff.mpr
        (lt_of_le_of_ne h2 (show 2 * 0 + 1 ≠ 2 * k from nat.two_mul_ne_two_mul_add_one.symm)))
#align polynomial.gal.gal_action_hom_bijective_of_prime_degree' Polynomial.Gal.galActionHom_bijective_of_prime_degree'

end Rationals

end Gal

end Polynomial


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.basic
import Mathlib.data.multiset.intervals
import Mathlib.PostPort

namespace Mathlib

/-!
# Intervals in ℕ as finsets

For now this only covers `Ico n m`, the "closed-open" interval containing `[n, ..., m-1]`.
-/

namespace finset

/-! ### intervals -/

/- Ico (a closed open interval) -/

/-- `Ico n m` is the set of natural numbers `n ≤ k < m`. -/
def Ico (n : ℕ) (m : ℕ) : finset ℕ := mk (multiset.Ico n m) (multiset.Ico.nodup n m)

namespace Ico

@[simp] theorem val (n : ℕ) (m : ℕ) : val (Ico n m) = multiset.Ico n m := rfl

@[simp] theorem to_finset (n : ℕ) (m : ℕ) : multiset.to_finset (multiset.Ico n m) = Ico n m :=
  Eq.symm (multiset.to_finset_eq (multiset.Ico.nodup n m))

theorem image_add (n : ℕ) (m : ℕ) (k : ℕ) : image (Add.add k) (Ico n m) = Ico (n + k) (m + k) :=
  sorry

theorem image_sub (n : ℕ) (m : ℕ) (k : ℕ) (h : k ≤ n) :
    image (fun (x : ℕ) => x - k) (Ico n m) = Ico (n - k) (m - k) :=
  sorry

theorem zero_bot (n : ℕ) : Ico 0 n = range n := eq_of_veq (multiset.Ico.zero_bot n)

@[simp] theorem card (n : ℕ) (m : ℕ) : card (Ico n m) = m - n := multiset.Ico.card n m

@[simp] theorem mem {n : ℕ} {m : ℕ} {l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m := multiset.Ico.mem

@[simp] theorem coe_eq_Ico {n : ℕ} {m : ℕ} : ↑(Ico n m) = set.Ico n m := sorry

theorem eq_empty_of_le {n : ℕ} {m : ℕ} (h : m ≤ n) : Ico n m = ∅ :=
  eq_of_veq (multiset.Ico.eq_zero_of_le h)

@[simp] theorem self_eq_empty (n : ℕ) : Ico n n = ∅ := eq_empty_of_le (le_refl n)

@[simp] theorem eq_empty_iff {n : ℕ} {m : ℕ} : Ico n m = ∅ ↔ m ≤ n :=
  iff.trans (iff.symm val_eq_zero) multiset.Ico.eq_zero_iff

theorem subset_iff {m₁ : ℕ} {n₁ : ℕ} {m₂ : ℕ} {n₂ : ℕ} (hmn : m₁ < n₁) :
    Ico m₁ n₁ ⊆ Ico m₂ n₂ ↔ m₂ ≤ m₁ ∧ n₁ ≤ n₂ :=
  sorry

protected theorem subset {m₁ : ℕ} {n₁ : ℕ} {m₂ : ℕ} {n₂ : ℕ} (hmm : m₂ ≤ m₁) (hnn : n₁ ≤ n₂) :
    Ico m₁ n₁ ⊆ Ico m₂ n₂ :=
  eq.mpr
    (id
      (Eq.trans (propext subset_iff)
        (forall_congr_eq fun (x : ℕ) => imp_congr_eq (propext mem) (propext mem))))
    fun (x : ℕ) (hx : m₁ ≤ x ∧ x < n₁) =>
      { left := le_trans hmm (and.left hx), right := lt_of_lt_of_le (and.right hx) hnn }

theorem union_consecutive {n : ℕ} {m : ℕ} {l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) :
    Ico n m ∪ Ico m l = Ico n l :=
  sorry

theorem union' {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} (hlm : l ≤ m) (hnk : n ≤ k) :
    Ico n m ∪ Ico l k = Ico (min n l) (max m k) :=
  sorry

theorem union {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} (h₁ : min n m ≤ max l k) (h₂ : min l k ≤ max n m) :
    Ico n m ∪ Ico l k = Ico (min n l) (max m k) :=
  sorry

@[simp] theorem inter_consecutive (n : ℕ) (m : ℕ) (l : ℕ) : Ico n m ∩ Ico m l = ∅ := sorry

theorem inter {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} : Ico n m ∩ Ico l k = Ico (max n l) (min m k) := sorry

theorem disjoint_consecutive (n : ℕ) (m : ℕ) (l : ℕ) : disjoint (Ico n m) (Ico m l) :=
  le_of_eq (inter_consecutive n m l)

@[simp] theorem succ_singleton (n : ℕ) : Ico n (n + 1) = singleton n :=
  eq_of_veq multiset.Ico.succ_singleton

theorem succ_top {n : ℕ} {m : ℕ} (h : n ≤ m) : Ico n (m + 1) = insert m (Ico n m) := sorry

theorem succ_top' {n : ℕ} {m : ℕ} (h : n < m) : Ico n m = insert (m - 1) (Ico n (m - 1)) := sorry

theorem insert_succ_bot {n : ℕ} {m : ℕ} (h : n < m) : insert n (Ico (n + 1) m) = Ico n m := sorry

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = singleton (m - 1) :=
  eq_of_veq (multiset.Ico.pred_singleton h)

@[simp] theorem not_mem_top {n : ℕ} {m : ℕ} : ¬m ∈ Ico n m := multiset.Ico.not_mem_top

theorem filter_lt_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n m :=
  eq_of_veq (multiset.Ico.filter_lt_of_top_le hml)

theorem filter_lt_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = ∅ :=
  eq_of_veq (multiset.Ico.filter_lt_of_le_bot hln)

theorem filter_Ico_bot {n : ℕ} {m : ℕ} (hnm : n < m) :
    filter (fun (x : ℕ) => x ≤ n) (Ico n m) = singleton n :=
  eq_of_veq (multiset.Ico.filter_le_of_bot hnm)

theorem filter_lt_of_ge {n : ℕ} {m : ℕ} {l : ℕ} (hlm : l ≤ m) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n l :=
  eq_of_veq (multiset.Ico.filter_lt_of_ge hlm)

@[simp] theorem filter_lt (n : ℕ) (m : ℕ) (l : ℕ) :
    filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n (min m l) :=
  eq_of_veq (multiset.Ico.filter_lt n m l)

theorem filter_le_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico n m :=
  eq_of_veq (multiset.Ico.filter_le_of_le_bot hln)

theorem filter_le_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = ∅ :=
  eq_of_veq (multiset.Ico.filter_le_of_top_le hml)

theorem filter_le_of_le {n : ℕ} {m : ℕ} {l : ℕ} (hnl : n ≤ l) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico l m :=
  eq_of_veq (multiset.Ico.filter_le_of_le hnl)

@[simp] theorem filter_le (n : ℕ) (m : ℕ) (l : ℕ) :
    filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico (max n l) m :=
  eq_of_veq (multiset.Ico.filter_le n m l)

@[simp] theorem diff_left (l : ℕ) (n : ℕ) (m : ℕ) : Ico n m \ Ico n l = Ico (max n l) m := sorry

@[simp] theorem diff_right (l : ℕ) (n : ℕ) (m : ℕ) : Ico n m \ Ico l m = Ico n (min m l) := sorry

theorem image_const_sub {k : ℕ} {m : ℕ} {n : ℕ} (hkn : k ≤ n) :
    image (fun (j : ℕ) => n - j) (Ico k m) = Ico (n + 1 - m) (n + 1 - k) :=
  sorry

end Ico

theorem range_eq_Ico (n : ℕ) : range n = Ico 0 n := sorry

theorem range_image_pred_top_sub (n : ℕ) : image (fun (j : ℕ) => n - 1 - j) (range n) = range n :=
  sorry

-- TODO We don't yet attempt to reproduce the entire interface for `Ico` for `Ico_ℤ`.

/-- `Ico_ℤ l u` is the set of integers `l ≤ k < u`. -/
def Ico_ℤ (l : ℤ) (u : ℤ) : finset ℤ :=
  map (function.embedding.mk (fun (n : ℕ) => ↑n + l) sorry) (range (int.to_nat (u - l)))

@[simp] theorem Ico_ℤ.mem {n : ℤ} {m : ℤ} {l : ℤ} : l ∈ Ico_ℤ n m ↔ n ≤ l ∧ l < m := sorry

@[simp] theorem Ico_ℤ.card (l : ℤ) (u : ℤ) : card (Ico_ℤ l u) = int.to_nat (u - l) := sorry

end Mathlib


import data.complex.basic
import data.matrix.basic
import data.matrix.notation
import data.fin.basic
import data.list.basic
import linear_algebra.matrix.determinant
import data.multiset.basic
import data.polynomial.basic
import data.polynomial.ring_division -- for polynomial.root
import basic
-- import linear_algebra.eigenspace
open matrix
open_locale matrix

mutual def Interlace, Interlace' {num_t: Type} [linear_order num_t] -- no need [linear_order num_t]
with Interlace: list num_t -> list num_t -> Prop
| (x :: xs) (y :: ys) := (x <= y) ∧ Interlace' xs (y :: ys)
| (x :: xs) nil := true
| _ _ := false
with Interlace': list num_t -> list num_t -> Prop
| (x :: xs) (y :: ys) := (y <= x) ∧ Interlace (x :: xs) ys
| _ _ := false

def principalSubMat {sz: ℕ} (A: mat (sz + 1) (sz + 1)) (k: fin (sz + 1)) := λ u v: fin sz,
  if fin.cast_succ u < k then
    if fin.cast_succ v < k then A u v else A u (v + 1)
  else
    if (fin.cast_succ v < k) then A (u + 1) v else A (u + 1) (v + 1)

def Id (n: ℕ): mat n n := λ u v: fin n, if u = v then 1 else 0

noncomputable def eigenPolynomial {n: ℕ} (A: mat n n): polynomial ℂ :=
  matrix.det (A.map (λx, polynomial.monomial 0 x) - (Id n).map (λx, polynomial.monomial 1 x))

-- i wish to indicate though it is of type complex, the complex part is always zero so I can still apply <
-- < still holds for complex, it's just it's not totality
-- Kevin advises to just rip im off ...
-- because (5, 0): ℂ is fundamentally different thing from 5: ℝ , or 5: ℕ.
#check matrix
lemma cauchy_interlace_theorem_lemma_1:
  forall (n: ℕ)
  (A: mat (n + 1) (n + 1)) (isHerA: Hermitian (n + 1) A)
  (k: fin (n + 1)),
    let B := principalSubMat A k,
        polyA := eigenPolynomial A,
        polyB := eigenPolynomial B in
  forall (a b ∈ rSolution polyA), a ≠ b -> exists (c ∈ rSolution polyB), (a < c) ∧ (c < b)