/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison

! This file was ported from Lean 3 source module group_theory.coset
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Quotient
import Mathlib.Data.Fintype.Prod
import Mathlib.GroupTheory.GroupAction.Basic
import Mathlib.GroupTheory.Subgroup.MulOpposite

/-!
# Cosets

This file develops the basic theory of left and right cosets.

## Main definitions

* `leftCoset a s`: the left coset `a * s` for an element `a : α` and a subset `s ⊆ α`, for an
  `AddGroup` this is `leftAddCoset a s`.
* `rightCoset s a`: the right coset `s * a` for an element `a : α` and a subset `s ⊆ α`, for an
  `AddGroup` this is `rightAddCoset s a`.
* `QuotientGroup.quotient s`: the quotient type representing the left cosets with respect to a
  subgroup `s`, for an `AddGroup` this is `QuotientAddGroup.quotient s`.
* `QuotientGroup.mk`: the canonical map from `α` to `α/s` for a subgroup `s` of `α`, for an
  `AddGroup` this is `QuotientAddGroup.mk`.
* `Subgroup.leftCosetEquivSubgroup`: the natural bijection between a left coset and the subgroup,
  for an `AddGroup` this is `AddSubgroup.leftCosetEquivAddSubgroup`.

## Notation

* `a *l s`: for `leftCoset a s`.
* `a +l s`: for `leftAddCoset a s`.
* `s *r a`: for `rightCoset s a`.
* `s +r a`: for `rightAddCoset s a`.

* `G ⧸ H` is the quotient of the (additive) group `G` by the (additive) subgroup `H`
-/

open Set Function

variable {α : Type _}

/-- The left coset `a * s` for an element `a : α` and a subset `s : set α` -/
@[to_additive leftAddCoset "The left coset `a+s` for an element `a : α` and a subset `s : set α`"]
def leftCoset [Mul α] (a : α) (s : Set α) : Set α :=
  (fun x => a * x) '' s
#align left_coset leftCoset
#align left_add_coset leftAddCoset

/-- The right coset `s * a` for an element `a : α` and a subset `s : set α` -/
@[to_additive rightAddCoset
      "The right coset `s+a` for an element `a : α` and a subset `s : set α`"]
def rightCoset [Mul α] (s : Set α) (a : α) : Set α :=
  (fun x => x * a) '' s
#align right_coset rightCoset
#align right_add_coset rightAddCoset

@[inherit_doc]
scoped[Coset] infixl:70 " *l " => leftCoset

@[inherit_doc]
scoped[Coset] infixl:70 " +l " => leftAddCoset

@[inherit_doc]
scoped[Coset] infixl:70 " *r " => rightCoset

@[inherit_doc]
scoped[Coset] infixl:70 " +r " => rightAddCoset

open Coset

section CosetMul

variable [Mul α]

@[to_additive mem_leftAddCoset]
theorem mem_leftCoset {s : Set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ a *l s :=
  mem_image_of_mem (fun b : α => a * b) hxS
#align mem_left_coset mem_leftCoset
#align mem_left_add_coset mem_leftAddCoset

@[to_additive mem_rightAddCoset]
theorem mem_rightCoset {s : Set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ s *r a :=
  mem_image_of_mem (fun b : α => b * a) hxS
#align mem_right_coset mem_rightCoset
#align mem_right_add_coset mem_rightAddCoset

/-- Equality of two left cosets `a * s` and `b * s`. -/
@[to_additive LeftAddCosetEquivalence "Equality of two left cosets `a + s` and `b + s`."]
def LeftCosetEquivalence (s : Set α) (a b : α) :=
  a *l s = b *l s
#align left_coset_equivalence LeftCosetEquivalence
#align left_add_coset_equivalence LeftAddCosetEquivalence

@[to_additive leftAddCosetEquivalence_rel]
theorem leftCosetEquivalence_rel (s : Set α) : Equivalence (LeftCosetEquivalence s) :=
  @Equivalence.mk _ (LeftCosetEquivalence s) (fun _ => rfl) Eq.symm Eq.trans
#align left_coset_equivalence_rel leftCosetEquivalence_rel
#align left_add_coset_equivalence_rel leftAddCosetEquivalence_rel

/-- Equality of two right cosets `s * a` and `s * b`. -/
@[to_additive RightAddCosetEquivalence "Equality of two right cosets `s + a` and `s + b`."]
def RightCosetEquivalence (s : Set α) (a b : α) :=
  s *r a = s *r b
#align right_coset_equivalence RightCosetEquivalence
#align right_add_coset_equivalence RightAddCosetEquivalence

@[to_additive rightAddCosetEquivalence_rel]
theorem rightCosetEquivalence_rel (s : Set α) : Equivalence (RightCosetEquivalence s) :=
  @Equivalence.mk _ (RightCosetEquivalence s) (fun _a => rfl) Eq.symm Eq.trans
#align right_coset_equivalence_rel rightCosetEquivalence_rel
#align right_add_coset_equivalence_rel rightAddCosetEquivalence_rel

end CosetMul

section CosetSemigroup

variable [Semigroup α]

@[to_additive (attr := simp) leftAddCoset_assoc]
theorem leftCoset_assoc (s : Set α) (a b : α) : a *l (b *l s) = a * b *l s := by
  simp [leftCoset, rightCoset, (image_comp _ _ _).symm, Function.comp, mul_assoc]
#align left_coset_assoc leftCoset_assoc
#align left_add_coset_assoc leftAddCoset_assoc

@[to_additive (attr := simp) rightAddCoset_assoc]
theorem rightCoset_assoc (s : Set α) (a b : α) : s *r a *r b = s *r (a * b) := by
  simp [leftCoset, rightCoset, (image_comp _ _ _).symm, Function.comp, mul_assoc]
#align right_coset_assoc rightCoset_assoc
#align right_add_coset_assoc rightAddCoset_assoc

@[to_additive leftAddCoset_rightAddCoset]
theorem leftCoset_rightCoset (s : Set α) (a b : α) : a *l s *r b = a *l (s *r b) := by
  simp [leftCoset, rightCoset, (image_comp _ _ _).symm, Function.comp, mul_assoc]
#align left_coset_right_coset leftCoset_rightCoset
#align left_add_coset_right_add_coset leftAddCoset_rightAddCoset

end CosetSemigroup

section CosetMonoid

variable [Monoid α] (s : Set α)

@[to_additive (attr := simp) zero_leftAddCoset]
theorem one_leftCoset : 1 *l s = s :=
  Set.ext <| by simp [leftCoset]
#align one_left_coset one_leftCoset
#align zero_left_add_coset zero_leftAddCoset

@[to_additive (attr := simp) rightAddCoset_zero]
theorem rightCoset_one : s *r 1 = s :=
  Set.ext <| by simp [rightCoset]
#align right_coset_one rightCoset_one
#align right_add_coset_zero rightAddCoset_zero

end CosetMonoid

section CosetSubmonoid

open Submonoid

variable [Monoid α] (s : Submonoid α)

@[to_additive mem_own_leftAddCoset]
theorem mem_own_leftCoset (a : α) : a ∈ a *l s :=
  suffices a * 1 ∈ a *l s by simpa
  mem_leftCoset a (one_mem s : 1 ∈ s)
#align mem_own_left_coset mem_own_leftCoset
#align mem_own_left_add_coset mem_own_leftAddCoset

@[to_additive mem_own_rightAddCoset]
theorem mem_own_rightCoset (a : α) : a ∈ (s : Set α) *r a :=
  suffices 1 * a ∈ (s : Set α) *r a by simpa
  mem_rightCoset a (one_mem s : 1 ∈ s)
#align mem_own_right_coset mem_own_rightCoset
#align mem_own_right_add_coset mem_own_rightAddCoset

@[to_additive mem_leftAddCoset_leftAddCoset]
theorem mem_leftCoset_leftCoset {a : α} (ha : a *l s = s) : a ∈ s := by
  rw [← SetLike.mem_coe, ← ha]; exact mem_own_leftCoset s a
#align mem_left_coset_left_coset mem_leftCoset_leftCoset
#align mem_left_add_coset_left_add_coset mem_leftAddCoset_leftAddCoset

@[to_additive mem_rightAddCoset_rightAddCoset]
theorem mem_rightCoset_rightCoset {a : α} (ha : (s : Set α) *r a = s) : a ∈ s := by
  rw [← SetLike.mem_coe, ← ha]; exact mem_own_rightCoset s a
#align mem_right_coset_right_coset mem_rightCoset_rightCoset
#align mem_right_add_coset_right_add_coset mem_rightAddCoset_rightAddCoset

end CosetSubmonoid

section CosetGroup

variable [Group α] {s : Set α} {x : α}

@[to_additive mem_leftAddCoset_iff]
theorem mem_leftCoset_iff (a : α) : x ∈ a *l s ↔ a⁻¹ * x ∈ s :=
  Iff.intro (fun ⟨b, hb, Eq⟩ => by simp [Eq.symm, hb]) fun h => ⟨a⁻¹ * x, h, by simp⟩
#align mem_left_coset_iff mem_leftCoset_iff
#align mem_left_add_coset_iff mem_leftAddCoset_iff

@[to_additive mem_rightAddCoset_iff]
theorem mem_rightCoset_iff (a : α) : x ∈ s *r a ↔ x * a⁻¹ ∈ s :=
  Iff.intro (fun ⟨b, hb, Eq⟩ => by simp [Eq.symm, hb]) fun h => ⟨x * a⁻¹, h, by simp⟩
#align mem_right_coset_iff mem_rightCoset_iff
#align mem_right_add_coset_iff mem_rightAddCoset_iff

end CosetGroup

section CosetSubgroup

open Subgroup

variable [Group α] (s : Subgroup α)

@[to_additive leftAddCoset_mem_leftAddCoset]
theorem leftCoset_mem_leftCoset {a : α} (ha : a ∈ s) : a *l s = s :=
  Set.ext <| by simp [mem_leftCoset_iff, mul_mem_cancel_left (s.inv_mem ha)]
#align left_coset_mem_left_coset leftCoset_mem_leftCoset
#align left_add_coset_mem_left_add_coset leftAddCoset_mem_leftAddCoset

@[to_additive rightAddCoset_mem_rightAddCoset]
theorem rightCoset_mem_rightCoset {a : α} (ha : a ∈ s) : (s : Set α) *r a = s :=
  Set.ext fun b => by simp [mem_rightCoset_iff, mul_mem_cancel_right (s.inv_mem ha)]
#align right_coset_mem_right_coset rightCoset_mem_rightCoset
#align right_add_coset_mem_right_add_coset rightAddCoset_mem_rightAddCoset

@[to_additive]
theorem orbit_subgroup_eq_rightCoset (a : α) : MulAction.orbit s a = s *r a :=
  Set.ext fun _b => ⟨fun ⟨c, d⟩ => ⟨c, c.2, d⟩, fun ⟨c, d, e⟩ => ⟨⟨c, d⟩, e⟩⟩
#align orbit_subgroup_eq_right_coset orbit_subgroup_eq_rightCoset
#align orbit_add_subgroup_eq_right_coset orbit_addSubgroup_eq_rightCoset

@[to_additive]
theorem orbit_subgroup_eq_self_of_mem {a : α} (ha : a ∈ s) : MulAction.orbit s a = s :=
  (orbit_subgroup_eq_rightCoset s a).trans (rightCoset_mem_rightCoset s ha)
#align orbit_subgroup_eq_self_of_mem orbit_subgroup_eq_self_of_mem
#align orbit_add_subgroup_eq_self_of_mem orbit_addSubgroup_eq_self_of_mem

@[to_additive]
theorem orbit_subgroup_one_eq_self : MulAction.orbit s (1 : α) = s :=
  orbit_subgroup_eq_self_of_mem s s.one_mem
#align orbit_subgroup_one_eq_self orbit_subgroup_one_eq_self
#align orbit_add_subgroup_zero_eq_self orbit_addSubgroup_zero_eq_self

@[to_additive eq_addCosets_of_normal]
theorem eq_cosets_of_normal (N : s.Normal) (g : α) : g *l s = s *r g :=
  Set.ext fun a => by simp [mem_leftCoset_iff, mem_rightCoset_iff]; rw [N.mem_comm_iff]
#align eq_cosets_of_normal eq_cosets_of_normal
#align eq_add_cosets_of_normal eq_addCosets_of_normal

@[to_additive normal_of_eq_addCosets]
theorem normal_of_eq_cosets (h : ∀ g : α, g *l s = s *r g) : s.Normal :=
  ⟨fun a ha g =>
    show g * a * g⁻¹ ∈ (s : Set α) by rw [← mem_rightCoset_iff, ← h]; exact mem_leftCoset g ha⟩
#align normal_of_eq_cosets normal_of_eq_cosets
#align normal_of_eq_add_cosets normal_of_eq_addCosets

@[to_additive normal_iff_eq_addCosets]
theorem normal_iff_eq_cosets : s.Normal ↔ ∀ g : α, g *l s = s *r g :=
  ⟨@eq_cosets_of_normal _ _ s, normal_of_eq_cosets s⟩
#align normal_iff_eq_cosets normal_iff_eq_cosets
#align normal_iff_eq_add_cosets normal_iff_eq_addCosets

@[to_additive leftAddCoset_eq_iff]
theorem leftCoset_eq_iff {x y : α} : leftCoset x s = leftCoset y s ↔ x⁻¹ * y ∈ s := by
  rw [Set.ext_iff]
  simp_rw [mem_leftCoset_iff, SetLike.mem_coe]
  constructor
  · intro h
    apply (h y).mpr
    rw [mul_left_inv]
    exact s.one_mem
  · intro h z
    rw [← mul_inv_cancel_right x⁻¹ y]
    rw [mul_assoc]
    exact s.mul_mem_cancel_left h
#align left_coset_eq_iff leftCoset_eq_iff
#align left_add_coset_eq_iff leftAddCoset_eq_iff

@[to_additive rightAddCoset_eq_iff]
theorem rightCoset_eq_iff {x y : α} : rightCoset (↑s) x = rightCoset s y ↔ y * x⁻¹ ∈ s := by
  rw [Set.ext_iff]
  simp_rw [mem_rightCoset_iff, SetLike.mem_coe]
  constructor
  · intro h
    apply (h y).mpr
    rw [mul_right_inv]
    exact s.one_mem
  · intro h z
    rw [← inv_mul_cancel_left y x⁻¹]
    rw [← mul_assoc]
    exact s.mul_mem_cancel_right h
#align right_coset_eq_iff rightCoset_eq_iff
#align right_add_coset_eq_iff rightAddCoset_eq_iff

end CosetSubgroup

-- porting note: see https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/.E2.9C.94.20to_additive.2Emap_namespace
run_cmd Lean.Elab.Command.liftCoreM <| ToAdditive.insertTranslation `QuotientGroup `QuotientAddGroup

namespace QuotientGroup

variable [Group α] (s : Subgroup α)

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
@[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
 of a subgroup."]
def leftRel : Setoid α :=
  MulAction.orbitRel (Subgroup.opposite s) α
#align quotient_group.left_rel QuotientGroup.leftRel
#align quotient_add_group.left_rel QuotientAddGroup.leftRel

variable {s}

@[to_additive]
theorem leftRel_apply {x y : α} : @Setoid.r _ (leftRel s) x y ↔ x⁻¹ * y ∈ s :=
  calc
    (∃ a : Subgroup.opposite s, y * MulOpposite.unop a = x) ↔ ∃ a : s, y * a = x :=
      s.oppositeEquiv.symm.exists_congr_left
    _ ↔ ∃ a : s, x⁻¹ * y = a⁻¹ :=
      by simp only [inv_mul_eq_iff_eq_mul, Subgroup.coe_inv, eq_mul_inv_iff_mul_eq]
    _ ↔ x⁻¹ * y ∈ s := by simp [exists_inv_mem_iff_exists_mem]

#align quotient_group.left_rel_apply QuotientGroup.leftRel_apply
#align quotient_add_group.left_rel_apply QuotientAddGroup.leftRel_apply

variable (s)

@[to_additive]
theorem leftRel_eq : @Setoid.r _ (leftRel s) = fun x y => x⁻¹ * y ∈ s :=
  funext₂ <| by
    simp only [eq_iff_iff]
    apply leftRel_apply
#align quotient_group.left_rel_eq QuotientGroup.leftRel_eq
#align quotient_add_group.left_rel_eq QuotientAddGroup.leftRel_eq

theorem leftRel_r_eq_leftCosetEquivalence :
    @Setoid.r _ (QuotientGroup.leftRel s) = LeftCosetEquivalence s := by
  ext
  rw [leftRel_eq]
  exact (leftCoset_eq_iff s).symm
#align quotient_group.left_rel_r_eq_left_coset_equivalence
  QuotientGroup.leftRel_r_eq_leftCosetEquivalence

@[to_additive]
instance leftRelDecidable [DecidablePred (· ∈ s)] : DecidableRel (leftRel s).r := fun x y => by
  rw [leftRel_eq]
  exact ‹DecidablePred (· ∈ s)› _
#align quotient_group.left_rel_decidable QuotientGroup.leftRelDecidable
#align quotient_add_group.left_rel_decidable QuotientAddGroup.leftRelDecidable

/-- `α ⧸ s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `α ⧸ s` is a group -/
@[to_additive "`α ⧸ s` is the quotient type representing the left cosets of `s`.  If `s` is a normal
 subgroup, `α ⧸ s` is a group"]
instance : HasQuotient α (Subgroup α) :=
  ⟨fun s => Quotient (leftRel s)⟩

/-- The equivalence relation corresponding to the partition of a group by right cosets of a
subgroup. -/
@[to_additive "The equivalence relation corresponding to the partition of a group by right cosets
 of a subgroup."]
def rightRel : Setoid α :=
  MulAction.orbitRel s α
#align quotient_group.right_rel QuotientGroup.rightRel
#align quotient_add_group.right_rel QuotientAddGroup.rightRel

variable {s}

@[to_additive]
theorem rightRel_apply {x y : α} : @Setoid.r _ (rightRel s) x y ↔ y * x⁻¹ ∈ s :=
  calc
    (∃ a : s, (a : α) * y = x) ↔ ∃ a : s, y * x⁻¹ = a⁻¹ :=
      by simp only [mul_inv_eq_iff_eq_mul, Subgroup.coe_inv, eq_inv_mul_iff_mul_eq]
    _ ↔ y * x⁻¹ ∈ s := by simp [exists_inv_mem_iff_exists_mem]

#align quotient_group.right_rel_apply QuotientGroup.rightRel_apply
#align quotient_add_group.right_rel_apply QuotientAddGroup.rightRel_apply

variable (s)

@[to_additive]
theorem rightRel_eq : @Setoid.r _ (rightRel s) = fun x y => y * x⁻¹ ∈ s :=
  funext₂ <| by
    simp only [eq_iff_iff]
    apply rightRel_apply
#align quotient_group.right_rel_eq QuotientGroup.rightRel_eq
#align quotient_add_group.right_rel_eq QuotientAddGroup.rightRel_eq

theorem rightRel_r_eq_rightCosetEquivalence :
    @Setoid.r _ (QuotientGroup.rightRel s) = RightCosetEquivalence s := by
  ext
  rw [rightRel_eq]
  exact (rightCoset_eq_iff s).symm
#align quotient_group.right_rel_r_eq_right_coset_equivalence QuotientGroup.rightRel_r_eq_rightCosetEquivalence

@[to_additive]
instance rightRelDecidable [DecidablePred (· ∈ s)] : DecidableRel (rightRel s).r := fun x y => by
  rw [rightRel_eq]
  exact ‹DecidablePred (· ∈ s)› _
#align quotient_group.right_rel_decidable QuotientGroup.rightRelDecidable
#align quotient_add_group.right_rel_decidable QuotientAddGroup.rightRelDecidable

/-- Right cosets are in bijection with left cosets. -/
@[to_additive "Right cosets are in bijection with left cosets."]
def quotientRightRelEquivQuotientLeftRel : Quotient (QuotientGroup.rightRel s) ≃ α ⧸ s
    where
  toFun :=
    Quotient.map' (fun g => g⁻¹) fun a b =>
      by
      rw [leftRel_apply, rightRel_apply]
      exact fun h => (congr_arg (· ∈ s) (by simp [mul_assoc])).mp (s.inv_mem h)
      -- porting note: replace with `by group`
  invFun :=
    Quotient.map' (fun g => g⁻¹) fun a b =>
      by
      rw [leftRel_apply, rightRel_apply]
      exact fun h => (congr_arg (· ∈ s) (by simp [mul_assoc])).mp (s.inv_mem h)
      -- porting note: replace with `by group`
  left_inv g :=
    Quotient.inductionOn' g fun g =>
      Quotient.sound'
        (by
          simp only [inv_inv]
          exact Quotient.exact' rfl)
  right_inv g :=
    Quotient.inductionOn' g fun g =>
      Quotient.sound'
        (by
          simp only [inv_inv]
          exact Quotient.exact' rfl)
#align quotient_group.quotient_right_rel_equiv_quotient_left_rel QuotientGroup.quotientRightRelEquivQuotientLeftRel
#align quotient_add_group.quotient_right_rel_equiv_quotient_left_rel QuotientAddGroup.quotientRightRelEquivQuotientLeftRel

@[to_additive]
instance fintypeQuotientRightRel [Fintype (α ⧸ s)] :
    Fintype (Quotient (QuotientGroup.rightRel s)) :=
  Fintype.ofEquiv (α ⧸ s) (QuotientGroup.quotientRightRelEquivQuotientLeftRel s).symm
#align quotient_group.fintype_quotient_right_rel QuotientGroup.fintypeQuotientRightRel
#align quotient_add_group.fintype_quotient_right_rel QuotientAddGroup.fintypeQuotientRightRel

@[to_additive]
theorem card_quotient_rightRel [Fintype (α ⧸ s)] :
    Fintype.card (Quotient (QuotientGroup.rightRel s)) = Fintype.card (α ⧸ s) :=
  Fintype.ofEquiv_card (QuotientGroup.quotientRightRelEquivQuotientLeftRel s).symm
#align quotient_group.card_quotient_right_rel QuotientGroup.card_quotient_rightRel
#align quotient_add_group.card_quotient_right_rel QuotientAddGroup.card_quotient_rightRel

end QuotientGroup

namespace QuotientGroup

variable [Group α] {s : Subgroup α}

@[to_additive]
instance fintype [Fintype α] (s : Subgroup α) [DecidableRel (leftRel s).r] : Fintype (α ⧸ s) :=
  Quotient.fintype (leftRel s)
#align quotient_group.fintype QuotientGroup.fintype
#align quotient_add_group.fintype QuotientAddGroup.fintype

/-- The canonical map from a group `α` to the quotient `α ⧸ s`. -/
@[to_additive (attr := coe) "The canonical map from an `AddGroup` `α` to the quotient `α ⧸ s`."]
abbrev mk (a : α) : α ⧸ s :=
  Quotient.mk'' a
#align quotient_group.mk QuotientGroup.mk
#align quotient_add_group.mk QuotientAddGroup.mk

@[to_additive]
theorem mk_surjective : Function.Surjective <| @mk _ _ s :=
  Quotient.surjective_Quotient_mk''
#align quotient_group.mk_surjective QuotientGroup.mk_surjective
#align quotient_add_group.mk_surjective QuotientAddGroup.mk_surjective

@[to_additive (attr := elab_as_elim)]
theorem induction_on {C : α ⧸ s → Prop} (x : α ⧸ s) (H : ∀ z, C (QuotientGroup.mk z)) : C x :=
  Quotient.inductionOn' x H
#align quotient_group.induction_on QuotientGroup.induction_on
#align quotient_add_group.induction_on QuotientAddGroup.induction_on

@[to_additive]
instance : CoeTC α (α ⧸ s) :=
  ⟨mk⟩

@[to_additive (attr := elab_as_elim)]
theorem induction_on' {C : α ⧸ s → Prop} (x : α ⧸ s) (H : ∀ z : α, C z) : C x :=
  Quotient.inductionOn' x H
#align quotient_group.induction_on' QuotientGroup.induction_on'
#align quotient_add_group.induction_on' QuotientAddGroup.induction_on'

@[to_additive (attr := simp)]
theorem quotient_liftOn_mk {β} (f : α → β) (h) (x : α) : Quotient.liftOn' (x : α ⧸ s) f h = f x :=
  rfl
#align quotient_group.quotient_lift_on_coe QuotientGroup.quotient_liftOn_mk
#align quotient_add_group.quotient_lift_on_coe QuotientAddGroup.quotient_liftOn_mk

@[to_additive]
theorem forall_mk {C : α ⧸ s → Prop} : (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
  mk_surjective.forall
#align quotient_group.forall_coe QuotientGroup.forall_mk
#align quotient_add_group.forall_coe QuotientAddGroup.forall_mk

@[to_additive]
theorem exists_mk {C : α ⧸ s → Prop} : (∃ x : α ⧸ s, C x) ↔ ∃ x : α, C x :=
  mk_surjective.exists
#align quotient_group.exists_coe QuotientGroup.exists_mk
#align quotient_add_group.exists_coe QuotientAddGroup.exists_mk

@[to_additive]
instance (s : Subgroup α) : Inhabited (α ⧸ s) :=
  ⟨((1 : α) : α ⧸ s)⟩

@[to_additive]
protected theorem eq {a b : α} : (a : α ⧸ s) = b ↔ a⁻¹ * b ∈ s :=
  calc
    _ ↔ @Setoid.r _ (leftRel s) a b := Quotient.eq''
    _ ↔ _ := by rw [leftRel_apply]

#align quotient_group.eq QuotientGroup.eq
#align quotient_add_group.eq QuotientAddGroup.eq

@[to_additive]
theorem eq' {a b : α} : (mk a : α ⧸ s) = mk b ↔ a⁻¹ * b ∈ s :=
  QuotientGroup.eq
#align quotient_group.eq' QuotientGroup.eq'
#align quotient_add_group.eq' QuotientAddGroup.eq'

@[to_additive] -- porting note: `simp` can prove this.
theorem out_eq' (a : α ⧸ s) : mk a.out' = a :=
  Quotient.out_eq' a
#align quotient_group.out_eq' QuotientGroup.out_eq'
#align quotient_add_group.out_eq' QuotientAddGroup.out_eq'

variable (s)

/- It can be useful to write `obtain ⟨h, H⟩ := mk_out'_eq_mul ...`, and then `rw [H]` or
  `simp_rw [H]` or `simp only [H]`. In order for `simp_rw` and `simp only` to work, this lemma is
  stated in terms of an arbitrary `h : s`, rathern that the specific `h = g⁻¹ * (mk g).out'`. -/
@[to_additive QuotientAddGroup.mk_out'_eq_mul]
theorem mk_out'_eq_mul (g : α) : ∃ h : s, (mk g : α ⧸ s).out' = g * h :=
  ⟨⟨g⁻¹ * (mk g).out', eq'.mp (mk g).out_eq'.symm⟩, by rw [mul_inv_cancel_left]⟩
#align quotient_group.mk_out'_eq_mul QuotientGroup.mk_out'_eq_mul
#align quotient_add_group.mk_out'_eq_mul QuotientAddGroup.mk_out'_eq_mul

variable {s} {a b : α}

@[to_additive (attr := simp)]
theorem mk_mul_of_mem (a : α) (hb : b ∈ s) : (mk (a * b) : α ⧸ s) = mk a := by
  rwa [eq', mul_inv_rev, inv_mul_cancel_right, s.inv_mem_iff]
#align quotient_group.mk_mul_of_mem QuotientGroup.mk_mul_of_mem
#align quotient_add_group.mk_add_of_mem QuotientAddGroup.mk_add_of_mem

@[to_additive]
theorem eq_class_eq_leftCoset (s : Subgroup α) (g : α) :
    { x : α | (x : α ⧸ s) = g } = leftCoset g s :=
  Set.ext fun z => by
    rw [mem_leftCoset_iff, Set.mem_setOf_eq, eq_comm, QuotientGroup.eq, SetLike.mem_coe]
#align quotient_group.eq_class_eq_left_coset QuotientGroup.eq_class_eq_leftCoset
#align quotient_add_group.eq_class_eq_left_coset QuotientAddGroup.eq_class_eq_leftCoset

@[to_additive]
theorem preimage_image_mk (N : Subgroup α) (s : Set α) :
    mk ⁻¹' ((mk : α → α ⧸ N) '' s) = ⋃ x : N, (fun y : α => y * x) ⁻¹' s := by
  ext x
  simp only [QuotientGroup.eq, SetLike.exists, exists_prop, Set.mem_preimage, Set.mem_unionᵢ,
    Set.mem_image, ← eq_inv_mul_iff_mul_eq]
  exact
    ⟨fun ⟨y, hs, hN⟩ => ⟨_, N.inv_mem hN, by simpa using hs⟩, fun ⟨z, hz, hxz⟩ =>
      ⟨x * z, hxz, by simpa using hz⟩⟩
#align quotient_group.preimage_image_coe QuotientGroup.preimage_image_mk
#align quotient_add_group.preimage_image_coe QuotientAddGroup.preimage_image_mk

end QuotientGroup

namespace Subgroup

open QuotientGroup

variable [Group α] {s : Subgroup α}

/-- The natural bijection between a left coset `g * s` and `s`. -/
@[to_additive "The natural bijection between the cosets `g + s` and `s`."]
def leftCosetEquivSubgroup (g : α) : leftCoset g s ≃ s :=
  ⟨fun x => ⟨g⁻¹ * x.1, (mem_leftCoset_iff _).1 x.2⟩, fun x => ⟨g * x.1, x.1, x.2, rfl⟩,
    fun ⟨x, hx⟩ => Subtype.eq <| by simp, fun ⟨g, hg⟩ => Subtype.eq <| by simp⟩
#align subgroup.left_coset_equiv_subgroup Subgroup.leftCosetEquivSubgroup
#align add_subgroup.left_coset_equiv_add_subgroup AddSubgroup.leftCosetEquivAddSubgroup

/-- The natural bijection between a right coset `s * g` and `s`. -/
@[to_additive "The natural bijection between the cosets `s + g` and `s`."]
def rightCosetEquivSubgroup (g : α) : rightCoset (↑s) g ≃ s :=
  ⟨fun x => ⟨x.1 * g⁻¹, (mem_rightCoset_iff _).1 x.2⟩, fun x => ⟨x.1 * g, x.1, x.2, rfl⟩,
    fun ⟨x, hx⟩ => Subtype.eq <| by simp, fun ⟨g, hg⟩ => Subtype.eq <| by simp⟩
#align subgroup.right_coset_equiv_subgroup Subgroup.rightCosetEquivSubgroup
#align add_subgroup.right_coset_equiv_add_subgroup AddSubgroup.rightCosetEquivAddSubgroup

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
@[to_additive addGroupEquivQuotientProdAddSubgroup
  "A (non-canonical) bijection between an add_group `α` and the product `(α/s) × s`"]
noncomputable def groupEquivQuotientProdSubgroup : α ≃ (α ⧸ s) × s :=
  calc
    α ≃ ΣL : α ⧸ s, { x : α // (x : α ⧸ s) = L } := (Equiv.sigmaFiberEquiv QuotientGroup.mk).symm
    _ ≃ ΣL : α ⧸ s, leftCoset (Quotient.out' L) s :=
      Equiv.sigmaCongrRight fun L => by
        rw [← eq_class_eq_leftCoset]
        show
          (_root_.Subtype fun x : α => Quotient.mk'' x = L) ≃
            _root_.Subtype fun x : α => Quotient.mk'' x = Quotient.mk'' _
        simp [-Quotient.eq'']
        rfl
    _ ≃ Σ _L : α ⧸ s, s := Equiv.sigmaCongrRight fun L => leftCosetEquivSubgroup _
    _ ≃ (α ⧸ s) × s := Equiv.sigmaEquivProd _ _

#align subgroup.group_equiv_quotient_times_subgroup Subgroup.groupEquivQuotientProdSubgroup
#align add_subgroup.add_group_equiv_quotient_times_add_subgroup AddSubgroup.addGroupEquivQuotientProdAddSubgroup

variable {t : Subgroup α}

/-- If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection. -/
@[to_additive "If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection."]
def quotientEquivOfEq (h : s = t) : α ⧸ s ≃ α ⧸ t
    where
  toFun := Quotient.map' id fun _a _b h' => h ▸ h'
  invFun := Quotient.map' id fun _a _b h' => h.symm ▸ h'
  left_inv q := induction_on' q fun _g => rfl
  right_inv q := induction_on' q fun _g => rfl
#align subgroup.quotient_equiv_of_eq Subgroup.quotientEquivOfEq
#align add_subgroup.quotient_equiv_of_eq AddSubgroup.quotientEquivOfEq

theorem quotientEquivOfEq_mk (h : s = t) (a : α) :
    quotientEquivOfEq h (QuotientGroup.mk a) = QuotientGroup.mk a :=
  rfl
#align subgroup.quotient_equiv_of_eq_mk Subgroup.quotientEquivOfEq_mk

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotientEquivProdOfLe`. -/
@[to_additive (attr := simps)
  "If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
  of the quotient map `G → G/K`. The classical version is `addQuotientEquivProdOfLe`."]
def quotientEquivProdOfLe' (h_le : s ≤ t) (f : α ⧸ t → α)
    (hf : Function.RightInverse f QuotientGroup.mk) : α ⧸ s ≃ (α ⧸ t) × t ⧸ s.subgroupOf t
    where
  toFun a :=
    ⟨a.map' id fun b c h => leftRel_apply.mpr (h_le (leftRel_apply.mp h)),
      a.map' (fun g : α => ⟨(f (Quotient.mk'' g))⁻¹ * g, leftRel_apply.mp (Quotient.exact' (hf g))⟩)
        fun b c h => by
        rw [leftRel_apply]
        change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s
        have key : f b = f c :=
          congr_arg f (Quotient.sound' (leftRel_apply.mpr (h_le (leftRel_apply.mp h))))
        rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left, ← leftRel_apply]⟩
  invFun a := by
    refine a.2.map' (fun (b : { x // x ∈ t}) => f a.1 * b) fun b c h => by
      rw [leftRel_apply] at h ⊢
      change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s
      rwa [mul_inv_rev, mul_assoc, inv_mul_cancel_left]
  left_inv := by
    refine' Quotient.ind' fun a => _
    simp_rw [Quotient.map'_mk'', id.def, mul_inv_cancel_left]
  right_inv := by
    refine' Prod.rec _
    refine' Quotient.ind' fun a => _
    refine' Quotient.ind' fun b => _
    have key : Quotient.mk'' (f (Quotient.mk'' a) * b) = Quotient.mk'' a :=
      (QuotientGroup.mk_mul_of_mem (f a) b.2).trans (hf a)
    simp_rw [Quotient.map'_mk'', id.def, key, inv_mul_cancel_left]
#align subgroup.quotient_equiv_prod_of_le' Subgroup.quotientEquivProdOfLe'
#align add_subgroup.quotient_equiv_sum_of_le' AddSubgroup.quotientEquivSumOfLe'

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotientEquivProdOfLe'`. -/
@[to_additive (attr := simps!) "If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively. The
 constructive version is `quotientEquivProdOfLe'`."]
noncomputable def quotientEquivProdOfLe (h_le : s ≤ t) : α ⧸ s ≃ (α ⧸ t) × t ⧸ s.subgroupOf t :=
  quotientEquivProdOfLe' h_le Quotient.out' Quotient.out_eq'
#align subgroup.quotient_equiv_prod_of_le Subgroup.quotientEquivProdOfLe
#align add_subgroup.quotient_equiv_sum_of_le AddSubgroup.quotientEquivSumOfLe

/-- If `s ≤ t`, then there is an embedding `s ⧸ H.subgroupOf s ↪ t ⧸ H.subgroupOf t`. -/
@[to_additive "If `s ≤ t`, then there is an embedding
 `s ⧸ H.addSubgroupOf s ↪ t ⧸ H.addSubgroupOf t`."]
def quotientSubgroupOfEmbeddingOfLe (H : Subgroup α) (h : s ≤ t) :
    s ⧸ H.subgroupOf s ↪ t ⧸ H.subgroupOf t
    where
  toFun :=
    Quotient.map' (inclusion h) fun a b =>
      by
      simp_rw [leftRel_eq]
      exact id
  inj' :=
    Quotient.ind₂' <| by
      intro a b h
      simpa only [Quotient.map'_mk'', eq'] using h
#align subgroup.quotient_subgroup_of_embedding_of_le Subgroup.quotientSubgroupOfEmbeddingOfLe
#align add_subgroup.quotient_add_subgroup_of_embedding_of_le AddSubgroup.quotientAddSubgroupOfEmbeddingOfLe

-- porting note: I had to add the type ascription to the right-hand side or else Lean times out.
@[to_additive (attr := simp)]
theorem quotientSubgroupOfEmbeddingOfLe_apply_mk (H : Subgroup α) (h : s ≤ t) (g : s) :
    quotientSubgroupOfEmbeddingOfLe H h (QuotientGroup.mk g) =
      (QuotientGroup.mk (inclusion h g) : (fun _ => { x // x ∈ t } ⧸ subgroupOf H t) ↑g) :=
  rfl

#align subgroup.quotient_subgroup_of_embedding_of_le_apply_mk Subgroup.quotientSubgroupOfEmbeddingOfLe_apply_mk
#align add_subgroup.quotient_add_subgroup_of_embedding_of_le_apply_mk AddSubgroup.quotientAddSubgroupOfEmbeddingOfLe_apply_mk

/-- If `s ≤ t`, then there is a map `H ⧸ s.subgroupOf H → H ⧸ t.subgroupOf H`. -/
@[to_additive "If `s ≤ t`, then there is an map `H ⧸ s.addSubgroupOf H → H ⧸ t.addSubgroupOf H`."]
def quotientSubgroupOfMapOfLe (H : Subgroup α) (h : s ≤ t) :
    H ⧸ s.subgroupOf H → H ⧸ t.subgroupOf H :=
  Quotient.map' id fun a b => by
    simp_rw [leftRel_eq]
    apply h
#align subgroup.quotient_subgroup_of_map_of_le Subgroup.quotientSubgroupOfMapOfLe
#align add_subgroup.quotient_add_subgroup_of_map_of_le AddSubgroup.quotientAddSubgroupOfMapOfLe

-- porting note: I had to add the type ascription to the right-hand side or else Lean times out.
@[to_additive (attr := simp)]
theorem quotientSubgroupOfMapOfLe_apply_mk (H : Subgroup α) (h : s ≤ t) (g : H) :
    quotientSubgroupOfMapOfLe H h (QuotientGroup.mk g) =
      (QuotientGroup.mk g : { x // x ∈ H } ⧸ subgroupOf t H) :=
  rfl
#align subgroup.quotient_subgroup_of_map_of_le_apply_mk
  Subgroup.quotientSubgroupOfMapOfLe_apply_mk
#align add_subgroup.quotient_add_subgroup_of_map_of_le_apply_mk
  AddSubgroup.quotientAddSubgroupOfMapOfLe_apply_mk

/-- If `s ≤ t`, then there is a map `α ⧸ s → α ⧸ t`. -/
@[to_additive "If `s ≤ t`, then there is an map `α ⧸ s → α ⧸ t`."]
def quotientMapOfLe (h : s ≤ t) : α ⧸ s → α ⧸ t :=
  Quotient.map' id fun a b => by
    simp_rw [leftRel_eq]
    apply h
#align subgroup.quotient_map_of_le Subgroup.quotientMapOfLe
#align add_subgroup.quotient_map_of_le AddSubgroup.quotientMapOfLe

@[to_additive (attr := simp)]
theorem quotientMapOfLe_apply_mk (h : s ≤ t) (g : α) :
    quotientMapOfLe h (QuotientGroup.mk g) = QuotientGroup.mk g :=
  rfl
#align subgroup.quotient_map_of_le_apply_mk Subgroup.quotientMapOfLe_apply_mk
#align add_subgroup.quotient_map_of_le_apply_mk AddSubgroup.quotientMapOfLe_apply_mk

/-- The natural embedding `H ⧸ (⨅ i, f i).subgroupOf H ↪ Π i, H ⧸ (f i).subgroupOf H`. -/
@[to_additive (attr := simps) "The natural embedding
 `H ⧸ (⨅ i, f i).addSubgroupOf H) ↪ Π i, H ⧸ (f i).addSubgroupOf H`."]
def quotientInfᵢSubgroupOfEmbedding {ι : Type _} (f : ι → Subgroup α) (H : Subgroup α) :
    H ⧸ (⨅ i, f i).subgroupOf H ↪ ∀ i, H ⧸ (f i).subgroupOf H
    where
  toFun q i := quotientSubgroupOfMapOfLe H (infᵢ_le f i) q
  inj' :=
    Quotient.ind₂' <| by
      simp_rw [funext_iff, quotientSubgroupOfMapOfLe_apply_mk, eq', mem_subgroupOf, mem_infᵢ,
        imp_self, forall_const]
#align subgroup.quotient_infi_subgroup_of_embedding Subgroup.quotientInfᵢSubgroupOfEmbedding
#align add_subgroup.quotient_infi_add_subgroup_of_embedding AddSubgroup.quotientInfᵢAddSubgroupOfEmbedding

-- porting note: I had to add the type ascription to the right-hand side or else Lean times out.
@[to_additive (attr := simp)]
theorem quotientInfᵢSubgroupOfEmbedding_apply_mk {ι : Type _} (f : ι → Subgroup α) (H : Subgroup α)
    (g : H) (i : ι) :
    quotientInfᵢSubgroupOfEmbedding f H (QuotientGroup.mk g) i =
      (QuotientGroup.mk g : { x // x ∈ H } ⧸ subgroupOf (f i) H) :=
  rfl
#align subgroup.quotient_infi_subgroup_of_embedding_apply_mk Subgroup.quotientInfᵢSubgroupOfEmbedding_apply_mk
#align add_subgroup.quotient_infi_add_subgroup_of_embedding_apply_mk AddSubgroup.quotientInfᵢAddSubgroupOfEmbedding_apply_mk

/-- The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`. -/
@[to_additive (attr := simps) "The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`."]
def quotientInfᵢEmbedding {ι : Type _} (f : ι → Subgroup α) : (α ⧸ ⨅ i, f i) ↪ ∀ i, α ⧸ f i
    where
  toFun q i := quotientMapOfLe (infᵢ_le f i) q
  inj' :=
    Quotient.ind₂' <| by
      simp_rw [funext_iff, quotientMapOfLe_apply_mk, eq', mem_infᵢ, imp_self, forall_const]
#align subgroup.quotient_infi_embedding Subgroup.quotientInfᵢEmbedding
#align add_subgroup.quotient_infi_embedding AddSubgroup.quotientInfᵢEmbedding

@[to_additive (attr := simp)]
theorem quotientInfᵢEmbedding_apply_mk {ι : Type _} (f : ι → Subgroup α) (g : α) (i : ι) :
    quotientInfᵢEmbedding f (QuotientGroup.mk g) i = QuotientGroup.mk g :=
  rfl
#align subgroup.quotient_infi_embedding_apply_mk Subgroup.quotientInfᵢEmbedding_apply_mk
#align add_subgroup.quotient_infi_embedding_apply_mk AddSubgroup.quotientInfᵢEmbedding_apply_mk

@[to_additive]
theorem card_eq_card_quotient_mul_card_subgroup [Fintype α] (s : Subgroup α) [Fintype s]
    [DecidablePred fun a => a ∈ s] : Fintype.card α = Fintype.card (α ⧸ s) * Fintype.card s := by
  rw [← Fintype.card_prod]; exact Fintype.card_congr Subgroup.groupEquivQuotientProdSubgroup
#align subgroup.card_eq_card_quotient_mul_card_subgroup Subgroup.card_eq_card_quotient_mul_card_subgroup
#align add_subgroup.card_eq_card_quotient_add_card_add_subgroup AddSubgroup.card_eq_card_quotient_add_card_addSubgroup

/-- **Lagrange's Theorem**: The order of a subgroup divides the order of its ambient group. -/
@[to_additive "**Lagrange's Theorem**: The order of an additive subgroup divides the order of its
 ambient additive group."]
theorem card_subgroup_dvd_card [Fintype α] (s : Subgroup α) [Fintype s] :
    Fintype.card s ∣ Fintype.card α := by
  classical simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_left ℕ]
#align subgroup.card_subgroup_dvd_card Subgroup.card_subgroup_dvd_card
#align add_subgroup.card_add_subgroup_dvd_card AddSubgroup.card_addSubgroup_dvd_card

@[to_additive]
theorem card_quotient_dvd_card [Fintype α] (s : Subgroup α) [DecidablePred (· ∈ s)] :
    Fintype.card (α ⧸ s) ∣ Fintype.card α := by
  simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_right ℕ]
#align subgroup.card_quotient_dvd_card Subgroup.card_quotient_dvd_card
#align add_subgroup.card_quotient_dvd_card AddSubgroup.card_quotient_dvd_card

open Fintype

variable {H : Type _} [Group H]

@[to_additive]
theorem card_dvd_of_injective [Fintype α] [Fintype H] (f : α →* H) (hf : Function.Injective f) :
    card α ∣ card H := by
  classical calc
      card α = card (f.range : Subgroup H) := card_congr (Equiv.ofInjective f hf)
      _ ∣ card H := card_subgroup_dvd_card _

#align subgroup.card_dvd_of_injective Subgroup.card_dvd_of_injective
#align add_subgroup.card_dvd_of_injective AddSubgroup.card_dvd_of_injective

@[to_additive]
theorem card_dvd_of_le {H K : Subgroup α} [Fintype H] [Fintype K] (hHK : H ≤ K) : card H ∣ card K :=
  card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)
#align subgroup.card_dvd_of_le Subgroup.card_dvd_of_le
#align add_subgroup.card_dvd_of_le AddSubgroup.card_dvd_of_le

@[to_additive]
theorem card_comap_dvd_of_injective (K : Subgroup H) [Fintype K] (f : α →* H) [Fintype (K.comap f)]
    (hf : Function.Injective f) : Fintype.card (K.comap f) ∣ Fintype.card K := by
  haveI : Fintype ((K.comap f).map f) :=
      Fintype.ofEquiv _ (equivMapOfInjective _ _ hf).toEquiv;
    calc
      Fintype.card (K.comap f) = Fintype.card ((K.comap f).map f) :=
        Fintype.card_congr (equivMapOfInjective _ _ hf).toEquiv
      _ ∣ Fintype.card K := card_dvd_of_le (map_comap_le _ _)

#align subgroup.card_comap_dvd_of_injective Subgroup.card_comap_dvd_of_injective
#align add_subgroup.card_comap_dvd_of_injective AddSubgroup.card_comap_dvd_of_injective

end Subgroup

namespace QuotientGroup

variable [Group α]

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α ⧸ s`, then there is a
(typically non-canonical) bijection between the preimage of `t` in `α` and the product `s × t`. -/
@[to_additive preimageMkEquivAddSubgroupProdSet
"If `s` is a subgroup of the additive group `α`, and `t` is a subset of `α ⧸ s`, then
 there is a (typically non-canonical) bijection between the preimage of `t` in `α` and the product
 `s × t`."]
noncomputable def preimageMkEquivSubgroupProdSet (s : Subgroup α) (t : Set (α ⧸ s)) :
    QuotientGroup.mk ⁻¹' t ≃ s × t
    where
  toFun a :=
    ⟨⟨((Quotient.out' (QuotientGroup.mk a)) : α)⁻¹ * a,
        leftRel_apply.mp (@Quotient.exact' _ (leftRel s) _ _ <| Quotient.out_eq' _)⟩,
      ⟨QuotientGroup.mk a, a.2⟩⟩
  invFun a :=
    ⟨Quotient.out' a.2.1 * a.1.1,
      show QuotientGroup.mk _ ∈ t by
        rw [mk_mul_of_mem _ a.1.2, out_eq']
        exact a.2.2⟩
  left_inv := fun ⟨a, ha⟩ => Subtype.eq <| show _ * _ = a by simp
  right_inv := fun ⟨⟨a, ha⟩, ⟨x, hx⟩⟩ => by ext <;> simp [ha]
#align quotient_group.preimage_mk_equiv_subgroup_times_set QuotientGroup.preimageMkEquivSubgroupProdSet
#align quotient_add_group.preimage_mk_equiv_add_subgroup_times_set QuotientAddGroup.preimageMkEquivAddSubgroupProdSet

end QuotientGroup


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach
-/
import field_theory.separable
import algebra.algebra.basic
import data.polynomial.degree
import algebra.char_p.exp_char

/-!

# Separable degree

This file contains basics about the separable degree of a polynomial.

## Main results

- `is_separable_contraction`: is the condition that `g(x^(q^m)) = f(x)` for some `m : ℕ`
- `has_separable_contraction`: the condition of having a separable contraction
- `has_separable_contraction.degree`: the separable degree, defined as the degree of some
  separable contraction
- `irreducible_has_separable_contraction`: any nonzero irreducible polynomial can be contracted
  to a separable polynomial
- `has_separable_contraction.dvd_degree'`: the degree of a separable contraction divides the degree,
  in function of the exponential characteristic of the field
- `has_separable_contraction.dvd_degree` and `has_separable_contraction.eq_degree` specialize the
  statement of `separable_degree_dvd_degree`
- `is_separable_contraction.degree_eq`: the separable degree is well-defined, implemented as the
  statement that the degree of any separable contraction equals `has_separable_contraction.degree`

## Tags

separable degree, degree, polynomial
-/

namespace polynomial

noncomputable theory
open_locale classical

section comm_semiring

variables {F : Type} [comm_semiring F] (q : ℕ)

/-- A separable contraction of a polynomial `f` is a separable polynomial `g` such that
`g(x^(q^m)) = f(x)` for some `m : ℕ`.-/
def is_separable_contraction (f : polynomial F) (g : polynomial F) : Prop :=
g.separable ∧ ∃ m : ℕ, expand F (q^m) g = f

/-- The condition of having a separable contration. -/
def has_separable_contraction (f : polynomial F) : Prop :=
∃ g : polynomial F, is_separable_contraction q f g

variables {q} {f : polynomial F} (hf : has_separable_contraction q f)

/-- A choice of a separable contraction. -/
def has_separable_contraction.contraction : polynomial F := classical.some hf

/-- The separable degree of a polynomial is the degree of a given separable contraction. -/
def has_separable_contraction.degree : ℕ := hf.contraction.nat_degree

/-- The separable degree divides the degree, in function of the exponential characteristic of F. -/
lemma is_separable_contraction.dvd_degree' {g} (hf : is_separable_contraction q f g) :
  ∃ m : ℕ, g.nat_degree * (q ^ m) = f.nat_degree :=
begin
  obtain ⟨m, rfl⟩ := hf.2,
  use m,
  rw nat_degree_expand,
end

lemma has_separable_contraction.dvd_degree' : ∃ m : ℕ, hf.degree * (q ^ m) = f.nat_degree :=
(classical.some_spec hf).dvd_degree'

/-- The separable degree divides the degree. -/
lemma has_separable_contraction.dvd_degree :
  hf.degree ∣ f.nat_degree :=
let ⟨a, ha⟩ := hf.dvd_degree' in dvd.intro (q ^ a) ha

/-- In exponential characteristic one, the separable degree equals the degree. -/
lemma has_separable_contraction.eq_degree {f : polynomial F}
  (hf : has_separable_contraction 1 f) : hf.degree = f.nat_degree :=
let ⟨a, ha⟩ := hf.dvd_degree' in by rw [←ha, one_pow a, mul_one]

end comm_semiring

section field

variables {F : Type} [field F]
variables (q : ℕ) {f : polynomial F} (hf : has_separable_contraction q f)

/-- Every irreducible polynomial can be contracted to a separable polynomial.
https://stacks.math.columbia.edu/tag/09H0 -/
lemma irreducible_has_separable_contraction (q : ℕ) [hF : exp_char F q]
  (f : polynomial F) [irred : irreducible f] (fn : f ≠ 0) : has_separable_contraction q f :=
begin
  casesI hF,
  { use f,
    exact ⟨irreducible.separable irred, ⟨0, by rw [pow_zero, expand_one]⟩⟩ },
  { haveI qp : fact (nat.prime q) := ⟨hF_hprime⟩,
    rcases exists_separable_of_irreducible q irred fn with ⟨n, g, hgs, hge⟩,
    exact ⟨g, hgs, n, hge⟩, }
end

/-- A helper lemma: if two expansions (along the positive characteristic) of two polynomials `g` and
`g'` agree, and the one with the larger degree is separable, then their degrees are the same. -/
lemma contraction_degree_eq_aux [hq : fact q.prime] [hF : char_p F q]
  (g g' : polynomial F) (m m' : ℕ)
  (h_expand : expand F (q^m) g = expand F (q^m') g')
  (h : m < m') (hg : g.separable):
  g.nat_degree =  g'.nat_degree :=
begin
  obtain ⟨s, rfl⟩ := nat.exists_eq_add_of_lt h,
  rw [add_assoc, pow_add, expand_mul] at h_expand,
  let aux := expand_injective (pow_pos hq.1.pos m) h_expand,
  rw aux at hg,
  have := (is_unit_or_eq_zero_of_separable_expand q (s + 1) hg).resolve_right
    s.succ_ne_zero,
  rw [aux, nat_degree_expand,
    nat_degree_eq_of_degree_eq_some (degree_eq_zero_of_is_unit this),
    zero_mul]
end

/-- If two expansions (along the positive characteristic) of two separable polynomials
`g` and `g'` agree, then they have the same degree. -/
theorem contraction_degree_eq_or_insep
  [hq : fact q.prime] [char_p F q]
  (g g' : polynomial F) (m m' : ℕ)
  (h_expand : expand F (q^m) g = expand F (q^m') g')
  (hg : g.separable) (hg' : g'.separable) :
  g.nat_degree = g'.nat_degree :=
begin
  by_cases h : m = m',
  { -- if `m = m'` then we show `g.nat_degree = g'.nat_degree` by unfolding the definitions
    rw h at h_expand,
    have expand_deg : ((expand F (q ^ m')) g).nat_degree =
      (expand F (q ^ m') g').nat_degree, by rw h_expand,
    rw [nat_degree_expand (q^m') g, nat_degree_expand (q^m') g'] at expand_deg,
    apply nat.eq_of_mul_eq_mul_left (pow_pos hq.1.pos m'),
    rw [mul_comm] at expand_deg, rw expand_deg, rw [mul_comm] },
  { cases ne.lt_or_lt h,
    { exact contraction_degree_eq_aux q g g' m m' h_expand h_1 hg },
    { exact (contraction_degree_eq_aux q g' g m' m h_expand.symm h_1 hg').symm, } }
end

/-- The separable degree equals the degree of any separable contraction, i.e., it is unique. -/
theorem is_separable_contraction.degree_eq [hF : exp_char F q]
  (g : polynomial F) (hg : is_separable_contraction q f g) :
  g.nat_degree = hf.degree :=
begin
  casesI hF,
  { rcases hg with ⟨g, m, hm⟩,
    rw [one_pow, expand_one] at hm,
    rw hf.eq_degree,
    rw hm, },
  { rcases hg with ⟨hg, m, hm⟩,
    let g' := classical.some hf,
    cases (classical.some_spec hf).2 with m' hm',
    haveI : fact q.prime := fact_iff.2 hF_hprime,
    apply contraction_degree_eq_or_insep q g g' m m',
    rw [hm, hm'],
    exact hg, exact (classical.some_spec hf).1 }
end

end field

end polynomial


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Lu-Ming Zhang

! This file was ported from Lean 3 source module combinatorics.simple_graph.adj_matrix
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.Basic
import Mathbin.Combinatorics.SimpleGraph.Connectivity
import Mathbin.LinearAlgebra.Matrix.Trace
import Mathbin.LinearAlgebra.Matrix.Symmetric

/-!
# Adjacency Matrices

This module defines the adjacency matrix of a graph, and provides theorems connecting graph
properties to computational properties of the matrix.

## Main definitions

* `matrix.is_adj_matrix`: `A : matrix V V α` is qualified as an "adjacency matrix" if
  (1) every entry of `A` is `0` or `1`,
  (2) `A` is symmetric,
  (3) every diagonal entry of `A` is `0`.

* `matrix.is_adj_matrix.to_graph`: for `A : matrix V V α` and `h : A.is_adj_matrix`,
  `h.to_graph` is the simple graph induced by `A`.

* `matrix.compl`: for `A : matrix V V α`, `A.compl` is supposed to be
  the adjacency matrix of the complement graph of the graph induced by `A`.

* `simple_graph.adj_matrix`: the adjacency matrix of a `simple_graph`.

* `simple_graph.adj_matrix_pow_apply_eq_card_walk`: each entry of the `n`th power of
  a graph's adjacency matrix counts the number of length-`n` walks between the corresponding
  pair of vertices.

-/

open BigOperators Matrix

open Finset Matrix SimpleGraph

variable {V α β : Type _}

namespace Matrix

/-- `A : matrix V V α` is qualified as an "adjacency matrix" if
    (1) every entry of `A` is `0` or `1`,
    (2) `A` is symmetric,
    (3) every diagonal entry of `A` is `0`. -/
structure IsAdjMatrix [Zero α] [One α] (A : Matrix V V α) : Prop where
  zero_or_one : ∀ i j, A i j = 0 ∨ A i j = 1 := by obviously
  symm : A.IsSymm := by obviously
  apply_diag : ∀ i, A i i = 0 := by obviously
#align matrix.is_adj_matrix Matrix.IsAdjMatrix

namespace IsAdjMatrix

variable {A : Matrix V V α}

@[simp]
theorem apply_diag_ne [MulZeroOneClass α] [Nontrivial α] (h : IsAdjMatrix A) (i : V) : ¬A i i = 1 :=
  by simp [h.apply_diag i]
#align matrix.is_adj_matrix.apply_diag_ne Matrix.IsAdjMatrix.apply_diag_ne

@[simp]
theorem apply_ne_one_iff [MulZeroOneClass α] [Nontrivial α] (h : IsAdjMatrix A) (i j : V) :
    ¬A i j = 1 ↔ A i j = 0 := by obtain h | h := h.zero_or_one i j <;> simp [h]
#align matrix.is_adj_matrix.apply_ne_one_iff Matrix.IsAdjMatrix.apply_ne_one_iff

@[simp]
theorem apply_ne_zero_iff [MulZeroOneClass α] [Nontrivial α] (h : IsAdjMatrix A) (i j : V) :
    ¬A i j = 0 ↔ A i j = 1 := by rw [← apply_ne_one_iff h, Classical.not_not]
#align matrix.is_adj_matrix.apply_ne_zero_iff Matrix.IsAdjMatrix.apply_ne_zero_iff

/-- For `A : matrix V V α` and `h : is_adj_matrix A`,
    `h.to_graph` is the simple graph whose adjacency matrix is `A`. -/
@[simps]
def toGraph [MulZeroOneClass α] [Nontrivial α] (h : IsAdjMatrix A) : SimpleGraph V
    where
  Adj i j := A i j = 1
  symm i j hij := by rwa [h.symm.apply i j]
  loopless i := by simp [h]
#align matrix.is_adj_matrix.to_graph Matrix.IsAdjMatrix.toGraph

instance [MulZeroOneClass α] [Nontrivial α] [DecidableEq α] (h : IsAdjMatrix A) :
    DecidableRel h.toGraph.Adj := by
  simp only [to_graph]
  infer_instance

end IsAdjMatrix

/-- For `A : matrix V V α`, `A.compl` is supposed to be the adjacency matrix of
    the complement graph of the graph induced by `A.adj_matrix`. -/
def compl [Zero α] [One α] [DecidableEq α] [DecidableEq V] (A : Matrix V V α) : Matrix V V α :=
  fun i j => ite (i = j) 0 (ite (A i j = 0) 1 0)
#align matrix.compl Matrix.compl

section Compl

variable [DecidableEq α] [DecidableEq V] (A : Matrix V V α)

@[simp]
theorem compl_apply_diag [Zero α] [One α] (i : V) : A.compl i i = 0 := by simp [compl]
#align matrix.compl_apply_diag Matrix.compl_apply_diag

@[simp]
theorem compl_apply [Zero α] [One α] (i j : V) : A.compl i j = 0 ∨ A.compl i j = 1 :=
  by
  unfold compl
  split_ifs <;> simp
#align matrix.compl_apply Matrix.compl_apply

@[simp]
theorem isSymm_compl [Zero α] [One α] (h : A.IsSymm) : A.compl.IsSymm :=
  by
  ext
  simp [compl, h.apply, eq_comm]
#align matrix.is_symm_compl Matrix.isSymm_compl

@[simp]
theorem isAdjMatrix_compl [Zero α] [One α] (h : A.IsSymm) : IsAdjMatrix A.compl :=
  { symm := by simp [h] }
#align matrix.is_adj_matrix_compl Matrix.isAdjMatrix_compl

namespace IsAdjMatrix

variable {A}

@[simp]
theorem compl [Zero α] [One α] (h : IsAdjMatrix A) : IsAdjMatrix A.compl :=
  isAdjMatrix_compl A h.symm
#align matrix.is_adj_matrix.compl Matrix.IsAdjMatrix.compl

theorem toGraph_compl_eq [MulZeroOneClass α] [Nontrivial α] (h : IsAdjMatrix A) :
    h.compl.toGraph = h.toGraphᶜ := by
  ext (v w)
  cases' h.zero_or_one v w with h h <;> by_cases hvw : v = w <;> simp [Matrix.compl, h, hvw]
#align matrix.is_adj_matrix.to_graph_compl_eq Matrix.IsAdjMatrix.toGraph_compl_eq

end IsAdjMatrix

end Compl

end Matrix

open Matrix

namespace SimpleGraph

variable (G : SimpleGraph V) [DecidableRel G.Adj]

variable (α)

/-- `adj_matrix G α` is the matrix `A` such that `A i j = (1 : α)` if `i` and `j` are
  adjacent in the simple graph `G`, and otherwise `A i j = 0`. -/
def adjMatrix [Zero α] [One α] : Matrix V V α
  | i, j => if G.Adj i j then 1 else 0
#align simple_graph.adj_matrix SimpleGraph.adjMatrix

variable {α}

@[simp]
theorem adjMatrix_apply (v w : V) [Zero α] [One α] :
    G.adjMatrix α v w = if G.Adj v w then 1 else 0 :=
  rfl
#align simple_graph.adj_matrix_apply SimpleGraph.adjMatrix_apply

@[simp]
theorem transpose_adjMatrix [Zero α] [One α] : (G.adjMatrix α)ᵀ = G.adjMatrix α :=
  by
  ext
  simp [adj_comm]
#align simple_graph.transpose_adj_matrix SimpleGraph.transpose_adjMatrix

@[simp]
theorem isSymm_adjMatrix [Zero α] [One α] : (G.adjMatrix α).IsSymm :=
  transpose_adjMatrix G
#align simple_graph.is_symm_adj_matrix SimpleGraph.isSymm_adjMatrix

variable (α)

/-- The adjacency matrix of `G` is an adjacency matrix. -/
@[simp]
theorem isAdjMatrix_adjMatrix [Zero α] [One α] : (G.adjMatrix α).IsAdjMatrix :=
  { zero_or_one := fun i j => by by_cases G.adj i j <;> simp [h] }
#align simple_graph.is_adj_matrix_adj_matrix SimpleGraph.isAdjMatrix_adjMatrix

/-- The graph induced by the adjacency matrix of `G` is `G` itself. -/
theorem toGraph_adjMatrix_eq [MulZeroOneClass α] [Nontrivial α] :
    (G.isAdjMatrix_adjMatrix α).toGraph = G := by
  ext
  simp only [is_adj_matrix.to_graph_adj, adj_matrix_apply, ite_eq_left_iff, zero_ne_one]
  apply Classical.not_not
#align simple_graph.to_graph_adj_matrix_eq SimpleGraph.toGraph_adjMatrix_eq

variable {α} [Fintype V]

@[simp]
theorem adjMatrix_dotProduct [NonAssocSemiring α] (v : V) (vec : V → α) :
    dotProduct (G.adjMatrix α v) vec = ∑ u in G.neighborFinset v, vec u := by
  simp [neighbor_finset_eq_filter, dot_product, sum_filter]
#align simple_graph.adj_matrix_dot_product SimpleGraph.adjMatrix_dotProduct

@[simp]
theorem dotProduct_adjMatrix [NonAssocSemiring α] (v : V) (vec : V → α) :
    dotProduct vec (G.adjMatrix α v) = ∑ u in G.neighborFinset v, vec u := by
  simp [neighbor_finset_eq_filter, dot_product, sum_filter, Finset.sum_apply]
#align simple_graph.dot_product_adj_matrix SimpleGraph.dotProduct_adjMatrix

@[simp]
theorem adjMatrix_mulVec_apply [NonAssocSemiring α] (v : V) (vec : V → α) :
    ((G.adjMatrix α).mulVec vec) v = ∑ u in G.neighborFinset v, vec u := by
  rw [mul_vec, adj_matrix_dot_product]
#align simple_graph.adj_matrix_mul_vec_apply SimpleGraph.adjMatrix_mulVec_apply

@[simp]
theorem adjMatrix_vecMul_apply [NonAssocSemiring α] (v : V) (vec : V → α) :
    ((G.adjMatrix α).vecMul vec) v = ∑ u in G.neighborFinset v, vec u :=
  by
  rw [← dot_product_adj_matrix, vec_mul]
  refine' congr rfl _; ext
  rw [← transpose_apply (adj_matrix α G) x v, transpose_adj_matrix]
#align simple_graph.adj_matrix_vec_mul_apply SimpleGraph.adjMatrix_vecMul_apply

@[simp]
theorem adjMatrix_mul_apply [NonAssocSemiring α] (M : Matrix V V α) (v w : V) :
    (G.adjMatrix α ⬝ M) v w = ∑ u in G.neighborFinset v, M u w := by
  simp [mul_apply, neighbor_finset_eq_filter, sum_filter]
#align simple_graph.adj_matrix_mul_apply SimpleGraph.adjMatrix_mul_apply

@[simp]
theorem mul_adjMatrix_apply [NonAssocSemiring α] (M : Matrix V V α) (v w : V) :
    (M ⬝ G.adjMatrix α) v w = ∑ u in G.neighborFinset w, M v u := by
  simp [mul_apply, neighbor_finset_eq_filter, sum_filter, adj_comm]
#align simple_graph.mul_adj_matrix_apply SimpleGraph.mul_adjMatrix_apply

variable (α)

@[simp]
theorem trace_adjMatrix [AddCommMonoid α] [One α] : Matrix.trace (G.adjMatrix α) = 0 := by
  simp [Matrix.trace]
#align simple_graph.trace_adj_matrix SimpleGraph.trace_adjMatrix

variable {α}

theorem adjMatrix_mul_self_apply_self [NonAssocSemiring α] (i : V) :
    (G.adjMatrix α ⬝ G.adjMatrix α) i i = degree G i := by simp [degree]
#align simple_graph.adj_matrix_mul_self_apply_self SimpleGraph.adjMatrix_mul_self_apply_self

variable {G}

@[simp]
theorem adjMatrix_mulVec_const_apply [Semiring α] {a : α} {v : V} :
    (G.adjMatrix α).mulVec (Function.const _ a) v = G.degree v * a := by simp [degree]
#align simple_graph.adj_matrix_mul_vec_const_apply SimpleGraph.adjMatrix_mulVec_const_apply

theorem adjMatrix_mulVec_const_apply_of_regular [Semiring α] {d : ℕ} {a : α}
    (hd : G.IsRegularOfDegree d) {v : V} : (G.adjMatrix α).mulVec (Function.const _ a) v = d * a :=
  by simp [hd v]
#align simple_graph.adj_matrix_mul_vec_const_apply_of_regular SimpleGraph.adjMatrix_mulVec_const_apply_of_regular

theorem adjMatrix_pow_apply_eq_card_walk [DecidableEq V] [Semiring α] (n : ℕ) (u v : V) :
    (G.adjMatrix α ^ n) u v = Fintype.card { p : G.Walk u v | p.length = n } :=
  by
  rw [card_set_walk_length_eq]
  induction' n with n ih generalizing u v
  · obtain rfl | h := eq_or_ne u v <;> simp [finset_walk_length, *]
  · nth_rw 1 [Nat.succ_eq_one_add]
    simp only [pow_add, pow_one, finset_walk_length, ih, mul_eq_mul, adj_matrix_mul_apply]
    rw [Finset.card_bunionᵢ]
    · norm_cast
      simp only [Nat.cast_sum, card_map, neighbor_finset_def]
      apply Finset.sum_toFinset_eq_subtype
    -- Disjointness for card_bUnion
    · rintro ⟨x, hx⟩ - ⟨y, hy⟩ - hxy
      rw [disjoint_iff_inf_le]
      intro p hp
      simp only [inf_eq_inter, mem_inter, mem_map, Function.Embedding.coeFn_mk, exists_prop] at
          hp <;>
        obtain ⟨⟨px, hpx, rfl⟩, ⟨py, hpy, hp⟩⟩ := hp
      cases hp
      simpa using hxy
#align simple_graph.adj_matrix_pow_apply_eq_card_walk SimpleGraph.adjMatrix_pow_apply_eq_card_walk

end SimpleGraph

namespace Matrix.IsAdjMatrix

variable [MulZeroOneClass α] [Nontrivial α]

variable {A : Matrix V V α} (h : IsAdjMatrix A)

/-- If `A` is qualified as an adjacency matrix,
    then the adjacency matrix of the graph induced by `A` is itself. -/
theorem adjMatrix_toGraph_eq [DecidableEq α] : h.toGraph.adjMatrix α = A :=
  by
  ext (i j)
  obtain h' | h' := h.zero_or_one i j <;> simp [h']
#align matrix.is_adj_matrix.adj_matrix_to_graph_eq Matrix.IsAdjMatrix.adjMatrix_toGraph_eq

end Matrix.IsAdjMatrix


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons .conj

namespace tup
variables {α : Type*} {l m n : ℕ}

definition append : α ^ m → α ^ n → α ^ (m + n)
| xs ys ⟨i, h⟩ :=
  if hm : i < m then
    xs ⟨i, hm⟩
  else
    ys ⟨i - m, nat.sub_lt_of_lt_add_of_ge (le_of_not_gt hm) h⟩

infixl ` ⊔ `:65 := append

lemma ith_append_of_lt {xs : α ^ m} {ys : α ^ n} {i : ℕ} (h : i < m) :
(xs ⊔ ys)[⟨i, nat.lt_add_right i m n h⟩] = xs[⟨i,h⟩] := dif_pos h

lemma ith_append_of_ge {xs : α ^ m} {ys : α ^ n} {i : ℕ} (h : i < m+n) (hm : i ≥ m) :
(xs ⊔ ys)[⟨i, h⟩] = ys[⟨i-m, nat.sub_lt_of_lt_add_of_ge hm h⟩] := dif_neg (not_lt_of_ge hm)

@[simp]
lemma append_lift_by {xs : α ^ m} {ys : α ^ n} :
∀ i, (xs ⊔ ys)[fin.lift_by n i] = xs[i]
| ⟨i, h⟩ := ith_append_of_lt h

@[simp]
lemma append_push_by {xs : α ^ m} {ys : α ^ n} :
∀ i : fin n, (xs ⊔ ys)[fin.push_by m i] = ys[i]
| ⟨i, h⟩ :=
  calc
  (xs ⊔ ys)[⟨m+i, nat.add_lt_add_left h m⟩]
      = ys[⟨(m+i)-m, _⟩] : ith_append_of_ge (nat.add_lt_add_left h m) (nat.le_add_right m i)
  ... = ys[⟨i, h⟩]       : by simp [nat.add_sub_cancel_left]

definition fun_append (f : α → Sort*) {xs : α ^ m} {ys : α ^ n} :
(Π i, f xs[i]) → (Π i, f ys[i]) → (Π i, f (xs ⊔ ys)[i]) :=
λ fx fy ⟨i, hi⟩,
if him : i < m then
  by simp [ith_append_of_lt him]; apply fx
else
  have him : i ≥ m, from le_of_not_gt him,
  by simp [ith_append_of_ge hi him]; apply fy

lemma prop_append (p : α → Prop) {xs : α ^ m} {ys : α ^ n} :
(∀ i, p xs[i]) → (∀ i, p ys[i]) → (∀ i, p (xs ⊔ ys)[i]) := fun_append p

lemma append_nil (xs : α ^ n) : xs ⊔ nil = xs :=
ext $ λ ⟨i,hi⟩, ith_append_of_lt hi

lemma append_conj (xs : α ^ m) (ys : α ^ n) (y : α) :
xs ⊔ (conj ys y) = tup.cast (add_assoc m n 1) (conj (xs ⊔ ys) y) :=
ext $ λ ⟨i,hi⟩,
have hi' : i < m + n + 1, by rw [add_assoc]; exact hi,
if him : i < m then
  have i < m + n, from nat.lt_add_right i m n him,
  by simp
  [ ith_append_of_lt him
  , ith_conj_of_lt this
  ]
else if himn : i < m + n then
  have him : i ≥ m, from le_of_not_gt him,
  have i - m < n, from nat.sub_lt_of_lt_add_of_ge him himn,
  by simp
  [ ith_append_of_ge hi him
  , ith_conj_of_lt this
  , ith_conj_of_lt himn
  , ith_append_of_ge himn him
  ]
else
  have him : i ≥ m, from le_of_not_gt him,
  have himn : i ≥ m + n, from le_of_not_gt himn,
  have i - m ≥ n, from nat.le_sub_of_add_le_of_ge him himn,
  by simp
  [ ith_conj_of_ge _ himn
  , ith_append_of_ge _ him
  , ith_conj_of_ge _ this
  ]

lemma nil_append' (xs : α ^ n) : tup.cast (nat.zero_add n) (nil ⊔ xs) = xs :=
have ∀ (i : fin n), fin.cast (ge_of_eq (nat.zero_add n)) i = fin.push_by 0 i,
from λ ⟨_,_⟩, by simp [fin.push_by],
ext $ λ ⟨i,hi⟩, by simp [ith_append_of_ge _ (nat.zero_le i)]

lemma nil_append (xs : α ^ n) : nil ⊔ xs = tup.cast (eq.symm $ nat.zero_add n) xs :=
eq_cast_symm_of_cast_eq $ nil_append' xs

lemma cons_append' (x : α) (xs : α ^ m) (ys : α ^ n) :
tup.cast (add_right_comm m 1 n) ((x :: xs) ⊔ ys) = (x :: (xs ⊔ ys)) :=
ext $ λ i,
match i with
| ⟨0,_⟩ := by simp [ith_append_of_lt (nat.zero_lt_succ m)]
| ⟨i+1,hi⟩ :=
  if him : i < m then
    by simp
    [ ith_append_of_lt (nat.succ_lt_succ him)
    , ith_append_of_lt him
    ]
  else
    have hi' : i + 1 < m + 1 + n, by rw ← add_right_comm m n 1; exact hi,
    have him : i ≥ m, from le_of_not_gt him,
    by simp
    [ ith_append_of_ge (nat.lt_of_succ_lt_succ hi) him
    , ith_append_of_ge hi' (nat.succ_le_succ him)
    ]
end

lemma cons_append (x : α) (xs : α ^ m) (ys : α ^ n) :
(x :: xs) ⊔ ys = tup.cast (add_right_comm m n 1) (x :: (xs ⊔ ys)) :=
eq_cast_symm_of_cast_eq $ cons_append' x xs ys

lemma append_assoc (xs : α ^ l) (ys : α ^ m) (zs : α ^ n) :
cast (nat.add_assoc l m n) ((xs ⊔ ys) ⊔ zs) = xs ⊔ (ys ⊔ zs) :=
ext $ λ ⟨i, hi⟩,
if hil : i < l then
  have hilm : i < l + m, from nat.lt_add_right i l m hil,
  by simp
  [ ith_append_of_lt hil
  , ith_append_of_lt hilm
  ]
else if hilm : i < l + m then
  have hil : i ≥ l, from le_of_not_gt hil,
  have i - l < m, from nat.sub_lt_of_lt_add_of_ge hil hilm,
  by simp
  [ ith_append_of_lt hilm
  , ith_append_of_ge _ hil
  , ith_append_of_lt this
  ]
else
  have hil : i ≥ l, from le_of_not_gt hil,
  have hilm : i ≥ l + m, from le_of_not_gt hilm,
  have i - l ≥ m, from nat.le_sub_of_add_le_of_ge hil hilm,
  by simp
  [ ith_append_of_ge _ hil
  , ith_append_of_ge _ this
  , ith_append_of_ge _ hilm
  , nat.sub_sub
  ]

@[reducible]
definition take {{m n : ℕ}} : n ≤ m → α ^ m → α ^ n
| h xs i := xs[fin.cast h i]

@[simp]
lemma take_val {m n : ℕ} (h : m ≤ n) {xs : α ^ n} :
∀ (i : fin m), (take h xs)[i] = xs[fin.cast h i] :=
λ _, rfl

@[simp]
lemma take_take {l m n : ℕ} {hlm : l ≤ m} {hmn : m ≤ n} {xs : α ^ n} :
take hlm (take hmn xs) = take (le_trans hlm hmn) xs :=
tup.ext $ λ i, by simp

@[simp]
lemma take_append {m n : ℕ} {xs : α ^ m} {ys : α ^ n} :
take (nat.le_add_right m n) (xs ⊔ ys) = xs :=
tup.ext $ λ ⟨i,hi⟩, by simp [ith_append_of_lt hi]

@[reducible]
definition drop {{m n : ℕ}} : m ≤ n → α ^ n → α ^ m
| h xs i := xs[fin.push h i]

@[simp]
lemma drop_val {m n : ℕ} (h : m ≤ n) {xs : α ^ n} :
∀ (i : fin m), (drop h xs)[i] = xs[fin.push h i] :=
λ _, rfl

@[simp]
lemma drop_drop {l m n : ℕ} {hlm : l ≤ m} {hmn : m ≤ n} {xs : α ^ n} :
drop hlm (drop hmn xs) = drop (le_trans hlm hmn) xs :=
tup.ext $ λ i, by simp

@[simp]
lemma drop_append {m n : ℕ} {xs : α ^ m} {ys : α ^ n} :
drop (nat.le_add_left n m) (xs ⊔ ys) = ys :=
tup.ext $ λ ⟨i,hi⟩,
have hlt : ((m + n) - n) + i < m + n,
from calc
((m + n) - n) + i
    = m + i : by rw nat.add_sub_cancel
... < m + n : nat.add_lt_add_left hi m,
have hge : ((m + n) - n) + i ≥ m,
from calc
((m + n) - n) + i
    = m + i : by rw nat.add_sub_cancel
... ≥ m : nat.le_add_right m i,
have heq : (((m + n) - n) + i) - m = i,
from calc
(((m + n) - n) + i) - m
    = (m + i) - m : by rw nat.add_sub_cancel
... = i : by rw nat.add_sub_cancel_left,
begin
rw [drop_val, fin.push_mk, ith_append_of_ge hlt hge],
apply ith_eq_of_veq,
exact heq
end

@[simp]
lemma append_take_drop {m n : ℕ} {xs : α ^ (m + n)} :
(take (nat.le_add_right m n) xs) ⊔ (drop (nat.le_add_left n m) xs) = xs :=
tup.ext $ λ ⟨i, hi⟩,
if h : i < m then
  by simp [ith_append_of_lt h]
else
  have i - m + (m + n - n) = i,
  from calc
  (i - m) + (m + n - n)
      = (i - m) + m : by rw nat.add_sub_cancel
  ... = i : by rw nat.sub_add_cancel (le_of_not_gt h),
  by simp [ith_append_of_ge hi (le_of_not_gt h), fin.push, this]

end tup

namespace ntup
variable {α : Type*}

@[reducible]
definition append : ntup α → ntup α → ntup α
| ⟨n, xs⟩ ⟨m, ys⟩ := ⟨n + m, xs ⊔ ys⟩

instance : has_emptyc (ntup α) := ⟨ntup.nil⟩
instance : has_append (ntup α) := ⟨append⟩

@[simp]
lemma append_length : ∀ (nxs nys : ntup α), (nxs ++ nys).length = nxs.length + nys.length
| ⟨nx,xs⟩ ⟨ny,ys⟩ := rfl

@[simp]
lemma append_to_tup : ∀ (nxs nys : ntup α),
(nxs ++ nys).to_tup = tup.cast (eq.symm $ append_length nxs nys) (nxs.to_tup ⊔ nys.to_tup)
| ⟨nx,xs⟩ ⟨ny,ys⟩ := by simp [sigma.snd]

@[simp]
lemma append_nil :
∀ (nxs : ntup α), nxs ++ nil = nxs
| ⟨nx,xs⟩ := by apply eq; simp; exact tup.append_nil xs

@[simp]
lemma nil_append :
∀ (nxs : ntup α), nil ++ nxs = nxs
| ⟨nx,xs⟩ := by apply eq; simp; exact tup.nil_append' xs

@[simp]
lemma append_assoc :
∀ (nxs nys nzs : ntup α), (nxs ++ nys) ++ nzs = nxs ++ (nys ++ nzs)
| ⟨nx,xs⟩ ⟨ny,ys⟩ ⟨nz,zs⟩ := by apply eq; simp; exact tup.append_assoc xs ys zs

end ntup


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens
-/
import tactic.ring_exp
import data.nat.parity
import data.nat.choose.sum

/-!
# Primorial

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

open finset
open nat
open_locale big_operators nat

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ := ∏ p in (filter prime (range (n + 1))), p
local notation x`#` := primorial x

lemma primorial_succ {n : ℕ} (n_big : 1 < n) (r : n % 2 = 1) : (n + 1)# = n# :=
begin
  have not_prime : ¬prime (n + 1),
  { intros is_prime,
    cases (prime.eq_two_or_odd is_prime) with _ n_even,
    { linarith, },
    { exfalso,
      rw ←not_even_iff at n_even r,
      have e : even (n + 1 - n) := (even_sub (lt_add_one n).le).2 (iff_of_false n_even r),
      simp only [add_tsub_cancel_left, not_even_one] at e,
      exact e, }, },
  apply finset.prod_congr,
  { rw [@range_succ (n + 1), filter_insert, if_neg not_prime], },
  { exact λ _ _, rfl, },
end

lemma dvd_choose_of_middling_prime (p : ℕ) (is_prime : prime p) (m : ℕ)
  (p_big : m + 1 < p) (p_small : p ≤ 2 * m + 1) : p ∣ choose (2 * m + 1) (m + 1) :=
begin
  have m_size : m + 1 ≤ 2 * m + 1 := le_of_lt (lt_of_lt_of_le p_big p_small),
  have s : ¬(p ∣ (m + 1)!),
  { intros p_div_fact,
    have p_le_succ_m : p ≤ m + 1 := (prime.dvd_factorial is_prime).mp p_div_fact,
    linarith, },
  have t : ¬(p ∣ (2 * m + 1 - (m + 1))!),
  { intros p_div_fact,
    have p_small : p ≤ 2 * m + 1 - (m + 1) := (prime.dvd_factorial is_prime).mp p_div_fact,
    linarith, },
  have expanded :
    choose (2 * m + 1) (m + 1) * (m + 1)! * (2 * m + 1 - (m + 1))! = (2 * m + 1)! :=
    @choose_mul_factorial_mul_factorial (2 * m + 1) (m + 1) m_size,
  have p_div_big_fact : p ∣ (2 * m + 1)! := (prime.dvd_factorial is_prime).mpr p_small,
  rw [←expanded, mul_assoc] at p_div_big_fact,
  obtain p_div_choose | p_div_facts : p ∣ choose (2 * m + 1) (m + 1) ∨ p ∣ _! * _! :=
    (prime.dvd_mul is_prime).1 p_div_big_fact,
  { exact p_div_choose, },
  cases (prime.dvd_mul is_prime).1 p_div_facts,
  cc, cc,
end

lemma prod_primes_dvd {s : finset ℕ} : ∀ (n : ℕ) (h : ∀ a ∈ s, prime a) (div : ∀ a ∈ s, a ∣ n),
  (∏ p in s, p) ∣ n :=
begin
  apply finset.induction_on s,
  { simp, },
  { intros a s a_not_in_s induct n primes divs,
    rw finset.prod_insert a_not_in_s,
    obtain ⟨k, rfl⟩ : a ∣ n, by exact divs a (finset.mem_insert_self a s),
    have step : ∏ p in s, p ∣ k,
    { apply induct k,
      { intros b b_in_s,
        exact primes b (finset.mem_insert_of_mem b_in_s), },
      { intros b b_in_s,
        have b_div_n, by exact divs b (finset.mem_insert_of_mem b_in_s),
        have a_prime : prime a, { exact primes a (finset.mem_insert_self a s), },
        have b_prime : prime b, { exact primes b (finset.mem_insert_of_mem b_in_s), },
        obtain b_div_a | b_div_k : b ∣ a ∨ b ∣ k, exact (prime.dvd_mul b_prime).mp b_div_n,
        { exfalso,
          have b_eq_a : b = a,
          { cases (nat.dvd_prime a_prime).1 b_div_a with b_eq_1 b_eq_a,
            { subst b_eq_1, exfalso, exact prime.ne_one b_prime rfl, },
            { exact b_eq_a } },
          subst b_eq_a,
          exact a_not_in_s b_in_s, },
        { exact b_div_k } } },
    exact mul_dvd_mul_left a step, }
end

lemma primorial_le_4_pow : ∀ (n : ℕ), n# ≤ 4 ^ n
| 0 := le_refl _
| 1 := le_of_inf_eq rfl
| (n + 2) :=
  match nat.mod_two_eq_zero_or_one (n + 1) with
  | or.inl n_odd :=
    match nat.even_iff.2 n_odd with
    | ⟨m, twice_m⟩ :=
      let recurse : m + 1 < n + 2 := by linarith in
      begin
        calc (n + 2)#
            = ∏ i in filter prime (range (2 * m + 2)), i : by simpa [←twice_m]
        ... = ∏ i in filter prime (finset.Ico (m + 2) (2 * m + 2) ∪ range (m + 2)), i :
              begin
                rw [range_eq_Ico, finset.union_comm, finset.Ico_union_Ico_eq_Ico],
                exact bot_le,
                simp only [add_le_add_iff_right],
                linarith,
              end
        ... = ∏ i in (filter prime (finset.Ico (m + 2) (2 * m + 2))
              ∪ (filter prime (range (m + 2)))), i :
              by rw filter_union
        ... = (∏ i in filter prime (finset.Ico (m + 2) (2 * m + 2)), i)
              * (∏ i in filter prime (range (m + 2)), i) :
              begin
                apply finset.prod_union,
                have disj : disjoint (finset.Ico (m + 2) (2 * m + 2)) (range (m + 2)),
                { simp only [finset.disjoint_left, and_imp, finset.mem_Ico, not_lt,
                    finset.mem_range],
                  intros _ pr _, exact pr, },
                exact finset.disjoint_filter_filter disj,
              end
        ... ≤ (∏ i in filter prime (finset.Ico (m + 2) (2 * m + 2)), i) * 4 ^ (m + 1) :
              by exact nat.mul_le_mul_left _ (primorial_le_4_pow (m + 1))
        ... ≤ (choose (2 * m + 1) (m + 1)) * 4 ^ (m + 1) :
              begin
                have s : ∏ i in filter prime (finset.Ico (m + 2) (2 * m + 2)),
                  i ∣ choose (2 * m + 1) (m + 1),
                { refine prod_primes_dvd  (choose (2 * m + 1) (m + 1)) _ _,
                  { intros a, rw finset.mem_filter, cc, },
                  { intros a, rw finset.mem_filter,
                    intros pr,
                    rcases pr with ⟨ size, is_prime ⟩,
                    simp only [finset.mem_Ico] at size,
                    rcases size with ⟨ a_big , a_small ⟩,
                    exact dvd_choose_of_middling_prime a is_prime m a_big
                      (nat.lt_succ_iff.mp a_small), }, },
                have r : ∏ i in filter prime (finset.Ico (m + 2) (2 * m + 2)),
                  i ≤ choose (2 * m + 1) (m + 1),
                { refine @nat.le_of_dvd _ _ _ s,
                  exact @choose_pos (2 * m + 1) (m + 1) (by linarith), },
                exact nat.mul_le_mul_right _ r,
              end
        ... = (choose (2 * m + 1) m) * 4 ^ (m + 1) : by rw choose_symm_half m
        ... ≤ 4 ^ m * 4 ^ (m + 1) : nat.mul_le_mul_right _ (choose_middle_le_pow m)
        ... = 4 ^ (2 * m + 1) : by ring_exp
        ... = 4 ^ (n + 2) : by rw ←twice_m,
      end
    end
  | or.inr n_even :=
    begin
      obtain one_lt_n | n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := lt_or_le 1 (n + 1),
      { rw primorial_succ (by linarith) n_even,
        calc (n + 1)#
              ≤ 4 ^ n.succ : primorial_le_4_pow (n + 1)
          ... ≤ 4 ^ (n + 2) : pow_le_pow (by norm_num) (nat.le_succ _), },
      { have n_zero : n = 0 := eq_bot_iff.2 (succ_le_succ_iff.1 n_le_one),
        norm_num [n_zero, primorial, range_succ, prod_filter, not_prime_zero, prime_two] },
    end

end


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne
-/
import analysis.convex.specific_functions

/-!
# Mean value inequalities

In this file we prove several mean inequalities for finite sums. Versions for integrals of some of
these inequalities are available in `measure_theory.mean_inequalities`.

## Main theorems: generalized mean inequality

The inequality says that for two non-negative vectors $w$ and $z$ with $\sum_{i\in s} w_i=1$
and $p ≤ q$ we have
$$
\sqrt[p]{\sum_{i\in s} w_i z_i^p} ≤ \sqrt[q]{\sum_{i\in s} w_i z_i^q}.
$$

Currently we only prove this inequality for $p=1$. As in the rest of `mathlib`, we provide
different theorems for natural exponents (`pow_arith_mean_le_arith_mean_pow`), integer exponents
(`zpow_arith_mean_le_arith_mean_zpow`), and real exponents (`rpow_arith_mean_le_arith_mean_rpow` and
`arith_mean_le_rpow_mean`). In the first two cases we prove
$$
\left(\sum_{i\in s} w_i z_i\right)^n ≤ \sum_{i\in s} w_i z_i^n
$$
in order to avoid using real exponents. For real exponents we prove both this and standard versions.

## TODO

- each inequality `A ≤ B` should come with a theorem `A = B ↔ _`; one of the ways to prove them
  is to define `strict_convex_on` functions.
- generalized mean inequality with any `p ≤ q`, including negative numbers;
- prove that the power mean tends to the geometric mean as the exponent tends to zero.

-/

universes u v

open finset
open_locale classical big_operators nnreal ennreal
noncomputable theory

variables {ι : Type u} (s : finset ι)

namespace real

theorem pow_arith_mean_le_arith_mean_pow (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) (n : ℕ) :
  (∑ i in s, w i * z i) ^ n ≤ ∑ i in s, (w i * z i ^ n) :=
(convex_on_pow n).map_sum_le hw hw' hz

theorem pow_arith_mean_le_arith_mean_pow_of_even (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) {n : ℕ} (hn : even n) :
  (∑ i in s, w i * z i) ^ n ≤ ∑ i in s, (w i * z i ^ n) :=
hn.convex_on_pow.map_sum_le hw hw' (λ _ _, trivial)

theorem zpow_arith_mean_le_arith_mean_zpow (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 < z i) (m : ℤ) :
  (∑ i in s, w i * z i) ^ m ≤ ∑ i in s, (w i * z i ^ m) :=
(convex_on_zpow m).map_sum_le hw hw' hz

theorem rpow_arith_mean_le_arith_mean_rpow (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) {p : ℝ} (hp : 1 ≤ p) :
  (∑ i in s, w i * z i) ^ p ≤ ∑ i in s, (w i * z i ^ p) :=
(convex_on_rpow hp).map_sum_le hw hw' hz

theorem arith_mean_le_rpow_mean (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) {p : ℝ} (hp : 1 ≤ p) :
  ∑ i in s, w i * z i ≤ (∑ i in s, (w i * z i ^ p)) ^ (1 / p) :=
begin
  have : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  rw [← rpow_le_rpow_iff _ _ this, ← rpow_mul, one_div_mul_cancel (ne_of_gt this), rpow_one],
  exact rpow_arith_mean_le_arith_mean_rpow s w z hw hw' hz hp,
  all_goals { apply_rules [sum_nonneg, rpow_nonneg_of_nonneg],
    intros i hi,
    apply_rules [mul_nonneg, rpow_nonneg_of_nonneg, hw i hi, hz i hi] },
end

end real

namespace nnreal

/-- Weighted generalized mean inequality, version sums over finite sets, with `ℝ≥0`-valued
functions and natural exponent. -/
theorem pow_arith_mean_le_arith_mean_pow (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) (n : ℕ) :
  (∑ i in s, w i * z i) ^ n ≤ ∑ i in s, (w i * z i ^ n) :=
by exact_mod_cast real.pow_arith_mean_le_arith_mean_pow s _ _ (λ i _, (w i).coe_nonneg)
  (by exact_mod_cast hw') (λ i _, (z i).coe_nonneg) n

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued
functions and real exponents. -/
theorem rpow_arith_mean_le_arith_mean_rpow (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) {p : ℝ}
  (hp : 1 ≤ p) :
  (∑ i in s, w i * z i) ^ p ≤ ∑ i in s, (w i * z i ^ p) :=
by exact_mod_cast real.rpow_arith_mean_le_arith_mean_rpow s _ _ (λ i _, (w i).coe_nonneg)
  (by exact_mod_cast hw') (λ i _, (z i).coe_nonneg) hp

/-- Weighted generalized mean inequality, version for two elements of `ℝ≥0` and real exponents. -/
theorem rpow_arith_mean_le_arith_mean2_rpow (w₁ w₂ z₁ z₂ : ℝ≥0) (hw' : w₁ + w₂ = 1) {p : ℝ}
  (hp : 1 ≤ p) :
  (w₁ * z₁ + w₂ * z₂) ^ p ≤ w₁ * z₁ ^ p + w₂ * z₂ ^ p :=
begin
  have h := rpow_arith_mean_le_arith_mean_rpow univ ![w₁, w₂] ![z₁, z₂] _ hp,
  { simpa [fin.sum_univ_succ] using h, },
  { simp [hw', fin.sum_univ_succ], },
end

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued
functions and real exponents. -/
theorem arith_mean_le_rpow_mean (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) {p : ℝ}
  (hp : 1 ≤ p) :
  ∑ i in s, w i * z i ≤ (∑ i in s, (w i * z i ^ p)) ^ (1 / p) :=
by exact_mod_cast real.arith_mean_le_rpow_mean s _ _ (λ i _, (w i).coe_nonneg)
  (by exact_mod_cast hw') (λ i _, (z i).coe_nonneg) hp

end nnreal

namespace ennreal

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0∞`-valued
functions and real exponents. -/
theorem rpow_arith_mean_le_arith_mean_rpow (w z : ι → ℝ≥0∞) (hw' : ∑ i in s, w i = 1) {p : ℝ}
  (hp : 1 ≤ p) :
  (∑ i in s, w i * z i) ^ p ≤ ∑ i in s, (w i * z i ^ p) :=
begin
  have hp_pos : 0 < p, from lt_of_lt_of_le zero_lt_one hp,
  have hp_nonneg : 0 ≤ p, from le_of_lt hp_pos,
  have hp_not_nonpos : ¬ p ≤ 0, by simp [hp_pos],
  have hp_not_neg : ¬ p < 0, by simp [hp_nonneg],
  have h_top_iff_rpow_top : ∀ (i : ι) (hi : i ∈ s), w i * z i = ⊤ ↔ w i * (z i) ^ p = ⊤,
  by simp [hp_pos, hp_nonneg, hp_not_nonpos, hp_not_neg],
  refine le_of_top_imp_top_of_to_nnreal_le _ _,
  { -- first, prove `(∑ i in s, w i * z i) ^ p = ⊤ → ∑ i in s, (w i * z i ^ p) = ⊤`
    rw [rpow_eq_top_iff, sum_eq_top_iff, sum_eq_top_iff],
    intro h,
    simp only [and_false, hp_not_neg, false_or] at h,
    rcases h.left with ⟨a, H, ha⟩,
    use [a, H],
    rwa ←h_top_iff_rpow_top a H, },
  { -- second, suppose both `(∑ i in s, w i * z i) ^ p ≠ ⊤` and `∑ i in s, (w i * z i ^ p) ≠ ⊤`,
    -- and prove `((∑ i in s, w i * z i) ^ p).to_nnreal ≤ (∑ i in s, (w i * z i ^ p)).to_nnreal`,
    -- by using `nnreal.rpow_arith_mean_le_arith_mean_rpow`.
    intros h_top_rpow_sum _,
    -- show hypotheses needed to put the `.to_nnreal` inside the sums.
    have h_top : ∀ (a : ι), a ∈ s → w a * z a ≠ ⊤,
    { have h_top_sum : ∑ (i : ι) in s, w i * z i ≠ ⊤,
      { intro h,
        rw [h, top_rpow_of_pos hp_pos] at h_top_rpow_sum,
        exact h_top_rpow_sum rfl, },
      exact λ a ha, (lt_top_of_sum_ne_top h_top_sum ha).ne },
    have h_top_rpow : ∀ (a : ι), a ∈ s → w a * z a ^ p ≠ ⊤,
    { intros i hi,
      specialize h_top i hi,
      rwa [ne.def, ←h_top_iff_rpow_top i hi], },
    -- put the `.to_nnreal` inside the sums.
    simp_rw [to_nnreal_sum h_top_rpow, ←to_nnreal_rpow, to_nnreal_sum h_top, to_nnreal_mul,
      ←to_nnreal_rpow],
    -- use corresponding nnreal result
    refine nnreal.rpow_arith_mean_le_arith_mean_rpow s (λ i, (w i).to_nnreal) (λ i, (z i).to_nnreal)
      _ hp,
    -- verify the hypothesis `∑ i in s, (w i).to_nnreal = 1`, using `∑ i in s, w i = 1` .
    have h_sum_nnreal : (∑ i in s, w i) = ↑(∑ i in s, (w i).to_nnreal),
    { rw coe_finset_sum,
      refine sum_congr rfl (λ i hi, (coe_to_nnreal _).symm),
      refine (lt_top_of_sum_ne_top _ hi).ne,
      exact hw'.symm ▸ ennreal.one_ne_top },
    rwa [←coe_eq_coe, ←h_sum_nnreal], },
end

/-- Weighted generalized mean inequality, version for two elements of `ℝ≥0∞` and real
exponents. -/
theorem rpow_arith_mean_le_arith_mean2_rpow (w₁ w₂ z₁ z₂ : ℝ≥0∞) (hw' : w₁ + w₂ = 1) {p : ℝ}
  (hp : 1 ≤ p) :
  (w₁ * z₁ + w₂ * z₂) ^ p ≤ w₁ * z₁ ^ p + w₂ * z₂ ^ p :=
begin
  have h := rpow_arith_mean_le_arith_mean_rpow univ ![w₁, w₂] ![z₁, z₂] _ hp,
  { simpa [fin.sum_univ_succ] using h, },
  { simp [hw', fin.sum_univ_succ], },
end

end ennreal

namespace ennreal

variables (f g : ι → ℝ≥0∞)  {p q : ℝ}

private lemma add_rpow_le_one_of_add_le_one {p : ℝ} (a b : ℝ≥0∞) (hab : a + b ≤ 1)
  (hp1 : 1 ≤ p) :
  a ^ p + b ^ p ≤ 1 :=
begin
  have h_le_one : ∀ x : ℝ≥0∞, x ≤ 1 → x ^ p ≤ x, from λ x hx, rpow_le_self_of_le_one hx hp1,
  have ha : a ≤ 1, from (self_le_add_right a b).trans hab,
  have hb : b ≤ 1, from (self_le_add_left b a).trans hab,
  exact (add_le_add (h_le_one a ha) (h_le_one b hb)).trans hab,
end

lemma add_rpow_le_rpow_add {p : ℝ} (a b : ℝ≥0∞) (hp1 : 1 ≤ p) :
  a ^ p + b ^ p ≤ (a + b) ^ p :=
begin
  have hp_pos : 0 < p := lt_of_lt_of_le zero_lt_one hp1,
  by_cases h_top : a + b = ⊤,
  { rw ←@ennreal.rpow_eq_top_iff_of_pos (a + b) p hp_pos at h_top,
    rw h_top,
    exact le_top, },
  obtain ⟨ha_top, hb_top⟩ := add_ne_top.mp h_top,
  by_cases h_zero : a + b = 0,
  { simp [add_eq_zero_iff.mp h_zero, ennreal.zero_rpow_of_pos hp_pos], },
  have h_nonzero : ¬(a = 0 ∧ b = 0), by rwa add_eq_zero_iff at h_zero,
  have h_add : a/(a+b) + b/(a+b) = 1, by rw [div_add_div_same, div_self h_zero h_top],
  have h := add_rpow_le_one_of_add_le_one (a/(a+b)) (b/(a+b)) h_add.le hp1,
  rw [div_rpow_of_nonneg a (a+b) hp_pos.le, div_rpow_of_nonneg b (a+b) hp_pos.le] at h,
  have hab_0 : (a + b)^p ≠ 0, by simp [ha_top, hb_top, hp_pos, h_nonzero],
  have hab_top : (a + b)^p ≠ ⊤, by simp [ha_top, hb_top, hp_pos, h_nonzero],
  have h_mul : (a + b)^p * (a ^ p / (a + b) ^ p + b ^ p / (a + b) ^ p) ≤ (a + b)^p,
  { nth_rewrite 3 ←mul_one ((a + b)^p),
    exact (mul_le_mul_left hab_0 hab_top).mpr h, },
  rwa [div_eq_mul_inv, div_eq_mul_inv, mul_add, mul_comm (a^p), mul_comm (b^p), ←mul_assoc,
    ←mul_assoc, mul_inv_cancel hab_0 hab_top, one_mul, one_mul] at h_mul,
end

lemma rpow_add_rpow_le_add {p : ℝ} (a b : ℝ≥0∞) (hp1 : 1 ≤ p) :
  (a ^ p + b ^ p) ^ (1/p) ≤ a + b :=
begin
  rw ←@ennreal.le_rpow_one_div_iff _ _ (1/p) (by simp [lt_of_lt_of_le zero_lt_one hp1]),
  rw one_div_one_div,
  exact add_rpow_le_rpow_add _ _ hp1,
end

theorem rpow_add_rpow_le {p q : ℝ} (a b : ℝ≥0∞) (hp_pos : 0 < p) (hpq : p ≤ q) :
  (a ^ q + b ^ q) ^ (1/q) ≤ (a ^ p + b ^ p) ^ (1/p) :=
begin
  have h_rpow : ∀ a : ℝ≥0∞, a^q = (a^p)^(q/p),
    from λ a, by rw [←ennreal.rpow_mul, div_eq_inv_mul, ←mul_assoc,
      _root_.mul_inv_cancel hp_pos.ne.symm, one_mul],
  have h_rpow_add_rpow_le_add : ((a^p)^(q/p) + (b^p)^(q/p)) ^ (1/(q/p)) ≤ a^p + b^p,
  { refine rpow_add_rpow_le_add (a^p) (b^p) _,
    rwa one_le_div hp_pos, },
  rw [h_rpow a, h_rpow b, ennreal.le_rpow_one_div_iff hp_pos, ←ennreal.rpow_mul, mul_comm,
    mul_one_div],
  rwa one_div_div at h_rpow_add_rpow_le_add,
end

lemma rpow_add_le_add_rpow {p : ℝ} (a b : ℝ≥0∞) (hp_pos : 0 < p) (hp1 : p ≤ 1) :
  (a + b) ^ p ≤ a ^ p + b ^ p :=
begin
  have h := rpow_add_rpow_le a b hp_pos hp1,
  rw one_div_one at h,
  repeat { rw ennreal.rpow_one at h },
  exact (ennreal.le_rpow_one_div_iff hp_pos).mp h,
end

end ennreal


/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn

! This file was ported from Lean 3 source module category_theory.action
! leanprover-community/mathlib commit aa812bd12a4dbbd2c129b38205f222df282df26d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Elements
import Mathbin.CategoryTheory.IsConnected
import Mathbin.CategoryTheory.SingleObj
import Mathbin.GroupTheory.GroupAction.Quotient
import Mathbin.GroupTheory.SemidirectProduct

/-!
# Actions as functors and as categories

From a multiplicative action M ↻ X, we can construct a functor from M to the category of
types, mapping the single object of M to X and an element `m : M` to map `X → X` given by
multiplication by `m`.
  This functor induces a category structure on X -- a special case of the category of elements.
A morphism `x ⟶ y` in this category is simply a scalar `m : M` such that `m • x = y`. In the case
where M is a group, this category is a groupoid -- the `action groupoid'.
-/

open MulAction SemidirectProduct

namespace CategoryTheory

universe u

variable (M : Type _) [Monoid M] (X : Type u) [MulAction M X]

/-- A multiplicative action M ↻ X viewed as a functor mapping the single object of M to X
  and an element `m : M` to the map `X → X` given by multiplication by `m`. -/
@[simps]
def actionAsFunctor : SingleObj M ⥤ Type u
    where
  obj _ := X
  map _ _ := (· • ·)
  map_id' _ := funext <| MulAction.one_smul
  map_comp' _ _ _ f g := funext fun x => (smul_smul g f x).symm
#align category_theory.action_as_functor CategoryTheory.actionAsFunctor

/-- A multiplicative action M ↻ X induces a category strucure on X, where a morphism
 from x to y is a scalar taking x to y. Due to implementation details, the object type
 of this category is not equal to X, but is in bijection with X. -/
def ActionCategory :=
  (actionAsFunctor M X).Elements deriving Category
#align category_theory.action_category CategoryTheory.ActionCategory

namespace ActionCategory

/-- The projection from the action category to the monoid, mapping a morphism to its
  label. -/
def π : ActionCategory M X ⥤ SingleObj M :=
  CategoryOfElements.π _
#align category_theory.action_category.π CategoryTheory.ActionCategory.π

@[simp]
theorem π_map (p q : ActionCategory M X) (f : p ⟶ q) : (π M X).map f = f.val :=
  rfl
#align category_theory.action_category.π_map CategoryTheory.ActionCategory.π_map

@[simp]
theorem π_obj (p : ActionCategory M X) : (π M X).obj p = SingleObj.star M :=
  Unit.ext
#align category_theory.action_category.π_obj CategoryTheory.ActionCategory.π_obj

variable {M X}

/-- The canonical map `action_category M X → X`. It is given by `λ x, x.snd`, but
  has a more explicit type. -/
protected def back : ActionCategory M X → X := fun x => x.snd
#align category_theory.action_category.back CategoryTheory.ActionCategory.back

instance : CoeTC X (ActionCategory M X) :=
  ⟨fun x => ⟨(), x⟩⟩

@[simp]
theorem coe_back (x : X) : (↑x : ActionCategory M X).back = x :=
  rfl
#align category_theory.action_category.coe_back CategoryTheory.ActionCategory.coe_back

@[simp]
theorem back_coe (x : ActionCategory M X) : ↑x.back = x := by ext <;> rfl
#align category_theory.action_category.back_coe CategoryTheory.ActionCategory.back_coe

variable (M X)

/-- An object of the action category given by M ↻ X corresponds to an element of X. -/
def objEquiv : X ≃ ActionCategory M X where
  toFun := coe
  invFun x := x.back
  left_inv := coe_back
  right_inv := back_coe
#align category_theory.action_category.obj_equiv CategoryTheory.ActionCategory.objEquiv

theorem hom_as_subtype (p q : ActionCategory M X) : (p ⟶ q) = { m : M // m • p.back = q.back } :=
  rfl
#align category_theory.action_category.hom_as_subtype CategoryTheory.ActionCategory.hom_as_subtype

instance [Inhabited X] : Inhabited (ActionCategory M X) :=
  ⟨show X from default⟩

instance [Nonempty X] : Nonempty (ActionCategory M X) :=
  Nonempty.map (objEquiv M X) inferInstance

variable {X} (x : X)

/-- The stabilizer of a point is isomorphic to the endomorphism monoid at the
  corresponding point. In fact they are definitionally equivalent. -/
def stabilizerIsoEnd : Stabilizer.submonoid M x ≃* End (↑x : ActionCategory M X) :=
  MulEquiv.refl _
#align category_theory.action_category.stabilizer_iso_End CategoryTheory.ActionCategory.stabilizerIsoEnd

@[simp]
theorem stabilizerIsoEnd_apply (f : Stabilizer.submonoid M x) :
    (stabilizerIsoEnd M x).toFun f = f :=
  rfl
#align category_theory.action_category.stabilizer_iso_End_apply CategoryTheory.ActionCategory.stabilizerIsoEnd_apply

@[simp]
theorem stabilizerIsoEnd_symm_apply (f : End _) : (stabilizerIsoEnd M x).invFun f = f :=
  rfl
#align category_theory.action_category.stabilizer_iso_End_symm_apply CategoryTheory.ActionCategory.stabilizerIsoEnd_symm_apply

variable {M X}

@[simp]
protected theorem id_val (x : ActionCategory M X) : Subtype.val (𝟙 x) = 1 :=
  rfl
#align category_theory.action_category.id_val CategoryTheory.ActionCategory.id_val

@[simp]
protected theorem comp_val {x y z : ActionCategory M X} (f : x ⟶ y) (g : y ⟶ z) :
    (f ≫ g).val = g.val * f.val :=
  rfl
#align category_theory.action_category.comp_val CategoryTheory.ActionCategory.comp_val

instance [IsPretransitive M X] [Nonempty X] : IsConnected (ActionCategory M X) :=
  zigzag_isConnected fun x y =>
    Relation.ReflTransGen.single <|
      Or.inl <| nonempty_subtype.mpr (show _ from exists_smul_eq M x.back y.back)

section Group

variable {G : Type _} [Group G] [MulAction G X]

noncomputable instance : Groupoid (ActionCategory G X) :=
  CategoryTheory.groupoidOfElements _

/-- Any subgroup of `G` is a vertex group in its action groupoid. -/
def endMulEquivSubgroup (H : Subgroup G) : End (objEquiv G (G ⧸ H) ↑(1 : G)) ≃* H :=
  MulEquiv.trans (stabilizerIsoEnd G ((1 : G) : G ⧸ H)).symm
    (MulEquiv.subgroupCongr <| stabilizer_quotient H)
#align category_theory.action_category.End_mul_equiv_subgroup CategoryTheory.ActionCategory.endMulEquivSubgroup

/-- A target vertex `t` and a scalar `g` determine a morphism in the action groupoid. -/
def homOfPair (t : X) (g : G) : ↑(g⁻¹ • t) ⟶ (t : ActionCategory G X) :=
  Subtype.mk g (smul_inv_smul g t)
#align category_theory.action_category.hom_of_pair CategoryTheory.ActionCategory.homOfPair

@[simp]
theorem homOfPair.val (t : X) (g : G) : (homOfPair t g).val = g :=
  rfl
#align category_theory.action_category.hom_of_pair.val CategoryTheory.ActionCategory.homOfPair.val

/-- Any morphism in the action groupoid is given by some pair. -/
protected def cases {P : ∀ ⦃a b : ActionCategory G X⦄, (a ⟶ b) → Sort _}
    (hyp : ∀ t g, P (homOfPair t g)) ⦃a b⦄ (f : a ⟶ b) : P f :=
  by
  refine' cast _ (hyp b.back f.val)
  rcases a with ⟨⟨⟩, a : X⟩
  rcases b with ⟨⟨⟩, b : X⟩
  rcases f with ⟨g : G, h : g • a = b⟩
  cases inv_smul_eq_iff.mpr h.symm
  rfl
#align category_theory.action_category.cases CategoryTheory.ActionCategory.cases

variable {H : Type _} [Group H]

/-- Given `G` acting on `X`, a functor from the corresponding action groupoid to a group `H`
    can be curried to a group homomorphism `G →* (X → H) ⋊ G`. -/
@[simps]
def curry (F : ActionCategory G X ⥤ SingleObj H) : G →* (X → H) ⋊[mulAutArrow] G :=
  have F_map_eq : ∀ {a b} {f : a ⟶ b}, F.map f = (F.map (homOfPair b.back f.val) : H) :=
    ActionCategory.cases fun _ _ => rfl
  { toFun := fun g => ⟨fun b => F.map (homOfPair b g), g⟩
    map_one' := by
      congr
      funext
      exact F_map_eq.symm.trans (F.map_id b)
    map_mul' := by
      intro g h
      congr ; funext
      exact F_map_eq.symm.trans (F.map_comp (hom_of_pair (g⁻¹ • b) h) (hom_of_pair b g)) }
#align category_theory.action_category.curry CategoryTheory.ActionCategory.curry

/-- Given `G` acting on `X`, a group homomorphism `φ : G →* (X → H) ⋊ G` can be uncurried to
    a functor from the action groupoid to `H`, provided that `φ g = (_, g)` for all `g`. -/
@[simps]
def uncurry (F : G →* (X → H) ⋊[mulAutArrow] G) (sane : ∀ g, (F g).right = g) :
    ActionCategory G X ⥤ SingleObj H where
  obj _ := ()
  map a b f := (F f.val).left b.back
  map_id' := by
    intro x
    rw [action_category.id_val, F.map_one]
    rfl
  map_comp' := by
    intro x y z f g; revert y z g
    refine' action_category.cases _
    simp [single_obj.comp_as_mul, sane]
#align category_theory.action_category.uncurry CategoryTheory.ActionCategory.uncurry

end Group

end ActionCategory

end CategoryTheory


/-
Copyright (c) 2022 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Julian Kuelshammer
-/

import data.real.basic

/-! Defining the plane ℝ²

This file defines the plane and equips it with the usual addition and scalar multiplication.

Some tactics that would be useful in the remainder:

cases : splits a structure into its component, e.g. if v is a pair of real numbers, cases v will split it
        into its first component v_x and its second component v_y.
simp : The simplifyer. Can be very good in simplifying things it is trained on. The challenge is to train it
       correctly. (Part of tidy.)
ext : The standard tactic to prove more complicated things are equal by splitting it into components. For
      example, it is already trained to prove that two functions f and g are equal if and only if they agree
      whenever applied to elements, i.e. f x = g x for all x, or that two subsets U and V of a set X are equal
      if and only if they have the same elements. (Part of tidy.)
ring : Let's you solve standard equations in rings.
-/

structure plane : Type :=
(x : ℝ) (y : ℝ)

namespace plane

/- We want to use the standard notation ℝ² for the real plane. -/
notation `ℝ²` := plane

/- Now let's define the addition on ℝ² like we are used to. This is done so we can write v + w for vectors v
  and w in ℝ² without having to specify how they are actually defined. -/
instance has_add_plane : has_add ℝ² := sorry

lemma add_assoc (u v w : ℝ²) : u + v + w = u + (v + w) :=
begin
  sorry
end

lemma add_comm (v w : ℝ²) : v + w = w + v :=
begin
  sorry
end

/- We want to give at least one example of a vector in ℝ², the zero vector. -/
def zero_vector : ℝ² := sorry

/- In mathematics, it is common to write 0_V for the zero vector of a vector space V, sometimes one even
  omits the subscript V. We want to be able to use the same abuse of notation in Lean. (With the difference
  that it should always be clear to Lean what specific 0 we are talking about.)-/
instance : has_zero ℝ² := sorry

@[simp] lemma add_zero (v : ℝ²) : v + 0 = v :=
begin
  sorry
end

@[simp] lemma zero_add (v : ℝ²) : 0 + v = v :=
begin
  sorry
end

/- Let's define the negation of a vector. -/
instance : has_neg ℝ² := sorry

@[simp] lemma add_neg_self (v : ℝ²) : v + -v = 0 :=
begin
  sorry
end

@[simp] lemma neg_add_self (v : ℝ²) : -v + v = 0 :=
begin
  sorry
end

/- We also want to define subtraction and scalar multiplication. -/
instance : has_sub ℝ² := sorry

instance : has_scalar ℝ ℝ² := sorry

lemma smul_assoc (a b : ℝ) (v : ℝ²) : (a * b) • v = a • (b • v) :=
begin
  sorry
end

@[simp] lemma one_smul (v : ℝ²) : (1 : ℝ) • v = v :=
begin
  sorry
end

@[simp] lemma smul_add (a : ℝ) (v w : ℝ²) : a • (v + w) = a • v + a • w :=
begin
  sorry
end

@[simp] lemma add_smul (a b : ℝ) (v : ℝ²) : (a + b) • v = a • v + b • v :=
begin
  sorry
end

end plane


inductive bin : ℕ → Prop
| bin_epsilon : bin 0
| bin_0 : ∀ n, bin n → bin (2 * n)
| bin_1 : ∀ n, bin n → bin (2 * n + 1)

definition is_expressible_in_binrary_notation := bin

example : ∀ n, is_expressible_in_binrary_notation n := begin
    intro,
    induction n,
    apply bin.bin_epsilon,
    induction n_ih,
    exact (bin.bin_1 0 bin.bin_epsilon),
    have pohe : (nat.succ (2 * n_ih_n)) = (2 * n_ih_n + 1), begin
        rw ← nat.add_one
    end,
    rw pohe,
    exact bin.bin_1 n_ih_n n_ih_a,
    have fuga: (nat.succ (2 * n_ih_n + 1)) = 2 * (nat.succ n_ih_n), begin
        calc
        (nat.succ (2 * n_ih_n + 1)) = 2 * n_ih_n + 1 + 1 : by rw nat.add_one
        ... = 2 * n_ih_n + (1 + 1) : by rw nat.add_assoc
        ... = 2 * n_ih_n + 2 : by simp
        ... = 2 * n_ih_n + 2 * 1 : by simp
        ... = 2 * (n_ih_n + 1) : by rw nat.left_distrib
        ... = 2 * (nat.succ n_ih_n) : by rw nat.add_one
    end,
    rw fuga,
    exact bin.bin_0 (nat.succ n_ih_n) n_ih_ih
end