lemma lt_aux_two (a b : mynat) : succ a ≤ b → a ≤ b ∧ ¬ (b ≤ a) :=
begin
intro h,
split,
apply le_trans _ (succ a),
exact le_succ_self a,
exact h,
intro h2,
apply not_succ_le_self a,
exact le_trans (succ a) b a h h2,
end


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

import algebra.ring.prod
import algebra.module.basic
import group_theory.submonoid.membership
import group_theory.submonoid.center
import data.set.finite
import data.equiv.ring

/-!
# Bundled subsemirings

We define bundled subsemirings and some standard constructions: `complete_lattice` structure,
`subtype` and `inclusion` ring homomorphisms, subsemiring `map`, `comap` and range (`srange`) of
a `ring_hom` etc.
-/

open_locale big_operators

universes u v w

variables {R : Type u} {S : Type v} {T : Type w}
  [non_assoc_semiring R] [non_assoc_semiring S] [non_assoc_semiring T]
  (M : submonoid R)

set_option old_structure_cmd true

/-- A subsemiring of a semiring `R` is a subset `s` that is both a multiplicative and an additive
submonoid. -/
structure subsemiring (R : Type u) [non_assoc_semiring R] extends submonoid R, add_submonoid R

/-- Reinterpret a `subsemiring` as a `submonoid`. -/
add_decl_doc subsemiring.to_submonoid

/-- Reinterpret a `subsemiring` as an `add_submonoid`. -/
add_decl_doc subsemiring.to_add_submonoid

namespace subsemiring

instance : set_like (subsemiring R) R :=
⟨subsemiring.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp]
lemma mem_carrier {s : subsemiring R} {x : R} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

/-- Two subsemirings are equal if they have the same elements. -/
@[ext] theorem ext {S T : subsemiring R} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy of a subsemiring with a new `carrier` equal to the old one. Useful to fix definitional
equalities.-/
protected def copy (S : subsemiring R) (s : set R) (hs : s = ↑S) : subsemiring R :=
{ carrier := s,
  ..S.to_add_submonoid.copy s hs,
  ..S.to_submonoid.copy s hs }

@[simp] lemma coe_copy (S : subsemiring R) (s : set R) (hs : s = ↑S) :
  (S.copy s hs : set R) = s := rfl

lemma copy_eq (S : subsemiring R) (s : set R) (hs : s = ↑S) : S.copy s hs = S :=
set_like.coe_injective hs

lemma to_submonoid_injective : function.injective (to_submonoid : subsemiring R → submonoid R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono] lemma to_submonoid_strict_mono : strict_mono (to_submonoid : subsemiring R → submonoid R) :=
λ _ _, id

@[mono] lemma to_submonoid_mono : monotone (to_submonoid : subsemiring R → submonoid R) :=
to_submonoid_strict_mono.monotone

lemma to_add_submonoid_injective :
  function.injective (to_add_submonoid : subsemiring R → add_submonoid R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono] lemma to_add_submonoid_strict_mono :
  strict_mono (to_add_submonoid : subsemiring R → add_submonoid R) := λ _ _, id

@[mono]
lemma to_add_submonoid_mono : monotone (to_add_submonoid : subsemiring R → add_submonoid R) :=
to_add_submonoid_strict_mono.monotone

/-- Construct a `subsemiring R` from a set `s`, a submonoid `sm`, and an additive
submonoid `sa` such that `x ∈ s ↔ x ∈ sm ↔ x ∈ sa`. -/
protected def mk' (s : set R) (sm : submonoid R) (hm : ↑sm = s)
  (sa : add_submonoid R) (ha : ↑sa = s) :
  subsemiring R :=
{ carrier := s,
  zero_mem' := ha ▸ sa.zero_mem,
  one_mem' := hm ▸ sm.one_mem,
  add_mem' := λ x y, by simpa only [← ha] using sa.add_mem,
  mul_mem' := λ x y, by simpa only [← hm] using sm.mul_mem }

@[simp] lemma coe_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) :
  (subsemiring.mk' s sm hm sa ha : set R) = s := rfl

@[simp] lemma mem_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) {x : R} :
  x ∈ subsemiring.mk' s sm hm sa ha ↔ x ∈ s :=
iff.rfl

@[simp] lemma mk'_to_submonoid {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa = s) :
  (subsemiring.mk' s sm hm sa ha).to_submonoid = sm :=
set_like.coe_injective hm.symm

@[simp] lemma mk'_to_add_submonoid {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_submonoid R} (ha : ↑sa  =s) :
  (subsemiring.mk' s sm hm sa ha).to_add_submonoid = sa :=
set_like.coe_injective ha.symm

end subsemiring

namespace subsemiring

variables (s : subsemiring R)

/-- A subsemiring contains the semiring's 1. -/
theorem one_mem : (1 : R) ∈ s := s.one_mem'

/-- A subsemiring contains the semiring's 0. -/
theorem zero_mem : (0 : R) ∈ s := s.zero_mem'

/-- A subsemiring is closed under multiplication. -/
theorem mul_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x * y ∈ s := s.mul_mem'

/-- A subsemiring is closed under addition. -/
theorem add_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x + y ∈ s := s.add_mem'

/-- Product of a list of elements in a `subsemiring` is in the `subsemiring`. -/
lemma list_prod_mem {R : Type*} [semiring R] (s : subsemiring R) {l : list R} :
  (∀x ∈ l, x ∈ s) → l.prod ∈ s :=
s.to_submonoid.list_prod_mem

/-- Sum of a list of elements in a `subsemiring` is in the `subsemiring`. -/
lemma list_sum_mem {l : list R} : (∀x ∈ l, x ∈ s) → l.sum ∈ s :=
s.to_add_submonoid.list_sum_mem

/-- Product of a multiset of elements in a `subsemiring` of a `comm_semiring`
    is in the `subsemiring`. -/
lemma multiset_prod_mem {R} [comm_semiring R] (s : subsemiring R) (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.prod ∈ s :=
s.to_submonoid.multiset_prod_mem m

/-- Sum of a multiset of elements in a `subsemiring` of a `semiring` is
in the `add_subsemiring`. -/
lemma multiset_sum_mem (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.sum ∈ s :=
s.to_add_submonoid.multiset_sum_mem m

/-- Product of elements of a subsemiring of a `comm_semiring` indexed by a `finset` is in the
    subsemiring. -/
lemma prod_mem {R : Type*} [comm_semiring R] (s : subsemiring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∏ i in t, f i ∈ s :=
s.to_submonoid.prod_mem h

/-- Sum of elements in an `subsemiring` of an `semiring` indexed by a `finset`
is in the `add_subsemiring`. -/
lemma sum_mem (s : subsemiring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∑ i in t, f i ∈ s :=
s.to_add_submonoid.sum_mem h

lemma pow_mem {R : Type*} [semiring R] (s : subsemiring R) {x : R} (hx : x ∈ s) (n : ℕ) :
  x^n ∈ s := s.to_submonoid.pow_mem hx n

lemma nsmul_mem {x : R} (hx : x ∈ s) (n : ℕ) :
  n • x ∈ s := s.to_add_submonoid.nsmul_mem hx n

lemma coe_nat_mem (n : ℕ) : (n : R) ∈ s :=
by simp only [← nsmul_one, nsmul_mem, one_mem]

/-- A subsemiring of a `non_assoc_semiring` inherits a `non_assoc_semiring` structure -/
instance to_non_assoc_semiring : non_assoc_semiring s :=
{ mul_zero := λ x, subtype.eq $ mul_zero x,
  zero_mul := λ x, subtype.eq $ zero_mul x,
  right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
  left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
  .. s.to_submonoid.to_mul_one_class, .. s.to_add_submonoid.to_add_comm_monoid }

@[simp, norm_cast] lemma coe_one : ((1 : s) : R) = (1 : R) := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : s) : R) = (0 : R) := rfl
@[simp, norm_cast] lemma coe_add (x y : s) : ((x + y : s) : R) = (x + y : R) := rfl
@[simp, norm_cast] lemma coe_mul (x y : s) : ((x * y : s) : R) = (x * y : R) := rfl

instance nontrivial [nontrivial R] : nontrivial s :=
nontrivial_of_ne 0 1 $ λ H, zero_ne_one (congr_arg subtype.val H)

instance no_zero_divisors [no_zero_divisors R] : no_zero_divisors s :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y h,
  or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero $ subtype.ext_iff.mp h)
    (λ h, or.inl $ subtype.eq h) (λ h, or.inr $ subtype.eq h) }

/-- A subsemiring of a `semiring` is a `semiring`. -/
instance to_semiring {R} [semiring R] (s : subsemiring R) : semiring s :=
{ ..s.to_non_assoc_semiring, ..s.to_submonoid.to_monoid }

@[simp, norm_cast] lemma coe_pow {R} [semiring R] (s : subsemiring R) (x : s) (n : ℕ) :
  ((x^n : s) : R) = (x^n : R) :=
begin
  induction n with n ih,
  { simp, },
  { simp [pow_succ, ih], },
end

/-- A subsemiring of a `comm_semiring` is a `comm_semiring`. -/
instance to_comm_semiring {R} [comm_semiring R] (s : subsemiring R) : comm_semiring s :=
{ mul_comm := λ _ _, subtype.eq $ mul_comm _ _, ..s.to_semiring}

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype : s →+* R :=
{ to_fun := coe, .. s.to_submonoid.subtype, .. s.to_add_submonoid.subtype }

@[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl

/-- A subsemiring of an `ordered_semiring` is an `ordered_semiring`. -/
instance to_ordered_semiring {R} [ordered_semiring R] (s : subsemiring R) : ordered_semiring s :=
subtype.coe_injective.ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A subsemiring of an `ordered_comm_semiring` is an `ordered_comm_semiring`. -/
instance to_ordered_comm_semiring {R} [ordered_comm_semiring R] (s : subsemiring R) :
  ordered_comm_semiring s :=
subtype.coe_injective.ordered_comm_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl)

/-- A subsemiring of a `linear_ordered_semiring` is a `linear_ordered_semiring`. -/
instance to_linear_ordered_semiring {R} [linear_ordered_semiring R] (s : subsemiring R) :
  linear_ordered_semiring s :=
subtype.coe_injective.linear_ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl)

/-! Note: currently, there is no `linear_ordered_comm_semiring`. -/

@[simp] lemma mem_to_submonoid {s : subsemiring R} {x : R} : x ∈ s.to_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_submonoid (s : subsemiring R) : (s.to_submonoid : set R) = s := rfl
@[simp] lemma mem_to_add_submonoid {s : subsemiring R} {x : R} :
  x ∈ s.to_add_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_add_submonoid (s : subsemiring R) : (s.to_add_submonoid : set R) = s := rfl

/-- The subsemiring `R` of the semiring `R`. -/
instance : has_top (subsemiring R) :=
⟨{ .. (⊤ : submonoid R), .. (⊤ : add_submonoid R) }⟩

@[simp] lemma mem_top (x : R) : x ∈ (⊤ : subsemiring R) := set.mem_univ x

@[simp] lemma coe_top : ((⊤ : subsemiring R) : set R) = set.univ := rfl

/-- The preimage of a subsemiring along a ring homomorphism is a subsemiring. -/
def comap (f : R →+* S) (s : subsemiring S) : subsemiring R :=
{ carrier := f ⁻¹' s,
  .. s.to_submonoid.comap (f : R →* S), .. s.to_add_submonoid.comap (f : R →+ S) }

@[simp]

@[simp]
lemma mem_comap {s : subsemiring S} {f : R →+* S} {x : R} : x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_comap (s : subsemiring T) (g : S →+* T) (f : R →+* S) :
  (s.comap g).comap f = s.comap (g.comp f) :=
rfl

/-- The image of a subsemiring along a ring homomorphism is a subsemiring. -/
def map (f : R →+* S) (s : subsemiring R) : subsemiring S :=
{ carrier := f '' s,
  .. s.to_submonoid.map (f : R →* S), .. s.to_add_submonoid.map (f : R →+ S) }

@[simp] lemma coe_map (f : R →+* S) (s : subsemiring R) : (s.map f : set S) = f '' s := rfl

@[simp] lemma mem_map {f : R →+* S} {s : subsemiring R} {y : S} :
  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
set.mem_image_iff_bex

@[simp] lemma map_id : s.map (ring_hom.id R) = s :=
set_like.coe_injective $ set.image_id _

lemma map_map (g : S →+* T) (f : R →+* S) : (s.map f).map g = s.map (g.comp f) :=
set_like.coe_injective $ set.image_image _ _ _

lemma map_le_iff_le_comap {f : R →+* S} {s : subsemiring R} {t : subsemiring S} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
set.image_subset_iff

lemma gc_map_comap (f : R →+* S) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

/-- A subsemiring is isomorphic to its image under an injective function -/
noncomputable def equiv_map_of_injective
  (f : R →+* S) (hf : function.injective f) : s ≃+* s.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _),
  map_add' := λ _ _, subtype.ext (f.map_add _ _),
  ..equiv.set.image f s hf }

@[simp] lemma coe_equiv_map_of_injective_apply
  (f : R →+* S) (hf : function.injective f) (x : s) :
  (equiv_map_of_injective s f hf x : S) = f x := rfl

end subsemiring

namespace ring_hom

variables (g : S →+* T) (f : R →+* S)

/-- The range of a ring homomorphism is a subsemiring. See Note [range copy pattern]. -/
def srange : subsemiring S :=
((⊤ : subsemiring R).map f).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_srange : (f.srange : set S) = set.range f := rfl

@[simp] lemma mem_srange {f : R →+* S} {y : S} : y ∈ f.srange ↔ ∃ x, f x = y :=
iff.rfl

lemma srange_eq_map (f : R →+* S) : f.srange = (⊤ : subsemiring R).map f :=
by { ext, simp }

lemma mem_srange_self (f : R →+* S) (x : R) : f x ∈ f.srange :=
mem_srange.mpr ⟨x, rfl⟩

lemma map_srange : f.srange.map g = (g.comp f).srange :=
by simpa only [srange_eq_map] using (⊤ : subsemiring R).map_map g f

/-- The range of a morphism of semirings is a fintype, if the domain is a fintype.
Note: this instance can form a diamond with `subtype.fintype` in the
  presence of `fintype S`.-/
instance fintype_srange [fintype R] [decidable_eq S] (f : R →+* S) : fintype (srange f) :=
set.fintype_range f

end ring_hom

namespace subsemiring

instance : has_bot (subsemiring R) := ⟨(nat.cast_ring_hom R).srange⟩

instance : inhabited (subsemiring R) := ⟨⊥⟩

lemma coe_bot : ((⊥ : subsemiring R) : set R) = set.range (coe : ℕ → R) :=
(nat.cast_ring_hom R).coe_srange

lemma mem_bot {x : R} : x ∈ (⊥ : subsemiring R) ↔ ∃ n : ℕ, ↑n=x := ring_hom.mem_srange

/-- The inf of two subsemirings is their intersection. -/
instance : has_inf (subsemiring R) :=
⟨λ s t,
  { carrier := s ∩ t,
    .. s.to_submonoid ⊓ t.to_submonoid,
    .. s.to_add_submonoid ⊓ t.to_add_submonoid }⟩

@[simp] lemma coe_inf (p p' : subsemiring R) : ((p ⊓ p' : subsemiring R) : set R) = p ∩ p' := rfl

@[simp] lemma mem_inf {p p' : subsemiring R} {x : R} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

instance : has_Inf (subsemiring R) :=
⟨λ s, subsemiring.mk' (⋂ t ∈ s, ↑t) (⨅ t ∈ s, subsemiring.to_submonoid t) (by simp)
  (⨅ t ∈ s, subsemiring.to_add_submonoid t) (by simp)⟩

@[simp, norm_cast] lemma coe_Inf (S : set (subsemiring R)) :
  ((Inf S : subsemiring R) : set R) = ⋂ s ∈ S, ↑s := rfl

lemma mem_Inf {S : set (subsemiring R)} {x : R} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := set.mem_bInter_iff

@[simp] lemma Inf_to_submonoid (s : set (subsemiring R)) :
  (Inf s).to_submonoid = ⨅ t ∈ s, subsemiring.to_submonoid t :=
mk'_to_submonoid _ _

@[simp] lemma Inf_to_add_submonoid (s : set (subsemiring R)) :
  (Inf s).to_add_submonoid = ⨅ t ∈ s, subsemiring.to_add_submonoid t :=
mk'_to_add_submonoid _ _

/-- Subsemirings of a semiring form a complete lattice. -/
instance : complete_lattice (subsemiring R) :=
{ bot := (⊥),
  bot_le := λ s x hx, let ⟨n, hn⟩ := mem_bot.1 hx in hn ▸ s.coe_nat_mem n,
  top := (⊤),
  le_top := λ s x hx, trivial,
  inf := (⊓),
  inf_le_left := λ s t x, and.left,
  inf_le_right := λ s t x, and.right,
  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
  .. complete_lattice_of_Inf (subsemiring R)
    (λ s, is_glb.of_image (λ s t,
      show (s : set R) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) is_glb_binfi)}

lemma eq_top_iff' (A : subsemiring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

section

/-- The center of a semiring `R` is the set of elements that commute with everything in `R` -/
def center (R) [semiring R] : subsemiring R :=
{ carrier := set.center R,
  zero_mem' := set.zero_mem_center R,
  add_mem' := λ a b, set.add_mem_center,
  .. submonoid.center R }

lemma coe_center (R) [semiring R] : ↑(center R) = set.center R := rfl

@[simp]
lemma center_to_submonoid (R) [semiring R] : (center R).to_submonoid = submonoid.center R := rfl

lemma mem_center_iff {R} [semiring R] {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
iff.rfl

instance decidable_mem_center {R} [semiring R] [decidable_eq R] [fintype R] :
  decidable_pred (∈ center R) :=
λ _, decidable_of_iff' _ mem_center_iff

@[simp] lemma center_eq_top (R) [comm_semiring R] : center R = ⊤ :=
set_like.coe_injective (set.center_eq_univ R)

/-- The center is commutative. -/
instance {R} [semiring R] : comm_semiring (center R) :=
{ ..submonoid.center.comm_monoid,
  ..(center R).to_semiring}

end

/-- The `subsemiring` generated by a set. -/
def closure (s : set R) : subsemiring R := Inf {S | s ⊆ S}

lemma mem_closure {x : R} {s : set R} : x ∈ closure s ↔ ∀ S : subsemiring R, s ⊆ S → x ∈ S :=
mem_Inf

/-- The subsemiring generated by a set includes the set. -/
@[simp] lemma subset_closure {s : set R} : s ⊆ closure s := λ x hx, mem_closure.2 $ λ S hS, hS hx

lemma not_mem_of_not_mem_closure {s : set R} {P : R} (hP : P ∉ closure s) : P ∉ s :=
λ h, hP (subset_closure h)

/-- A subsemiring `S` includes `closure s` if and only if it includes `s`. -/
@[simp]
lemma closure_le {s : set R} {t : subsemiring R} : closure s ≤ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, λ h, Inf_le h⟩

/-- Subsemiring closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
lemma closure_mono ⦃s t : set R⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ set.subset.trans h subset_closure

lemma closure_eq_of_le {s : set R} {t : subsemiring R} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
  closure s = t :=
le_antisymm (closure_le.2 h₁) h₂

lemma mem_map_equiv {f : R ≃+* S} {K : subsemiring R} {x : S} :
  x ∈ K.map (f : R →+* S) ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

lemma map_equiv_eq_comap_symm (f : R ≃+* S) (K : subsemiring R) :
  K.map (f : R →+* S) = K.comap f.symm :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

lemma comap_equiv_eq_map_symm (f : R ≃+* S) (K : subsemiring S) :
  K.comap (f : R →+* S) = K.map f.symm :=
(map_equiv_eq_comap_symm f.symm K).symm

end subsemiring

namespace submonoid

/-- The additive closure of a submonoid is a subsemiring. -/
def subsemiring_closure (M : submonoid R) : subsemiring R :=
{ one_mem' := add_submonoid.mem_closure.mpr (λ y hy, hy M.one_mem),
  mul_mem' := λ x y, M.mul_mem_add_closure,
  ..add_submonoid.closure (M : set R)}

lemma subsemiring_closure_coe :
  (M.subsemiring_closure : set R) = add_submonoid.closure (M : set R) := rfl

lemma subsemiring_closure_to_add_submonoid :
  M.subsemiring_closure.to_add_submonoid = add_submonoid.closure (M : set R) := rfl

/-- The `subsemiring` generated by a multiplicative submonoid coincides with the
`subsemiring.closure` of the submonoid itself . -/
lemma subsemiring_closure_eq_closure : M.subsemiring_closure = subsemiring.closure (M : set R) :=
begin
  ext,
  refine ⟨λ hx, _, λ hx, (subsemiring.mem_closure.mp hx) M.subsemiring_closure (λ s sM, _)⟩;
  rintros - ⟨H1, rfl⟩;
  rintros - ⟨H2, rfl⟩,
  { exact add_submonoid.mem_closure.mp hx H1.to_add_submonoid H2 },
  { exact H2 sM }
end

end submonoid

namespace subsemiring

@[simp]
lemma closure_submonoid_closure (s : set R) : closure ↑(submonoid.closure s) = closure s :=
le_antisymm
  (closure_le.mpr (λ y hy, (submonoid.mem_closure.mp hy) (closure s).to_submonoid subset_closure))
  (closure_mono (submonoid.subset_closure))

/-- The elements of the subsemiring closure of `M` are exactly the elements of the additive closure
of a multiplicative submonoid `M`. -/
lemma coe_closure_eq (s : set R) :
  (closure s : set R) = add_submonoid.closure (submonoid.closure s : set R) :=
by simp [← submonoid.subsemiring_closure_to_add_submonoid, submonoid.subsemiring_closure_eq_closure]

lemma mem_closure_iff {s : set R} {x} :
  x ∈ closure s ↔ x ∈ add_submonoid.closure (submonoid.closure s : set R) :=
set.ext_iff.mp (coe_closure_eq s) x

@[simp]
lemma closure_add_submonoid_closure {s : set R} : closure ↑(add_submonoid.closure s) = closure s :=
begin
  ext x,
  refine ⟨λ hx, _, λ hx, closure_mono add_submonoid.subset_closure hx⟩,
  rintros - ⟨H, rfl⟩,
  rintros - ⟨J, rfl⟩,
  refine (add_submonoid.mem_closure.mp (mem_closure_iff.mp hx)) H.to_add_submonoid (λ y hy, _),
  refine (submonoid.mem_closure.mp hy) H.to_submonoid (λ z hz, _),
  exact (add_submonoid.mem_closure.mp hz) H.to_add_submonoid (λ w hw, J hw),
end

/-- An induction principle for closure membership. If `p` holds for `0`, `1`, and all elements
of `s`, and is preserved under addition and multiplication, then `p` holds for all elements
of the closure of `s`. -/
@[elab_as_eliminator]
lemma closure_induction {s : set R} {p : R → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0) (H1 : p 1)
  (Hadd : ∀ x y, p x → p y → p (x + y)) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, H1, Hmul, H0, Hadd⟩).2 Hs h

lemma mem_closure_iff_exists_list {R} [semiring R] {s : set R} {x} : x ∈ closure s ↔
  ∃ L : list (list R), (∀ t ∈ L, ∀ y ∈ t, y ∈ s) ∧ (L.map list.prod).sum = x :=
⟨λ hx, add_submonoid.closure_induction (mem_closure_iff.1 hx)
  (λ x hx, suffices ∃ t : list R, (∀ y ∈ t, y ∈ s) ∧ t.prod = x,
    from let ⟨t, ht1, ht2⟩ := this in ⟨[t], list.forall_mem_singleton.2 ht1,
      by rw [list.map_singleton, list.sum_singleton, ht2]⟩,
    submonoid.closure_induction hx
      (λ x hx, ⟨[x], list.forall_mem_singleton.2 hx, one_mul x⟩)
      ⟨[], list.forall_mem_nil _, rfl⟩
      (λ x y ⟨t, ht1, ht2⟩ ⟨u, hu1, hu2⟩, ⟨t ++ u, list.forall_mem_append.2 ⟨ht1, hu1⟩,
        by rw [list.prod_append, ht2, hu2]⟩))
  ⟨[], list.forall_mem_nil _, rfl⟩
  (λ x y ⟨L, HL1, HL2⟩ ⟨M, HM1, HM2⟩, ⟨L ++ M, list.forall_mem_append.2 ⟨HL1, HM1⟩,
    by rw [list.map_append, list.sum_append, HL2, HM2]⟩),
λ ⟨L, HL1, HL2⟩, HL2 ▸ list_sum_mem _ (λ r hr, let ⟨t, ht1, ht2⟩ := list.mem_map.1 hr in
  ht2 ▸ list_prod_mem _ (λ y hy, subset_closure $ HL1 t ht1 y hy))⟩

variable (R)

/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : galois_insertion (@closure R _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {R}

/-- Closure of a subsemiring `S` equals `S`. -/
lemma closure_eq (s : subsemiring R) : closure (s : set R) = s := (subsemiring.gi R).l_u_eq s

@[simp] lemma closure_empty : closure (∅ : set R) = ⊥ := (subsemiring.gi R).gc.l_bot

@[simp] lemma closure_univ : closure (set.univ : set R) = ⊤ := @coe_top R _ ▸ closure_eq ⊤

lemma closure_union (s t : set R) : closure (s ∪ t) = closure s ⊔ closure t :=
(subsemiring.gi R).gc.l_sup

lemma closure_Union {ι} (s : ι → set R) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subsemiring.gi R).gc.l_supr

lemma closure_sUnion (s : set (set R)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
(subsemiring.gi R).gc.l_Sup

lemma map_sup (s t : subsemiring R) (f : R →+* S) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : R →+* S) (s : ι → subsemiring R) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : subsemiring S) (f : R →+* S) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_infi {ι : Sort*} (f : R →+* S) (s : ι → subsemiring S) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp] lemma map_bot (f : R →+* S) : (⊥ : subsemiring R).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp] lemma comap_top (f : R →+* S) : (⊤ : subsemiring S).comap f = ⊤ :=
(gc_map_comap f).u_top

/-- Given `subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is `s × t`
as a subsemiring of `R × S`. -/
def prod (s : subsemiring R) (t : subsemiring S) : subsemiring (R × S) :=
{ carrier := (s : set R).prod t,
  .. s.to_submonoid.prod t.to_submonoid, .. s.to_add_submonoid.prod t.to_add_submonoid}

@[norm_cast]
lemma coe_prod (s : subsemiring R) (t : subsemiring S) :
  (s.prod t : set (R × S)) = (s : set R).prod (t : set S) :=
rfl

lemma mem_prod {s : subsemiring R} {t : subsemiring S} {p : R × S} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[mono] lemma prod_mono ⦃s₁ s₂ : subsemiring R⦄ (hs : s₁ ≤ s₂) ⦃t₁ t₂ : subsemiring S⦄
  (ht : t₁ ≤ t₂) : s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

lemma prod_mono_right (s : subsemiring R) : monotone (λ t : subsemiring S, s.prod t) :=
prod_mono (le_refl s)

lemma prod_mono_left (t : subsemiring S) : monotone (λ s : subsemiring R, s.prod t) :=
λ s₁ s₂ hs, prod_mono hs (le_refl t)

lemma prod_top (s : subsemiring R) :
  s.prod (⊤ : subsemiring S) = s.comap (ring_hom.fst R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

lemma top_prod (s : subsemiring S) :
  (⊤ : subsemiring R).prod s = s.comap (ring_hom.snd R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp]
lemma top_prod_top : (⊤ : subsemiring R).prod (⊤ : subsemiring S) = ⊤ :=
(top_prod _).trans $ comap_top _

/-- Product of subsemirings is isomorphic to their product as monoids. -/
def prod_equiv (s : subsemiring R) (t : subsemiring S) : s.prod t ≃+* s × t :=
{ map_mul' := λ x y, rfl, map_add' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subsemiring R} (hS : directed (≤) S)
  {x : R} :
  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  let U : subsemiring R := subsemiring.mk' (⋃ i, (S i : set R))
    (⨆ i, (S i).to_submonoid) (submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id))
    (⨆ i, (S i).to_add_submonoid) (add_submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id)),
  suffices : (⨆ i, S i) ≤ U, by simpa using @this x,
  exact supr_le (λ i x hx, set.mem_Union.2 ⟨i, hx⟩),
end

lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subsemiring R} (hS : directed (≤) S) :
  ((⨆ i, S i : subsemiring R) : set R) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

lemma mem_Sup_of_directed_on {S : set (subsemiring R)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : R} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

lemma coe_Sup_of_directed_on {S : set (subsemiring R)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set R) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

end subsemiring

namespace ring_hom

variables [non_assoc_semiring T] {s : subsemiring R}

open subsemiring

/-- Restriction of a ring homomorphism to a subsemiring of the domain. -/
def srestrict (f : R →+* S) (s : subsemiring R) : s →+* S := f.comp s.subtype

@[simp] lemma srestrict_apply (f : R →+* S) (x : s) : f.srestrict s x = f x := rfl

/-- Restriction of a ring homomorphism to a subsemiring of the codomain. -/
def cod_srestrict (f : R →+* S) (s : subsemiring S) (h : ∀ x, f x ∈ s) : R →+* s :=
{ to_fun := λ n, ⟨f n, h n⟩,
  .. (f : R →* S).cod_mrestrict s.to_submonoid h,
  .. (f : R →+ S).cod_mrestrict s.to_add_submonoid h }

/-- Restriction of a ring homomorphism to its range interpreted as a subsemiring.

This is the bundled version of `set.range_factorization`. -/
def srange_restrict (f : R →+* S) : R →+* f.srange :=
f.cod_srestrict f.srange f.mem_srange_self

@[simp] lemma coe_srange_restrict (f : R →+* S) (x : R) :
  (f.srange_restrict x : S) = f x :=
rfl

lemma srange_restrict_surjective (f : R →+* S) : function.surjective f.srange_restrict :=
λ ⟨y, hy⟩, let ⟨x, hx⟩ := mem_srange.mp hy in ⟨x, subtype.ext hx⟩

lemma srange_top_iff_surjective {f : R →+* S} :
  f.srange = (⊤ : subsemiring S) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_srange, coe_top]) set.range_iff_surjective

/-- The range of a surjective ring homomorphism is the whole of the codomain. -/
lemma srange_top_of_surjective (f : R →+* S) (hf : function.surjective f) :
  f.srange = (⊤ : subsemiring S) :=
srange_top_iff_surjective.2 hf

/-- The subsemiring of elements `x : R` such that `f x = g x` -/
def eq_slocus (f g : R →+* S) : subsemiring R :=
{ carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_mlocus g }

/-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/
lemma eq_on_sclosure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_slocus g, from closure_le.2 h

lemma eq_of_eq_on_stop {f g : R →+* S} (h : set.eq_on f g (⊤ : subsemiring R)) :
  f = g :=
ext $ λ x, h trivial

lemma eq_of_eq_on_sdense {s : set R} (hs : closure s = ⊤) {f g : R →+* S} (h : s.eq_on f g) :
  f = g :=
eq_of_eq_on_stop $ hs ▸ eq_on_sclosure h

lemma sclosure_preimage_le (f : R →+* S) (s : set S) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a ring homomorphism of the subsemiring generated by a set equals
the subsemiring generated by the image of the set. -/
lemma map_sclosure (f : R →+* S) (s : set R) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (sclosure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

end ring_hom

namespace subsemiring

open ring_hom

/-- The ring homomorphism associated to an inclusion of subsemirings. -/
def inclusion {S T : subsemiring R} (h : S ≤ T) : S →* T :=
S.subtype.cod_srestrict _ (λ x, h x.2)

@[simp] lemma srange_subtype (s : subsemiring R) : s.subtype.srange = s :=
set_like.coe_injective $ (coe_srange _).trans subtype.range_coe

@[simp]
lemma range_fst : (fst R S).srange = ⊤ :=
(fst R S).srange_top_of_surjective $ prod.fst_surjective

@[simp]
lemma range_snd : (snd R S).srange = ⊤ :=
(snd R S).srange_top_of_surjective $ prod.snd_surjective

@[simp]
lemma prod_bot_sup_bot_prod (s : subsemiring R) (t : subsemiring S) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono_right s bot_le) (prod_mono_left t bot_le)) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem _
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set_like.mem_coe.2 $ one_mem ⊥⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set_like.mem_coe.2 $ one_mem ⊥, hp.2⟩)

end subsemiring

namespace ring_equiv

variables {s t : subsemiring R}

/-- Makes the identity isomorphism from a proof two subsemirings of a multiplicative
    monoid are equal. -/
def subsemiring_congr (h : s = t) : s ≃+* t :=
{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

/-- Restrict a ring homomorphism with a left inverse to a ring isomorphism to its
`ring_hom.srange`. -/
def sof_left_inverse {g : S → R} {f : R →+* S} (h : function.left_inverse g f) :
  R ≃+* f.srange :=
{ to_fun := λ x, f.srange_restrict x,
  inv_fun := λ x, (g ∘ f.srange.subtype) x,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := ring_hom.mem_srange.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  ..f.srange_restrict }

@[simp] lemma sof_left_inverse_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : R) :
  ↑(sof_left_inverse h x) = f x := rfl

@[simp] lemma sof_left_inverse_symm_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : f.srange) :
  (sof_left_inverse h).symm x = g x := rfl

end ring_equiv

/-! ### Actions by `subsemiring`s

These are just copies of the definitions about `submonoid` starting from `submonoid.mul_action`.
The only new result is `subsemiring.module`.

When `R` is commutative, `algebra.of_subsemiring` provides a stronger result than those found in
this file, which uses the same scalar action.
-/
section actions

namespace subsemiring

variables {R' α β : Type*} [semiring R']

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [mul_action R' α] (S : subsemiring R') : mul_action S α :=
S.to_submonoid.mul_action

lemma smul_def [mul_action R' α] {S : subsemiring R'} (g : S) (m : α) : g • m = (g : R') • m := rfl

instance smul_comm_class_left
  [mul_action R' β] [has_scalar α β] [smul_comm_class R' α β] (S : subsemiring R') :
  smul_comm_class S α β :=
S.to_submonoid.smul_comm_class_left

instance smul_comm_class_right
  [has_scalar α β] [mul_action R' β] [smul_comm_class α R' β] (S : subsemiring R') :
  smul_comm_class α S β :=
S.to_submonoid.smul_comm_class_right

/-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/
instance
  [has_scalar α β] [mul_action R' α] [mul_action R' β] [is_scalar_tower R' α β]
  (S : subsemiring R') :
  is_scalar_tower S α β :=
S.to_submonoid.is_scalar_tower

instance [mul_action R' α] [has_faithful_scalar R' α] (S : subsemiring R') :
  has_faithful_scalar S α :=
S.to_submonoid.has_faithful_scalar

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [add_monoid α] [distrib_mul_action R' α] (S : subsemiring R') : distrib_mul_action S α :=
S.to_submonoid.distrib_mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [monoid α] [mul_distrib_mul_action R' α] (S : subsemiring R') :
  mul_distrib_mul_action S α :=
S.to_submonoid.mul_distrib_mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [add_comm_monoid α] [module R' α] (S : subsemiring R') : module S α :=
{ smul := (•), .. module.comp_hom _ S.subtype }

end subsemiring

end actions

-- While this definition is not about `subsemiring`s, this is the earliest we have
-- both `ordered_semiring` and `submonoid` available.

/-- Submonoid of positive elements of an ordered semiring. -/
def pos_submonoid (R : Type*) [ordered_semiring R] [nontrivial R] : submonoid R :=
{ carrier := {x | 0 < x},
  one_mem' := show (0 : R) < 1, from zero_lt_one,
  mul_mem' := λ x y (hx : 0 < x) (hy : 0 < y), mul_pos hx hy }

@[simp] lemma mem_pos_monoid {R : Type*} [ordered_semiring R] [nontrivial R] (u : units R) :
  ↑u ∈ pos_submonoid R ↔ (0 : R) < u := iff.rfl


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

! This file was ported from Lean 3 source module data.zmod.defs
! leanprover-community/mathlib commit 1126441d6bccf98c81214a0780c73d499f6721fe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.NeZero
import Mathlib.Data.Nat.ModEq
import Mathlib.Data.Fintype.Lattice

/-!
# Definition of `ZMod n` + basic results.

This file provides the basic details of `ZMod n`, including its commutative ring structure.

## Implementation details

This used to be inlined into `Data.ZMod.Basic`. This file imports `CharP.Basic`, which is an
issue; all `CharP` instances create an `Algebra (ZMod p) R` instance; however, this instance may
not be definitionally equal to other `Algebra` instances (for example, `GaloisField` also has an
`Algebra` instance as it is defined as a `SplittingField`). The way to fix this is to use the
forgetful inheritance pattern, and make `CharP` carry the data of what the `smul` should be (so
for example, the `smul` on the `GaloisField` `CharP` instance should be equal to the `smul` from
its `SplittingField` structure); there is only one possible `ZMod p` algebra for any `p`, so this
is not an issue mathematically. For this to be possible, however, we need `CharP.Basic` to be
able to import some part of `ZMod`.

-/

namespace Fin

/-!
## Ring structure on `Fin n`

We define a commutative ring structure on `Fin n`.
Afterwords, when we define `ZMod n` in terms of `Fin n`, we use these definitions
to register the ring structure on `ZMod n` as type class instance.
-/

open Nat.ModEq Int

/-- Multiplicative commutative semigroup structure on `fin n`. -/
instance (n : ℕ) : CommSemigroup (Fin n) :=
  { inferInstanceAs (Mul (Fin n)) with
    mul_assoc := fun ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩ =>
      Fin.eq_of_veq <|
        calc
          a * b % n * c ≡ a * b * c [MOD n] := (Nat.mod_modEq _ _).mul_right _
          _ ≡ a * (b * c) [MOD n] := by rw [mul_assoc]
          _ ≡ a * (b * c % n) [MOD n] := (Nat.mod_modEq _ _).symm.mul_left _
    mul_comm := Fin.mul_comm }

private theorem left_distrib_aux (n : ℕ) : ∀ a b c : Fin n, a * (b + c) = a * b + a * c :=
  fun ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩ =>
  Fin.eq_of_veq <|
    calc
      a * ((b + c) % n) ≡ a * (b + c) [MOD n] := (Nat.mod_modEq _ _).mul_left _
      _ ≡ a * b + a * c [MOD n] := by rw [mul_add]
      _ ≡ a * b % n + a * c % n [MOD n] := (Nat.mod_modEq _ _).symm.add (Nat.mod_modEq _ _).symm

/-- Commutative ring structure on `Fin n`. -/
instance (n : ℕ) [NeZero n] : CommRing (Fin n) :=
  { Fin.instAddMonoidWithOneFin n, Fin.addCommGroup n,
    Fin.instCommSemigroupFin n with
    one_mul := Fin.one_mul
    mul_one := Fin.mul_one
    left_distrib := left_distrib_aux n
    right_distrib := fun a b c => by
      rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm],
    -- porting note: new, see
    -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/ring.20vs.20Ring/near/322876462
    zero_mul := Fin.zero_mul
    mul_zero := Fin.mul_zero }

end Fin

/-- The integers modulo `n : ℕ`. -/
def ZMod : ℕ → Type
  | 0 => ℤ
  | n + 1 => Fin (n + 1)
#align zmod ZMod

instance ZMod.decidableEq : ∀ n : ℕ, DecidableEq (ZMod n)
  | 0 => inferInstanceAs (DecidableEq ℤ)
  | n + 1 => inferInstanceAs (DecidableEq (Fin (n + 1)))
#align zmod.decidable_eq ZMod.decidableEq

instance ZMod.repr : ∀ n : ℕ, Repr (ZMod n)
  | 0 => by dsimp [ZMod]; infer_instance
  | n + 1 => by dsimp [ZMod]; infer_instance
#align zmod.has_repr ZMod.repr

namespace ZMod

instance fintype : ∀ (n : ℕ) [NeZero n], Fintype (ZMod n)
  | 0, h => (h.ne rfl).elim
  | n + 1, _ => Fin.fintype (n + 1)
#align zmod.fintype ZMod.fintype

instance infinite : Infinite (ZMod 0) :=
  Int.infinite
#align zmod.infinite ZMod.infinite

@[simp]
theorem card (n : ℕ) [Fintype (ZMod n)] : Fintype.card (ZMod n) = n := by
  cases n with
  | zero => exact (not_finite (ZMod 0)).elim
  | succ n => convert Fintype.card_fin (n + 1) using 2
#align zmod.card ZMod.card

/- We define each field by cases, to ensure that the eta-expanded `ZMod.commRing` is defeq to the
original, this helps avoid diamonds with instances coming from classes extending `CommRing` such as
field. -/
instance commRing (n : ℕ) : CommRing (ZMod n) where
  add := Nat.casesOn n (@Add.add Int _) fun n => @Add.add (Fin n.succ) _
  add_assoc := Nat.casesOn n (@add_assoc Int _) fun n => @add_assoc (Fin n.succ) _
  zero := Nat.casesOn n (0 : Int) fun n => (0 : Fin n.succ)
  zero_add := Nat.casesOn n (@zero_add Int _) fun n => @zero_add (Fin n.succ) _
  add_zero := Nat.casesOn n (@add_zero Int _) fun n => @add_zero (Fin n.succ) _
  neg := Nat.casesOn n (@Neg.neg Int _) fun n => @Neg.neg (Fin n.succ) _
  sub := Nat.casesOn n (@Sub.sub Int _) fun n => @Sub.sub (Fin n.succ) _
  sub_eq_add_neg := Nat.casesOn n (@sub_eq_add_neg Int _) fun n => @sub_eq_add_neg (Fin n.succ) _
  zsmul := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).zsmul fun n => (inferInstanceAs (CommRing (Fin n.succ))).zsmul
  zsmul_zero' := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).zsmul_zero'
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).zsmul_zero'
  zsmul_succ' := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).zsmul_succ'
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).zsmul_succ'
  zsmul_neg' := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).zsmul_neg'
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).zsmul_neg'
  nsmul := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).nsmul fun n => (inferInstanceAs (CommRing (Fin n.succ))).nsmul
  nsmul_zero := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).nsmul_zero
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).nsmul_zero
  nsmul_succ := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).nsmul_succ
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).nsmul_succ
  -- porting note: `match` didn't work here
  add_left_neg := Nat.casesOn n (@add_left_neg Int _) fun n => @add_left_neg (Fin n.succ) _
  add_comm := Nat.casesOn n (@add_comm Int _) fun n => @add_comm (Fin n.succ) _
  mul := Nat.casesOn n (@Mul.mul Int _) fun n => @Mul.mul (Fin n.succ) _
  mul_assoc := Nat.casesOn n (@mul_assoc Int _) fun n => @mul_assoc (Fin n.succ) _
  one := Nat.casesOn n (1 : Int) fun n => (1 : Fin n.succ)
  one_mul := Nat.casesOn n (@one_mul Int _) fun n => @one_mul (Fin n.succ) _
  mul_one := Nat.casesOn n (@mul_one Int _) fun n => @mul_one (Fin n.succ) _
  natCast := Nat.casesOn n ((↑) : ℕ → ℤ) fun n => ((↑) : ℕ → Fin n.succ)
  natCast_zero := Nat.casesOn n (@Nat.cast_zero Int _) fun n => @Nat.cast_zero (Fin n.succ) _
  natCast_succ := Nat.casesOn n (@Nat.cast_succ Int _) fun n => @Nat.cast_succ (Fin n.succ) _
  intCast := Nat.casesOn n ((↑) : ℤ → ℤ) fun n => ((↑) : ℤ → Fin n.succ)
  intCast_ofNat := Nat.casesOn n (@Int.cast_ofNat Int _) fun n => @Int.cast_ofNat (Fin n.succ) _
  intCast_negSucc :=
    Nat.casesOn n (@Int.cast_negSucc Int _) fun n => @Int.cast_negSucc (Fin n.succ) _
  left_distrib := Nat.casesOn n (@left_distrib Int _ _ _) fun n => @left_distrib (Fin n.succ) _ _ _
  right_distrib :=
    Nat.casesOn n (@right_distrib Int _ _ _) fun n => @right_distrib (Fin n.succ) _ _ _
  mul_comm := Nat.casesOn n (@mul_comm Int _) fun n => @mul_comm (Fin n.succ) _
  -- porting note: new, see
  -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/ring.20vs.20Ring/near/322876462
  zero_mul := Nat.casesOn n (@zero_mul Int _) fun n => @zero_mul (Fin n.succ) _
  mul_zero := Nat.casesOn n (@mul_zero Int _) fun n => @mul_zero (Fin n.succ) _
  -- porting note: all npow fields are new, but probably should be backported
  npow := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).npow fun n => (inferInstanceAs (CommRing (Fin n.succ))).npow
  npow_zero := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).npow_zero
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).npow_zero
  npow_succ := Nat.casesOn n
    (inferInstanceAs (CommRing ℤ)).npow_succ
    fun n => (inferInstanceAs (CommRing (Fin n.succ))).npow_succ
#align zmod.comm_ring ZMod.commRing

instance inhabited (n : ℕ) : Inhabited (ZMod n) :=
  ⟨0⟩
#align zmod.inhabited ZMod.inhabited

end ZMod


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

/-!
# Basic properties of group actions
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

open_locale big_operators
open function

namespace mul_action

variables (α) [monoid α] [mul_action α β]

/-- The orbit of an element under an action. -/
def orbit (b : β) := set.range (λ x : α, x • b)

variable {α}

lemma mem_orbit_iff {b₁ b₂ : β} : b₂ ∈ orbit α b₁ ↔ ∃ x : α, x • b₁ = b₂ :=
iff.rfl

@[simp] lemma mem_orbit (b : β) (x : α) : x • b ∈ orbit α b :=
⟨x, rfl⟩

@[simp] lemma mem_orbit_self (b : β) : b ∈ orbit α b :=
⟨1, by simp [mul_action.one_smul]⟩

variables (α) (β)

/-- The set of elements fixed under the whole action. -/
def fixed_points : set β := {b : β | ∀ x : α, x • b = b}

/-- `fixed_by g` is the subfield of elements fixed by `g`. -/
def fixed_by (g : α) : set β :=
{ x | g • x = x }

theorem fixed_eq_Inter_fixed_by : fixed_points α β = ⋂ g : α, fixed_by α β g :=
set.ext $ λ x, ⟨λ hx, set.mem_Inter.2 $ λ g, hx g, λ hx g, by exact (set.mem_Inter.1 hx g : _)⟩

variables {α} (β)

@[simp] lemma mem_fixed_points {b : β} :
  b ∈ fixed_points α β ↔ ∀ x : α, x • b = b := iff.rfl

@[simp] lemma mem_fixed_by {g : α} {b : β} :
  b ∈ fixed_by α β g ↔ g • b = b := iff.rfl

lemma mem_fixed_points' {b : β} : b ∈ fixed_points α β ↔
  (∀ b', b' ∈ orbit α b → b' = b) :=
⟨λ h b h₁, let ⟨x, hx⟩ := mem_orbit_iff.1 h₁ in hx ▸ h x,
λ h b, h _ (mem_orbit _ _)⟩

variables (α) {β}

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
def stabilizer.submonoid (b : β) : submonoid α :=
{ carrier := { a | a • b = b },
  one_mem' := one_smul _ b,
  mul_mem' := λ a a' (ha : a • b = b) (hb : a' • b = b),
    show (a * a') • b = b, by rw [←smul_smul, hb, ha] }

@[simp] lemma mem_stabilizer_submonoid_iff {b : β} {a : α} :
  a ∈ stabilizer.submonoid α b ↔ a • b = b := iff.rfl

end mul_action

namespace mul_action
variable (α)
variables [group α] [mul_action α β]

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
def stabilizer (b : β) : subgroup α :=
{ inv_mem' := λ a (ha : a • b = b), show a⁻¹ • b = b, by rw [inv_smul_eq_iff, ha]
  ..stabilizer.submonoid α b }

variables {α} {β}

@[simp] lemma mem_stabilizer_iff {b : β} {a : α} :
  a ∈ stabilizer α b ↔ a • b = b := iff.rfl

lemma orbit_eq_iff {a b : β} :
   orbit α a = orbit α b ↔ a ∈ orbit α b:=
⟨λ h, h ▸ mem_orbit_self _,
λ ⟨x, (hx : x • b = a)⟩, set.ext (λ c, ⟨λ ⟨y, (hy : y • a = c)⟩, ⟨y * x,
  show (y * x) • b = c, by rwa [mul_action.mul_smul, hx]⟩,
  λ ⟨y, (hy : y • b = c)⟩, ⟨y * x⁻¹,
    show (y * x⁻¹) • a = c, by
      conv {to_rhs, rw [← hy, ← mul_one y, ← inv_mul_self x, ← mul_assoc,
        mul_action.mul_smul, hx]}⟩⟩)⟩

variables (α) {β}

@[simp] lemma mem_orbit_smul (g : α) (a : β) : a ∈ orbit α (g • a) :=
⟨g⁻¹, by simp⟩

@[simp] lemma smul_mem_orbit_smul (g h : α) (a : β) : g • a ∈ orbit α (h • a) :=
⟨g * h⁻¹, by simp [mul_smul]⟩

variables (α) (β)
/-- The relation "in the same orbit". -/
def orbit_rel : setoid β :=
{ r := λ a b, a ∈ orbit α b,
  iseqv := ⟨mem_orbit_self, λ a b, by simp [orbit_eq_iff.symm, eq_comm],
    λ a b, by simp [orbit_eq_iff.symm, eq_comm] {contextual := tt}⟩ }

variables {α β}

open quotient_group

/-- Action on left cosets. -/
def mul_left_cosets (H : subgroup α)
  (x : α) (y : quotient H) : quotient H :=
quotient.lift_on' y (λ y, quotient_group.mk ((x : α) * y))
  (λ a b (hab : _ ∈ H), quotient_group.eq.2
    (by rwa [mul_inv_rev, ← mul_assoc, mul_assoc (a⁻¹), inv_mul_self, mul_one]))

instance quotient (H : subgroup α) : mul_action α (quotient H) :=
{ smul := mul_left_cosets H,
  one_smul := λ a, quotient.induction_on' a (λ a, quotient_group.eq.2
    (by simp [subgroup.one_mem])),
  mul_smul := λ x y a, quotient.induction_on' a (λ a, quotient_group.eq.2
    (by simp [mul_inv_rev, subgroup.one_mem, mul_assoc])) }

@[simp] lemma quotient.smul_mk (H : subgroup α) (a x : α) :
  (a • quotient_group.mk x : quotient_group.quotient H) = quotient_group.mk (a * x) := rfl

@[simp] lemma quotient.smul_coe (H : subgroup α) (a x : α) :
  (a • x : quotient_group.quotient H) = ↑(a * x) := rfl

instance mul_left_cosets_comp_subtype_val (H I : subgroup α) :
  mul_action I (quotient H) :=
mul_action.comp_hom (quotient H) (subgroup.subtype I)

variables (α) {β} (x : β)

/-- The canonical map from the quotient of the stabilizer to the set. -/
def of_quotient_stabilizer (g : quotient (mul_action.stabilizer α x)) : β :=
quotient.lift_on' g (•x) $ λ g1 g2 H,
calc  g1 • x
    = g1 • (g1⁻¹ * g2) • x : congr_arg _ H.symm
... = g2 • x : by rw [smul_smul, mul_inv_cancel_left]

@[simp] theorem of_quotient_stabilizer_mk (g : α) :
  of_quotient_stabilizer α x (quotient_group.mk g) = g • x :=
rfl

theorem of_quotient_stabilizer_mem_orbit (g) : of_quotient_stabilizer α x g ∈ orbit α x :=
quotient.induction_on' g $ λ g, ⟨g, rfl⟩

theorem of_quotient_stabilizer_smul (g : α) (g' : quotient (mul_action.stabilizer α x)) :
  of_quotient_stabilizer α x (g • g') = g • of_quotient_stabilizer α x g' :=
quotient.induction_on' g' $ λ _, mul_smul _ _ _

theorem injective_of_quotient_stabilizer : function.injective (of_quotient_stabilizer α x) :=
λ y₁ y₂, quotient.induction_on₂' y₁ y₂ $ λ g₁ g₂ (H : g₁ • x = g₂ • x), quotient.sound' $
show (g₁⁻¹ * g₂) • x = x, by rw [mul_smul, ← H, inv_smul_smul]

/-- Orbit-stabilizer theorem. -/
noncomputable def orbit_equiv_quotient_stabilizer (b : β) :
  orbit α b ≃ quotient (stabilizer α b) :=
equiv.symm $ equiv.of_bijective
  (λ g, ⟨of_quotient_stabilizer α b g, of_quotient_stabilizer_mem_orbit α b g⟩)
  ⟨λ x y hxy, injective_of_quotient_stabilizer α b (by convert congr_arg subtype.val hxy),
  λ ⟨b, ⟨g, hgb⟩⟩, ⟨g, subtype.eq hgb⟩⟩

@[simp] theorem orbit_equiv_quotient_stabilizer_symm_apply (b : β) (a : α) :
  ((orbit_equiv_quotient_stabilizer α b).symm a : β) = a • b :=
rfl

@[simp] lemma stabilizer_quotient {G} [group G] (H : subgroup G) :
  mul_action.stabilizer G ((1 : G) : quotient H) = H :=
by { ext, simp [quotient_group.eq] }

end mul_action

section
variables [monoid α] [add_monoid β] [distrib_mul_action α β]

lemma list.smul_sum {r : α} {l : list β} :
  r • l.sum = (l.map ((•) r)).sum :=
(const_smul_hom β r).map_list_sum l

end

section
variables [monoid α] [add_comm_monoid β] [distrib_mul_action α β]

lemma multiset.smul_sum {r : α} {s : multiset β} :
  r • s.sum = (s.map ((•) r)).sum :=
(const_smul_hom β r).map_multiset_sum s

lemma finset.smul_sum {r : α} {f : γ → β} {s : finset γ} :
  r • ∑ x in s, f x = ∑ x in s, r • f x :=
(const_smul_hom β r).map_sum f s

end

/-- `G` acts pretransitively on `X` if for any `x y` there is `g` such that `g • x = y`.
  A transitive action should furthermore have `X` nonempty. -/
class is_pretransitive (G X) [monoid G] [mul_action G X] : Prop :=
(exists_smul_eq : ∀ x y : X, ∃ g : G, g • x = y)

lemma exists_smul_eq (M) {X} [monoid M] [mul_action M X] [is_pretransitive M X] (x y : X) :
  ∃ m : M, m • x = y := is_pretransitive.exists_smul_eq x y

instance is_pretransitive_quotient (G) [group G] (H : subgroup G) :
  is_pretransitive G (quotient_group.quotient H) :=
{ exists_smul_eq := begin
    rintros ⟨x⟩ ⟨y⟩,
    refine ⟨y * x⁻¹, quotient_group.eq.mpr _⟩,
    simp only [H.one_mem, mul_left_inv, inv_mul_cancel_right],
  end }


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Jeremy Avigad

The order relation on the integers. We show that int is an instance of linear_comm_ordered_ring
and transfer the results.
-/
import .basic algebra.ordered_ring
open nat
open decidable
open int eq.ops

namespace int

private definition nonneg (a : ℤ) : Prop := int.cases_on a (take n, true) (take n, false)
protected definition le (a b : ℤ) : Prop := nonneg (b - a)

definition int_has_le [instance] [priority int.prio]: has_le int :=
has_le.mk int.le

protected definition lt (a b : ℤ) : Prop := (a + 1) ≤ b

definition int_has_lt [instance] [priority int.prio]: has_lt int :=
has_lt.mk int.lt

local attribute nonneg [reducible]
private definition decidable_nonneg [instance] (a : ℤ) : decidable (nonneg a) := int.cases_on a _ _
definition decidable_le [instance] (a b : ℤ) : decidable (a ≤ b) := decidable_nonneg _
definition decidable_lt [instance] (a b : ℤ) : decidable (a < b) := decidable_nonneg _

private theorem nonneg.elim {a : ℤ} : nonneg a → ∃n : ℕ, a = n :=
int.cases_on a (take n H, exists.intro n rfl) (take n', false.elim)

private theorem nonneg_or_nonneg_neg (a : ℤ) : nonneg a ∨ nonneg (-a) :=
int.cases_on a (take n, or.inl trivial) (take n, or.inr trivial)

theorem le.intro {a b : ℤ} {n : ℕ} (H : a + n = b) : a ≤ b :=
have n = b - a, from eq_add_neg_of_add_eq (begin rewrite [add.comm, H] end), -- !add.comm ▸ H),
show nonneg (b - a), from this ▸ trivial

theorem le.elim {a b : ℤ} (H : a ≤ b) : ∃n : ℕ, a + n = b :=
obtain (n : ℕ) (H1 : b - a = n), from nonneg.elim H,
exists.intro n (!add.comm ▸ iff.mpr !add_eq_iff_eq_add_neg (H1⁻¹))

protected theorem le_total (a b : ℤ) : a ≤ b ∨ b ≤ a :=
or.imp_right
  (assume H : nonneg (-(b - a)),
   have -(b - a) = a - b, from !neg_sub,
   show nonneg (a - b), from this ▸ H)
  (nonneg_or_nonneg_neg (b - a))

theorem of_nat_le_of_nat_of_le {m n : ℕ} (H : #nat m ≤ n) : of_nat m ≤ of_nat n :=
obtain (k : ℕ) (Hk : m + k = n), from nat.le.elim H,
le.intro (Hk ▸ (of_nat_add m k)⁻¹)

theorem le_of_of_nat_le_of_nat {m n : ℕ} (H : of_nat m ≤ of_nat n) : (#nat m ≤ n) :=
obtain (k : ℕ) (Hk : of_nat m + of_nat k = of_nat n), from le.elim H,
have m + k = n, from of_nat.inj (of_nat_add m k ⬝ Hk),
nat.le.intro this

theorem of_nat_le_of_nat_iff (m n : ℕ) : of_nat m ≤ of_nat n ↔ m ≤ n :=
iff.intro le_of_of_nat_le_of_nat of_nat_le_of_nat_of_le

theorem lt_add_succ (a : ℤ) (n : ℕ) : a < a + succ n :=
le.intro (show a + 1 + n = a + succ n, from
  calc
    a + 1 + n = a + (1 + n) : add.assoc
      ... = a + (n + 1)     : by rewrite (int.add_comm 1 n)
      ... = a + succ n      : rfl)

theorem lt.intro {a b : ℤ} {n : ℕ} (H : a + succ n = b) : a < b :=
H ▸ lt_add_succ a n

theorem lt.elim {a b : ℤ} (H : a < b) : ∃n : ℕ, a + succ n = b :=
obtain (n : ℕ) (Hn : a + 1 + n = b), from le.elim H,
have a + succ n = b, from
  calc
    a + succ n = a + 1 + n : by rewrite [add.assoc, int.add_comm 1 n]
           ... = b         : Hn,
exists.intro n this

theorem of_nat_lt_of_nat_iff (n m : ℕ) : of_nat n < of_nat m ↔ n < m :=
calc
  of_nat n < of_nat m ↔ of_nat n + 1 ≤ of_nat m : iff.refl
    ... ↔ of_nat (nat.succ n) ≤ of_nat m        : of_nat_succ n ▸ !iff.refl
    ... ↔ nat.succ n ≤ m                        : of_nat_le_of_nat_iff
    ... ↔ n < m                                 : iff.symm (lt_iff_succ_le _ _)

theorem lt_of_of_nat_lt_of_nat {m n : ℕ} (H : of_nat m < of_nat n) : #nat m < n :=
iff.mp !of_nat_lt_of_nat_iff H

theorem of_nat_lt_of_nat_of_lt {m n : ℕ} (H : #nat m < n) : of_nat m < of_nat n :=
iff.mpr !of_nat_lt_of_nat_iff H

/- show that the integers form an ordered additive group -/

protected theorem le_refl (a : ℤ) : a ≤ a :=
le.intro (add_zero a)

protected theorem le_trans {a b c : ℤ} (H1 : a ≤ b) (H2 : b ≤ c) : a ≤ c :=
obtain (n : ℕ) (Hn : a + n = b), from le.elim H1,
obtain (m : ℕ) (Hm : b + m = c), from le.elim H2,
have a + of_nat (n + m) = c, from
  calc
    a + of_nat (n + m) = a + (of_nat n + m) : {of_nat_add n m}
      ... = a + n + m : (add.assoc a n m)⁻¹
      ... = b + m : {Hn}
      ... = c : Hm,
le.intro this

protected theorem le_antisymm : ∀ {a b : ℤ}, a ≤ b → b ≤ a → a = b :=
take a b : ℤ, assume (H₁ : a ≤ b) (H₂ : b ≤ a),
obtain (n : ℕ) (Hn : a + n = b), from le.elim H₁,
obtain (m : ℕ) (Hm : b + m = a), from le.elim H₂,
have a + of_nat (n + m) = a + 0, from
  calc
    a + of_nat (n + m) = a + (of_nat n + m) : by rewrite of_nat_add
      ... = a + n + m                       : by rewrite add.assoc
      ... = b + m                           : by rewrite Hn
      ... = a                               : by rewrite Hm
      ... = a + 0                           : by rewrite add_zero,
have of_nat (n + m) = of_nat 0, from add.left_cancel this,
have n + m = 0,                 from of_nat.inj this,
have n = 0,                     from nat.eq_zero_of_add_eq_zero_right this,
show a = b, from
  calc
    a = a + 0    : add_zero
  ... = a + n    : by rewrite this
  ... = b        : Hn

protected theorem lt_irrefl (a : ℤ) : ¬ a < a :=
(suppose a < a,
  obtain (n : ℕ) (Hn : a + succ n = a), from lt.elim this,
  have a + succ n = a + 0, from
    Hn ⬝ !add_zero⁻¹,
  !succ_ne_zero (of_nat.inj (add.left_cancel this)))

protected theorem ne_of_lt {a b : ℤ} (H : a < b) : a ≠ b :=
(suppose a = b, absurd (this ▸ H) (int.lt_irrefl b))

theorem le_of_lt {a b : ℤ} (H : a < b) : a ≤ b :=
obtain (n : ℕ) (Hn : a + succ n = b), from lt.elim H,
le.intro Hn

protected theorem lt_iff_le_and_ne (a b : ℤ) : a < b ↔ (a ≤ b ∧ a ≠ b) :=
iff.intro
  (assume H, and.intro (le_of_lt H) (int.ne_of_lt H))
  (assume H,
    have a ≤ b, from and.elim_left H,
    have a ≠ b, from and.elim_right H,
    obtain (n : ℕ) (Hn : a + n = b), from le.elim `a ≤ b`,
    have n ≠ 0, from (assume H' : n = 0, `a ≠ b` (!add_zero ▸ H' ▸ Hn)),
    obtain (k : ℕ) (Hk : n = nat.succ k), from nat.exists_eq_succ_of_ne_zero this,
    lt.intro (Hk ▸ Hn))

protected theorem le_iff_lt_or_eq (a b : ℤ) : a ≤ b ↔ (a < b ∨ a = b) :=
iff.intro
  (assume H,
    by_cases
      (suppose a = b, or.inr this)
      (suppose a ≠ b,
        obtain (n : ℕ) (Hn : a + n = b), from le.elim H,
        have n ≠ 0, from (assume H' : n = 0, `a ≠ b` (!add_zero ▸ H' ▸ Hn)),
        obtain (k : ℕ) (Hk : n = nat.succ k), from nat.exists_eq_succ_of_ne_zero this,
        or.inl (lt.intro (Hk ▸ Hn))))
  (assume H,
    or.elim H
      (assume H1, le_of_lt H1)
      (assume H1, H1 ▸ !int.le_refl))

theorem lt_succ (a : ℤ) : a < a + 1 :=
int.le_refl (a + 1)

protected theorem add_le_add_left {a b : ℤ} (H : a ≤ b) (c : ℤ) : c + a ≤ c + b :=
obtain (n : ℕ) (Hn : a + n = b), from le.elim H,
have H2 : c + a + n = c + b, from
  calc
    c + a + n = c + (a + n) : add.assoc c a n
      ... = c + b : {Hn},
le.intro H2

protected theorem add_lt_add_left {a b : ℤ} (H : a < b) (c : ℤ) : c + a < c + b :=
let H' := le_of_lt H in
(iff.mpr (int.lt_iff_le_and_ne _ _)) (and.intro (int.add_le_add_left H' _)
                                  (take Heq, let Heq' := add_left_cancel Heq in
                                   !int.lt_irrefl (Heq' ▸ H)))

protected theorem mul_nonneg {a b : ℤ} (Ha : 0 ≤ a) (Hb : 0 ≤ b) : 0 ≤ a * b :=
obtain (n : ℕ) (Hn : 0 + n = a), from le.elim Ha,
obtain (m : ℕ) (Hm : 0 + m = b), from le.elim Hb,
le.intro
  (eq.symm
    (calc
      a * b = (0 + n) * b : by rewrite Hn
        ... = n * b       : by rewrite zero_add
        ... = n * (0 + m) : by rewrite Hm
        ... = n * m       : by rewrite zero_add
        ... = 0 + n * m   : by rewrite zero_add))

protected theorem mul_pos {a b : ℤ} (Ha : 0 < a) (Hb : 0 < b) : 0 < a * b :=
obtain (n : ℕ) (Hn : 0 + nat.succ n = a), from lt.elim Ha,
obtain (m : ℕ) (Hm : 0 + nat.succ m = b), from lt.elim Hb,
lt.intro
  (eq.symm
    (calc
      a * b = (0 + nat.succ n) * b                     : by rewrite Hn
        ... = nat.succ n * b                           : by rewrite zero_add
        ... = nat.succ n * (0 + nat.succ m)            : by rewrite Hm
        ... = nat.succ n * nat.succ m                  : by rewrite zero_add
        ... = of_nat (nat.succ n * nat.succ m)         : by rewrite of_nat_mul
        ... = of_nat (nat.succ n * m + nat.succ n)     : by rewrite nat.mul_succ
        ... = of_nat (nat.succ (nat.succ n * m + n))   : by rewrite nat.add_succ
        ... = 0 + nat.succ (nat.succ n * m + n)        : by rewrite zero_add))

protected theorem zero_lt_one : (0 : ℤ) < 1 := trivial

protected theorem not_le_of_gt {a b : ℤ} (H : a < b) : ¬ b ≤ a :=
  assume Hba,
  let Heq := int.le_antisymm (le_of_lt H) Hba in
  !int.lt_irrefl (Heq ▸ H)

protected theorem lt_of_lt_of_le {a b c : ℤ} (Hab : a < b) (Hbc : b ≤ c) : a < c :=
  let Hab' := le_of_lt Hab in
  let Hac := int.le_trans Hab' Hbc in
  (iff.mpr !int.lt_iff_le_and_ne) (and.intro Hac
    (assume Heq, int.not_le_of_gt (Heq ▸ Hab) Hbc))

protected theorem lt_of_le_of_lt  {a b c : ℤ} (Hab : a ≤ b) (Hbc : b < c) : a < c :=
  let Hbc' := le_of_lt Hbc in
  let Hac := int.le_trans Hab Hbc' in
  (iff.mpr !int.lt_iff_le_and_ne) (and.intro Hac
    (assume Heq, int.not_le_of_gt (Heq⁻¹ ▸ Hbc) Hab))

protected definition linear_ordered_comm_ring [trans_instance] :
    linear_ordered_comm_ring int :=
⦃linear_ordered_comm_ring, int.integral_domain,
  le               := int.le,
  le_refl          := int.le_refl,
  le_trans         := @int.le_trans,
  le_antisymm      := @int.le_antisymm,
  lt               := int.lt,
  le_of_lt         := @int.le_of_lt,
  lt_irrefl        := int.lt_irrefl,
  lt_of_lt_of_le   := @int.lt_of_lt_of_le,
  lt_of_le_of_lt   := @int.lt_of_le_of_lt,
  add_le_add_left  := @int.add_le_add_left,
  mul_nonneg       := @int.mul_nonneg,
  mul_pos          := @int.mul_pos,
  le_iff_lt_or_eq  := int.le_iff_lt_or_eq,
  le_total         := int.le_total,
  zero_ne_one      := int.zero_ne_one,
  zero_lt_one      := int.zero_lt_one,
  add_lt_add_left  := @int.add_lt_add_left⦄

protected definition decidable_linear_ordered_comm_ring [instance] :
    decidable_linear_ordered_comm_ring int :=
⦃decidable_linear_ordered_comm_ring,
 int.linear_ordered_comm_ring,
 decidable_lt := decidable_lt⦄

/- more facts specific to int -/

theorem of_nat_nonneg (n : ℕ) : 0 ≤ of_nat n := trivial

theorem of_nat_pos {n : ℕ} (Hpos : #nat n > 0) : of_nat n > 0 :=
of_nat_lt_of_nat_of_lt Hpos

theorem of_nat_succ_pos (n : nat) : of_nat (nat.succ n) > 0 :=
of_nat_pos !nat.succ_pos

theorem exists_eq_of_nat {a : ℤ} (H : 0 ≤ a) : ∃n : ℕ, a = of_nat n :=
obtain (n : ℕ) (H1 : 0 + of_nat n = a), from le.elim H,
exists.intro n (!zero_add ▸ (H1⁻¹))

theorem exists_eq_neg_of_nat {a : ℤ} (H : a ≤ 0) : ∃n : ℕ, a = -(of_nat n) :=
have -a ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos H,
obtain (n : ℕ) (Hn : -a = of_nat n), from exists_eq_of_nat this,
exists.intro n (eq_neg_of_eq_neg (Hn⁻¹))

theorem of_nat_nat_abs_of_nonneg {a : ℤ} (H : a ≥ 0) : of_nat (nat_abs a) = a :=
obtain (n : ℕ) (Hn : a = of_nat n), from exists_eq_of_nat H,
Hn⁻¹ ▸ congr_arg of_nat (nat_abs_of_nat n)

theorem of_nat_nat_abs_of_nonpos {a : ℤ} (H : a ≤ 0) : of_nat (nat_abs a) = -a :=
have -a ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos H,
calc
  of_nat (nat_abs a) = of_nat (nat_abs (-a)) : nat_abs_neg
                 ... = -a                    : of_nat_nat_abs_of_nonneg this

theorem of_nat_nat_abs (b : ℤ) : nat_abs b = abs b :=
or.elim (le.total 0 b)
  (assume H : b ≥ 0, of_nat_nat_abs_of_nonneg H ⬝ (abs_of_nonneg H)⁻¹)
  (assume H : b ≤ 0, of_nat_nat_abs_of_nonpos H ⬝ (abs_of_nonpos H)⁻¹)

theorem nat_abs_abs (a : ℤ) : nat_abs (abs a) = nat_abs a :=
abs.by_cases rfl !nat_abs_neg

theorem lt_of_add_one_le {a b : ℤ} (H : a + 1 ≤ b) : a < b :=
obtain (n : nat) (H1 : a + 1 + n = b), from le.elim H,
have a + succ n = b, by rewrite [-H1, add.assoc, add.comm 1],
lt.intro this

theorem add_one_le_of_lt {a b : ℤ} (H : a < b) : a + 1 ≤ b :=
obtain (n : nat) (H1 : a + succ n = b), from lt.elim H,
have a + 1 + n = b, by rewrite [-H1, add.assoc, add.comm 1],
le.intro this

theorem lt_add_one_of_le {a b : ℤ} (H : a ≤ b) : a < b + 1 :=
lt_add_of_le_of_pos H trivial

theorem le_of_lt_add_one {a b : ℤ} (H : a < b + 1) : a ≤ b :=
have H1 : a + 1 ≤ b + 1, from add_one_le_of_lt H,
le_of_add_le_add_right H1

theorem sub_one_le_of_lt {a b : ℤ} (H : a ≤ b) : a - 1 < b :=
lt_of_add_one_le (begin rewrite sub_add_cancel, exact H end)

theorem lt_of_sub_one_le {a b : ℤ} (H : a - 1 < b) : a ≤ b :=
!sub_add_cancel ▸ add_one_le_of_lt H

theorem le_sub_one_of_lt {a b : ℤ} (H : a < b) : a ≤ b - 1 :=
le_of_lt_add_one begin rewrite sub_add_cancel, exact H end

theorem lt_of_le_sub_one {a b : ℤ} (H : a ≤ b - 1) : a < b :=
!sub_add_cancel ▸ (lt_add_one_of_le H)

theorem sign_of_succ (n : nat) : sign (nat.succ n) = 1 :=
sign_of_pos (of_nat_pos !nat.succ_pos)

theorem exists_eq_neg_succ_of_nat {a : ℤ} : a < 0 → ∃m : ℕ, a = -[1+m] :=
int.cases_on a
  (take (m : nat) H, absurd (of_nat_nonneg m : 0 ≤ m) (not_le_of_gt H))
  (take (m : nat) H, exists.intro m rfl)

theorem eq_one_of_mul_eq_one_right {a b : ℤ} (H : a ≥ 0) (H' : a * b = 1) : a = 1 :=
have a * b > 0, by rewrite H'; apply trivial,
have b > 0, from pos_of_mul_pos_left this H,
have a > 0, from pos_of_mul_pos_right `a * b > 0` (le_of_lt `b > 0`),
or.elim (le_or_gt a 1)
  (suppose a ≤ 1,
    show a = 1, from le.antisymm this (add_one_le_of_lt `a > 0`))
  (suppose a > 1,
    have a * b ≥ 2 * 1,
      from mul_le_mul (add_one_le_of_lt `a > 1`) (add_one_le_of_lt `b > 0`) trivial H,
    have false, by rewrite [H' at this]; exact this,
    false.elim this)

theorem eq_one_of_mul_eq_one_left {a b : ℤ} (H : b ≥ 0) (H' : a * b = 1) : b = 1 :=
eq_one_of_mul_eq_one_right H (!mul.comm ▸ H')

theorem eq_one_of_mul_eq_self_left {a b : ℤ} (Hpos : a ≠ 0) (H : b * a = a) : b = 1 :=
eq_of_mul_eq_mul_right Hpos (H ⬝ (one_mul a)⁻¹)

theorem eq_one_of_mul_eq_self_right {a b : ℤ} (Hpos : b ≠ 0) (H : b * a = b) : a = 1 :=
eq_one_of_mul_eq_self_left Hpos (!mul.comm ▸ H)

theorem eq_one_of_dvd_one {a : ℤ} (H : a ≥ 0) (H' : a ∣ 1) : a = 1 :=
dvd.elim H'
  (take b,
    suppose 1 = a * b,
    eq_one_of_mul_eq_one_right H this⁻¹)

theorem exists_least_of_bdd {P : ℤ → Prop} [HP : decidable_pred P]
    (Hbdd : ∃ b : ℤ, ∀ z : ℤ, z ≤ b → ¬ P z)
        (Hinh : ∃ z : ℤ, P z) : ∃ lb : ℤ, P lb ∧ (∀ z : ℤ, z < lb → ¬ P z) :=
  begin
    cases Hbdd with [b, Hb],
    cases Hinh with [elt, Helt],
    existsi b + of_nat (least (λ n, P (b + of_nat n)) (nat.succ (nat_abs (elt - b)))),
    have Heltb : elt > b, begin
      apply lt_of_not_ge,
      intro Hge,
      apply (Hb _ Hge) Helt
    end,
    have H' : P (b + of_nat (nat_abs (elt - b))), begin
      rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt (iff.mpr !sub_pos_iff_lt Heltb)),
              add.comm, sub_add_cancel],
      apply Helt
    end,
    apply and.intro,
    apply least_of_lt _ !lt_succ_self H',
    intros z Hz,
    cases em (z ≤ b) with [Hzb, Hzb],
    apply Hb _ Hzb,
    let Hzb' := lt_of_not_ge Hzb,
    let Hpos := iff.mpr !sub_pos_iff_lt Hzb',
    have Hzbk : z = b + of_nat (nat_abs (z - b)),
      by rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos), int.add_comm, sub_add_cancel],
    have Hk : nat_abs (z - b) < least (λ n, P (b + of_nat n)) (nat.succ (nat_abs (elt - b))), begin
     note Hz' := iff.mp !lt_add_iff_sub_lt_left Hz,
     rewrite [-of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos) at Hz'],
     apply lt_of_of_nat_lt_of_nat Hz'
    end,
    let Hk' := not_le_of_gt Hk,
    rewrite Hzbk,
    apply λ p, mt (ge_least_of_lt _ p) Hk',
    apply nat.lt_trans Hk,
    apply least_lt _ !lt_succ_self H'
  end

theorem exists_greatest_of_bdd {P : ℤ → Prop} [HP : decidable_pred P]
    (Hbdd : ∃ b : ℤ, ∀ z : ℤ, z ≥ b → ¬ P z)
        (Hinh : ∃ z : ℤ, P z) : ∃ ub : ℤ, P ub ∧ (∀ z : ℤ, z > ub → ¬ P z) :=
  begin
    cases Hbdd with [b, Hb],
    cases Hinh with [elt, Helt],
    existsi b - of_nat (least (λ n, P (b - of_nat n)) (nat.succ (nat_abs (b - elt)))),
    have Heltb : elt < b, begin
      apply lt_of_not_ge,
      intro Hge,
      apply (Hb _ Hge) Helt
    end,
    have H' : P (b - of_nat (nat_abs (b - elt))), begin
      rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt (iff.mpr !sub_pos_iff_lt Heltb)),
              sub_sub_self],
      apply Helt
    end,
    apply and.intro,
    apply least_of_lt _ !lt_succ_self H',
    intros z Hz,
    cases em (z ≥ b) with [Hzb, Hzb],
    apply Hb _ Hzb,
    let Hzb' := lt_of_not_ge Hzb,
    let Hpos := iff.mpr !sub_pos_iff_lt Hzb',
    have Hzbk : z = b - of_nat (nat_abs (b - z)),
      by rewrite [of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos), sub_sub_self],
    have Hk : nat_abs (b - z) < least (λ n, P (b - of_nat n)) (nat.succ (nat_abs (b - elt))), begin
      note Hz' := iff.mp !lt_add_iff_sub_lt_left (iff.mpr !lt_add_iff_sub_lt_right Hz),
      rewrite [-of_nat_nat_abs_of_nonneg (int.le_of_lt Hpos) at Hz'],
      apply lt_of_of_nat_lt_of_nat Hz'
    end,
    let Hk' := not_le_of_gt Hk,
    rewrite Hzbk,
    apply λ p, mt (ge_least_of_lt _ p) Hk',
    apply nat.lt_trans Hk,
    apply least_lt _ !lt_succ_self H'
  end

end int


import data.fintype group_theory.subgroup

open equiv function finset
variables {α : Type*} {β : Type*}

instance decidable_eq_equiv [decidable_eq α] [decidable_eq β]
  [fintype α] : decidable_eq (α ≃ β) :=
λ a b, decidable_of_iff (a.1 = b.1)
  ⟨λ h, equiv.ext _ _ (congr_fun h), congr_arg _⟩

instance {n : ℕ} : decidable_linear_order (fin n) :=
{ decidable_le := fin.decidable_le,
  ..fin.linear_order }

def trunc_decidable_linear_order_fintype (α : Type*) [decidable_eq α] [fintype α] :
  trunc (decidable_linear_order α) :=
trunc.rec_on_subsingleton (fintype.equiv_fin α)
(λ f, trunc.mk
  { le := λ a b, f a ≤ f b,
    lt := λ a b, f a < f b,
    le_refl := λ a, le_refl (f a),
    le_trans := λ a b c, @le_trans _ _ (f a) _ _,
    le_antisymm := λ a b h₁ h₂, f.bijective.1 (le_antisymm h₁ h₂),
    le_total := λ a b, le_total (f a) _,
    lt_iff_le_not_le := λ a b, @lt_iff_le_not_le _ _ (f a) _,
    decidable_le := λ a b, fin.decidable_le _ _ })

namespace finset

def attach_fin (s : finset ℕ) {n : ℕ} (h : ∀ m ∈ s, m < n) :
  finset (fin n) :=
⟨s.1.pmap (λ a ha, ⟨a, ha⟩) h, multiset.nodup_pmap (λ _ _ _ _, fin.mk.inj) s.2⟩

@[simp] lemma mem_attach_fin {n : ℕ} {s : finset ℕ} (h : ∀ m ∈ s, m < n) {a : fin n} :
  a ∈ s.attach_fin h ↔ a.1 ∈ s :=
⟨λ h, let ⟨b, hb₁, hb₂⟩ := multiset.mem_pmap.1 h in hb₂ ▸ hb₁,
λ h, multiset.mem_pmap.2 ⟨a.1, h, fin.eta _ _⟩⟩

lemma eq_empty_iff_forall_not_mem {s : finset α} : s = ∅ ↔ ∀ x, x ∉ s :=
⟨λ h, by simp [h], λ h, eq_empty_of_forall_not_mem h⟩

end finset

@[derive decidable_eq] inductive mu2
|     one : mu2
| neg_one : mu2

namespace mu2

def neg : mu2 → mu2
|     one := neg_one
| neg_one :=     one

instance : has_one mu2 := ⟨one⟩
instance : has_neg mu2 := ⟨neg⟩
instance : fintype mu2 := ⟨{one, neg_one}, λ a, by cases a; simp⟩

@[simp] lemma card_mu2 : fintype.card mu2 = 2 := rfl

def mul : mu2 → mu2 → mu2
|   1    1  :=  1
| (-1) (-1) :=  1
|   1  (-1) := -1
| (-1)   1  := -1

instance : comm_group mu2 :=
by refine_struct { mul := mul, inv := id, one := 1 }; exact dec_trivial

@[simp] lemma ne_neg_one_iff : ∀ a : mu2, a ≠ -1 ↔ a = 1 := dec_trivial
@[simp] lemma ne_one_iff : ∀ a : mu2, a ≠ 1 ↔ a = -1 := dec_trivial

end mu2

namespace equiv.perm

@[simp] lemma one_apply (a : α) :
  (1 : perm α) a = a := rfl

@[simp] lemma mul_apply (f g : perm α) (a : α) :
  (f * g) a = f (g a) := rfl

@[simp] lemma inv_apply_self (f : perm α) (a : α) :
  f⁻¹ (f a) = a := equiv.inverse_apply_apply _ _

@[simp] lemma apply_inv_self (f : perm α) (a : α) :
  f (f⁻¹ a) = a := equiv.apply_inverse_apply _ _

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp] lemma swap_inv [decidable_eq α] (x y : α) :
  (equiv.swap x y)⁻¹ = equiv.swap x y := rfl

lemma swap_conj [decidable_eq α] {a b x y : α}
  (hab : a ≠ b) (hxy : x ≠ y) :
  {f : perm α // f * swap x y * f⁻¹ = swap a b} :=
⟨swap a x * swap y (swap a x b), equiv.ext _ _ $ λ n,
begin
  by_cases hxb : x = b,
  { rw [hxb, swap_apply_right, mul_inv_rev],
    dsimp [mul_apply, swap_apply_def],
    split_ifs; cc },
  { rw [swap_apply_of_ne_of_ne (ne.symm hab) (ne.symm hxb), mul_inv_rev],
    dsimp [mul_apply, swap_apply_def],
    split_ifs; cc }
end⟩

/-- set of all pairs ⟨a, b⟩ : Σ a : fin n, fin n such that b < a -/
def fin_pairs_lt (n : ℕ) : finset (Σ a : fin n, fin n) :=
(univ : finset (fin n)).sigma (λ a, (range a.1).attach_fin
  (λ m hm, lt_trans (mem_range.1 hm) a.2))

def sign_aux {n : ℕ} (a : perm (fin n)) : mu2 :=
(fin_pairs_lt n).prod
(λ x, if a x.1 ≤ a x.2 then -1 else 1)

lemma mem_fin_pairs_lt {n : ℕ} {a : Σ a : fin n, fin n} :
  a ∈ fin_pairs_lt n ↔ a.2 < a.1 :=
by simp [fin_pairs_lt, fin.lt_def]

@[simp] lemma sign_aux_one (n : ℕ) : sign_aux (1 : perm (fin n)) = 1 :=
begin
  unfold sign_aux,
  conv { to_rhs, rw ← @finset.prod_const_one _ mu2
    (fin_pairs_lt n) },
  exact finset.prod_congr rfl (λ a ha, if_neg
    (not_le_of_gt (mem_fin_pairs_lt.1 ha)))
end

@[simp] lemma equiv.symm.trans_apply {α β γ : Type*} (f : α ≃ β) (g : β ≃ γ) (a : γ) :
  (f.trans g).symm a = f.symm (g.symm a) := rfl

def sign_bij_aux {n : ℕ} (f : perm (fin n)) (a : Σ a : fin n, fin n) :
  Σ a : fin n, fin n :=
if hxa : f a.2 < f a.1
then ⟨f a.1, f a.2⟩
else ⟨f a.2, f a.1⟩

lemma sign_bij_aux_inj {n : ℕ} {f : perm (fin n)} : ∀ a b : Σ a : fin n, fin n,
   a ∈ fin_pairs_lt n → b ∈ fin_pairs_lt n → sign_bij_aux f a = sign_bij_aux f b → a = b :=
λ ⟨a₁, a₂⟩ ⟨b₁, b₂⟩ ha hb h, begin
  unfold sign_bij_aux at h,
  rw mem_fin_pairs_lt at *,
  have : ¬b₁ < b₂ := not_lt_of_ge (le_of_lt hb),
  split_ifs at h;
  simp [*, injective.eq_iff f.bijective.1, sigma.mk.inj_eq] at *
end

lemma sign_bij_aux_surj {n : ℕ} {f : perm (fin n)} : ∀ a ∈ fin_pairs_lt n,
  ∃ b ∈ fin_pairs_lt n, a = sign_bij_aux f b :=
λ ⟨a₁, a₂⟩ ha,
if hxa : f⁻¹ a₂ < f⁻¹ a₁
then ⟨⟨f⁻¹ a₁, f⁻¹ a₂⟩, mem_fin_pairs_lt.2 hxa,
  by dsimp [sign_bij_aux];
    rw [apply_inv_self, apply_inv_self, dif_pos (mem_fin_pairs_lt.1 ha)]⟩
else ⟨⟨f⁻¹ a₂, f⁻¹ a₁⟩, mem_fin_pairs_lt.2 $ lt_of_le_of_ne
  (le_of_not_gt hxa) $ λ h,
    by simpa [mem_fin_pairs_lt, (f⁻¹).bijective.1 h, lt_irrefl] using ha,
  by dsimp [sign_bij_aux];
    rw [apply_inv_self, apply_inv_self,
      dif_neg (not_lt_of_ge (le_of_lt (mem_fin_pairs_lt.1 ha)))]⟩

lemma sign_bij_aux_mem {n : ℕ} {f : perm (fin n)}: ∀ a : Σ a : fin n, fin n,
  a ∈ fin_pairs_lt n → sign_bij_aux f a ∈ fin_pairs_lt n :=
λ ⟨a₁, a₂⟩ ha, begin
  unfold sign_bij_aux,
  split_ifs with h,
  { exact mem_fin_pairs_lt.2 h },
  { exact mem_fin_pairs_lt.2
    (lt_of_le_of_ne (le_of_not_gt h)
      (λ h, ne_of_lt (mem_fin_pairs_lt.1 ha) (f.bijective.1 h.symm))) }
end

@[simp] lemma sign_aux_inv {n : ℕ} (f : perm (fin n)) : sign_aux f⁻¹ = sign_aux f :=
prod_bij (λ a ha, sign_bij_aux f⁻¹ a)
sign_bij_aux_mem
(λ ⟨a, b⟩ hab, if h : f⁻¹ b < f⁻¹ a
  then by rw [sign_bij_aux, dif_pos h, if_neg (not_le_of_gt h), apply_inv_self,
    apply_inv_self, if_neg (not_le_of_gt $ mem_fin_pairs_lt.1 hab)]
  else by rw [sign_bij_aux, if_pos (le_of_not_gt h), dif_neg h, apply_inv_self,
    apply_inv_self, if_pos (le_of_lt $ mem_fin_pairs_lt.1 hab)])
sign_bij_aux_inj
sign_bij_aux_surj

lemma sign_aux_mul {n : ℕ} (f g : perm (fin n)) :
  sign_aux (f * g) = sign_aux f * sign_aux g :=
sign_aux_inv g ▸ begin
  unfold sign_aux,
  rw ← prod_mul_distrib,
  refine prod_bij (λ a ha, sign_bij_aux g a) sign_bij_aux_mem _ sign_bij_aux_inj sign_bij_aux_surj,
  rintros ⟨a, b⟩ hab,
  rw [sign_bij_aux, mul_apply, mul_apply],
  rw mem_fin_pairs_lt at hab,
  by_cases h : g b < g a,
  { rw dif_pos h,
    simp [not_le_of_gt hab]; congr },
  { rw [dif_neg h, inv_apply_self, inv_apply_self, if_pos (le_of_lt hab)],
    by_cases h₁ : f (g b) ≤ f (g a),
    { have : f (g b) ≠ f (g a),
      { rw [ne.def, injective.eq_iff f.bijective.1,
          injective.eq_iff g.bijective.1];
        exact ne_of_lt hab },
      rw [if_pos h₁, if_neg (not_le_of_gt
        (lt_of_le_of_ne h₁ this))],
      refl },
    { rw [if_neg h₁, if_pos (le_of_lt (lt_of_not_ge h₁))],
      refl } }
end

@[simp] lemma if_ne_neg {α : Type} {p : Prop} [decidable p] {a b : α} :
  (if p then a else b) ≠ b ↔ p ∧ a ≠ b :=
(decidable.em p).elim (λ hp, by simp [hp]) (λ hp, by simp [hp])

@[simp] lemma if_ne_pos {α : Type} {p : Prop} [decidable p] {a b : α} :
  (if p then a else b) ≠ a ↔ ¬p ∧ b ≠ a :=
(decidable.em p).elim (λ hp, by simp [hp]) (λ hp, by simp [hp])

@[simp] lemma dif_ne_neg {α : Type} {p : Prop} [decidable p] {a : p → α} {b : α} :
  (if hp : p then a hp else b) ≠ b ↔ ∃ hp : p, a hp ≠ b :=
(decidable.em p).elim (λ hp, by simp [hp]) (λ hp, by simp [hp])

@[simp] lemma dif_ne_pos {α : Type} {p : Prop} [decidable p] {a : α} {b : ¬p → α} :
  (if hp : p then a else b hp) ≠ a ↔ ∃ hp : ¬p, b hp ≠ a :=
(decidable.em p).elim (λ hp, by simp [hp]) (λ hp, by simp [hp])

private lemma sign_aux_swap_zero_one {n : ℕ} (hn : 2 ≤ n) :
  sign_aux (swap (⟨0, lt_of_lt_of_le dec_trivial hn⟩ : fin n)
  ⟨1, lt_of_lt_of_le dec_trivial hn⟩) = -1 :=
let zero : fin n := ⟨0, lt_of_lt_of_le dec_trivial hn⟩ in
let one : fin n := ⟨1, lt_of_lt_of_le dec_trivial hn⟩ in
have hzo : zero < one := dec_trivial,
show sign_aux (swap zero one) = sign_aux (swap
  (⟨0, dec_trivial⟩ : fin 2) ⟨1, dec_trivial⟩),
begin
  refine eq.symm (prod_bij_ne_one (λ _ _ _, ⟨one, zero⟩)
    (λ _ _ _, mem_fin_pairs_lt.2 hzo) dec_trivial
    (λ a ha₁ ha₂, ⟨⟨⟨1, dec_trivial⟩, ⟨0, dec_trivial⟩⟩, dec_trivial, dec_trivial, _⟩)
    dec_trivial),
  replace ha₂ : ite (a.fst = zero) one (ite (a.fst = one) zero (a.fst)) ≤
    ite (a.snd = zero) one (ite (a.snd = one) zero (a.snd)):= (if_ne_neg.1 ha₂).1,
  replace ha₁ := mem_fin_pairs_lt.1 ha₁,
  cases a with a₁ a₂,
  have : ¬ one ≤ zero := dec_trivial,
  have : ∀ a : fin n, ¬a < zero := λ a, nat.not_lt_zero a.1,
  have : a₂ < one → a₂ = zero := λ h, fin.eq_of_veq (nat.le_zero_iff.1 (nat.le_of_lt_succ h)),
  have : a₁ ≤ one → a₁ = zero ∨ a₁ = one := fin.cases_on a₁
    (λ a, nat.cases_on a (λ _ _, or.inl dec_trivial)
    (λ a, nat.cases_on a (λ _ _, or.inr dec_trivial)
    (λ _ _ h, absurd h dec_trivial))),
  have : a₁ ≤ zero → a₁ = zero := fin.eq_of_veq ∘ nat.le_zero_iff.1,
  have : a₁ ≤ a₂ → a₂ < a₁ → false := not_lt_of_ge,
  split_ifs at ha₂;
  simp [*, lt_irrefl, -not_lt] at *
end

lemma sign_aux_swap : ∀ {n : ℕ} {x y : fin n} (hxy : x ≠ y),
  sign_aux (swap x y) = -1
| 0 := dec_trivial
| 1 := dec_trivial
| (n+2) := λ x y hxy,
let ⟨f, hf⟩ := swap_conj hxy (show (⟨0, dec_trivial⟩ : fin (n + 2)) ≠
  ⟨1, dec_trivial⟩, from dec_trivial) in
have h2n : 2 ≤ n + 2 := dec_trivial,
by rw [← hf, sign_aux_mul, sign_aux_mul, sign_aux_swap_zero_one h2n,
  mul_right_comm, ← sign_aux_mul, mul_inv_self, sign_aux_one, one_mul]

def sign [fintype α] [decidable_eq α] (x : perm α) : mu2 :=
trunc.lift
  (λ f : α ≃ fin (fintype.card α), sign_aux ((f.symm.trans x).trans f))
  (λ f g, calc sign_aux ((f.symm.trans x).trans f) =
    sign_aux (f.symm.trans g * (f.symm.trans x).trans f * (f.symm.trans g)⁻¹) :
      by rw [sign_aux_mul, sign_aux_mul, mul_right_comm, ← sign_aux_mul,
        mul_inv_self, sign_aux_one, one_mul]
  ... = sign_aux (equiv.trans (equiv.trans (equiv.symm g) x) g) : congr_arg sign_aux
    $ equiv.ext _ _ $ λ a,
      by rw inv_def; simp [equiv.symm.trans_apply])
(fintype.equiv_fin α)

instance [decidable_eq α] [fintype α] : is_group_hom (sign : perm α → mu2) :=
⟨λ x y, by unfold sign; exact
trunc.induction_on (fintype.equiv_fin α)
(λ f, begin
  simp only [trunc.lift_beta, mul_def],
  rw ← sign_aux_mul,
  exact congr_arg sign_aux (equiv.ext _ _ (λ x, by simp))
end)⟩

@[simp] lemma sign_swap [fintype α] [decidable_eq α] {x y : α} (h : x ≠ y) :
  sign (swap x y) = -1 :=
begin
  unfold sign,
  refine trunc.induction_on (fintype.equiv_fin α) (λ f, _),
  have : (f.symm.trans (swap x y)).trans f = swap (f x) (f y),
    from equiv.ext _ _ (λ b, begin
      have : ∀ z : α, f.2 b = z → b = f.1 z :=
        λ z hz, by simp [hz.symm, f.right_inv b],
      unfold_coes at *,
      dsimp [equiv.swap, equiv.swap_core, equiv.trans, equiv.symm],
      split_ifs; simp [*, f.left_inv x, f.right_inv b, f.left_inv y] at *
     end),
  rw [trunc.lift_beta, this,
    sign_aux_swap (mt (injective.eq_iff f.bijective.1).1 h)]
end

def is_swap [decidable_eq α] (f : perm α) := ∃ x y : α, x ≠ y ∧ f = swap x y

def is_cycle (f : perm α) := ∃ x : α, ∀ y : α, ∃ n : ℕ, (f ^ n) x = y

def support [fintype α] [decidable_eq α] (f : perm α) := (@univ α _).filter (λ x, f x ≠ x)

@[simp] lemma mem_support_iff [fintype α] [decidable_eq α] {f : perm α} {a : α} :
  a ∈ f.support ↔ f a ≠ a := by simp [support]

@[simp] lemma support_eq_empty [fintype α] [decidable_eq α] {f : perm α} :
  f.support = ∅ ↔ f = 1 :=
⟨λ h, equiv.ext _ _ (by simpa [finset.eq_empty_iff_forall_not_mem] using h),
  λ h, by simp [h, finset.eq_empty_iff_forall_not_mem]⟩

lemma support_transpose_mul [decidable_eq α] [fintype α] {f : perm α} {x : α}
  (hx : x ∈ f.support) : (swap x (f x) * f).support ⊆ f.support.erase x :=
λ y hy, begin
  rw mem_support_iff at hx,
  simp only [mem_support_iff, swap_apply_def, mem_erase, mul_apply,
    injective.eq_iff f.bijective.1] at *,
  by_cases h : f y = x,
  { exact ⟨λ h₂, by simp * at *, λ h₂, by simp * at *⟩ },
  { split_ifs at hy; cc }
end

/-- list of tranpositions whose product is `f` -/
def swap_factors [fintype α] [decidable_eq α]
  [decidable_linear_order α] : Π f : perm α,
  {l : list (perm α) // l.prod = f ∧ ∀ g ∈ l, is_swap g}
| f := if h : f = 1 then ⟨[], eq.symm $ support_eq_empty.1 (by simp [h]), by simp⟩
  else
  let x := @option.get _ f.support.min (option.is_some_iff_exists.2
    (let ⟨a, ha⟩ := exists_mem_of_ne_empty (mt support_eq_empty.1 h) in min_of_mem ha)) in
  have hx : x ∈ f.support := mem_of_min (option.get_mem _),
  have wf : ((swap x (f x))⁻¹ * f).support.card < f.support.card :=
    calc ((swap x (f x))⁻¹ * f).support.card ≤ (f.support.erase x).card :
      card_le_of_subset (by rw swap_inv; exact support_transpose_mul hx)
    ... < f.support.card : by rw card_erase_of_mem hx;
      exact nat.pred_lt (mt card_eq_zero.1 (ne_empty_of_mem hx)),
  let l := swap_factors ((swap x (f x))⁻¹ * f) in
  ⟨swap x (f x) :: l.1,
  by rw [list.prod_cons, l.2.1, ← mul_assoc, mul_inv_self, one_mul],
  λ g hg, ((list.mem_cons_iff _ _ _).1 hg).elim
    (λ hgt, ⟨x, f x, ne.symm $ mem_support_iff.1 hx, hgt⟩)
    (l.2.2 _)⟩
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ f, f.support.card)⟩]}

def trunc_swap_factors [fintype α] [decidable_eq α] (f : perm α) :
  trunc {l : list (perm α) // l.prod = f ∧ ∀ g ∈ l, is_swap g} :=
trunc.rec_on_subsingleton (trunc_decidable_linear_order_fintype α)
(λ I, by exactI trunc.mk (swap_factors f))

lemma eq_sign_of_surjective_hom [fintype α] [decidable_eq α] {s : perm α → mu2}
  [is_group_hom s] (hs : surjective s) : s = sign :=
have ∀ x y : α, x ≠ y → s (swap x y) = -1 :=
  λ x y hxy, classical.by_contradiction $ λ h,
    have ∀ a b : α, a ≠ b → s (swap a b) = 1 :=
    λ a b hab, let ⟨g, hg⟩ := swap_conj hab hxy in
      by rwa [← hg, is_group_hom.mul s, mul_comm, ← is_group_hom.mul s,
        ← mul_assoc, inv_mul_self, one_mul, ← mu2.ne_neg_one_iff],
  let ⟨g, hg⟩ := hs (-1) in
  let ⟨l, hl⟩ := trunc.out (trunc_swap_factors g) in
  have s l.prod = 1 := (is_group_hom.mem_ker s).1 $ is_submonoid.list_prod_mem
     (λ g hg, let ⟨x,y, hxy⟩ := hl.2 g hg in hxy.2.symm ▸
       (is_group_hom.mem_ker s).2 $ this x y hxy.1),
  by simp [hl.1.symm, this] at hg;
    contradiction,
funext $ λ f,
let ⟨l, hl₁, hl₂⟩ := trunc.out (trunc_swap_factors f) in
hl₁ ▸ begin
  clear hl₁,
  induction l with g l ih,
  { simp [is_group_hom.one s, is_group_hom.one (@sign α _ _)] },
  { rcases hl₂ g (list.mem_cons_self _ _) with ⟨x, y, hxy⟩,
    rw [list.prod_cons, is_group_hom.mul s, is_group_hom.mul (@sign α _ _),
      hxy.2, sign_swap hxy.1, this _ _ hxy.1,
      ih (λ g hg, hl₂ g (list.mem_cons_of_mem _ hg))] }
end

end equiv.perm


/-
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.bracket
import group_theory.subgroup.basic
import tactic.group

/-!
# Commutators of Subgroups

If `G` is a group and `H₁ H₂ : subgroup G` then the commutator `⁅H₁, H₂⁆ : subgroup G`
is the subgroup of `G` generated by the commutators `h₁ * h₂ * h₁⁻¹ * h₂⁻¹`.

## Main definitions

* `⁅g₁, g₂⁆` : the commutator of the elements `g₁` and `g₂`
    (defined by `commutator_element` elsewhere).
* `⁅H₁, H₂⁆` : the commutator of the subgroups `H₁` and `H₂`.
-/

variables {G G' F : Type*} [group G] [group G'] [monoid_hom_class F G G'] (f : F) {g₁ g₂ g₃ g : G}

lemma commutator_element_eq_one_iff_mul_comm : ⁅g₁, g₂⁆ = 1 ↔ g₁ * g₂ = g₂ * g₁ :=
by rw [commutator_element_def, mul_inv_eq_one, mul_inv_eq_iff_eq_mul]

lemma commutator_element_eq_one_iff_commute : ⁅g₁, g₂⁆ = 1 ↔ commute g₁ g₂ :=
commutator_element_eq_one_iff_mul_comm

lemma commute.commutator_eq (h : commute g₁ g₂) : ⁅g₁, g₂⁆ = 1 :=
commutator_element_eq_one_iff_commute.mpr h

variables (g₁ g₂ g₃ g)

@[simp] lemma commutator_element_one_right : ⁅g, (1 : G)⁆ = 1 :=
(commute.one_right g).commutator_eq

@[simp] lemma commutator_element_one_left : ⁅(1 : G), g⁆ = 1 :=
(commute.one_left g).commutator_eq

@[simp] lemma commutator_element_inv : ⁅g₁, g₂⁆⁻¹ = ⁅g₂, g₁⁆ :=
by simp_rw [commutator_element_def, mul_inv_rev, inv_inv, mul_assoc]

lemma map_commutator_element : (f ⁅g₁, g₂⁆ : G') = ⁅f g₁, f g₂⁆ :=
by simp_rw [commutator_element_def, map_mul f, map_inv f]

lemma conjugate_commutator_element : g₃ * ⁅g₁, g₂⁆ * g₃⁻¹ = ⁅g₃ * g₁ * g₃⁻¹, g₃ * g₂ * g₃⁻¹⁆ :=
map_commutator_element (mul_aut.conj g₃).to_monoid_hom g₁ g₂

namespace subgroup

/-- The commutator of two subgroups `H₁` and `H₂`. -/
instance commutator : has_bracket (subgroup G) (subgroup G) :=
⟨λ H₁ H₂, closure {g | ∃ (g₁ ∈ H₁) (g₂ ∈ H₂), ⁅g₁, g₂⁆ = g}⟩

lemma commutator_def (H₁ H₂ : subgroup G) :
  ⁅H₁, H₂⁆ = closure {g | ∃ (g₁ ∈ H₁) (g₂ ∈ H₂), ⁅g₁, g₂⁆ = g} := rfl

variables {g₁ g₂ g₃} {H₁ H₂ H₃ K₁ K₂ : subgroup G}

lemma commutator_mem_commutator (h₁ : g₁ ∈ H₁) (h₂ : g₂ ∈ H₂) : ⁅g₁, g₂⁆ ∈ ⁅H₁, H₂⁆ :=
subset_closure ⟨g₁, h₁, g₂, h₂, rfl⟩

lemma commutator_le : ⁅H₁, H₂⁆ ≤ H₃ ↔ ∀ (g₁ ∈ H₁) (g₂ ∈ H₂), ⁅g₁, g₂⁆ ∈ H₃ :=
H₃.closure_le.trans ⟨λ h a b c d, h ⟨a, b, c, d, rfl⟩, λ h g ⟨a, b, c, d, h_eq⟩, h_eq ▸ h a b c d⟩

lemma commutator_mono (h₁ : H₁ ≤ K₁) (h₂ : H₂ ≤ K₂) : ⁅H₁, H₂⁆ ≤ ⁅K₁, K₂⁆ :=
commutator_le.mpr (λ g₁ hg₁ g₂ hg₂, commutator_mem_commutator (h₁ hg₁) (h₂ hg₂))

lemma commutator_eq_bot_iff_le_centralizer : ⁅H₁, H₂⁆ = ⊥ ↔ H₁ ≤ H₂.centralizer :=
begin
  rw [eq_bot_iff, commutator_le],
  refine forall_congr (λ p, forall_congr (λ hp, forall_congr (λ q, forall_congr (λ hq, _)))),
  rw [mem_bot, commutator_element_eq_one_iff_mul_comm, eq_comm],
end

/-- **The Three Subgroups Lemma** (via the Hall-Witt identity) -/
lemma commutator_commutator_eq_bot_of_rotate
  (h1 : ⁅⁅H₂, H₃⁆, H₁⁆ = ⊥) (h2 : ⁅⁅H₃, H₁⁆, H₂⁆ = ⊥) : ⁅⁅H₁, H₂⁆, H₃⁆ = ⊥ :=
begin
  simp_rw [commutator_eq_bot_iff_le_centralizer, commutator_le,
    mem_centralizer_iff_commutator_eq_one, ←commutator_element_def] at h1 h2 ⊢,
  intros x hx y hy z hz,
  transitivity x * z * ⁅y, ⁅z⁻¹, x⁻¹⁆⁆⁻¹ * z⁻¹ * y * ⁅x⁻¹, ⁅y⁻¹, z⁆⁆⁻¹ * y⁻¹ * x⁻¹,
  { group },
  { rw [h1 _ (H₂.inv_mem hy) _ hz _ (H₁.inv_mem hx), h2 _ (H₃.inv_mem hz) _ (H₁.inv_mem hx) _ hy],
    group },
end

variables (H₁ H₂)

lemma commutator_comm_le : ⁅H₁, H₂⁆ ≤ ⁅H₂, H₁⁆ :=
commutator_le.mpr (λ g₁ h₁ g₂ h₂,
  commutator_element_inv g₂ g₁ ▸ ⁅H₂, H₁⁆.inv_mem_iff.mpr (commutator_mem_commutator h₂ h₁))

lemma commutator_comm : ⁅H₁, H₂⁆ = ⁅H₂, H₁⁆ :=
le_antisymm (commutator_comm_le H₁ H₂) (commutator_comm_le H₂ H₁)

section normal

instance commutator_normal [h₁ : H₁.normal] [h₂ : H₂.normal] : normal ⁅H₁, H₂⁆ :=
begin
  let base : set G := {x | ∃ (g₁ ∈ H₁) (g₂ ∈ H₂), ⁅g₁, g₂⁆ = x},
  change (closure base).normal,
  suffices h_base : base = group.conjugates_of_set base,
  { rw h_base,
    exact subgroup.normal_closure_normal },
  refine set.subset.antisymm group.subset_conjugates_of_set (λ a h, _),
  simp_rw [group.mem_conjugates_of_set_iff, is_conj_iff] at h,
  rcases h with ⟨b, ⟨c, hc, e, he, rfl⟩, d, rfl⟩,
  exact ⟨_, h₁.conj_mem c hc d, _, h₂.conj_mem e he d, (conjugate_commutator_element c e d).symm⟩,
end

lemma commutator_def' [H₁.normal] [H₂.normal] :
  ⁅H₁, H₂⁆ = normal_closure {g | ∃ (g₁ ∈ H₁) (g₂ ∈ H₂), ⁅g₁, g₂⁆ = g} :=
le_antisymm closure_le_normal_closure (normal_closure_le_normal subset_closure)

lemma commutator_le_right [h : H₂.normal] : ⁅H₁, H₂⁆ ≤ H₂ :=
commutator_le.mpr (λ g₁ h₁ g₂ h₂, H₂.mul_mem (h.conj_mem g₂ h₂ g₁) (H₂.inv_mem h₂))

lemma commutator_le_left [H₁.normal] : ⁅H₁, H₂⁆ ≤ H₁ :=
commutator_comm H₂ H₁ ▸ commutator_le_right H₂ H₁

@[simp] lemma commutator_bot_left : ⁅(⊥ : subgroup G), H₁⁆ = ⊥ :=
le_bot_iff.mp (commutator_le_left ⊥ H₁)

@[simp] lemma commutator_bot_right : ⁅H₁, ⊥⁆ = (⊥ : subgroup G) :=
le_bot_iff.mp (commutator_le_right H₁ ⊥)

lemma commutator_le_inf [normal H₁] [normal H₂] : ⁅H₁, H₂⁆ ≤ H₁ ⊓ H₂ :=
le_inf (commutator_le_left H₁ H₂) (commutator_le_right H₁ H₂)

end normal

lemma map_commutator (f : G →* G') : map f ⁅H₁, H₂⁆ = ⁅map f H₁, map f H₂⁆ :=
begin
  simp_rw [le_antisymm_iff, map_le_iff_le_comap, commutator_le, mem_comap, map_commutator_element],
  split,
  { intros p hp q hq,
    exact commutator_mem_commutator (mem_map_of_mem _ hp) (mem_map_of_mem _ hq), },
  { rintros _ ⟨p, hp, rfl⟩ _ ⟨q, hq, rfl⟩,
    rw ← map_commutator_element,
    exact mem_map_of_mem _ (commutator_mem_commutator hp hq) }
end

lemma commutator_prod_prod (K₁ K₂ : subgroup G') :
  ⁅H₁.prod K₁, H₂.prod K₂⁆ = ⁅H₁, H₂⁆.prod ⁅K₁, K₂⁆ :=
begin
  apply le_antisymm,
  { rw commutator_le,
    rintros ⟨p₁, p₂⟩ ⟨hp₁, hp₂⟩ ⟨q₁, q₂⟩ ⟨hq₁, hq₂⟩,
    exact ⟨commutator_mem_commutator hp₁ hq₁, commutator_mem_commutator hp₂ hq₂⟩ },
  { rw prod_le_iff, split;
    { rw map_commutator,
      apply commutator_mono;
      simp [le_prod_iff, map_map, monoid_hom.fst_comp_inl, monoid_hom.snd_comp_inl,
        monoid_hom.fst_comp_inr, monoid_hom.snd_comp_inr ], }, }
end

variables {H₁ H₂}

lemma commutator_le_map_commutator {f : G →* G'} {K₁ K₂ : subgroup G'}
  (h₁ : K₁ ≤ H₁.map f) (h₂ : K₂ ≤ H₂.map f) : ⁅K₁, K₂⁆ ≤ ⁅H₁, H₂⁆.map f :=
(commutator_mono h₁ h₂).trans (ge_of_eq (map_commutator H₁ H₂ f))

/-- The commutator of direct product is contained in the direct product of the commutators.

See `commutator_pi_pi_of_fintype` for equality given `fintype η`.
-/
lemma commutator_pi_pi_le {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)]
  (H K : Π i, subgroup (Gs i)) :
  ⁅subgroup.pi set.univ H, subgroup.pi set.univ K⁆ ≤ subgroup.pi set.univ (λ i, ⁅H i, K i⁆) :=
commutator_le.mpr $ λ p hp q hq i hi, commutator_mem_commutator (hp i hi) (hq i hi)

/-- The commutator of a finite direct product is contained in the direct product of the commutators.
-/
lemma commutator_pi_pi_of_fintype {η : Type*} [fintype η] {Gs : η → Type*}
  [∀ i, group (Gs i)] (H K : Π i, subgroup (Gs i)) :
  ⁅subgroup.pi set.univ H, subgroup.pi set.univ K⁆ = subgroup.pi set.univ (λ i, ⁅H i, K i⁆) :=
begin
  classical,
  apply le_antisymm (commutator_pi_pi_le H K),
  { rw pi_le_iff, intros i hi,
    rw map_commutator,
    apply commutator_mono;
    { rw le_pi_iff,
      intros j hj,
      rintros _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩,
      by_cases h : j = i,
      { subst h, simpa using hx, },
      { simp [h, one_mem] }, }, },
end

end subgroup