/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Scott Morrison, Simon Hudon

! This file was ported from Lean 3 source module category_theory.endomorphism
! 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.Algebra.Hom.Equiv.Basic
import Mathbin.CategoryTheory.Groupoid
import Mathbin.CategoryTheory.Opposites
import Mathbin.GroupTheory.GroupAction.Defs

/-!
# Endomorphisms

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

Definition and basic properties of endomorphisms and automorphisms of an object in a category.

For each `X : C`, we provide `End X := X ⟶ X` with a monoid structure,
and `Aut X := X ≅ X ` with a group structure.
-/

universe v v' u u'

namespace CategoryTheory

#print CategoryTheory.End /-
/-- Endomorphisms of an object in a category. Arguments order in multiplication agrees with
`function.comp`, not with `category.comp`. -/
def End {C : Type u} [CategoryStruct.{v} C] (X : C) :=
  X ⟶ X
#align category_theory.End CategoryTheory.End
-/

namespace End

section Struct

variable {C : Type u} [CategoryStruct.{v} C] (X : C)

#print CategoryTheory.End.one /-
instance one : One (End X) :=
  ⟨𝟙 X⟩
#align category_theory.End.has_one CategoryTheory.End.one
-/

#print CategoryTheory.End.inhabited /-
instance inhabited : Inhabited (End X) :=
  ⟨𝟙 X⟩
#align category_theory.End.inhabited CategoryTheory.End.inhabited
-/

#print CategoryTheory.End.mul /-
/-- Multiplication of endomorphisms agrees with `function.comp`, not `category_struct.comp`. -/
instance mul : Mul (End X) :=
  ⟨fun x y => y ≫ x⟩
#align category_theory.End.has_mul CategoryTheory.End.mul
-/

variable {X}

#print CategoryTheory.End.of /-
/-- Assist the typechecker by expressing a morphism `X ⟶ X` as a term of `End X`. -/
def of (f : X ⟶ X) : End X :=
  f
#align category_theory.End.of CategoryTheory.End.of
-/

#print CategoryTheory.End.asHom /-
/-- Assist the typechecker by expressing an endomorphism `f : End X` as a term of `X ⟶ X`. -/
def asHom (f : End X) : X ⟶ X :=
  f
#align category_theory.End.as_hom CategoryTheory.End.asHom
-/

#print CategoryTheory.End.one_def /-
@[simp]
theorem one_def : (1 : End X) = 𝟙 X :=
  rfl
#align category_theory.End.one_def CategoryTheory.End.one_def
-/

#print CategoryTheory.End.mul_def /-
@[simp]
theorem mul_def (xs ys : End X) : xs * ys = ys ≫ xs :=
  rfl
#align category_theory.End.mul_def CategoryTheory.End.mul_def
-/

end Struct

#print CategoryTheory.End.monoid /-
/-- Endomorphisms of an object form a monoid -/
instance monoid {C : Type u} [Category.{v} C] {X : C} : Monoid (End X) :=
  { End.mul X, End.one X with
    mul_one := Category.id_comp
    one_mul := Category.comp_id
    mul_assoc := fun x y z => (Category.assoc z y x).symm }
#align category_theory.End.monoid CategoryTheory.End.monoid
-/

section MulAction

variable {C : Type u} [Category.{v} C]

open Opposite

#print CategoryTheory.End.mulActionRight /-
instance mulActionRight {X Y : C} : MulAction (End Y) (X ⟶ Y)
    where
  smul r f := f ≫ r
  one_smul := Category.comp_id
  mul_smul r s f := Eq.symm <| Category.assoc _ _ _
#align category_theory.End.mul_action_right CategoryTheory.End.mulActionRight
-/

#print CategoryTheory.End.mulActionLeft /-
instance mulActionLeft {X : Cᵒᵖ} {Y : C} : MulAction (End X) (unop X ⟶ Y)
    where
  smul r f := r.unop ≫ f
  one_smul := Category.id_comp
  mul_smul r s f := Category.assoc _ _ _
#align category_theory.End.mul_action_left CategoryTheory.End.mulActionLeft
-/

#print CategoryTheory.End.smul_right /-
theorem smul_right {X Y : C} {r : End Y} {f : X ⟶ Y} : r • f = f ≫ r :=
  rfl
#align category_theory.End.smul_right CategoryTheory.End.smul_right
-/

#print CategoryTheory.End.smul_left /-
theorem smul_left {X : Cᵒᵖ} {Y : C} {r : End X} {f : unop X ⟶ Y} : r • f = r.unop ≫ f :=
  rfl
#align category_theory.End.smul_left CategoryTheory.End.smul_left
-/

end MulAction

#print CategoryTheory.End.group /-
/-- In a groupoid, endomorphisms form a group -/
instance group {C : Type u} [Groupoid.{v} C] (X : C) : Group (End X) :=
  { End.monoid with
    mul_left_inv := Groupoid.comp_inv
    inv := Groupoid.inv }
#align category_theory.End.group CategoryTheory.End.group
-/

end End

#print CategoryTheory.isUnit_iff_isIso /-
theorem isUnit_iff_isIso {C : Type u} [Category.{v} C] {X : C} (f : End X) :
    IsUnit (f : End X) ↔ IsIso f :=
  ⟨fun h => { out := ⟨h.Unit.inv, ⟨h.Unit.inv_val, h.Unit.val_inv⟩⟩ }, fun h =>
    ⟨⟨f, inv f, by simp, by simp⟩, rfl⟩⟩
#align category_theory.is_unit_iff_is_iso CategoryTheory.isUnit_iff_isIso
-/

variable {C : Type u} [Category.{v} C] (X : C)

#print CategoryTheory.Aut /-
/-- Automorphisms of an object in a category.

The order of arguments in multiplication agrees with
`function.comp`, not with `category.comp`.
-/
def Aut (X : C) :=
  X ≅ X
#align category_theory.Aut CategoryTheory.Aut
-/

namespace Aut

#print CategoryTheory.Aut.inhabited /-
instance inhabited : Inhabited (Aut X) :=
  ⟨Iso.refl X⟩
#align category_theory.Aut.inhabited CategoryTheory.Aut.inhabited
-/

instance : Group (Aut X) := by
  refine_struct
            { one := iso.refl X
              inv := iso.symm
              mul := flip iso.trans
              div := _
              npow := @npowRec (Aut X) ⟨iso.refl X⟩ ⟨flip iso.trans⟩
              zpow := @zpowRec (Aut X) ⟨iso.refl X⟩ ⟨flip iso.trans⟩ ⟨iso.symm⟩ } <;>
          intros <;>
        try rfl <;>
      ext <;>
    simp [flip, (· * ·), Monoid.mul, MulOneClass.mul, MulOneClass.one, One.one, Monoid.one, Inv.inv]

/- warning: category_theory.Aut.Aut_mul_def -> CategoryTheory.Aut.Aut_mul_def is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C) (f : CategoryTheory.Aut.{u1, u2} C _inst_1 X) (g : CategoryTheory.Aut.{u1, u2} C _inst_1 X), Eq.{succ u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (HMul.hMul.{u1, u1, u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (instHMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (MulOneClass.toHasMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.group.{u1, u2} C _inst_1 X)))))) f g) (CategoryTheory.Iso.trans.{u1, u2} C _inst_1 X X X g f)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C) (f : CategoryTheory.Aut.{u1, u2} C _inst_1 X) (g : CategoryTheory.Aut.{u1, u2} C _inst_1 X), Eq.{succ u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (HMul.hMul.{u1, u1, u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (instHMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (MulOneClass.toMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.instGroupAut.{u1, u2} C _inst_1 X)))))) f g) (CategoryTheory.Iso.trans.{u1, u2} C _inst_1 X X X g f)
Case conversion may be inaccurate. Consider using '#align category_theory.Aut.Aut_mul_def CategoryTheory.Aut.Aut_mul_defₓ'. -/
theorem Aut_mul_def (f g : Aut X) : f * g = g.trans f :=
  rfl
#align category_theory.Aut.Aut_mul_def CategoryTheory.Aut.Aut_mul_def

/- warning: category_theory.Aut.Aut_inv_def -> CategoryTheory.Aut.Aut_inv_def is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C) (f : CategoryTheory.Aut.{u1, u2} C _inst_1 X), Eq.{succ u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Inv.inv.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toHasInv.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.group.{u1, u2} C _inst_1 X))) f) (CategoryTheory.Iso.symm.{u1, u2} C _inst_1 X X f)
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C) (f : CategoryTheory.Aut.{u1, u2} C _inst_1 X), Eq.{succ u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Inv.inv.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (InvOneClass.toInv.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvOneMonoid.toInvOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivisionMonoid.toDivInvOneMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivisionMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.instGroupAut.{u1, u2} C _inst_1 X))))) f) (CategoryTheory.Iso.symm.{u1, u2} C _inst_1 X X f)
Case conversion may be inaccurate. Consider using '#align category_theory.Aut.Aut_inv_def CategoryTheory.Aut.Aut_inv_defₓ'. -/
theorem Aut_inv_def (f : Aut X) : f⁻¹ = f.symm :=
  rfl
#align category_theory.Aut.Aut_inv_def CategoryTheory.Aut.Aut_inv_def

/- warning: category_theory.Aut.units_End_equiv_Aut -> CategoryTheory.Aut.unitsEndEquivAut is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C), MulEquiv.{u1, u1} (Units.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X)) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (MulOneClass.toHasMul.{u1} (Units.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X)) (Units.mulOneClass.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X))) (MulOneClass.toHasMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.group.{u1, u2} C _inst_1 X)))))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (X : C), MulEquiv.{u1, u1} (Units.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X)) (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (MulOneClass.toMul.{u1} (Units.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X)) (Units.instMulOneClassUnits.{u1} (CategoryTheory.End.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u2} C _inst_1 X))) (MulOneClass.toMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.instGroupAut.{u1, u2} C _inst_1 X)))))
Case conversion may be inaccurate. Consider using '#align category_theory.Aut.units_End_equiv_Aut CategoryTheory.Aut.unitsEndEquivAutₓ'. -/
/-- Units in the monoid of endomorphisms of an object
are (multiplicatively) equivalent to automorphisms of that object.
-/
def unitsEndEquivAut : (End X)ˣ ≃* Aut X
    where
  toFun f := ⟨f.1, f.2, f.4, f.3⟩
  invFun f := ⟨f.1, f.2, f.4, f.3⟩
  left_inv := fun ⟨f₁, f₂, f₃, f₄⟩ => rfl
  right_inv := fun ⟨f₁, f₂, f₃, f₄⟩ => rfl
  map_mul' f g := by rcases f with ⟨⟩ <;> rcases g with ⟨⟩ <;> rfl
#align category_theory.Aut.units_End_equiv_Aut CategoryTheory.Aut.unitsEndEquivAut

/- warning: category_theory.Aut.Aut_mul_equiv_of_iso -> CategoryTheory.Aut.autMulEquivOfIso is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C}, (CategoryTheory.Iso.{u1, u2} C _inst_1 X Y) -> (MulEquiv.{u1, u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (MulOneClass.toHasMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.group.{u1, u2} C _inst_1 X))))) (MulOneClass.toHasMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (CategoryTheory.Aut.group.{u1, u2} C _inst_1 Y))))))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] {X : C} {Y : C}, (CategoryTheory.Iso.{u1, u2} C _inst_1 X Y) -> (MulEquiv.{u1, u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (MulOneClass.toMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 X) (CategoryTheory.Aut.instGroupAut.{u1, u2} C _inst_1 X))))) (MulOneClass.toMul.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u2} C _inst_1 Y) (CategoryTheory.Aut.instGroupAut.{u1, u2} C _inst_1 Y))))))
Case conversion may be inaccurate. Consider using '#align category_theory.Aut.Aut_mul_equiv_of_iso CategoryTheory.Aut.autMulEquivOfIsoₓ'. -/
/-- Isomorphisms induce isomorphisms of the automorphism group -/
def autMulEquivOfIso {X Y : C} (h : X ≅ Y) : Aut X ≃* Aut Y
    where
  toFun x := ⟨h.inv ≫ x.Hom ≫ h.Hom, h.inv ≫ x.inv ≫ h.Hom⟩
  invFun y := ⟨h.Hom ≫ y.Hom ≫ h.inv, h.Hom ≫ y.inv ≫ h.inv⟩
  left_inv := by tidy
  right_inv := by tidy
  map_mul' := by simp [Aut_mul_def]
#align category_theory.Aut.Aut_mul_equiv_of_iso CategoryTheory.Aut.autMulEquivOfIso

end Aut

namespace Functor

variable {D : Type u'} [Category.{v'} D] (f : C ⥤ D) (X)

/- warning: category_theory.functor.map_End -> CategoryTheory.Functor.mapEnd is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (X : C) {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (f : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), MonoidHom.{u1, u2} (CategoryTheory.End.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1) X) (CategoryTheory.End.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (Monoid.toMulOneClass.{u1} (CategoryTheory.End.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u3} C _inst_1 X)) (Monoid.toMulOneClass.{u2} (CategoryTheory.End.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (CategoryTheory.End.monoid.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (X : C) {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (f : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), MonoidHom.{u1, u2} (CategoryTheory.End.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1) X) (CategoryTheory.End.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (Monoid.toMulOneClass.{u1} (CategoryTheory.End.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1) X) (CategoryTheory.End.monoid.{u1, u3} C _inst_1 X)) (Monoid.toMulOneClass.{u2} (CategoryTheory.End.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2) (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (CategoryTheory.End.monoid.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.map_End CategoryTheory.Functor.mapEndₓ'. -/
/-- `f.map` as a monoid hom between endomorphism monoids. -/
@[simps]
def mapEnd : End X →* End (f.obj X)
    where
  toFun := Functor.map f
  map_mul' x y := f.map_comp y x
  map_one' := f.map_id X
#align category_theory.functor.map_End CategoryTheory.Functor.mapEnd

/- warning: category_theory.functor.map_Aut -> CategoryTheory.Functor.mapAut is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (X : C) {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (f : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), MonoidHom.{u1, u2} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (CategoryTheory.Aut.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (CategoryTheory.Aut.group.{u1, u3} C _inst_1 X)))) (Monoid.toMulOneClass.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (DivInvMonoid.toMonoid.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (Group.toDivInvMonoid.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)) (CategoryTheory.Aut.group.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 f X)))))
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] (X : C) {D : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} D] (f : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2), MonoidHom.{u1, u2} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (CategoryTheory.Aut.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (Monoid.toMulOneClass.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (DivInvMonoid.toMonoid.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (Group.toDivInvMonoid.{u1} (CategoryTheory.Aut.{u1, u3} C _inst_1 X) (CategoryTheory.Aut.instGroupAut.{u1, u3} C _inst_1 X)))) (Monoid.toMulOneClass.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (DivInvMonoid.toMonoid.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (Group.toDivInvMonoid.{u2} (CategoryTheory.Aut.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)) (CategoryTheory.Aut.instGroupAut.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 f) X)))))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.map_Aut CategoryTheory.Functor.mapAutₓ'. -/
/-- `f.map_iso` as a group hom between automorphism groups. -/
def mapAut : Aut X →* Aut (f.obj X) where
  toFun := f.mapIso
  map_mul' x y := f.mapIso_trans y x
  map_one' := f.mapIso_refl X
#align category_theory.functor.map_Aut CategoryTheory.Functor.mapAut

end Functor

end CategoryTheory


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
Ported by: Jon Eugster

! This file was ported from Lean 3 source module data.pi.algebra
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Data.Prod.Basic
import Mathlib.Logic.Unique
import Mathlib.Data.Sum.Basic
import Mathlib.Tactic.Classical

/-!
# Instances and theorems on pi types

This file provides basic definitions and notation instances for Pi types.

Instances of more sophisticated classes are defined in `Pi.lean` files elsewhere.
-/

open Function

universe u v₁ v₂ v₃

variable {I : Type u}

-- The indexing type
variable {α β γ : Type _}

-- The families of types already equipped with instances
variable {f : I → Type v₁} {g : I → Type v₂} {h : I → Type v₃}

variable (x y : ∀ i, f i) (i : I)

namespace Pi

/-! `1`, `0`, `+`, `*`, `+ᵥ`, `•`, `^`, `-`, `⁻¹`, and `/` are defined pointwise. -/

@[to_additive]
instance instOne [∀ i, One <| f i] : One (∀ i : I, f i) :=
  ⟨fun _ => 1⟩

#align pi.has_one Pi.instOne
#align pi.has_zero Pi.instZero

@[to_additive (attr := simp)]
theorem one_apply [∀ i, One <| f i] : (1 : ∀ i, f i) i = 1 :=
  rfl
#align pi.one_apply Pi.one_apply
#align pi.zero_apply Pi.zero_apply

@[to_additive]
theorem one_def [∀ i, One <| f i] : (1 : ∀ i, f i) = fun _ => 1 :=
  rfl
#align pi.one_def Pi.one_def
#align pi.zero_def Pi.zero_def

@[to_additive (attr := simp)]
theorem const_one [One β] : const α (1 : β) = 1 :=
  rfl
#align pi.const_one Pi.const_one
#align pi.const_zero Pi.const_zero

@[to_additive (attr := simp)]
theorem one_comp [One γ] (x : α → β) : (1 : β → γ) ∘ x = 1 :=
  rfl
#align pi.one_comp Pi.one_comp
#align pi.zero_comp Pi.zero_comp

@[to_additive (attr := simp)]
theorem comp_one [One β] (x : β → γ) : x ∘ (1 : α → β) = const α (x 1) :=
  rfl
#align pi.comp_one Pi.comp_one
#align pi.comp_zero Pi.comp_zero

@[to_additive]
instance instMul [∀ i, Mul <| f i] : Mul (∀ i : I, f i) :=
  ⟨fun f g i => f i * g i⟩

#align pi.has_mul Pi.instMul
#align pi.has_add Pi.instAdd

@[to_additive (attr := simp)]
theorem mul_apply [∀ i, Mul <| f i] : (x * y) i = x i * y i :=
  rfl
#align pi.mul_apply Pi.mul_apply
#align pi.add_apply Pi.add_apply

@[to_additive]
theorem mul_def [∀ i, Mul <| f i] : x * y = fun i => x i * y i :=
  rfl
#align pi.mul_def Pi.mul_def
#align pi.add_def Pi.add_def

@[to_additive (attr := simp)]
theorem const_mul [Mul β] (a b : β) : const α a * const α b = const α (a * b) :=
  rfl
#align pi.const_mul Pi.const_mul
#align pi.const_add Pi.const_add

@[to_additive]
theorem mul_comp [Mul γ] (x y : β → γ) (z : α → β) : (x * y) ∘ z = x ∘ z * y ∘ z :=
  rfl
#align pi.mul_comp Pi.mul_comp
#align pi.add_comp Pi.add_comp

@[to_additive]
instance instSMul [∀ i, SMul α <| f i] : SMul α (∀ i : I, f i) :=
  ⟨fun s x => fun i => s • x i⟩

#align pi.has_smul Pi.instSMul
#align pi.has_vadd Pi.instVAdd

@[to_additive existing instSMul]
instance instPow [∀ i, Pow (f i) β] : Pow (∀ i, f i) β :=
  ⟨fun x b i => x i ^ b⟩

@[to_additive (attr := simp, to_additive) (reorder := 5) smul_apply]
theorem pow_apply [∀ i, Pow (f i) β] (x : ∀ i, f i) (b : β) (i : I) : (x ^ b) i = x i ^ b :=
  rfl
#align pi.pow_apply Pi.pow_apply
#align pi.smul_apply Pi.smul_apply
#align pi.vadd_apply Pi.vadd_apply

@[to_additive (attr := to_additive) (reorder := 5) smul_def]
theorem pow_def [∀ i, Pow (f i) β] (x : ∀ i, f i) (b : β) : x ^ b = fun i => x i ^ b :=
  rfl
#align pi.pow_def Pi.pow_def
#align pi.smul_def Pi.smul_def
#align pi.vadd_def Pi.vadd_def

@[to_additive (attr := simp, to_additive) (reorder := 2 5) smul_const]
theorem const_pow [Pow α β] (a : α) (b : β) : const I a ^ b = const I (a ^ b) :=
  rfl
#align pi.const_pow Pi.const_pow
#align pi.smul_const Pi.smul_const
#align pi.vadd_const Pi.vadd_const

@[to_additive (attr := to_additive) (reorder := 6) smul_comp]
theorem pow_comp [Pow γ α] (x : β → γ) (a : α) (y : I → β) : (x ^ a) ∘ y = x ∘ y ^ a :=
  rfl
#align pi.pow_comp Pi.pow_comp
#align pi.smul_comp Pi.smul_comp
#align pi.vadd_comp Pi.vadd_comp

/-!
Porting note: `bit0` and `bit1` are deprecated. This section can be removed entirely
(without replacement?).
-/
section deprecated

set_option linter.deprecated false

@[simp, deprecated]
theorem bit0_apply [∀ i, Add <| f i] : (bit0 x) i = bit0 (x i) :=
  rfl
#align pi.bit0_apply Pi.bit0_apply

@[simp, deprecated]
theorem bit1_apply [∀ i, Add <| f i] [∀ i, One <| f i] : (bit1 x) i = bit1 (x i) :=
  rfl
#align pi.bit1_apply Pi.bit1_apply

end deprecated

@[to_additive]
instance instInv [∀ i, Inv <| f i] : Inv (∀ i : I, f i) :=
  ⟨fun f i => (f i)⁻¹⟩

#align pi.has_inv Pi.instInv
#align pi.has_neg Pi.instNeg

@[to_additive (attr := simp)]
theorem inv_apply [∀ i, Inv <| f i] : x⁻¹ i = (x i)⁻¹ :=
  rfl
#align pi.inv_apply Pi.inv_apply
#align pi.neg_apply Pi.neg_apply

@[to_additive]
theorem inv_def [∀ i, Inv <| f i] : x⁻¹ = fun i => (x i)⁻¹ :=
  rfl
#align pi.inv_def Pi.inv_def
#align pi.neg_def Pi.neg_def

@[to_additive]
theorem const_inv [Inv β] (a : β) : (const α a)⁻¹ = const α a⁻¹ :=
  rfl
#align pi.const_inv Pi.const_inv
#align pi.const_neg Pi.const_neg

@[to_additive]
theorem inv_comp [Inv γ] (x : β → γ) (y : α → β) : x⁻¹ ∘ y = (x ∘ y)⁻¹ :=
  rfl
#align pi.inv_comp Pi.inv_comp
#align pi.neg_comp Pi.neg_comp

@[to_additive]
instance instDiv [∀ i, Div <| f i] : Div (∀ i : I, f i) :=
  ⟨fun f g i => f i / g i⟩

#align pi.has_div Pi.instDiv
#align pi.has_sub Pi.instSub

@[to_additive (attr := simp)]
theorem div_apply [∀ i, Div <| f i] : (x / y) i = x i / y i :=
  rfl
#align pi.div_apply Pi.div_apply
#align pi.sub_apply Pi.sub_apply

@[to_additive]
theorem div_def [∀ i, Div <| f i] : x / y = fun i => x i / y i :=
  rfl
#align pi.div_def Pi.div_def
#align pi.sub_def Pi.sub_def

@[to_additive]
theorem div_comp [Div γ] (x y : β → γ) (z : α → β) : (x / y) ∘ z = x ∘ z / y ∘ z :=
  rfl
#align pi.div_comp Pi.div_comp
#align pi.sub_comp Pi.sub_comp

@[to_additive (attr := simp)]
theorem const_div [Div β] (a b : β) : const α a / const α b = const α (a / b) :=
  rfl
#align pi.const_div Pi.const_div
#align pi.const_sub Pi.const_sub

section

variable [DecidableEq I]

variable [∀ i, One (f i)] [∀ i, One (g i)] [∀ i, One (h i)]

/-- The function supported at `i`, with value `x` there, and `1` elsewhere. -/
@[to_additive "The function supported at `i`, with value `x` there, and `0` elsewhere."]
def mulSingle (i : I) (x : f i) : ∀ (j : I), f j :=
  Function.update 1 i x

#align pi.mul_single Pi.mulSingle
#align pi.single Pi.single

@[to_additive (attr := simp)]
theorem mulSingle_eq_same (i : I) (x : f i) : mulSingle i x i = x :=
  Function.update_same i x _

#align pi.mul_single_eq_same Pi.mulSingle_eq_same
#align pi.single_eq_same Pi.single_eq_same

@[to_additive (attr := simp)]
theorem mulSingle_eq_of_ne {i i' : I} (h : i' ≠ i) (x : f i) : mulSingle i x i' = 1 :=
  Function.update_noteq h x _

#align pi.mul_single_eq_of_ne Pi.mulSingle_eq_of_ne
#align pi.single_eq_of_ne Pi.single_eq_of_ne

/-- Abbreviation for `mulSingle_eq_of_ne h.symm`, for ease of use by `simp`. -/
@[to_additive (attr := simp)
  "Abbreviation for `single_eq_of_ne h.symm`, for ease of use by `simp`."]
theorem mulSingle_eq_of_ne' {i i' : I} (h : i ≠ i') (x : f i) : mulSingle i x i' = 1 :=
  mulSingle_eq_of_ne h.symm x

#align pi.mul_single_eq_of_ne' Pi.mulSingle_eq_of_ne'
#align pi.single_eq_of_ne' Pi.single_eq_of_ne'

@[to_additive (attr := simp)]
theorem mulSingle_one (i : I) : mulSingle i (1 : f i) = 1 :=
  Function.update_eq_self _ _

#align pi.mul_single_one Pi.mulSingle_one
#align pi.single_zero Pi.single_zero

-- Porting notes:
-- 1) Why do I have to specify the type of `mulSingle i x` explicitly?
-- 2) Why do I have to specify the type of `(1 : I → β)`?
-- 3) Removed `{β : Sort _}` as `[One β]` converts it to a type anyways.
/-- On non-dependent functions, `Pi.mulSingle` can be expressed as an `ite` -/
@[to_additive "On non-dependent functions, `Pi.single` can be expressed as an `ite`"]
theorem mulSingle_apply [One β] (i : I) (x : β) (i' : I) :
    (mulSingle i x : I → β) i' = if i' = i then x else 1 :=
  Function.update_apply (1 : I → β) i x i'

#align pi.mul_single_apply Pi.mulSingle_apply
#align pi.single_apply Pi.single_apply

-- Porting notes : Same as above.
/-- On non-dependent functions, `Pi.mulSingle` is symmetric in the two indices. -/
@[to_additive "On non-dependent functions, `Pi.single` is symmetric in the two indices."]
theorem mulSingle_comm [One β] (i : I) (x : β) (i' : I) :
    (mulSingle i x : I → β) i' = (mulSingle i' x : I → β) i := by
  simp [mulSingle_apply, eq_comm]

#align pi.mul_single_comm Pi.mulSingle_comm
#align pi.single_comm Pi.single_comm

@[to_additive]
theorem apply_mulSingle (f' : ∀ i, f i → g i) (hf' : ∀ i, f' i 1 = 1) (i : I) (x : f i) (j : I) :
    f' j (mulSingle i x j) = mulSingle i (f' i x) j := by
  simpa only [Pi.one_apply, hf', mulSingle] using Function.apply_update f' 1 i x j

#align pi.apply_mul_single Pi.apply_mulSingle
#align pi.apply_single Pi.apply_single

@[to_additive apply_single₂]
theorem apply_mulSingle₂ (f' : ∀ i, f i → g i → h i) (hf' : ∀ i, f' i 1 1 = 1) (i : I)
    (x : f i) (y : g i) (j : I) :
    f' j (mulSingle i x j) (mulSingle i y j) = mulSingle i (f' i x y) j := by
  by_cases h : j = i
  · subst h
    simp only [mulSingle_eq_same]
  · simp only [mulSingle_eq_of_ne h, hf']

#align pi.apply_mul_single₂ Pi.apply_mulSingle₂
#align pi.apply_single₂ Pi.apply_single₂

@[to_additive]
theorem mulSingle_op {g : I → Type _} [∀ i, One (g i)] (op : ∀ i, f i → g i)
    (h : ∀ i, op i 1 = 1) (i : I) (x : f i) :
    mulSingle i (op i x) = fun j => op j (mulSingle i x j) :=
  Eq.symm <| funext <| apply_mulSingle op h i x

#align pi.mul_single_op Pi.mulSingle_op
#align pi.single_op Pi.single_op

@[to_additive]
theorem mulSingle_op₂ {g₁ g₂ : I → Type _} [∀ i, One (g₁ i)] [∀ i, One (g₂ i)]
    (op : ∀ i, g₁ i → g₂ i → f i) (h : ∀ i, op i 1 1 = 1) (i : I) (x₁ : g₁ i) (x₂ : g₂ i) :
    mulSingle i (op i x₁ x₂) = fun j => op j (mulSingle i x₁ j) (mulSingle i x₂ j) :=
  Eq.symm <| funext <| apply_mulSingle₂ op h i x₁ x₂

#align pi.mul_single_op₂ Pi.mulSingle_op₂
#align pi.single_op₂ Pi.single_op₂

variable (f)

@[to_additive]
theorem mulSingle_injective (i : I) : Function.Injective (mulSingle i : f i → ∀ i, f i) :=
  Function.update_injective _ i

#align pi.mul_single_injective Pi.mulSingle_injective
#align pi.single_injective Pi.single_injective

@[to_additive (attr := simp)]
theorem mulSingle_inj (i : I) {x y : f i} : mulSingle i x = mulSingle i y ↔ x = y :=
  (Pi.mulSingle_injective _ _).eq_iff

#align pi.mul_single_inj Pi.mulSingle_inj
#align pi.single_inj Pi.single_inj

end

/-- The mapping into a product type built from maps into each component. -/
@[simp]
protected def prod (f' : ∀ i, f i) (g' : ∀ i, g i) (i : I) : f i × g i :=
  (f' i, g' i)
#align pi.prod Pi.prod

-- Porting note : simp now unfolds the lhs, so we are not marking these as simp.
-- @[simp]
theorem prod_fst_snd : Pi.prod (Prod.fst : α × β → α) (Prod.snd : α × β → β) = id :=
  funext fun _ => Prod.mk.eta
#align pi.prod_fst_snd Pi.prod_fst_snd

-- Porting note : simp now unfolds the lhs, so we are not marking these as simp.
-- @[simp]
theorem prod_snd_fst : Pi.prod (Prod.snd : α × β → β) (Prod.fst : α × β → α) = Prod.swap :=
  rfl
#align pi.prod_snd_fst Pi.prod_snd_fst

end Pi

namespace Function

section Extend

@[to_additive]
theorem extend_one [One γ] (f : α → β) : Function.extend f (1 : α → γ) (1 : β → γ) = 1 :=
  funext fun _ => by apply ite_self
#align function.extend_one Function.extend_one
#align function.extend_zero Function.extend_zero

@[to_additive]
theorem extend_mul [Mul γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ):
    Function.extend f (g₁ * g₂) (e₁ * e₂) = Function.extend f g₁ e₁ * Function.extend f g₂ e₂ := by
  classical
  funext x
  simp only [not_exists, extend_def, Pi.mul_apply, apply_dite₂, dite_eq_ite, ite_self]
-- Porting note: The Lean3 statement was
-- `funext $ λ _, by convert (apply_dite2 (*) _ _ _ _ _).symm`
-- which converts to
-- `funext fun _ => by convert (apply_dite₂ (· * ·) _ _ _ _ _).symm`
-- However this does not work, and we're not sure why.
#align function.extend_mul Function.extend_mul
#align function.extend_add Function.extend_add

@[to_additive]
theorem extend_inv [Inv γ] (f : α → β) (g : α → γ) (e : β → γ) :
    Function.extend f g⁻¹ e⁻¹ = (Function.extend f g e)⁻¹ := by
  classical
  funext x
  simp only [not_exists, extend_def, Pi.inv_apply, apply_dite Inv.inv]
-- Porting note: The Lean3 statement was
-- `funext $ λ _, by convert (apply_dite has_inv.inv _ _ _).symm`
-- which converts to
-- `funext fun _ => by convert (apply_dite Inv.inv _ _ _).symm`
-- However this does not work, and we're not sure why.
#align function.extend_inv Function.extend_inv
#align function.extend_neg Function.extend_neg

@[to_additive]
theorem extend_div [Div γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ) :
    Function.extend f (g₁ / g₂) (e₁ / e₂) = Function.extend f g₁ e₁ / Function.extend f g₂ e₂ := by
  classical
  funext x
  simp [Function.extend_def, apply_dite₂]
-- Porting note: The Lean3 statement was
-- `funext $ λ _, by convert (apply_dite2 (/) _ _ _ _ _).symm`
-- which converts to
-- `funext fun _ => by convert (apply_dite₂ (· / ·) _ _ _ _ _).symm`
-- However this does not work, and we're not sure why.
#align function.extend_div Function.extend_div
#align function.extend_sub Function.extend_sub

end Extend

theorem surjective_pi_map {F : ∀ i, f i → g i} (hF : ∀ i, Surjective (F i)) :
    Surjective fun x : ∀ i, f i => fun i => F i (x i) := fun y =>
  ⟨fun i => (hF i (y i)).choose, funext fun i => (hF i (y i)).choose_spec⟩
#align function.surjective_pi_map Function.surjective_pi_map

theorem injective_pi_map {F : ∀ i, f i → g i} (hF : ∀ i, Injective (F i)) :
    Injective fun x : ∀ i, f i => fun i => F i (x i) :=
  fun _ _ h => funext fun i => hF i <| (congr_fun h i : _)
#align function.injective_pi_map Function.injective_pi_map

theorem bijective_pi_map {F : ∀ i, f i → g i} (hF : ∀ i, Bijective (F i)) :
    Bijective fun x : ∀ i, f i => fun i => F i (x i) :=
  ⟨injective_pi_map fun i => (hF i).injective, surjective_pi_map fun i => (hF i).surjective⟩
#align function.bijective_pi_map Function.bijective_pi_map

end Function

/-- If the one function is surjective, the codomain is trivial. -/
@[to_additive "If the zero function is surjective, the codomain is trivial."]
def uniqueOfSurjectiveOne (α : Type _) {β : Type _} [One β] (h : Function.Surjective (1 : α → β)) :
    Unique β :=
  h.uniqueOfSurjectiveConst α (1 : β)
#align unique_of_surjective_one uniqueOfSurjectiveOne
#align unique_of_surjective_zero uniqueOfSurjectiveZero

@[to_additive]
theorem Subsingleton.pi_mulSingle_eq {α : Type _} [DecidableEq I] [Subsingleton I] [One α]
    (i : I) (x : α) : Pi.mulSingle i x = fun _ => x :=
  funext fun j => by rw [Subsingleton.elim j i, Pi.mulSingle_eq_same]

#align subsingleton.pi_mul_single_eq Subsingleton.pi_mulSingle_eq
#align subsingleton.pi_single_eq Subsingleton.pi_single_eq

namespace Sum

variable (a a' : α → γ) (b b' : β → γ)

@[to_additive (attr := simp)]
theorem elim_one_one [One γ] : Sum.elim (1 : α → γ) (1 : β → γ) = 1 :=
  Sum.elim_const_const 1
#align sum.elim_one_one Sum.elim_one_one
#align sum.elim_zero_zero Sum.elim_zero_zero

@[to_additive (attr := simp)]
theorem elim_mulSingle_one [DecidableEq α] [DecidableEq β] [One γ] (i : α) (c : γ) :
    Sum.elim (Pi.mulSingle i c) (1 : β → γ) = Pi.mulSingle (Sum.inl i) c := by
  simp only [Pi.mulSingle, Sum.elim_update_left, elim_one_one]

@[to_additive (attr := simp)]
theorem elim_one_mulSingle [DecidableEq α] [DecidableEq β] [One γ] (i : β) (c : γ) :
    Sum.elim (1 : α → γ) (Pi.mulSingle i c) = Pi.mulSingle (Sum.inr i) c := by
  simp only [Pi.mulSingle, Sum.elim_update_right, elim_one_one]

#align sum.elim_mul_single_one Sum.elim_mulSingle_one
#align sum.elim_one_mul_single Sum.elim_one_mulSingle
#align sum.elim_single_zero Sum.elim_single_zero
#align sum.elim_zero_single Sum.elim_zero_single

@[to_additive]
theorem elim_inv_inv [Inv γ] : Sum.elim a⁻¹ b⁻¹ = (Sum.elim a b)⁻¹ :=
  (Sum.comp_elim Inv.inv a b).symm
#align sum.elim_inv_inv Sum.elim_inv_inv
#align sum.elim_neg_neg Sum.elim_neg_neg

@[to_additive]

@[to_additive]
theorem elim_div_div [Div γ] : Sum.elim (a / a') (b / b') = Sum.elim a b / Sum.elim a' b' := by
  ext x
  cases x <;> rfl
#align sum.elim_div_div Sum.elim_div_div
#align sum.elim_sub_sub Sum.elim_sub_sub

end Sum


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

From: https://github.com/leanprover-community/mathlib/blob/6b93ea7e4bbe7822960e821141e5a931537cd755/src/ring_theory/graded_algebra/homogeneous_ideal.lean
-/
import ring_theory.ideal.basic
import ring_theory.ideal.operations
import linear_algebra.finsupp

import cicm2022.internal.graded_ring

/-!
# Homogeneous ideals of a graded algebra

This file defines homogeneous ideals of `graded_ring 𝒜` where `𝒜 : ι → submodule R A` and
operations on them.

## Main definitions

For any `I : ideal A`:
* `ideal.is_homogeneous 𝒜 I`: The property that an ideal is closed under `graded_ring.proj`.
* `homogeneous_ideal 𝒜`: The structure extending ideals which satisfy `ideal.is_homogeneous`
* `ideal.homogeneous_core I 𝒜`: The largest homogeneous ideal smaller than `I`.
* `ideal.homogeneous_hull I 𝒜`: The smallest homogeneous ideal larger than `I`.

## Main statements

* `homogeneous_ideal.complete_lattice`: `ideal.is_homogeneous` is preserved by `⊥`, `⊤`, `⊔`, `⊓`,
  `⨆`, `⨅`, and so the subtype of homogeneous ideals inherits a complete lattice structure.
* `ideal.homogeneous_core.gi`: `ideal.homogeneous_core` forms a galois insertion with coercion.
* `ideal.homogeneous_hull.gi`: `ideal.homogeneous_hull` forms a galois insertion with coercion.

## Implementation notes

We introduce `ideal.homogeneous_core'` earlier than might be expected so that we can get access
to `ideal.is_homogeneous.iff_exists` as quickly as possible.

## Tags

graded algebra, homogeneous
-/

open set_like direct_sum set
open_locale big_operators pointwise direct_sum

variables {ι σ R A : Type*}

section homogeneous_def

variables [semiring A]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
variables [decidable_eq ι] [add_monoid ι] [graded_ring 𝒜]
variable (I : ideal A)
include A

/--An `I : ideal A` is homogeneous if for every `r ∈ I`, all homogeneous components
  of `r` are in `I`.-/
def ideal.is_homogeneous : Prop :=
∀ (i : ι) ⦃r : A⦄, r ∈ I → (direct_sum.decompose 𝒜 r i : A) ∈ I

/-- For any `semiring A`, we collect the homogeneous ideals of `A` into a type. -/
structure homogeneous_ideal extends submodule A A :=
(is_homogeneous' : ideal.is_homogeneous 𝒜 to_submodule)

variable {𝒜}
/--Converting a homogeneous ideal to an ideal-/
def homogeneous_ideal.to_ideal (I : homogeneous_ideal 𝒜) : ideal A := I.to_submodule

lemma homogeneous_ideal.is_homogeneous (I : homogeneous_ideal 𝒜) :
  I.to_ideal.is_homogeneous 𝒜 := I.is_homogeneous'

lemma homogeneous_ideal.to_ideal_injective :
  function.injective (homogeneous_ideal.to_ideal : homogeneous_ideal 𝒜 → ideal A) :=
λ ⟨x, hx⟩ ⟨y, hy⟩ (h : x = y), by simp [h]

instance homogeneous_ideal.set_like : set_like (homogeneous_ideal 𝒜) A :=
{ coe := λ I, I.to_ideal,
  coe_injective' := λ I J h, homogeneous_ideal.to_ideal_injective $ set_like.coe_injective h }

@[ext] lemma homogeneous_ideal.ext {I J : homogeneous_ideal 𝒜}
  (h : I.to_ideal = J.to_ideal) : I = J := homogeneous_ideal.to_ideal_injective h

@[simp] lemma homogeneous_ideal.mem_iff {I : homogeneous_ideal 𝒜} {x : A} :
  x ∈ I.to_ideal ↔ x ∈ I := iff.rfl

end homogeneous_def

section homogeneous_core

variables [semiring A]
variables [set_like σ A]  (𝒜 : ι → σ)
variable (I : ideal A)
include A

/-- For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_core' 𝒜`
is the largest homogeneous ideal of `A` contained in `I`, as an ideal. -/
def ideal.homogeneous_core' (I : ideal A) : ideal A :=
ideal.span (coe '' ((coe : subtype (is_homogeneous 𝒜) → A) ⁻¹' I))

lemma ideal.homogeneous_core'_mono : monotone (ideal.homogeneous_core' 𝒜) :=
λ I J I_le_J, ideal.span_mono $ set.image_subset _ $ λ x, @I_le_J _

lemma ideal.homogeneous_core'_le : I.homogeneous_core' 𝒜 ≤ I :=
ideal.span_le.2 $ image_preimage_subset _ _

end homogeneous_core

section is_homogeneous_ideal_defs

variables [semiring A]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
variables [decidable_eq ι] [add_monoid ι] [graded_ring 𝒜]
variable (I : ideal A)
include A

lemma ideal.is_homogeneous_iff_forall_subset :
  I.is_homogeneous 𝒜 ↔ ∀ i, (I : set A) ⊆ graded_ring.proj 𝒜 i ⁻¹' I :=
iff.rfl

lemma ideal.is_homogeneous_iff_subset_Inter :
  I.is_homogeneous 𝒜 ↔ (I : set A) ⊆ ⋂ i, graded_ring.proj 𝒜 i ⁻¹' ↑I :=
subset_Inter_iff.symm

lemma ideal.mul_homogeneous_element_mem_of_mem
  {I : ideal A} (r x : A) (hx₁ : is_homogeneous 𝒜 x) (hx₂ : x ∈ I) (j : ι) :
  graded_ring.proj 𝒜 j (r * x) ∈ I :=
begin
  classical,
  rw [←direct_sum.sum_support_decompose 𝒜 r, finset.sum_mul, map_sum],
  apply ideal.sum_mem,
  intros k hk,
  obtain ⟨i, hi⟩ := hx₁,
  have mem₁ : (direct_sum.decompose 𝒜 r k : A) * x ∈ 𝒜 (k + i) := graded_monoid.mul_mem
    (set_like.coe_mem _) hi,
  erw [graded_ring.proj_apply, direct_sum.decompose_of_mem 𝒜 mem₁,
    coe_of_apply, set_like.coe_mk],
  split_ifs,
  { exact I.mul_mem_left _ hx₂ },
  { exact I.zero_mem },
end

lemma ideal.is_homogeneous_span (s : set A) (h : ∀ x ∈ s, is_homogeneous 𝒜 x) :
  (ideal.span s).is_homogeneous 𝒜 :=
begin
  rintros i r hr,
  rw [ideal.span, finsupp.span_eq_range_total] at hr,
  rw linear_map.mem_range at hr,
  obtain ⟨s, rfl⟩ := hr,
  rw [finsupp.total_apply, finsupp.sum, decompose_sum, dfinsupp.finset_sum_apply,
    add_submonoid_class.coe_finset_sum],
  refine ideal.sum_mem _ _,
  rintros z hz1,
  rw [smul_eq_mul],
  refine ideal.mul_homogeneous_element_mem_of_mem 𝒜 (s z) z _ _ i,
  { rcases z with ⟨z, hz2⟩,
    apply h _ hz2, },
  { exact ideal.subset_span z.2 },
end

/--For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_core' 𝒜`
is the largest homogeneous ideal of `A` contained in `I`.-/
def ideal.homogeneous_core : homogeneous_ideal 𝒜 :=
⟨ideal.homogeneous_core' 𝒜 I,
  ideal.is_homogeneous_span _ _ (λ x h, by { rw [subtype.image_preimage_coe] at h, exact h.2 })⟩

lemma ideal.homogeneous_core_mono : monotone (ideal.homogeneous_core 𝒜) :=
ideal.homogeneous_core'_mono 𝒜

lemma ideal.to_ideal_homogeneous_core_le : (I.homogeneous_core 𝒜).to_ideal ≤ I :=
ideal.homogeneous_core'_le 𝒜 I

variables {𝒜 I}

lemma ideal.mem_homogeneous_core_of_is_homogeneous_of_mem {x : A}
  (h : set_like.is_homogeneous 𝒜 x) (hmem : x ∈ I) : x ∈ I.homogeneous_core 𝒜 :=
ideal.subset_span ⟨⟨x, h⟩, hmem, rfl⟩

lemma ideal.is_homogeneous.to_ideal_homogeneous_core_eq_self (h : I.is_homogeneous 𝒜) :
  (I.homogeneous_core 𝒜).to_ideal = I :=
begin
  apply le_antisymm (I.homogeneous_core'_le 𝒜) _,
  intros x hx,
  classical,
  rw ←direct_sum.sum_support_decompose 𝒜 x,
  exact ideal.sum_mem _ (λ j hj, ideal.subset_span ⟨⟨_, is_homogeneous_coe _⟩, h _ hx, rfl⟩)
end

@[simp] lemma homogeneous_ideal.to_ideal_homogeneous_core_eq_self (I : homogeneous_ideal 𝒜) :
  I.to_ideal.homogeneous_core 𝒜 = I :=
by ext1; convert ideal.is_homogeneous.to_ideal_homogeneous_core_eq_self I.is_homogeneous

variables (𝒜 I)

lemma ideal.is_homogeneous.iff_eq : I.is_homogeneous 𝒜 ↔ (I.homogeneous_core 𝒜).to_ideal = I :=
⟨ λ hI, hI.to_ideal_homogeneous_core_eq_self,
  λ hI, hI ▸ (ideal.homogeneous_core 𝒜 I).2 ⟩

lemma ideal.is_homogeneous.iff_exists :
  I.is_homogeneous 𝒜 ↔ ∃ (S : set (homogeneous_submonoid 𝒜)), I = ideal.span (coe '' S) :=
begin
  rw [ideal.is_homogeneous.iff_eq, eq_comm],
  exact ((set.image_preimage.compose (submodule.gi _ _).gc).exists_eq_l _).symm,
end

end is_homogeneous_ideal_defs

/-! ### Operations

In this section, we show that `ideal.is_homogeneous` is preserved by various notations, then use
these results to provide these notation typeclasses for `homogeneous_ideal`. -/

section operations

section semiring

variables [semiring A] [decidable_eq ι] [add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
include A

namespace ideal.is_homogeneous

lemma bot : ideal.is_homogeneous 𝒜 ⊥ := λ i r hr,
begin
  simp only [ideal.mem_bot] at hr,
  rw [hr, decompose_zero, zero_apply],
  apply ideal.zero_mem
end

lemma top : ideal.is_homogeneous 𝒜 ⊤ :=
λ i r hr, by simp only [submodule.mem_top]

variables {𝒜}

lemma inf {I J : ideal A} (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) :
  (I ⊓ J).is_homogeneous 𝒜 :=
λ i r hr, ⟨HI _ hr.1, HJ _ hr.2⟩

lemma sup {I J : ideal A} (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) :
  (I ⊔ J).is_homogeneous 𝒜 :=
begin
  rw iff_exists at HI HJ ⊢,
  obtain ⟨⟨s₁, rfl⟩, ⟨s₂, rfl⟩⟩ := ⟨HI, HJ⟩,
  refine ⟨s₁ ∪ s₂, _⟩,
  rw [set.image_union],
  exact (submodule.span_union _ _).symm,
end

protected lemma supr {κ : Sort*} {f : κ → ideal A} (h : ∀ i, (f i).is_homogeneous 𝒜) :
  (⨆ i, f i).is_homogeneous 𝒜 :=
begin
  simp_rw iff_exists at h ⊢,
  choose s hs using h,
  refine ⟨⋃ i, s i, _⟩,
  simp_rw [set.image_Union, ideal.span_Union],
  congr',
  exact funext hs,
end

protected lemma infi {κ : Sort*} {f : κ → ideal A} (h : ∀ i, (f i).is_homogeneous 𝒜) :
  (⨅ i, f i).is_homogeneous 𝒜 :=
begin
  intros i x hx,
  simp only [ideal.mem_infi] at ⊢ hx,
  exact λ j, h _ _ (hx j),
end

lemma supr₂ {κ : Sort*} {κ' : κ → Sort*} {f : Π i, κ' i → ideal A}
  (h : ∀ i j, (f i j).is_homogeneous 𝒜) :
  (⨆ i j, f i j).is_homogeneous 𝒜 :=
is_homogeneous.supr $ λ i, is_homogeneous.supr $ h i

lemma infi₂ {κ : Sort*} {κ' : κ → Sort*} {f : Π i, κ' i → ideal A}
  (h : ∀ i j, (f i j).is_homogeneous 𝒜) :
  (⨅ i j, f i j).is_homogeneous 𝒜 :=
is_homogeneous.infi $ λ i, is_homogeneous.infi $ h i

lemma Sup {ℐ : set (ideal A)} (h : ∀ I ∈ ℐ, ideal.is_homogeneous 𝒜 I) :
  (Sup ℐ).is_homogeneous 𝒜 :=
by { rw Sup_eq_supr, exact supr₂ h }

lemma Inf {ℐ : set (ideal A)} (h : ∀ I ∈ ℐ, ideal.is_homogeneous 𝒜 I) :
  (Inf ℐ).is_homogeneous 𝒜 :=
by { rw Inf_eq_infi, exact infi₂ h }

end ideal.is_homogeneous

variables {𝒜}

namespace homogeneous_ideal

instance : partial_order (homogeneous_ideal 𝒜) := set_like.partial_order

instance : has_top (homogeneous_ideal 𝒜) := ⟨⟨⊤, ideal.is_homogeneous.top 𝒜⟩⟩
instance : has_bot (homogeneous_ideal 𝒜) := ⟨⟨⊥, ideal.is_homogeneous.bot 𝒜⟩⟩
instance : has_sup (homogeneous_ideal 𝒜) := ⟨λ I J, ⟨_, I.is_homogeneous.sup J.is_homogeneous⟩⟩
instance : has_inf (homogeneous_ideal 𝒜) := ⟨λ I J, ⟨_, I.is_homogeneous.inf J.is_homogeneous⟩⟩
instance : has_Sup (homogeneous_ideal 𝒜) :=
⟨λ S, ⟨⨆ s ∈ S, to_ideal s, ideal.is_homogeneous.supr₂ $ λ s _, s.is_homogeneous⟩⟩
instance : has_Inf (homogeneous_ideal 𝒜) :=
⟨λ S, ⟨⨅ s ∈ S, to_ideal s, ideal.is_homogeneous.infi₂ $ λ s _, s.is_homogeneous⟩⟩

@[simp] lemma coe_top : ((⊤ : homogeneous_ideal 𝒜) : set A) = univ := rfl
@[simp] lemma coe_bot : ((⊥ : homogeneous_ideal 𝒜) : set A) = 0 := rfl
@[simp] lemma coe_sup (I J : homogeneous_ideal 𝒜) : ↑(I ⊔ J) = (I + J : set A) :=
submodule.coe_sup _ _
@[simp] lemma coe_inf (I J : homogeneous_ideal 𝒜) : (↑(I ⊓ J) : set A) = I ∩ J := rfl

@[simp] lemma to_ideal_top : (⊤ : homogeneous_ideal 𝒜).to_ideal = (⊤ : ideal A) := rfl
@[simp] lemma to_ideal_bot : (⊥ : homogeneous_ideal 𝒜).to_ideal = (⊥ : ideal A) := rfl

@[simp] lemma to_ideal_sup (I J : homogeneous_ideal 𝒜) :
  (I ⊔ J).to_ideal = I.to_ideal ⊔ J.to_ideal := rfl

@[simp] lemma to_ideal_inf (I J : homogeneous_ideal 𝒜) :
  (I ⊓ J).to_ideal = I.to_ideal ⊓ J.to_ideal := rfl

@[simp] lemma to_ideal_Sup (ℐ : set (homogeneous_ideal 𝒜)) :
  (Sup ℐ).to_ideal = ⨆ s ∈ ℐ, to_ideal s := rfl

@[simp] lemma to_ideal_Inf (ℐ : set (homogeneous_ideal 𝒜)) :
  (Inf ℐ).to_ideal = ⨅ s ∈ ℐ, to_ideal s := rfl

@[simp] lemma to_ideal_supr {κ : Sort*} (s : κ → homogeneous_ideal 𝒜) :
  (⨆ i, s i).to_ideal = ⨆ i, (s i).to_ideal :=
by rw [supr, to_ideal_Sup, supr_range]

@[simp] lemma to_ideal_infi {κ : Sort*} (s : κ → homogeneous_ideal 𝒜) :
  (⨅ i, s i).to_ideal = ⨅ i, (s i).to_ideal :=
by rw [infi, to_ideal_Inf, infi_range]

@[simp] lemma to_ideal_supr₂ {κ : Sort*} {κ' : κ → Sort*} (s : Π i, κ' i → homogeneous_ideal 𝒜) :
  (⨆ i j, s i j).to_ideal = ⨆ i j, (s i j).to_ideal :=
by simp_rw to_ideal_supr

@[simp] lemma to_ideal_infi₂ {κ : Sort*} {κ' : κ → Sort*} (s : Π i, κ' i → homogeneous_ideal 𝒜) :
  (⨅ i j, s i j).to_ideal = ⨅ i j, (s i j).to_ideal :=
by simp_rw to_ideal_infi

@[simp] lemma eq_top_iff (I : homogeneous_ideal 𝒜) : I = ⊤ ↔ I.to_ideal = ⊤ :=
to_ideal_injective.eq_iff.symm

@[simp] lemma eq_bot_iff (I : homogeneous_ideal 𝒜) : I = ⊥ ↔ I.to_ideal = ⊥ :=
to_ideal_injective.eq_iff.symm

instance : complete_lattice (homogeneous_ideal 𝒜) :=
to_ideal_injective.complete_lattice _ to_ideal_sup to_ideal_inf to_ideal_Sup to_ideal_Inf
  to_ideal_top to_ideal_bot

instance : has_add (homogeneous_ideal 𝒜) := ⟨(⊔)⟩

@[simp] lemma to_ideal_add (I J : homogeneous_ideal 𝒜) :
  (I + J).to_ideal = I.to_ideal + J.to_ideal := rfl

instance : inhabited (homogeneous_ideal 𝒜) := { default := ⊥ }

end homogeneous_ideal

end semiring

section comm_semiring
variables [comm_semiring A]
variables [decidable_eq ι] [add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] {𝒜 : ι → σ} [graded_ring 𝒜]
variable (I : ideal A)
include A

lemma ideal.is_homogeneous.mul {I J : ideal A}
  (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) : (I * J).is_homogeneous 𝒜 :=
begin
  rw ideal.is_homogeneous.iff_exists at HI HJ ⊢,
  obtain ⟨⟨s₁, rfl⟩, ⟨s₂, rfl⟩⟩ := ⟨HI, HJ⟩,
  rw ideal.span_mul_span',
  exact ⟨s₁ * s₂, congr_arg _ $ (set.image_mul (homogeneous_submonoid 𝒜).subtype).symm⟩,
end

variables {𝒜}

instance : has_mul (homogeneous_ideal 𝒜) :=
{ mul := λ I J, ⟨I.to_ideal * J.to_ideal, I.is_homogeneous.mul J.is_homogeneous⟩ }

@[simp] lemma homogeneous_ideal.to_ideal_mul (I J : homogeneous_ideal 𝒜) :
  (I * J).to_ideal = I.to_ideal * J.to_ideal := rfl

end comm_semiring

end operations

/-! ### Homogeneous core

Note that many results about the homogeneous core came earlier in this file, as they are helpful
for building the lattice structure. -/

section homogeneous_core

open homogeneous_ideal

variables [semiring A] [decidable_eq ι] [add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
variable (I : ideal A)
include A

lemma ideal.homogeneous_core.gc : galois_connection to_ideal (ideal.homogeneous_core 𝒜) :=
λ I J, ⟨
  λ H, I.to_ideal_homogeneous_core_eq_self ▸ ideal.homogeneous_core_mono 𝒜 H,
  λ H, le_trans H (ideal.homogeneous_core'_le _ _)⟩

/--`to_ideal : homogeneous_ideal 𝒜 → ideal A` and `ideal.homogeneous_core 𝒜` forms a galois
coinsertion-/
def ideal.homogeneous_core.gi : galois_coinsertion to_ideal (ideal.homogeneous_core 𝒜) :=
{ choice := λ I HI,
    ⟨I, le_antisymm (I.to_ideal_homogeneous_core_le 𝒜) HI ▸ homogeneous_ideal.is_homogeneous _⟩,
  gc := ideal.homogeneous_core.gc 𝒜,
  u_l_le := λ I, ideal.homogeneous_core'_le _ _,
  choice_eq := λ I H, le_antisymm H (I.to_ideal_homogeneous_core_le _) }

lemma ideal.homogeneous_core_eq_Sup :
  I.homogeneous_core 𝒜 = Sup {J : homogeneous_ideal 𝒜 | J.to_ideal ≤ I} :=
eq.symm $ is_lub.Sup_eq $ (ideal.homogeneous_core.gc 𝒜).is_greatest_u.is_lub

lemma ideal.homogeneous_core'_eq_Sup :
  I.homogeneous_core' 𝒜 = Sup {J : ideal A | J.is_homogeneous 𝒜 ∧ J ≤ I} :=
begin
  refine (is_lub.Sup_eq _).symm,
  apply is_greatest.is_lub,
  have coe_mono : monotone (to_ideal : homogeneous_ideal 𝒜 → ideal A) := λ x y, id,
  convert coe_mono.map_is_greatest (ideal.homogeneous_core.gc 𝒜).is_greatest_u using 1,
  ext,
  rw [mem_image, mem_set_of_eq],
  refine ⟨λ hI, ⟨⟨x, hI.1⟩, ⟨hI.2, rfl⟩⟩, by rintro ⟨x, ⟨hx, rfl⟩⟩; exact ⟨x.is_homogeneous, hx⟩⟩,
end

end homogeneous_core

/-! ### Homogeneous hulls -/

section homogeneous_hull

open homogeneous_ideal

variables [semiring A] [decidable_eq ι] [add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
variable (I : ideal A)
include A

/--For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_hull 𝒜` is
the smallest homogeneous ideal containing `I`. -/
def ideal.homogeneous_hull : homogeneous_ideal 𝒜 :=
⟨ideal.span {r : A | ∃ (i : ι) (x : I), (direct_sum.decompose 𝒜 (x : A) i : A) = r}, begin
  refine ideal.is_homogeneous_span _ _ (λ x hx, _),
  obtain ⟨i, x, rfl⟩ := hx,
  apply set_like.is_homogeneous_coe
end⟩

lemma ideal.le_to_ideal_homogeneous_hull :
  I ≤ (ideal.homogeneous_hull 𝒜 I).to_ideal :=
begin
  intros r hr,
  classical,
  rw [←direct_sum.sum_support_decompose 𝒜 r],
  refine ideal.sum_mem _ _, intros j hj,
  apply ideal.subset_span, use j, use ⟨r, hr⟩, refl,
end

lemma ideal.homogeneous_hull_mono : monotone (ideal.homogeneous_hull 𝒜) := λ I J I_le_J,
begin
  apply ideal.span_mono,
  rintros r ⟨hr1, ⟨x, hx⟩, rfl⟩,
  refine ⟨hr1, ⟨⟨x, I_le_J hx⟩, rfl⟩⟩,
end

variables {I 𝒜}

lemma ideal.is_homogeneous.to_ideal_homogeneous_hull_eq_self (h : I.is_homogeneous 𝒜) :
  (ideal.homogeneous_hull 𝒜 I).to_ideal = I :=
begin
  apply le_antisymm _ (ideal.le_to_ideal_homogeneous_hull _ _),
  apply (ideal.span_le).2,
  rintros _ ⟨i, x, rfl⟩,
  exact h _ x.prop,
end

@[simp] lemma homogeneous_ideal.homogeneous_hull_to_ideal_eq_self (I : homogeneous_ideal 𝒜) :
  I.to_ideal.homogeneous_hull 𝒜 = I :=
homogeneous_ideal.to_ideal_injective $ I.is_homogeneous.to_ideal_homogeneous_hull_eq_self

variables (I 𝒜)

lemma ideal.to_ideal_homogeneous_hull_eq_supr :
  (I.homogeneous_hull 𝒜).to_ideal = ⨆ i, ideal.span (graded_ring.proj 𝒜 i '' I) :=
begin
  rw ←ideal.span_Union,
  apply congr_arg ideal.span _,
  ext1,
  simp only [set.mem_Union, set.mem_image, mem_set_of_eq, graded_ring.proj_apply,
    set_like.exists, exists_prop, subtype.coe_mk, set_like.mem_coe],
end

lemma ideal.homogeneous_hull_eq_supr :
  (I.homogeneous_hull 𝒜) =
  ⨆ i, ⟨ideal.span (graded_ring.proj 𝒜 i '' I), ideal.is_homogeneous_span 𝒜 _
    (by {rintros _ ⟨x, -, rfl⟩, apply set_like.is_homogeneous_coe})⟩ :=
by { ext1, rw [ideal.to_ideal_homogeneous_hull_eq_supr, to_ideal_supr], refl }

end homogeneous_hull

section galois_connection

open homogeneous_ideal

variables [semiring A] [decidable_eq ι] [add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
include A

lemma ideal.homogeneous_hull.gc : galois_connection (ideal.homogeneous_hull 𝒜) to_ideal :=
λ I J, ⟨
  le_trans (ideal.le_to_ideal_homogeneous_hull _ _),
  λ H, J.homogeneous_hull_to_ideal_eq_self ▸ ideal.homogeneous_hull_mono 𝒜 H⟩

/-- `ideal.homogeneous_hull 𝒜` and `to_ideal : homogeneous_ideal 𝒜 → ideal A` form a galois
insertion-/
def ideal.homogeneous_hull.gi : galois_insertion (ideal.homogeneous_hull 𝒜) to_ideal :=
{ choice := λ I H, ⟨I, le_antisymm H (I.le_to_ideal_homogeneous_hull 𝒜) ▸ is_homogeneous _⟩,
  gc := ideal.homogeneous_hull.gc 𝒜,
  le_l_u := λ I, ideal.le_to_ideal_homogeneous_hull _ _,
  choice_eq := λ I H, le_antisymm (I.le_to_ideal_homogeneous_hull 𝒜) H}

lemma ideal.homogeneous_hull_eq_Inf (I : ideal A) :
  ideal.homogeneous_hull 𝒜 I = Inf { J : homogeneous_ideal 𝒜 | I ≤ J.to_ideal } :=
eq.symm $ is_glb.Inf_eq $ (ideal.homogeneous_hull.gc 𝒜).is_least_l.is_glb

end galois_connection

section irrelevant_ideal

variables [semiring A]
variables [decidable_eq ι]
variables [canonically_ordered_add_monoid ι]
variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
include A

open graded_ring set_like.graded_monoid direct_sum

/--
For a graded ring `⨁ᵢ 𝒜ᵢ` graded by a `canonically_ordered_add_monoid ι`, the irrelevant ideal
refers to `⨁_{i>0} 𝒜ᵢ`, or equivalently `{a | a₀ = 0}`. This definition is used in `Proj`
construction where `ι` is always `ℕ` so the irrelevant ideal is simply elements with `0` as
0-th coordinate.

# Future work
Here in the definition, `ι` is assumed to be `canonically_ordered_add_monoid`. However, the notion
of irrelevant ideal makes sense in a more general setting by defining it as the ideal of elements
with `0` as i-th coordinate for all `i ≤ 0`, i.e. `{a | ∀ (i : ι), i ≤ 0 → aᵢ = 0}`.
-/
def homogeneous_ideal.irrelevant : homogeneous_ideal 𝒜 :=
⟨(graded_ring.proj_zero_ring_hom 𝒜).ker, λ i r (hr : (decompose 𝒜 r 0 : A) = 0), begin
  change (decompose 𝒜 (decompose 𝒜 r _ : A) 0 : A) = 0,
  by_cases h : i = 0,
  { rw [h, hr, decompose_zero, zero_apply, add_submonoid_class.coe_zero] },
  { rw [decompose_of_mem_ne 𝒜 (set_like.coe_mem _) h] }
end⟩

@[simp] lemma homogeneous_ideal.mem_irrelevant_iff (a : A) :
  a ∈ homogeneous_ideal.irrelevant 𝒜 ↔ proj 𝒜 0 a = 0 := iff.rfl

@[simp] lemma homogeneous_ideal.to_ideal_irrelevant :
  (homogeneous_ideal.irrelevant 𝒜).to_ideal = (graded_ring.proj_zero_ring_hom 𝒜).ker := rfl

end irrelevant_ideal


namespace xena

-- Lean already has natural numbers, called `nat`
-- but we are in a different "namespace" so we can make a new nat
-- which will really be called xena.nat

inductive xnat
| zero : xnat
| succ : xnat → xnat

open xnat

-- #print xnat -- as you can see, they're called xena.xnat

-- The idea is that there are two kinds of ways to construct
-- an element of the set xnat (or, as a computer scientist
-- would say, an object of type xnat).
--
-- The first one is xnat.zero, which is zero:

-- #check zero

-- The second one is that if n is an xnat, then
-- succ n is an xnat.

-- #check succ (zero)

-- #check succ (succ (succ (succ zero)))

-- We think of "succ" as meaning "successor", i.e. "the next one"

-- These are the *only* ways of building xnats. So every xnat
-- must be of the form succ (succ (succ ... zero)))...)
-- with some number of succs.

-- Because zero, and the successor function, are the only ways of
-- building elements of the set xnat, and because different constructions
-- are by definition different xnats, you can see that we have here
-- a model of the set {0,1,2,3,4,...}

-- with 0 = zero
-- and 1 = succ zero
-- and 2 = succ (succ zero)

-- and so on.

-- Now, behind the scenes, when Lean constructed our set xnat,
-- it also constructed two important functions: a function for
-- proving things by induction, and a function for defining things
-- by recursion (which is the same as induction but for defining
-- things rather than proving things -- you'll see examples in a minute).

-- For example we can now define addition, by recursion:

definition add : xnat → xnat → xnat -- this slightly weird notation means "put two naturals in, get one out"
| n zero := n
| n (succ p) := succ (add n p)

-- This definition reads as follows. We define a function "add (n,m)" by:
-- if m = zero then add(n,m)=n
-- if m = succ p then add(n,m)=succ(add(n,p))

-- We can use the more familiar notation "0" for zero and "+" for add
-- with some Lean trickery:

notation a + b := add a b
definition one := succ zero
definition two := succ one

example : one + one = two :=
begin
refl
end

-- #check zero + zero
-- #reduce zero + zero

-- #check one + one
-- #reduce one + one

-- associativity

theorem add_assoc (a b c : xnat) : (a + b) + c = a + (b + c) :=

-- remark: a+b+C=(a+b)+c
begin
induction c with n Hn,
  unfold add,
unfold add,
rw [Hn],
end

theorem add_zero (n : xnat) : n + zero = n := by unfold add

theorem zero_add (n : xnat) : zero + n = n :=
begin
induction n with t Ht,
  refl,
unfold add,
rw [Ht],
end

-- Now let's prove that a+b=b+a for all xnats a and b!
-- I want to prove this by induction on a, say. But
-- the base case is 0+b=b+0 and even that needs a proof.
-- So let's prove that first, by induction on b.
-- Note that this next bit will be pretty impossible to understand
-- unless you are actually using Lean.

-- set_option pp.notation false

theorem zero_add_eq_add_zero (n : xnat) : zero + n = n + zero :=
begin
rewrite [zero_add,add_zero]
end

-- #check zero_add_eq_add_zero

/-
induction b with n Hn, -- this starts our induction on b; the "with" just names the variable and hypothesis.
  -- We now have two problems -- the base case and the inductive step.
  -- The base case is just to prove that 0 + 0 = 0 + 0, and this is true by
  -- the fact that "= is reflexive", which is a silly way of saying that x=x for every x.
  -- So we can prove this using reflexivity.
  refl,
-- For the inductive step you can see that we need to use the definition of +. So let's apply it
-- by "unfolding" it.
-- At this point in the argument our hypothesis is 0+n=n+0
-- and our goal is 0+(succ n) = (succ n)+0.
unfold add, -- this unfolds add in the goal.
-- By *definition* of add, 0+(succ n) is succ(0+n)
-- and ny *definition*, (succ n)+0 is succ n.
-- So now the goal has changed to proving succ(0+n)=succ(n)
-- This would be easy if we knew 0+n=n! But our hypothesis is that 0+n=n+0 which is a bit different!
-- We need to unfold that right hand add in the hypothesis as well, because n+0=n by definition.
unfold add at Hn, -- Now the hypothesis is 0+n=n
-- So now we just substitute the hypothesis into the goal
-- using the "rewrite" command.
rewrite [Hn], -- and now we are done!
end
-/

theorem one_add_eq_succ (n : xnat) : (succ zero) + n = succ n :=
begin
induction n with a Ha,
  refl,
  unfold add,
  rw [Ha],
end

theorem add_one_eq_succ (n : xnat) : n + (succ zero) = succ n :=
begin
unfold add
end

-- Now we can prove that a+b=b+a for all a,b

theorem add_comm (a b : xnat) : a + b = b + a :=
begin
induction a with m Hm,
-- Our base case is just the previous
-- theorem zero_add_eq_add_zero:
  exact zero_add_eq_add_zero b,
-- The inductive step: we are assuming
-- Hm : forall b, m+b=b+m
-- and we need to prove
-- forall b, (succ m) + b = b + (succ m).
-- let's get this "forall" out of the goal

-- now let's unfold add so b + (succ m) changes to succ (b+m)
unfold add,
-- the trick now is to apply our hypothesis Hm
rewrite ←one_add_eq_succ,
rewrite ←one_add_eq_succ (b+m),
rewrite add_assoc,
rewrite Hm
end

-- bonus stage

theorem eq_iff_succ_eq_succ (a b : xnat) : succ a = succ b ↔ a = b :=
begin
split,
  exact succ.inj,
assume H : a = b,
rw [H]
end

theorem add_cancel_right (a b t : xnat) :  a = b ↔ a+t = b+t :=
begin
split,
  assume H : a=b,
  induction t with n Hn,
    unfold add,
    exact H,
  unfold add,
  rw [Hn],

induction t with n Hn,
  unfold add,
  assume H : a=b,
  exact H,
unfold add,
rwa [eq_iff_succ_eq_succ],
end

definition mul : xnat → xnat → xnat -- this slightly weird notation means "put two naturals in, get one out"
| n zero := zero
| n (succ p) := (mul n p) + n

notation a * b := mul a b

theorem mul_zero (a : xnat) : a * zero = zero := rfl

theorem zero_mul (a : xnat) : zero * a = zero :=
begin
induction a with n Hn,
  refl,
unfold mul,
rw Hn,
refl
end

theorem mul_one (a : xnat) : a * (succ zero) = a :=
begin
unfold mul,
exact zero_add a,
end

theorem one_mul (a : xnat) : (succ zero) * a = a :=
begin
induction a with n Hn,
  refl,
unfold mul,
rewrite Hn,
exact add_one_eq_succ n
end

theorem right_distrib (a b c : xnat) : a * (b + c) = a* b + a * c :=
begin
induction c with n Hn,
  unfold add,
  unfold mul,
  unfold add,
unfold add,
unfold mul,
rewrite Hn,
rewrite add_assoc
end

theorem left_distrib (a b c : xnat) : (a + b) * c = a * c + b * c :=
begin
induction c with n Hn,
  unfold mul,
  refl,
rw [←add_one_eq_succ,right_distrib,Hn,right_distrib,right_distrib],
rw [mul_one,mul_one,mul_one],
rw [add_assoc,←add_assoc (b*n),add_comm (b*n),←add_assoc,←add_assoc,←add_assoc],
end

theorem mul_assoc (a b c : xnat) : (a * b) * c = a * (b * c) :=
begin
induction c with n Hn,
  unfold mul,
unfold mul,
rewrite right_distrib,
rewrite Hn,
end

theorem mul_comm (a b : xnat) : a * b = b * a :=
begin
induction b with n Hn,
  rewrite zero_mul,
  exact mul_zero a,
unfold mul,
rewrite Hn,
rewrite ←add_one_eq_succ,
rewrite left_distrib,
rewrite one_mul,
end

definition less_than : xnat → xnat → Prop
| n zero := false
| zero (succ p) := true
| (succ m) (succ p) := less_than m p

notation a < b := less_than a b

notation b > a := less_than a b

theorem add_succ_equals_succ (a b : xnat) : a + (succ b) = succ (a + b) :=
begin
  rw [←add_one_eq_succ,←add_one_eq_succ (a+b)],
  rw add_assoc,
end

theorem inequality_A1 (a b t : xnat) : a < b → a + t < b + t :=
begin
assume H : a < b,
induction t with n Hn,
  unfold add,
  exact H,
repeat {rw [add_succ_equals_succ]},
unfold less_than,
exact Hn
end

-- set_option pp.notation false

theorem not_less_than_zero (a : xnat) : ¬ (a < zero) :=
begin
assume H : a < zero,
  cases a,
  exact H,
exact H,
end

-- set_option pp.notation false

definition less_than_or_equal (a b : xnat) := a=b ∨ a<b

notation a ≤ b := less_than_or_equal a b
notation b ≤ a := a ≤ b

theorem zero_leq (a : xnat) : zero ≤ a :=
begin
cases a,
  unfold less_than_or_equal,
  left,
  refl,
unfold less_than_or_equal,
right,
unfold less_than,
end

theorem zero_lt_succ (a : xnat) : zero < succ a := trivial

theorem not_succ_le_zero (a : xnat) : ¬ (succ a ≤ zero) :=
begin
assume H : succ a ≤ zero,
cases H with H1 H2,
  exact xnat.no_confusion H1,
  exact H2,
end

theorem lt_succ (a : xnat) : a < succ a :=
begin
induction a with n Hn,
  unfold less_than,
unfold less_than,
exact Hn,
end

theorem succ_lt_succ_of_lt (a b : xnat) : a < b → succ a < succ b :=
begin
assume H : a < b,
unfold less_than,
exact H,
end

theorem le_of_succ_le_succ (a b : xnat) : succ a ≤ succ b → a ≤ b :=
begin
assume H : succ a ≤ succ b,
cases H with H1 H2,
  left,
  rwa [←eq_iff_succ_eq_succ],
right,
unfold less_than at H2,
assumption,
end

theorem lt_or_eq_or_gt' (a : xnat) : ∀ b, a < b ∨ a = b ∨ b < a :=
begin
induction a with n Hn,
  intro b,
  cases b,
    right,left,
    trivial,
  left,
  trivial,
intro b,
cases b with m,
  cases n,
    right,right,
    trivial,
  right,right,
  trivial,
unfold less_than,
rw [eq_iff_succ_eq_succ],
exact Hn m,
end

theorem lt_or_eq_or_gt (a b : xnat) : a < b ∨ a = b ∨ b < a :=
begin
exact lt_or_eq_or_gt' a b,
end

theorem lt_irrefl (a : xnat) : ¬ (a < a) :=
begin
  induction a with n Hn,
  unfold less_than,
  trivial,
unfold less_than,
assumption,
end

theorem ne_of_lt (a b : xnat) : a < b → ¬ (a=b) :=
begin
assume Hlt : a < b,
assume Heq : a = b,
rw Heq at Hlt,
exact lt_irrefl b Hlt,
end

theorem lt_antisymm' (b : xnat) : ∀ a, a < b → ¬ (b < a) :=
begin
induction b with n Hn,
  intro a,
  assume H : a < zero,
  exfalso,
  exact not_less_than_zero a H,
intro a,
cases a with m Hm,
  intro,
  exact not_less_than_zero (succ n),
unfold less_than,
exact Hn m,
end

theorem lt_antisymm (a b : xnat) : a < b → ¬  (b < a) :=
begin
exact lt_antisymm' b a
end

theorem inequality_A2' (a : xnat) : ∀ b c, a < b → b < c → a < c :=
begin
induction a with n Hn,
  intros b c,
  assume H1 : zero < b,
  assume H2 : b < c,
  induction c with m Hm,
    exfalso,
    exact not_less_than_zero b H2,
  unfold less_than,
intros b c,
cases b with m,
  unfold less_than,
  intro H,
  exfalso,
  exact H,
cases c,
  intro H1,
  unfold less_than,
  intro,assumption,
unfold less_than,
exact Hn m c,
end

theorem inequality_A2 (a b c : xnat) : a<b → b<c → a<c :=
begin
exact inequality_A2' a b c,
end
-- Done A1 : a<b -> a+t<b+t
-- Done A2 : a<b, b<c -> a<c
-- A3 : exactly one of a<b, a=b, a>b.
-- A4 : x>0,y>0 -> xy>0

theorem inequality_A3 (a b : xnat) : (a<b ∨ a=b ∨ b < a)
                                   ∧ (a<b → ¬ (a=b))
                                   ∧ (a<b → ¬ (b<a))
                                   ∧ ((a=b)→ ¬ (b<a)) :=
begin
split,
  exact lt_or_eq_or_gt a b,
split,
  exact ne_of_lt a b,
split,
  exact lt_antisymm a b,
intro H1,
intro H2,
exact ne_of_lt b a H2 (eq.symm H1),
end

theorem inequality_A4 (a b : xnat) : a>zero → b>zero → a*b > zero :=
begin
assume Ha : a > zero,
assume Hb : b > zero,
cases a with n,
  exfalso,
  exact Ha,
cases b with m,
  exfalso,
  exact Hb,
dunfold mul,
dunfold add,
dunfold less_than,
trivial,
end

theorem lt_succ_of_lt (a b : xnat) : a < b → a < succ b :=
begin
admit,
end

theorem le_iff_add (a b : xnat) : a < b ↔ ∃ t : xnat, b = a + succ t :=
begin
split,
  assume H : a < b,
  induction b with n Hn,
    exfalso,
    exact not_less_than_zero a H,
  admit,admit
end

theorem lt_succ_iff_leq (a b : xnat) : a < succ b ↔ a ≤ b :=
begin
split,
  assume H : a < succ b,
  induction b with n Hn,
    cases a,
      left,
      refl,
    exfalso,
    unfold less_than at H,
    cases a,
      exact H,
    exact H,
  admit,
admit,
end

end xena

/-
#print conv

example (P : ℕ → ℕ → ℕ → Prop) (x:ℕ) (H:x=0) : P x x x :=
begin
  conv {for x [2] {rw H}},
  admit
end

end xena

-/


--------------------------------------------------------------------------------
-- File     : PUZ130_1 : TPTP v7.3.0. Released v5.5.0.
-- Domain   : Puzzles
-- Problem  : Garfield and Odie
-- Version  : Especial.
-- English  : Garfield is a cat and Odie is a dog. Cats and dogs are pets. Jon
--            is a human. Every pet has a human owner. Jon owns Garfield and
--            Odie, and they are the only cat and dog he owns. If a dog chases
--            a cat, then the cat's owner hates the dog's owner. Odie has chased
--            Garfield. Therefore, Jon hates himself.

-- Source   : [TPTP : tptp.org]
--------------------------------------------------------------------------------

variable animal : Type
variable cat : Type
variable dog : Type
variable human: Type
variable cat_to_animal: cat → animal
variable dog_to_animal: dog → animal
variable garfield : cat
variable odie : dog
variable jon: human
variable owner_of : animal → human
variable chased : dog → cat → Prop
variable hates : human → human → Prop

-- axioms (as variables too)
variable human_owner :
  ∀ A : animal,
  ∃ H : human,
  H = owner_of(A)

variable jon_owns_garfield :
  jon = owner_of(cat_to_animal garfield)

variable jon_owns_odie :
  jon = owner_of(dog_to_animal odie)

variable jon_owns_only :
  ∀ A : animal,
  jon = owner_of(A) →
  A = cat_to_animal(garfield) ∨ A = dog_to_animal(odie)

variable dog_chase_cat :
  ∀ (C : cat) (D : dog),
  chased D C →
  hates
    (owner_of(cat_to_animal(C)))
    (owner_of(dog_to_animal(D)))

variable odie_chased_garfield :
  chased odie garfield

-- conjecture : jon_hates_jon
include jon_owns_garfield
include jon_owns_odie
theorem jon_hates_jon : hates jon jon :=
  have a1 : hates _ _,
  from dog_chase_cat _ _ odie_chased_garfield,
  begin
    rw jon_owns_garfield.symm at a1,
    rw jon_owns_odie.symm at a1,
    assumption
  end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module data.nat.with_bot
! leanprover-community/mathlib commit 966e0cf0685c9cedf8a3283ac69eef4d5f2eaca2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.Data.Nat.Order.Basic
import Mathlib.Algebra.Order.Monoid.WithTop
import Aesop

/-!
# `WithBot ℕ`

Lemmas about the type of natural numbers with a bottom element adjoined.
-/

namespace Nat

namespace WithBot

theorem add_eq_zero_iff {n m : WithBot ℕ} : n + m = 0 ↔ n = 0 ∧ m = 0 := by
  rcases n, m with ⟨_ | _, _ | _⟩
  any_goals (exact ⟨fun h => Option.noConfusion h, fun h => Option.noConfusion h.1⟩)
  exact ⟨fun h => Option.noConfusion h, fun h => Option.noConfusion h.2⟩
  repeat' erw [WithBot.coe_eq_coe]
  exact add_eq_zero_iff' (zero_le _) (zero_le _)
#align nat.with_bot.add_eq_zero_iff Nat.WithBot.add_eq_zero_iff

theorem add_eq_two_iff {n m : WithBot ℕ} :
    n + m = 2 ↔ n = 0 ∧ m = 2 ∨ n = 1 ∧ m = 1 ∨ n = 2 ∧ m = 0 := by
  rcases n, m with ⟨_ | _, _ | _⟩
  any_goals refine' ⟨fun h => Option.noConfusion h, fun h => _⟩; aesop
  repeat' erw [WithBot.coe_eq_coe]
  exact Nat.add_eq_two_iff
#align nat.with_bot.add_eq_two_iff Nat.WithBot.add_eq_two_iff

theorem add_eq_three_iff {n m : WithBot ℕ} :
    n + m = 3 ↔ n = 0 ∧ m = 3 ∨ n = 1 ∧ m = 2 ∨ n = 2 ∧ m = 1 ∨ n = 3 ∧ m = 0 := by
  rcases n, m with ⟨_ | _, _ | _⟩
  any_goals refine' ⟨fun h => Option.noConfusion h, fun h => _⟩; aesop
  repeat' erw [WithBot.coe_eq_coe]
  exact Nat.add_eq_three_iff
#align nat.with_bot.add_eq_three_iff Nat.WithBot.add_eq_three_iff

theorem coe_nonneg {n : ℕ} : 0 ≤ (n : WithBot ℕ) := by
  rw [← WithBot.coe_zero]
  exact WithBot.coe_le_coe.mpr (Nat.zero_le n)
#align nat.with_bot.coe_nonneg Nat.WithBot.coe_nonneg

@[simp]
theorem lt_zero_iff (n : WithBot ℕ) : n < 0 ↔ n = ⊥ := by
 refine' Option.casesOn n _ _
 exact of_eq_true (eq_true_of_decide (Eq.refl true))
 intro n
 refine' ⟨fun h => _, fun h => _⟩
 exfalso
 · rw [WithBot.some_eq_coe] at h
   exact not_le_of_lt h WithBot.coe_nonneg
 · rw [h]
   exact of_eq_true (eq_true_of_decide (Eq.refl true))
#align nat.with_bot.lt_zero_iff Nat.WithBot.lt_zero_iff

theorem one_le_iff_zero_lt {x : WithBot ℕ} : 1 ≤ x ↔ 0 < x := by
  refine' ⟨fun h => lt_of_lt_of_le (WithBot.coe_lt_coe.mpr zero_lt_one) h, fun h => _⟩
  induction x using WithBot.recBotCoe
  · exact (not_lt_bot h).elim
  · exact WithBot.coe_le_coe.mpr (Nat.succ_le_iff.mpr (WithBot.coe_lt_coe.mp h))
#align nat.with_bot.one_le_iff_zero_lt Nat.WithBot.one_le_iff_zero_lt

theorem lt_one_iff_le_zero {x : WithBot ℕ} : x < 1 ↔ x ≤ 0 :=
  not_iff_not.mp (by simpa using one_le_iff_zero_lt)
#align nat.with_bot.lt_one_iff_le_zero Nat.WithBot.lt_one_iff_le_zero

theorem add_one_le_of_lt {n m : WithBot ℕ} (h : n < m) : n + 1 ≤ m := by
  cases n
  · exact bot_le
  cases m
  exacts [(not_lt_bot h).elim, WithBot.some_le_some.2 (WithBot.some_lt_some.1 h)]
#align nat.with_bot.add_one_le_of_lt Nat.WithBot.add_one_le_of_lt

end WithBot

end Nat


/-
Copyright (c) 2022 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import measure_theory.group.add_circle
import dynamics.ergodic.ergodic
import measure_theory.covering.density_theorem
import data.set.pointwise.iterate

/-!
# Ergodic maps of the additive circle

This file contains proofs of ergodicity for maps of the additive circle.

## Main definitions:

 * `add_circle.ergodic_zsmul`: given `n : ℤ` such that `1 < |n|`, the self map `y ↦ n • y` on
   the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_nsmul`: given `n : ℕ` such that `1 < n`, the self map `y ↦ n • y` on
   the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_zsmul_add`: given `n : ℤ` such that `1 < |n|` and `x : add_circle T`, the
   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_nsmul_add`: given `n : ℕ` such that `1 < n` and `x : add_circle T`, the
   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).

-/

open set function measure_theory measure_theory.measure filter metric
open_locale measure_theory nnreal ennreal topology pointwise

namespace add_circle

variables {T : ℝ} [hT : fact (0 < T)]
include hT

/-- If a null-measurable subset of the circle is almost invariant under rotation by a family of
rational angles with denominators tending to infinity, then it must be almost empty or almost full.
-/
lemma ae_empty_or_univ_of_forall_vadd_ae_eq_self
  {s : set $ add_circle T} (hs : null_measurable_set s volume)
  {ι : Type*} {l : filter ι} [l.ne_bot] {u : ι → add_circle T}
  (hu₁ : ∀ i, ((u i) +ᵥ s : set _) =ᵐ[volume] s) (hu₂ : tendsto (add_order_of ∘ u) l at_top) :
  s =ᵐ[volume] (∅ : set $ add_circle T) ∨ s =ᵐ[volume] univ :=
begin
  /- Sketch of proof:
  Assume `T = 1` for simplicity and let `μ` be the Haar measure. We may assume `s` has positive
  measure since otherwise there is nothing to prove. In this case, by Lebesgue's density theorem,
  there exists a point `d` of positive density. Let `Iⱼ` be the sequence of closed balls about `d`
  of diameter `1 / nⱼ` where `nⱼ` is the additive order of `uⱼ`. Since `d` has positive density we
  must have `μ (s ∩ Iⱼ) / μ Iⱼ → 1` along `l`. However since `s` is invariant under the action of
  `uⱼ` and since `Iⱼ` is a fundamental domain for this action, we must have
  `μ (s ∩ Iⱼ) = nⱼ * μ s = (μ Iⱼ) * μ s`. We thus have `μ s → 1` and thus `μ s = 1`. -/
  set μ := (volume : measure $ add_circle T),
  set n : ι → ℕ := add_order_of ∘ u,
  have hT₀ : 0 < T := hT.out,
  have hT₁ : ennreal.of_real T ≠ 0 := by simpa,
  rw [ae_eq_empty, ae_eq_univ_iff_measure_eq hs, add_circle.measure_univ],
  cases (eq_or_ne (μ s) 0) with h h, { exact or.inl h, },
  right,
  obtain ⟨d, -, hd⟩ : ∃ d, d ∈ s ∧ ∀ {ι'} {l : filter ι'} (w : ι' → add_circle T) (δ : ι' → ℝ),
    tendsto δ l (𝓝[>] 0) → (∀ᶠ j in l, d ∈ closed_ball (w j) (1 * δ j)) →
      tendsto (λ j, μ (s ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l (𝓝 1) :=
    exists_mem_of_measure_ne_zero_of_ae h (is_doubling_measure.ae_tendsto_measure_inter_div μ s 1),
  let I : ι → set (add_circle T) := λ j, closed_ball d (T / (2 * ↑(n j))),
  replace hd : tendsto (λ j, μ (s ∩ I j) / μ (I j)) l (𝓝 1),
  { let δ : ι → ℝ := λ j, T / (2 * ↑(n j)),
    have hδ₀ : ∀ᶠ j in l, 0 < δ j :=
      (hu₂.eventually_gt_at_top 0).mono (λ j hj, div_pos hT₀ $ by positivity),
    have hδ₁ : tendsto δ l (𝓝[>] 0),
    { refine tendsto_nhds_within_iff.mpr ⟨_, hδ₀⟩,
      replace hu₂ : tendsto (λ j, (T⁻¹ * 2) * n j) l at_top :=
        (tendsto_coe_nat_at_top_iff.mpr hu₂).const_mul_at_top (by positivity : 0 < T⁻¹ * 2),
      convert hu₂.inv_tendsto_at_top,
      ext j,
      simp only [δ, pi.inv_apply, mul_inv_rev, inv_inv, div_eq_inv_mul, ← mul_assoc], },
    have hw : ∀ᶠ j in l, d ∈ closed_ball d (1 * δ j) := hδ₀.mono (λ j hj, by simp [hj.le]),
    exact hd _ δ hδ₁ hw, },
  suffices : ∀ᶠ j in l, μ (s ∩ I j) / μ (I j) = μ s / ennreal.of_real T,
  { replace hd := hd.congr' this,
    rwa [tendsto_const_nhds_iff, ennreal.div_eq_one_iff hT₁ ennreal.of_real_ne_top] at hd, },
  refine (hu₂.eventually_gt_at_top 0).mono (λ j hj, _),
  have huj : is_of_fin_add_order (u j) := add_order_of_pos_iff.mp hj,
  have huj' : 1 ≤ (↑(n j) : ℝ), { norm_cast, exact nat.succ_le_iff.mpr hj, },
  have hI₀ : μ (I j) ≠ 0 := (measure_closed_ball_pos _ d $ by positivity).ne.symm,
  have hI₁ : μ (I j) ≠ ⊤ := measure_ne_top _ _,
  have hI₂ : μ (I j) * ↑(n j) = ennreal.of_real T,
  { rw [volume_closed_ball, mul_div, mul_div_mul_left T _ two_ne_zero,
      min_eq_right (div_le_self hT₀.le huj'), mul_comm, ← nsmul_eq_mul, ← ennreal.of_real_nsmul,
      nsmul_eq_mul, mul_div_cancel'],
    exact nat.cast_ne_zero.mpr hj.ne', },
  rw [ennreal.div_eq_div_iff hT₁ ennreal.of_real_ne_top hI₀ hI₁,
    volume_of_add_preimage_eq s _ (u j) d huj (hu₁ j) closed_ball_ae_eq_ball, nsmul_eq_mul,
    ← mul_assoc, hI₂],
end

lemma ergodic_zsmul {n : ℤ} (hn : 1 < |n|) : ergodic (λ (y : add_circle T), n • y) :=
{ ae_empty_or_univ := λ s hs hs',
  begin
    let u : ℕ → add_circle T := λ j, ↑(((↑1 : ℝ) / ↑(n.nat_abs^j)) * T),
    replace hn : 1 < n.nat_abs, { rwa [int.abs_eq_nat_abs, nat.one_lt_cast] at hn, },
    have hu₀ : ∀ j, add_order_of (u j) = n.nat_abs^j,
    { exact λ j, add_order_of_div_of_gcd_eq_one (pow_pos (pos_of_gt hn) j) (gcd_one_left _), },
    have hnu : ∀ j, n^j • (u j) = 0 := λ j, by rw [← add_order_of_dvd_iff_zsmul_eq_zero, hu₀,
      int.coe_nat_pow, int.coe_nat_abs, ← abs_pow, abs_dvd],
    have hu₁ : ∀ j, ((u j) +ᵥ s : set _) =ᵐ[volume] s :=
      λ j, by rw vadd_eq_self_of_preimage_zsmul_eq_self hs' (hnu j),
    have hu₂ : tendsto (λ j, add_order_of $ u j) at_top at_top,
    { simp_rw hu₀, exact nat.tendsto_pow_at_top_at_top_of_one_lt hn, },
    exact ae_empty_or_univ_of_forall_vadd_ae_eq_self hs.null_measurable_set hu₁ hu₂,
  end,
  .. measure_preserving_zsmul volume (abs_pos.mp $ lt_trans zero_lt_one hn), }

lemma ergodic_nsmul {n : ℕ} (hn : 1 < n) : ergodic (λ (y : add_circle T), n • y) :=
ergodic_zsmul (by simp [hn] : 1 < |(n : ℤ)|)

lemma ergodic_zsmul_add (x : add_circle T) {n : ℤ} (h : 1 < |n|) : ergodic $ λ y, n • y + x :=
begin
  set f : add_circle T → add_circle T := λ y, n • y + x,
  let e : add_circle T ≃ᵐ add_circle T := measurable_equiv.add_left (divisible_by.div x $ n - 1),
  have he : measure_preserving e volume volume := measure_preserving_add_left volume _,
  suffices : e ∘ f ∘ e.symm = λ y, n • y,
  { rw [← he.ergodic_conjugate_iff, this], exact ergodic_zsmul h, },
  replace h : n - 1 ≠ 0, { rw ←abs_one at h, rw sub_ne_zero, exact ne_of_apply_ne _ (ne_of_gt h), },
  have hnx : n • divisible_by.div x (n - 1) = x + divisible_by.div x (n - 1),
  { conv_rhs { congr, rw ←divisible_by.div_cancel x h }, rw [sub_smul, one_smul, sub_add_cancel], },
  ext y,
  simp only [f, hnx, measurable_equiv.coe_add_left, measurable_equiv.symm_add_left, comp_app,
    smul_add, zsmul_neg', neg_smul, neg_add_rev],
  abel,
end

lemma ergodic_nsmul_add (x : add_circle T) {n : ℕ} (h : 1 < n) : ergodic $ λ y, n • y + x :=
ergodic_zsmul_add x (by simp [h] : 1 < |(n : ℤ)|)

end add_circle


/-
Quick&dirty port of some parts of `data.equiv.basic` from Lean 3.

Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/

import UniverseAbstractions.MathlibFragments.Init.Notation

set_option autoBoundImplicitLocal false

universe u₁ u₂ u₃ u₄ v

structure Equiv (α : Sort u₁) (β : Sort u₂) where
(toFun    : α → β)
(invFun   : β → α)
(leftInv  : ∀ x, invFun (toFun x) = x)
(rightInv : ∀ y, toFun (invFun y) = y)

namespace Equiv

instance : HasEquivalence (Sort u₁) (Sort u₂) := ⟨Equiv⟩
instance (α : Sort u₁) (β : Sort u₂) : CoeFun (α ≃ β) (λ _ => α → β) := ⟨Equiv.toFun⟩

theorem ext {α : Sort u₁} {β : Sort u₂} {e₁ e₂ : α ≃ β} :
  e₁.toFun = e₂.toFun ∧ e₁.invFun = e₂.invFun → e₁ = e₂ :=
sorry

theorem inj {α : Sort u₁} {β : Sort u₂} {e₁ e₂ : α ≃ β} :
  e₁.toFun = e₂.toFun → e₁ = e₂ :=
sorry

def refl (α : Sort u₁) : α ≃ α := ⟨id, id, λ x => rfl, λ y => rfl⟩

def symm {α : Sort u₁} {β : Sort u₂} (e : α ≃ β) : β ≃ α := ⟨e.invFun, e.toFun, e.rightInv, e.leftInv⟩

theorem trans_leftInv {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} (e₁ : α ≃ β) (e₂ : β ≃ γ) (x : α) :
  e₁.invFun (e₂.invFun (e₂.toFun (e₁.toFun x))) = x :=
Eq.trans (congrArg e₁.invFun (e₂.leftInv (e₁.toFun x))) (e₁.leftInv x)

theorem trans_rightInv {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} (e₁ : α ≃ β) (e₂ : β ≃ γ) (y : γ) :
  e₂.toFun (e₁.toFun (e₁.invFun (e₂.invFun y))) = y :=
trans_leftInv (symm e₂) (symm e₁) y

def trans {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
⟨e₂.toFun ∘ e₁.toFun, e₁.invFun ∘ e₂.invFun, trans_leftInv e₁ e₂, trans_rightInv e₁ e₂⟩

variable {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} {δ : Sort u₄}

@[simp] theorem symm_symm (e : α ≃ β) : symm (symm e) = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem trans_refl (e : α ≃ β) : trans e (refl β) = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem refl_symm : symm (refl α) = refl α := rfl

@[simp] theorem refl_trans (e : α ≃ β) : trans (refl α) e = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem symm_trans (e : α ≃ β) : trans (symm e) e = refl β :=
ext ⟨funext e.rightInv, funext e.rightInv⟩

@[simp] theorem trans_symm (e : α ≃ β) : trans e (symm e) = refl α := symm_trans (symm e)

@[simp] theorem symm_trans_symm (ab : α ≃ β) (bc : β ≃ γ) :
  symm (trans ab bc) = trans (symm bc) (symm ab) := rfl

theorem trans_assoc (ab : α ≃ β) (bc : β ≃ γ) (cd : γ ≃ δ) :
  trans (trans ab bc) cd = trans ab (trans bc cd) := rfl

end Equiv


-- Subconjunto_de_la_imagen_inversa.lean
-- Subconjunto de la imagen inversa
-- José A. Alonso Jiménez
-- Sevilla, 8 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    f[s] ⊆ u ↔ s ⊆ f⁻¹[u]
-- ----------------------------------------------------------------------

import data.set.basic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  s : set α
variable  u : set β

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

example : f '' s ⊆ u ↔ s ⊆ f ⁻¹' u :=
begin
  split,
  { intros h x xs,
    apply mem_preimage.mpr,
    apply h,
    apply mem_image_of_mem,
    exact xs, },
  { intros h y hy,
    rcases hy with ⟨x, xs, fxy⟩,
    rw ← fxy,
    exact h xs, },
end

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

example : f '' s ⊆ u ↔ s ⊆ f ⁻¹' u :=
begin
  split,
  { intros h x xs,
    apply h,
    apply mem_image_of_mem,
    exact xs, },
  { rintros h y ⟨x, xs, rfl⟩,
    exact h xs, },
end

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

example : f '' s ⊆ u ↔ s ⊆ f ⁻¹' u :=
image_subset_iff

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

example : f '' s ⊆ u ↔ s ⊆ f ⁻¹' u :=
by simp


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
    exact hp,
  apply and.intro,
    exact hq,
  exact hp,
end

#print test

theorem test' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp,
  exact and.intro hq hp,
end

#print test'

theorem test'' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp; exact and.intro hq hp,
end

theorem test''' (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
by exact and.intro hp (and.intro hq hp)


/-
Copyright (c) 2020. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring
import Mathlib.tactic.doc_commands
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# `group`

Normalizes expressions in the language of groups. The basic idea is to use the simplifier
to put everything into a product of group powers (`gpow` which takes a group element and an
integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
since `ring` can normalize an exponent to zero, leading to a factor that can be removed
before collecting exponents again. The simplifier step also uses some extra lemmas to avoid
some `ring` invocations.

## Tags

group_theory
-/

-- The next four lemmas are not general purpose lemmas, they are intended for use only by

-- the `group` tactic.

theorem tactic.group.gpow_trick {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) (m : ℤ) : a * b ^ n * b ^ m = a * b ^ (n + m) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b ^ n * b ^ m = a * b ^ (n + m))) (mul_assoc a (b ^ n) (b ^ m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b ^ n * b ^ m) = a * b ^ (n + m))) (Eq.symm (gpow_add b n m))))
      (Eq.refl (a * b ^ (n + m))))

theorem tactic.group.gpow_trick_one {G : Type u_1} [group G] (a : G) (b : G) (m : ℤ) : a * b * b ^ m = a * b ^ (m + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b * b ^ m = a * b ^ (m + 1))) (mul_assoc a b (b ^ m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b * b ^ m) = a * b ^ (m + 1))) (mul_self_gpow b m)))
      (Eq.refl (a * b ^ (m + 1))))

theorem tactic.group.gpow_trick_one' {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) : a * b ^ n * b = a * b ^ (n + 1) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b ^ n * b = a * b ^ (n + 1))) (mul_assoc a (b ^ n) b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b ^ n * b) = a * b ^ (n + 1))) (mul_gpow_self b n)))
      (Eq.refl (a * b ^ (n + 1))))

theorem tactic.group.gpow_trick_sub {G : Type u_1} [group G] (a : G) (b : G) (n : ℤ) (m : ℤ) : a * b ^ n * b ^ (-m) = a * b ^ (n - m) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b ^ n * b ^ (-m) = a * b ^ (n - m))) (mul_assoc a (b ^ n) (b ^ (-m)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b ^ n * b ^ (-m)) = a * b ^ (n - m))) (Eq.symm (gpow_add b n (-m)))))
      (Eq.refl (a * b ^ (n + -m))))

namespace tactic

/-- Auxilliary tactic for the `group` tactic. Calls the simplifier only. -/
/-- Auxilliary tactic for the `group` tactic. Calls `ring` to normalize exponents. -/
end tactic

namespace tactic.interactive

/--
Tactic for normalizing expressions in multiplicative groups, without assuming
commutativity, using only the group axioms without any information about which group
is manipulated.

(For additive commutative groups, use the `abel` tactic instead.)

Example:
```lean
example {G : Type} [group G] (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h, -- normalizes `h` which becomes `h : c = d`
  rw h,       -- the goal is now `a*d*d⁻¹ = a`
  group,      -- which then normalized and closed
end
```
-/
end tactic.interactive


import hom.basic group_theory.congruence

namespace mygroup

namespace quotient

-- We will in this file define quotient groups using congruences

/- We define `group_con` as an extention of `con` which respects the inverse
operation -/
structure group_con (G : Type) [group G] extends con G :=
(inv' : ∀ {x y}, r x y → r x⁻¹ y⁻¹)

-- A `group_con G` induces a group structure with its congruence classes

variables {G : Type} [group G]

-- We define a coercion from `group_con G` to `setoid G`
instance has_coe_to_setoid : has_coe (group_con G) (setoid G) :=
  ⟨λ R, R.to_con.to_setoid⟩

/- Coercion from a `group_con G` to its underlying binary relation -/
instance : has_coe_to_fun (group_con G) := ⟨_, λ R, λ x y, R.r x y⟩

lemma mul {R : group_con G} {x₀ x₁ y₀ y₁ : G} :
  R x₀ x₁ → R y₀ y₁ → R (x₀ * y₀) (x₁ * y₁) := by apply R.mul'

lemma inv {R : group_con G} {x y : G} : R x y → R x⁻¹ y⁻¹ := by apply R.inv'

-- A quotient on a `group_con G` is the quotient on its coerced setoid
def quotient (R : group_con G) := quotient (R : setoid G)

variables {R : group_con G}

-- Coercion from a group to its quotient
instance : has_coe_t G (quotient R) := ⟨quotient.mk'⟩

-- We can think of the coercion above as making a term of `G` into its
-- equivalence class. So two elements of type `quotient R` are equal iff
-- they are related by the binary relation `R`
lemma eq {x y : G} : (x  : quotient R) = y ↔ R x y := quotient.eq'

def lift_on {β} {R : group_con G} (x : quotient R) (f : G → β)
  (h : ∀ x y, R x y → f x = f y) : β := quotient.lift_on' x f h

def lift_on₂ {β} {R : group_con G} (x y : quotient R) (f : G → G → β)
  (h : ∀ a₁ a₂ b₁ b₂, R a₁ b₁ → R a₂ b₂ → f a₁ a₂ = f b₁ b₂) : β :=
quotient.lift_on₂' x y f h

-- Mathematically, we define mul for `quotient R` by taking to congruence
-- classes and outputing the congruence class of their mul, i.e.
-- (*) : (⟦g⟧, ⟦h⟧) ↦ ⟦g * h⟧

-- In Lean, we achieve this by using `lift_on₂` where given some type `β`
-- (in this case `quotient R`), two elements of `quotient R` and a function
-- `f : G → G → β` that respects `R`, it returns a term of `β`.
instance : has_mul (quotient R) :=
{ mul := λ x y, lift_on₂ x y (λ x y, ((x * y : G) : quotient R))
    $ λ _ _ _ _ h₁ h₂, eq.2 (mul h₁ h₂) }

-- Similar story for the inverse in which we use `lift_on` instead.
-- Mathematically, the inverse is defined to be the congruence class of the
-- inverse, i.e. (⁻¹) : ⟦g⟧ ↦ ⟦g⁻¹⟧
instance : has_inv (quotient R) :=
  ⟨λ x, lift_on x (λ x, ((x⁻¹ : G) : quotient R)) $ λ _ _ h, eq.2 (inv h)⟩

instance : has_one (quotient R) := ⟨((1 : G) : quotient R)⟩

lemma coe     (x : G)   : quotient.mk' x = (x : quotient R) := rfl
lemma coe_mul (x y : G) : (x : quotient R) * y = ((x * y : G) : quotient R) := rfl
lemma coe_inv (x : G)   : (x : quotient R)⁻¹ = ((x⁻¹ : G): quotient R) := rfl
lemma coe_one           : ((1 : G) : quotient R) = 1 := rfl

-- I think the rhs is more desirable in most cases so I will make simp use them
attribute [simp] coe coe_mul coe_inv coe_one

-- We now simply need to prove all the group axioms

-- To prove propositions regarding elements of `quotient R` we need to use the
-- induction principle for quotients `quotient.induciton_on`.
-- In this case we are using the variant of this induction principle with
-- three arguments.
-- Essentially, to prove a proposition true for all `x : quotient R`, it
-- suffices to prove that the proposition is true for all `(g : G) : quotient R`
lemma mul_assoc' {a b c : quotient R} : a * b * c = a * (b * c) :=
begin
  apply quotient.induction_on₃' a b c,
  intros _ _ _,
  iterate 3 { rw coe },
  iterate 4 { rw coe_mul },
  rw group.mul_assoc
end

lemma one_mul' {a : quotient R} : 1 * a = a :=
begin
  apply quotient.induction_on' a,
  intro x, rw [coe, ← coe_one, coe_mul, group.one_mul]
end

lemma mul_left_inv' {a : quotient R} : a⁻¹ * a = 1 :=
begin
  apply quotient.induction_on' a,
  intro x, rw [coe, coe_inv, coe_mul, group.mul_left_inv, coe_one]
end

-- With that we find `quotient R` form a group
instance of_quotient : group (quotient R) :=
{ mul := (*), one := (1), inv := has_inv.inv,
  mul_assoc := λ _ _ _, mul_assoc',
  one_mul := λ _, one_mul',
  mul_left_inv := λ _, mul_left_inv' }

-- But this is not how most of us learnt quotient groups. For us, quotient groups
-- are defined by creating a group structure on the set of coests of a normal
-- subgroup. We will show that the equivalence relation `lcoset_rel H` in which
-- `x ~ y ↔ x ⋆ H = y ⋆ H` is a group congruence if and only if H is normal.

/- The main proposition we will prove is that given a subgroup H of the group G,
the equivalence relation ~ : (g, k) ↦ g H = k H on G is a group congruence if
and only if H is normal. -/

open mygroup.subgroup lagrange function

variables {H : subgroup G} {N : normal G}

def lcoset_rel (H : subgroup G) := λ x y, x ⋆ H = y ⋆ H
local notation x ` ~ `:70 y := lcoset_rel H x y
local notation x ` ~[ `:70 H:70 ` ] `:0 y:0 := lcoset_rel H x y

lemma lcoset_rel_def (x y : G) : x ~ y ↔ x ⋆ H = y ⋆ H := iff.rfl

lemma lcoset_iseqv (H : subgroup G) : equivalence (lcoset_rel H) :=
begin
  refine ⟨by tauto, λ _ _ hxy, hxy.symm, _⟩,
  intros _ _ _ hxy hyz, unfold lcoset_rel at *, rw [hxy, hyz]
end

lemma lcoset_mul {x₀ x₁ y₀ y₁ : G}
  (hx : x₀ ~[↑N] x₁) (hy : y₀ ~[↑N] y₁) : (x₀ * y₀) ~[↑N] (x₁ * y₁) :=
begin
  rw [lcoset_rel_def, lcoset_eq] at *,
  have := N.conj_mem _ hx y₁⁻¹,
  rw group.inv_inv at this,
  replace this := N.mul_mem' this hy,
  rw [← group.mul_assoc, group.mul_assoc (y₁⁻¹ * (x₁⁻¹ * x₀)),
      group.mul_right_inv, group.mul_one, ← group.mul_assoc] at this,
  rwa [group.inv_mul, ← group.mul_assoc],
end

lemma lcoset_inv {x y : G} (hxy : x ~[↑N] y) : (x⁻¹ ~[↑N] y⁻¹) :=
begin
  rw [lcoset_rel_def, lcoset_eq] at *,
  rw ← group.inv_mul,
  apply N.inv_mem',
  convert N.conj_mem' _ hxy y,
  simp [← group.mul_assoc]
end

/-- If `H` is normal, then `lcoset_rel H` is a group congruence -/
def con_of_normal (G : Type) [group G] (N : normal G) : group_con G :=
{ r := lcoset_rel N,
  iseqv := lcoset_iseqv N,
  mul' := λ x₀ x₁ y₀ y₁ hx hy, lcoset_mul hx hy,
  inv' := λ x y hxy, lcoset_inv hxy }

lemma con_of_normal_def {G : Type} [group G] {N : normal G} (x y : G) :
con_of_normal G N x y ↔ x ~[↑N] y := iff.rfl

lemma con_one_of_mem : ∀ h ∈ H, h ~ 1 :=
begin
  intros h hh,
  rw [lcoset_rel_def, lcoset_eq], simpa
end

lemma mem_of_con_one {g : G} (hg : g ~ 1) : g ∈ H :=
by rwa [lcoset_rel_def, lcoset_eq, group.one_inv, group.one_mul] at hg

/-- If `lcoset_rel H` is a congruence then `H` is normal -/
def normal_of_con (H : subgroup G) {R : group_con G}
  (hR : R.r = lcoset_rel H) : normal G :=
{ conj_mem' := λ n hn g, mem_of_con_one $
    begin
      rw [← hR, (show (1 : G) = g * 1 * g⁻¹, by simp)],
      refine R.mul' (R.mul' (R.iseqv.1 _) _) (R.iseqv.1 _),
       { rw hR, exact con_one_of_mem _ hn }
    end .. H }

lemma con_one_iff_mem (h : G) : h ~ 1 ↔ h ∈ H := ⟨mem_of_con_one, con_one_of_mem h⟩

-- So now, whenever we would like to work with "normal" quotient groups of
-- a group `G` over a normal group `N`, we write `quotient (con_of_normal N)`
notation G ` /ₘ `:70 N:70 := quotient (con_of_normal G N)

/-- For all elements `c : G /ₘ N`, there is some `g : G` such that `⟦g⟧ = c`-/
lemma exists_mk {N : normal G} (c : G /ₘ N) : ∃ g : G, (g : G /ₘ N) = c :=
  @quotient.exists_rep G (con_of_normal G N) c

/-- `(⟦p⟧ : G /ₘ N) = ⟦q⟧` iff `p ⋆ N = q ⋆ N` where `p q : G` -/
lemma mk_eq {p q : G} : (p : G /ₘ N) = q ↔ p ⋆ N = q ⋆ N :=
  ⟨λ h, quotient.eq.1 h, λ h, quotient.eq.2 h⟩

lemma mk_eq' {p q : G} : (p : G /ₘ N) = q ↔ q⁻¹ * p ∈ N :=
begin
  rw mk_eq,
  exact lcoset_eq
end

lemma coe_pow (g : G) (n : ℤ) : (g : G /ₘ N) ^ n = ((g ^ n : G) : G /ₘ N) :=
begin
  apply int.induction_on n,
    { refl },
    { intros _ hi,
      rw [group.pow_add, group.pow_add, ← quotient.coe_mul, hi], congr },
    { intros _ hi,
      rw [group.pow_sub, group.pow_sub, group.pow_neg_one_inv,
        group.pow_neg_one_inv, hi, ← quotient.coe_mul, quotient.coe_inv] }
end

end quotient

end mygroup