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

import data.fin.vec_notation
import group_theory.abelianization
import set_theory.cardinal

/-!
# Solvable Groups

In this file we introduce the notion of a solvable group. We define a solvable group as one whose
derived series is eventually trivial. This requires defining the commutator of two subgroups and
the derived series of a group.

## Main definitions

* `derived_series G n` : the `n`th term in the derived series of `G`, defined by iterating
    `general_commutator` starting with the top subgroup
* `is_solvable G` : the group `G` is solvable
-/

open subgroup

variables {G G' : Type*} [group G] [group G'] {f : G →* G'}

section derived_series

variables (G)

/-- The derived series of the group `G`, obtained by starting from the subgroup `⊤` and repeatedly
  taking the commutator of the previous subgroup with itself for `n` times. -/
def derived_series : ℕ → subgroup G
| 0       := ⊤
| (n + 1) := ⁅(derived_series n), (derived_series n)⁆

@[simp] lemma derived_series_zero : derived_series G 0 = ⊤ := rfl

@[simp] lemma derived_series_succ (n : ℕ) :
  derived_series G (n + 1) = ⁅(derived_series G n), (derived_series G n)⁆ := rfl

lemma derived_series_normal (n : ℕ) : (derived_series G n).normal :=
begin
  induction n with n ih,
  { exact (⊤ : subgroup G).normal_of_characteristic },
  { exactI subgroup.commutator_normal (derived_series G n) (derived_series G n) }
end

@[simp] lemma derived_series_one : derived_series G 1 = commutator G :=
rfl

end derived_series

section commutator_map

section derived_series_map

variables (f)

lemma map_derived_series_le_derived_series (n : ℕ) :
  (derived_series G n).map f ≤ derived_series G' n :=
begin
  induction n with n ih,
  { simp only [derived_series_zero, le_top], },
  { simp only [derived_series_succ, map_commutator, commutator_mono, ih] }
end

variables {f}

lemma derived_series_le_map_derived_series (hf : function.surjective f) (n : ℕ) :
  derived_series G' n ≤ (derived_series G n).map f :=
begin
  induction n with n ih,
  { rwa [derived_series_zero, derived_series_zero, top_le_iff, ← monoid_hom.range_eq_map,
    ← monoid_hom.range_top_iff_surjective.mpr], },
  { simp only [*, derived_series_succ, commutator_le_map_commutator], }
end

lemma map_derived_series_eq (hf : function.surjective f) (n : ℕ) :
  (derived_series G n).map f = derived_series G' n :=
le_antisymm (map_derived_series_le_derived_series f n) (derived_series_le_map_derived_series hf n)

end derived_series_map
end commutator_map

section solvable

variables (G)

/-- A group `G` is solvable if its derived series is eventually trivial. We use this definition
  because it's the most convenient one to work with. -/
class is_solvable : Prop :=
(solvable : ∃ n : ℕ, derived_series G n = ⊥)

lemma is_solvable_def : is_solvable G ↔ ∃ n : ℕ, derived_series G n = ⊥ :=
⟨λ h, h.solvable, λ h, ⟨h⟩⟩

@[priority 100]
instance comm_group.is_solvable {G : Type*} [comm_group G] : is_solvable G :=
begin
  use 1,
  rw [eq_bot_iff, derived_series_one],
  calc commutator G ≤ (monoid_hom.id G).ker : abelianization.commutator_subset_ker (monoid_hom.id G)
  ... = ⊥ : rfl,
end

lemma is_solvable_of_comm {G : Type*} [hG : group G]
  (h : ∀ a b : G, a * b = b * a) : is_solvable G :=
begin
  letI hG' : comm_group G := { mul_comm := h .. hG },
  casesI hG,
  exact comm_group.is_solvable,
end

lemma is_solvable_of_top_eq_bot (h : (⊤ : subgroup G) = ⊥) : is_solvable G :=
⟨⟨0, h⟩⟩

@[priority 100]
instance is_solvable_of_subsingleton [subsingleton G] : is_solvable G :=
is_solvable_of_top_eq_bot G (by ext; simp at *)

variables {G}

lemma solvable_of_solvable_injective (hf : function.injective f) [h : is_solvable G'] :
  is_solvable G :=
begin
  rw is_solvable_def at *,
  cases h with n hn,
  use n,
  rw ← map_eq_bot_iff_of_injective _ hf,
  rw eq_bot_iff at *,
  calc map f (derived_series G n) ≤ derived_series G' n : map_derived_series_le_derived_series f n
  ... ≤ ⊥ : hn,
end

instance subgroup_solvable_of_solvable (H : subgroup G) [h : is_solvable G] : is_solvable H :=
solvable_of_solvable_injective (show function.injective (subtype H), from subtype.val_injective)

lemma solvable_of_surjective (hf : function.surjective f) [h : is_solvable G] :
  is_solvable G' :=
begin
  rw is_solvable_def at *,
  cases h with n hn,
  use n,
  calc derived_series G' n = (derived_series G n).map f : eq.symm (map_derived_series_eq hf n)
    ... = (⊥ : subgroup G).map f : by rw hn
    ... = ⊥ : map_bot f,
end

instance solvable_quotient_of_solvable (H : subgroup G) [H.normal] [h : is_solvable G] :
  is_solvable (G ⧸ H) :=
solvable_of_surjective (show function.surjective (quotient_group.mk' H), by tidy)

lemma solvable_of_ker_le_range {G' G'' : Type*} [group G'] [group G''] (f : G' →* G)
  (g : G →* G'') (hfg : g.ker ≤ f.range) [hG' : is_solvable G'] [hG'' : is_solvable G''] :
  is_solvable G :=
begin
  obtain ⟨n, hn⟩ := id hG'',
  suffices : ∀ k : ℕ, derived_series G (n + k) ≤ (derived_series G' k).map f,
  { obtain ⟨m, hm⟩ := id hG',
    use n + m,
    specialize this m,
    rwa [hm, map_bot, le_bot_iff] at this },
  intro k,
  induction k with k hk,
  { rw [add_zero, derived_series_zero, ←monoid_hom.range_eq_map],
    refine le_trans _ hfg,
    rw [←map_eq_bot_iff, eq_bot_iff, ←hn],
    exact map_derived_series_le_derived_series g n },
  { rw [nat.add_succ, derived_series_succ, derived_series_succ],
    exact commutator_le_map_commutator hk hk },
end

instance solvable_prod {G' : Type*} [group G'] [h : is_solvable G] [h' : is_solvable G'] :
  is_solvable (G × G') :=
solvable_of_ker_le_range (monoid_hom.inl G G') (monoid_hom.snd G G')
  (λ x hx, ⟨x.1, prod.ext rfl hx.symm⟩)

end solvable

section is_simple_group

variable [is_simple_group G]

lemma is_simple_group.derived_series_succ {n : ℕ} : derived_series G n.succ = commutator G :=
begin
  induction n with n ih,
  { exact derived_series_one G },
  rw [derived_series_succ, ih],
  cases (commutator.normal G).eq_bot_or_eq_top with h h,
  { rw [h, commutator_bot_left] },
  { rwa h },
end

lemma is_simple_group.comm_iff_is_solvable :
  (∀ a b : G, a * b = b * a) ↔ is_solvable G :=
⟨is_solvable_of_comm, λ ⟨⟨n, hn⟩⟩, begin
  cases n,
  { rw derived_series_zero at hn,
    intros a b,
    refine (mem_bot.1 _).trans (mem_bot.1 _).symm;
    { rw ← hn,
      exact mem_top _ } },
  { rw is_simple_group.derived_series_succ at hn,
    intros a b,
    rw [← mul_inv_eq_one, mul_inv_rev, ← mul_assoc, ← mem_bot, ← hn, commutator_eq_closure],
    exact subset_closure ⟨a, b, rfl⟩ }
end⟩

end is_simple_group

section perm_not_solvable

lemma not_solvable_of_mem_derived_series {g : G} (h1 : g ≠ 1)
  (h2 : ∀ n : ℕ, g ∈ derived_series G n) : ¬ is_solvable G :=
mt (is_solvable_def _).mp (not_exists_of_forall_not
  (λ n h, h1 (subgroup.mem_bot.mp ((congr_arg (has_mem.mem g) h).mp (h2 n)))))

lemma equiv.perm.fin_5_not_solvable : ¬ is_solvable (equiv.perm (fin 5)) :=
begin
  let x : equiv.perm (fin 5) := ⟨![1, 2, 0, 3, 4], ![2, 0, 1, 3, 4], dec_trivial, dec_trivial⟩,
  let y : equiv.perm (fin 5) := ⟨![3, 4, 2, 0, 1], ![3, 4, 2, 0, 1], dec_trivial, dec_trivial⟩,
  let z : equiv.perm (fin 5) := ⟨![0, 3, 2, 1, 4], ![0, 3, 2, 1, 4], dec_trivial, dec_trivial⟩,
  have key : x = z * ⁅x, y * x * y⁻¹⁆ * z⁻¹ := by dec_trivial,
  refine not_solvable_of_mem_derived_series (show x ≠ 1, by dec_trivial) (λ n, _),
  induction n with n ih,
  { exact mem_top x },
  { rw [key, (derived_series_normal _ _).mem_comm_iff, inv_mul_cancel_left],
    exact commutator_mem_commutator ih ((derived_series_normal _ _).conj_mem _ ih _) },
end

lemma equiv.perm.not_solvable (X : Type*) (hX : 5 ≤ cardinal.mk X) :
  ¬ is_solvable (equiv.perm X) :=
begin
  introI h,
  have key : nonempty (fin 5 ↪ X),
  { rwa [←cardinal.lift_mk_le, cardinal.mk_fin, cardinal.lift_nat_cast,
    nat.cast_bit1, nat.cast_bit0, nat.cast_one, cardinal.lift_id] },
  exact equiv.perm.fin_5_not_solvable (solvable_of_solvable_injective
    (equiv.perm.via_embedding_hom_injective (nonempty.some key))),
end

end perm_not_solvable


variable (men : Type) (barber : men)

variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  let s : Prop := shaves barber barber
  have h' : s ↔ ¬ s := h barber
  show False from
    have h'' : ¬s :=
      λ hs : s => (h'.mp hs) hs
    h'' (h'.mpr h'')


import subgroup_world.subgroup_mul -- hide

variables {G : Type} [group G] -- hide

/-
## The normalizer subgroup

In this level you need to prove that the normalizer of any subset $A \subseteq G$ is a subgroup of $G$.

Below you can see the definition of the normalizer, as a certain subset of $G$. You can use `normalizer_mem`
to `rw`rite the definition, if needed.
-/
@[reducible] -- hide
def normalizer  (A : set G) := {g : G | ∀ a, a ∈ A ↔ g*a*g⁻¹ ∈ A }

/- Axiom: normalizer (A : set G)
{g : G | ∀ a, a ∈ A ↔ g*a*g⁻¹ ∈ A }
-/

lemma normalizer_mem (A : set G) (g : G) : g ∈ normalizer A ↔ ∀ a, a ∈ A ↔ g*a*g⁻¹ ∈ A
:= iff.rfl -- hide

/- Axiom: normalizer_mem (A : set G)
g ∈ normalizer A ↔ ∀ a, a ∈ A ↔ g*a*g⁻¹ ∈ A
-/

/- Lemma: no-side-bar
The normalizer $N_G(A)$ is a subgroup of $G$.
-/
lemma sn1 {A : set G} : subgroup (normalizer A) :=
begin
  split,
  {
    use 1,
    rw normalizer_mem,
    intro a,
    rw (show 1 * a * 1⁻¹ = a, by group),
  },
  {
    intros x y hx hy,
    rw normalizer_mem at hx hy ⊢,
    intros c,
    split,
    {
      intros hc,
      rw show x * y⁻¹ * c * (x * y⁻¹)⁻¹ = x * (y⁻¹ * c * y) * x⁻¹, by group,
      specialize hy (y⁻¹ * c * y),
      rw (show y * (y⁻¹ * c * y) * y⁻¹ = c, by group) at hy,
      exact (hx (y⁻¹ * c * y)).1 (hy.2 hc),
    },
    {
      intro hc,
      rw (show x * y⁻¹ * c * (x * y⁻¹)⁻¹ = x * (y⁻¹ * c * y)* x⁻¹, by group) at hc,
      have : y⁻¹ * c * y ∈ A,
      {
        specialize hx (y⁻¹ * c * y),
        rw hx,
        assumption,
      },
      specialize hy (y⁻¹* c * y),
      rw (show c = y * (y⁻¹ * c * y) * y⁻¹, by group),
      rw ←hy,
      assumption,
    }
  }

end


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

This file defines a typeclass for types α with an ordered
enumeration of the elements (as opposed to a `fintype`
instance, which is an unordered enumeration).  This is
intended to allow for explicit calculation in a wider range
of cases.
-/

-- TODO:
-- instances for (co) products etc

import data.finset data.fintype.basic data.list.basic logic.encodable.basic
import data.fin_extra

universes u v

variables {α : Type*} {β : Type*} {γ : Type*}

class enumeration (α : Type*) :=
(elems : list α)
(nodup : list.nodup elems)
(complete : ∀ x : α, x ∈ elems)

instance enumeration_fintype [e : enumeration α] : fintype α :=
  ⟨⟨e.elems,e.nodup⟩,e.complete⟩

namespace enumeration

variable (α)
variable [enumeration α]

def univ_list : list α := (@enumeration.elems α _)
def univ_nodup : list.nodup (univ_list α) := (@enumeration.nodup α _)
def univ_complete := (@enumeration.complete α _)

lemma enum_card : fintype.card α = (@enumeration.elems α _).length :=
begin
  dsimp[fintype.card,finset.univ,fintype.elems,finset.card],refl,
end

#check function.left_inverse.injective
def of_equiv (f : α ≃ β) : enumeration β :=
{ elems := (univ_list α).map f.to_fun,
  nodup := list.nodup.map
    (function.left_inverse.injective f.left_inv) (univ_nodup α),
  complete :=
  begin
    intro b,
    rw[← f.right_inv b],
    exact list.mem_map_of_mem f.to_fun (univ_complete α (f.inv_fun b)),
   end }

variable [decidable_eq α]

def fin_equiv {n : ℕ} (h : (univ_list α).length = n) : α ≃ (fin n) :=
begin
  let els := univ_list α,
  let inv_fun : (fin n) → α :=
    λ i, els.nth_le i.val (@eq.subst ℕ (nat.lt i.val) _ _ h.symm i.is_lt),
  let to_fun_aux : ∀ (a : α), {i : fin n // inv_fun i = a} :=
  begin
    intro a,
    let i_val := els.index_of a,
    let i_lt_l := list.index_of_lt_length.mpr (enumeration.complete a),
    let i_lt_n : i_val < n := @eq.subst ℕ (nat.lt i_val) _ _ h i_lt_l,
    let i : fin n := ⟨i_val,i_lt_n⟩,
    have : inv_fun i = a :=
      by { cases h,exact list.index_of_nth_le i_lt_l },
    exact ⟨i,this⟩
  end,
  let to_fun : α → (fin n) := λ a, (to_fun_aux a).val,
  let left_inv : ∀ a : α, inv_fun (to_fun a) = a :=
    λ a, (to_fun_aux a).property,
  let right_inv : ∀ i : (fin n), to_fun (inv_fun i) = i :=
  begin
   intro i,cases i with i_val i_is_lt,
   apply fin.eq_of_veq,
   let i_lt_l : i_val < els.length :=
    @eq.subst ℕ (nat.lt i_val) _ _ h.symm i_is_lt,
   exact list.nth_le_index_of (univ_nodup α) i_val i_lt_l,
  end,
  exact ⟨to_fun,inv_fun,left_inv,right_inv⟩
end

instance : encodable α :=
begin
 let els := univ_list α,
 let f := fin_equiv α rfl,
 let encode : α → ℕ := λ a,(f.to_fun a).val,
 let decode : ℕ → option α :=
 begin
  intro i,
  by_cases h : i < els.length,
  {exact some (f.inv_fun ⟨i,h⟩),},
  {exact none,}
 end,
 let encodek : ∀ a, decode (encode a) = some a :=
 begin
  intro a,
  dsimp[decode,encode],
  have : ((f a) : ℕ) < els.length := (f.to_fun a).is_lt,
  rw[dif_pos this], simp only [equiv.symm_apply_apply, fin.eta],
 end,
 exact ⟨encode,decode,encodek⟩
end

def subtype_enumeration {p : α → Prop} (l : list α)
 (l_nodup : list.nodup l)
 (l_mem : ∀ x : α, x ∈ l ↔ p x) : enumeration {x // p x} :=
begin
 let α1 := {x // p x},
 let elems1 : list α1 := @list.pmap α α1 p subtype.mk l (λ x, (l_mem x).mp),
 let nodup : elems1.nodup :=
  @list.nodup.pmap α α1 p subtype.mk l (λ x, (l_mem x).mp)
   (λ a _ b _,congr_arg subtype.val) l_nodup,
 let complete : ∀ a1 : α1, a1 ∈ elems1 :=
 begin
  intro a1, cases a1,
  let h0 := ((@list.mem_pmap α α1 p subtype.mk l
               (λ x, (l_mem x).mp)) ⟨a1_val,a1_property⟩).mpr,
  have h1 : a1_val ∈ l := (l_mem a1_val).mpr a1_property,
  exact h0 ⟨a1_val,h1,rfl⟩,
 end,
 exact ⟨elems1,nodup,complete⟩
end

instance (p : α → Prop) [decidable_pred p] : enumeration {a // p a} :=
begin
 let l := (univ_list α).filter p,
 let l_nodup : l.nodup := list.nodup.filter p (univ_nodup α),
 let l_mem : ∀ x : α, x ∈ l ↔ p x :=
 begin
  intro x,
  let h0 : x ∈ univ_list α := (univ_complete α) x,
  simp[list.mem_filter,h0],
 end,
 exact subtype_enumeration α l l_nodup l_mem,
end

end enumeration

namespace fin

instance : ∀ (n : ℕ), enumeration (fin n)
| 0 := { elems := [], nodup := list.nodup_nil, complete := λ i, fin.elim0 i }
| (n + 1) := {
  elems := list.cons (0 : fin (n + 1)) ((enumeration n).elems.map fin.succ),
  nodup := begin
    rw [list.nodup_cons], split,
    { intro h, rcases list.mem_map.mp h with ⟨i,hi⟩,
      exact i.succ_ne_zero hi.2 },
    { exact list.nodup.map (λ a₁ a₂ ha, fin.succ_inj.mp ha) (enumeration n).nodup }
  end,
  complete := begin
    rintro ⟨i,hi⟩, cases i with i,
    { apply list.mem_cons_self },
    { let i' : fin n := ⟨i,nat.lt_of_succ_lt_succ hi⟩,
      have : (⟨i.succ,hi⟩ : fin (n + 1)) = i'.succ := fin.eq_of_veq rfl,
      rw [this],
      apply list.mem_cons_of_mem,
      apply list.mem_map_of_mem,
      apply (enumeration n).complete }
  end
}

lemma enumeration_zero : (@enumeration.elems (fin 0) _) = [] := rfl

lemma enumeration_succ (n : ℕ) :
  (@enumeration.elems (fin (n + 1)) _) =
  (0 : fin (n + 1)) :: ((@enumeration.elems (fin n) _).map fin.succ) := rfl

lemma enumeration_coe (n : ℕ) :
  (@enumeration.elems (fin n) _).map (coe : (fin n) → ℕ) = list.range n :=
begin
  let f : ℕ → list ℕ := λ m,
    (@enumeration.elems (fin m) _).map (coe : (fin m) → ℕ),
  change f n = list.range n,
  have f_zero : f 0 = [] := rfl,
  have f_step : ∀ m, f (m + 1) = 0 :: ((f m).map nat.succ) := λ m,
    by { dsimp [f],
         rw [enumeration_succ, list.map_cons, list.map_map, list.map_map],
         congr' 2, funext i,
         rw [function.comp_app, function.comp_app, fin.coe_succ] },
  have map_add_add : ∀ (p q : ℕ) (l : list ℕ),
    (l.map ((+) q)).map ((+) p) = l.map ((+) (p + q)) :=
      by { intros, rw[list.map_map], congr' 1, funext i, rw [add_assoc] },
  suffices h : ∀ (p q : ℕ), f (p + q) = list.range_core p ((f q).map ((+) p)),
  { have h₀ := h n 0,
    rw [add_zero, f_zero, list.map] at h₀, exact h₀ },
  { intro p, induction p with p ih,
    { intro q,
      have : ((+) 0 : ℕ → ℕ) = id := by { funext i, exact zero_add i },
      rw [zero_add, list.range_core, this, list.map_id] },
    { intro q,
      have : (f (q + 1)).map ((+) p) = p :: ((f q).map ((+) (p + 1))) :=
      begin
        rw [f_step q, list.map_cons, add_zero, list.map_map],
        congr' 2,  funext i, rw [function.comp_app, add_assoc, add_comm 1]
      end,
      rw [list.range_core, ← this, ← ih (q + 1), add_assoc p 1 q, add_comm 1 q]
    } }
end

end fin


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import group_theory.order_of_element
import algebra.punit_instances
import algebra.gcd_monoid.finset
import tactic.by_contra
import number_theory.padics.padic_val

/-!
# Exponent of a group

This file defines the exponent of a group, or more generally a monoid. For a group `G` it is defined
to be the minimal `n≥1` such that `g ^ n = 1` for all `g ∈ G`. For a finite group `G`,
it is equal to the lowest common multiple of the order of all elements of the group `G`.

## Main definitions

* `monoid.exponent_exists` is a predicate on a monoid `G` saying that there is some positive `n`
  such that `g ^ n = 1` for all `g ∈ G`.
* `monoid.exponent` defines the exponent of a monoid `G` as the minimal positive `n` such that
  `g ^ n = 1` for all `g ∈ G`, by convention it is `0` if no such `n` exists.
* `add_monoid.exponent_exists` the additive version of `monoid.exponent_exists`.
* `add_monoid.exponent` the additive version of `monoid.exponent`.

## Main results

* `monoid.lcm_order_eq_exponent`: For a finite left cancel monoid `G`, the exponent is equal to the
  `finset.lcm` of the order of its elements.
* `monoid.exponent_eq_supr_order_of(')`: For a commutative cancel monoid, the exponent is
  equal to `⨆ g : G, order_of g` (or zero if it has any order-zero elements).

## TODO
* Refactor the characteristic of a ring to be the exponent of its underlying additive group.
-/

universe u

variable {G : Type u}

open_locale classical

namespace monoid

section monoid

variables (G) [monoid G]

/--A predicate on a monoid saying that there is a positive integer `n` such that `g ^ n = 1`
  for all `g`.-/
@[to_additive "A predicate on an additive monoid saying that there is a positive integer `n` such
  that `n • g = 0` for all `g`."]
def exponent_exists  := ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1

/--The exponent of a group is the smallest positive integer `n` such that `g ^ n = 1` for all
  `g ∈ G` if it exists, otherwise it is zero by convention.-/
@[to_additive "The exponent of an additive group is the smallest positive integer `n` such that
  `n • g = 0` for all `g ∈ G` if it exists, otherwise it is zero by convention."]
noncomputable def exponent :=
if h : exponent_exists G then nat.find h else 0

variable {G}

@[to_additive]
lemma exponent_exists_iff_ne_zero : exponent_exists G ↔ exponent G ≠ 0 :=
begin
  rw [exponent],
  split_ifs,
  { simp [h, @not_lt_zero' ℕ] }, --if this isn't done this way, `to_additive` freaks
  { tauto },
end

@[to_additive]
lemma exponent_eq_zero_iff : exponent G = 0 ↔ ¬ exponent_exists G :=
by simp only [exponent_exists_iff_ne_zero, not_not]

@[to_additive]
lemma exponent_eq_zero_of_order_zero {g : G} (hg : order_of g = 0) : exponent G = 0 :=
exponent_eq_zero_iff.mpr $ λ ⟨n, hn, hgn⟩, order_of_eq_zero_iff'.mp hg n hn $ hgn g

@[to_additive exponent_nsmul_eq_zero]
lemma pow_exponent_eq_one (g : G) : g ^ exponent G = 1 :=
begin
  by_cases exponent_exists G,
  { simp_rw [exponent, dif_pos h],
    exact (nat.find_spec h).2 g },
  { simp_rw [exponent, dif_neg h, pow_zero] }
end

@[to_additive]
lemma pow_eq_mod_exponent {n : ℕ} (g : G): g ^ n = g ^ (n % exponent G) :=
calc g ^ n = g ^ (n % exponent G + exponent G * (n / exponent G)) : by rw [nat.mod_add_div]
  ... = g ^ (n % exponent G) : by simp [pow_add, pow_mul, pow_exponent_eq_one]

@[to_additive]
lemma exponent_pos_of_exists (n : ℕ) (hpos : 0 < n) (hG : ∀ g : G, g ^ n = 1) :
  0 < exponent G :=
begin
  have h : ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1 := ⟨n, hpos, hG⟩,
  rw [exponent, dif_pos],
  exact (nat.find_spec h).1,
end

@[to_additive]

@[to_additive]
lemma exponent_min (m : ℕ) (hpos : 0 < m) (hm : m < exponent G) : ∃ g : G, g ^ m ≠ 1 :=
begin
  by_contra' h,
  have hcon : exponent G ≤ m := exponent_min' m hpos h,
  linarith,
end

@[simp, to_additive]
lemma exp_eq_one_of_subsingleton [subsingleton G] : exponent G = 1 :=
begin
  apply le_antisymm,
  { apply exponent_min' _ nat.one_pos,
    simp },
  { apply nat.succ_le_of_lt,
    apply exponent_pos_of_exists 1 (nat.one_pos),
    simp },
end

@[to_additive add_order_dvd_exponent]
lemma order_dvd_exponent (g : G) : (order_of g) ∣ exponent G :=
order_of_dvd_of_pow_eq_one $ pow_exponent_eq_one g

variable (G)

@[to_additive]
lemma exponent_dvd_of_forall_pow_eq_one (G) [monoid G] (n : ℕ) (hG : ∀ g : G, g ^ n = 1) :
  exponent G ∣ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hpos,
  { exact dvd_zero _ },
  apply nat.dvd_of_mod_eq_zero,
  by_contradiction h,
  have h₁ := nat.pos_of_ne_zero h,
  have h₂ : n % exponent G < exponent G := nat.mod_lt _ (exponent_pos_of_exists n hpos hG),
  have h₃ : exponent G ≤ n % exponent G,
  { apply exponent_min' _ h₁,
    simp_rw ←pow_eq_mod_exponent,
    exact hG },
  linarith,
end

@[to_additive lcm_add_order_of_dvd_exponent]
lemma lcm_order_of_dvd_exponent [fintype G] : (finset.univ : finset G).lcm order_of ∣ exponent G :=
begin
  apply finset.lcm_dvd,
  intros g hg,
  exact order_dvd_exponent g
end

@[to_additive exists_order_of_eq_pow_padic_val_nat_add_exponent]
lemma _root_.nat.prime.exists_order_of_eq_pow_factorization_exponent {p : ℕ} (hp : p.prime) :
  ∃ g : G, order_of g = p ^ (exponent G).factorization p :=
begin
  haveI := fact.mk hp,
  rcases eq_or_ne ((exponent G).factorization p) 0 with h | h,
  { refine ⟨1, by rw [h, pow_zero, order_of_one]⟩ },
  have he : 0 < exponent G := ne.bot_lt (λ ht,
    by {rw ht at h, apply h, rw [bot_eq_zero, nat.factorization_zero, finsupp.zero_apply] }),
  rw ← finsupp.mem_support_iff at h,
  obtain ⟨g, hg⟩ : ∃ (g : G), g ^ (exponent G / p) ≠ 1,
  { suffices key : ¬ exponent G ∣ exponent G / p,
    { simpa using mt (exponent_dvd_of_forall_pow_eq_one G (exponent G / p)) key },
    exact λ hd, hp.one_lt.not_le ((mul_le_iff_le_one_left he).mp $
                nat.le_of_dvd he $ nat.mul_dvd_of_dvd_div (nat.dvd_of_mem_factorization h) hd) },
  obtain ⟨k, hk : exponent G = p ^ _ * k⟩ := nat.pow_factorization_dvd _ _,
  obtain ⟨t, ht⟩ := nat.exists_eq_succ_of_ne_zero (finsupp.mem_support_iff.mp h),
  refine ⟨g ^ k, _⟩,
  rw ht,
  apply order_of_eq_prime_pow,
  { rwa [hk, mul_comm, ht, pow_succ', ←mul_assoc, nat.mul_div_cancel _ hp.pos, pow_mul] at hg },
  { rw [←nat.succ_eq_add_one, ←ht, ←pow_mul, mul_comm, ←hk],
    exact pow_exponent_eq_one g },
end

variable {G}

@[to_additive] lemma exponent_ne_zero_iff_range_order_of_finite (h : ∀ g : G, 0 < order_of g) :
  exponent G ≠ 0 ↔ (set.range (order_of : G → ℕ)).finite :=
begin
  refine ⟨λ he, _, λ he, _⟩,
  { by_contra h,
    obtain ⟨m, ⟨t, rfl⟩, het⟩ := set.infinite.exists_nat_lt h (exponent G),
    exact pow_ne_one_of_lt_order_of' he het (pow_exponent_eq_one t) },
  { lift (set.range order_of) to finset ℕ using he with t ht,
    have htpos : 0 < t.prod id,
    { refine finset.prod_pos (λ a ha, _),
      rw [←finset.mem_coe, ht] at ha,
      obtain ⟨k, rfl⟩ := ha,
      exact h k },
    suffices : exponent G ∣ t.prod id,
    { intro h,
      rw [h, zero_dvd_iff] at this,
      exact htpos.ne' this },
    refine exponent_dvd_of_forall_pow_eq_one _ _ (λ g, _),
    rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd, pow_zero g],
    apply finset.dvd_prod_of_mem,
    rw [←finset.mem_coe, ht],
    exact set.mem_range_self g },
end

@[to_additive] lemma exponent_eq_zero_iff_range_order_of_infinite (h : ∀ g : G, 0 < order_of g) :
  exponent G = 0 ↔ (set.range (order_of : G → ℕ)).infinite :=
have _ := exponent_ne_zero_iff_range_order_of_finite h,
by rwa [ne.def, not_iff_comm, iff.comm] at this

@[to_additive lcm_add_order_eq_exponent]
lemma lcm_order_eq_exponent [fintype G] : (finset.univ : finset G).lcm order_of = exponent G :=
begin
  apply nat.dvd_antisymm (lcm_order_of_dvd_exponent G),
  refine exponent_dvd_of_forall_pow_eq_one G _ (λ g, _),
  obtain ⟨m, hm⟩ : order_of g ∣ finset.univ.lcm order_of := finset.dvd_lcm (finset.mem_univ g),
  rw [hm, pow_mul, pow_order_of_eq_one, one_pow]
end

end monoid

section left_cancel_monoid

variable [left_cancel_monoid G]

@[to_additive]
lemma exponent_ne_zero_of_fintype [fintype G] : exponent G ≠ 0 :=
by simpa [←lcm_order_eq_exponent, finset.lcm_eq_zero_iff] using λ x, (order_of_pos x).ne'

end left_cancel_monoid

section comm_monoid

variable [comm_monoid G]

@[to_additive] lemma exponent_eq_supr_order_of (h : ∀ g : G, 0 < order_of g) :
  exponent G = ⨆ g : G, order_of g :=
begin
  rw supr,
  rcases eq_or_ne (exponent G) 0 with he | he,
  { rw [he, set.infinite.nat.Sup_eq_zero $ (exponent_eq_zero_iff_range_order_of_infinite h).1 he] },
  have hne : (set.range (order_of : G → ℕ)).nonempty := ⟨1, 1, order_of_one⟩,
  have hfin : (set.range (order_of : G → ℕ)).finite,
  { rwa [← exponent_ne_zero_iff_range_order_of_finite h] },
  obtain ⟨t, ht⟩ := hne.cSup_mem hfin,
  apply nat.dvd_antisymm _,
  { rw ←ht,
    apply order_dvd_exponent },
  refine nat.dvd_of_factors_subperm he _,
  rw list.subperm_ext_iff,
  by_contra' h,
  obtain ⟨p, hp, hpe⟩ := h,
  replace hp := nat.prime_of_mem_factors hp,
  simp only [nat.factors_count_eq] at hpe,
  set k := (order_of t).factorization p with hk,
  obtain ⟨g, hg⟩ := hp.exists_order_of_eq_pow_factorization_exponent G,
  suffices : order_of t < order_of (t ^ (p ^ k) * g),
  { rw ht at this,
    exact this.not_le (le_cSup hfin.bdd_above $ set.mem_range_self _) },
  have hpk  : p ^ k ∣ order_of t := nat.pow_factorization_dvd _ _,
  have hpk' : order_of (t ^ p ^ k) = order_of t / p ^ k,
  { rw [order_of_pow' t (pow_ne_zero k hp.ne_zero), nat.gcd_eq_right hpk] },
  obtain ⟨a, ha⟩ := nat.exists_eq_add_of_lt hpe,
  have hcoprime : (order_of (t ^ p ^ k)).coprime (order_of g),
  { rw [hg, nat.coprime_pow_right_iff (pos_of_gt hpe), nat.coprime_comm],
    apply or.resolve_right (nat.coprime_or_dvd_of_prime hp _),
    nth_rewrite 0 ←pow_one p,
    convert nat.pow_succ_factorization_not_dvd (h $ t ^ p ^ k).ne' hp,
    rw [hpk', nat.factorization_div hpk],
    simp [hp] },
  rw [(commute.all _ g).order_of_mul_eq_mul_order_of_of_coprime hcoprime, hpk', hg, ha, ←ht, ←hk,
      pow_add, pow_add, pow_one, ←mul_assoc, ←mul_assoc, nat.div_mul_cancel, mul_assoc,
      lt_mul_iff_one_lt_right $ h t, ←pow_succ'],
  exact one_lt_pow hp.one_lt a.succ_ne_zero,
  exact hpk
end

@[to_additive] lemma exponent_eq_supr_order_of' :
  exponent G = if ∃ g : G, order_of g = 0 then 0 else ⨆ g : G, order_of g :=
begin
  split_ifs,
  { obtain ⟨g, hg⟩ := h,
    exact exponent_eq_zero_of_order_zero hg },
  { have := not_exists.mp h,
    exact exponent_eq_supr_order_of (λ g, ne.bot_lt $ this g) }
end

end comm_monoid

section cancel_comm_monoid

variables [cancel_comm_monoid G]

@[to_additive] lemma exponent_eq_max'_order_of [fintype G] :
  exponent G = ((@finset.univ G _).image order_of).max' ⟨1, by simp⟩ :=
begin
  rw [←finset.nonempty.cSup_eq_max', finset.coe_image, finset.coe_univ, set.image_univ, ← supr],
  exact exponent_eq_supr_order_of order_of_pos
end

end cancel_comm_monoid

end monoid