import group_theory.perm group_theory.order_of_element

variables {α : Type*} [decidable_eq α]
open finset function
namespace equiv
namespace perm

def disjoint (f g : perm α) := ∀ x : α, f x = x ∨ g x = x

def cycle_of_aux (f : perm α) : Π (n : ℕ) (y : α), list α
| 0     y := []
| (n+1) y := y :: (cycle_of_aux n (f y))

lemma length_cycle_of_aux (f : perm α) (n : ℕ) : ∀ y : α, (cycle_of_aux f n y).length = n :=
by induction n; simp [cycle_of_aux, *]

@[simp] lemma nth_cycle_of_aux [fintype α] (f : perm α) : ∀ {n m : ℕ} (y : α)
  (hn : nat.succ m < (cycle_of_aux f n y).length),
  list.nth_le (cycle_of_aux f n y) (nat.succ m) hn =
  f (list.nth_le (cycle_of_aux f n y) m (nat.lt_of_succ_lt hn))
| 0     m     y hn := (nat.not_lt_zero _ hn).elim
| 1     0     y hn := (lt_irrefl _ hn).elim
| (n+2) 0     y hn := rfl
| (n+1) (m+1) y hn :=
  begin
    unfold cycle_of_aux list.nth_le,
    rw nth_cycle_of_aux,
    refl,
  end

@[simp] lemma nth_cycle_of_aux_eq_pow [fintype α] (f : perm α) : ∀ {n m : ℕ} (x : α)
  (hm : m < (cycle_of_aux f n x).length), (cycle_of_aux f n x).nth_le m hm = (f ^ m) x
| 0     m     := λ _ hm, absurd hm dec_trivial
| (n+1) 0     := λ _ _, rfl
| (n+1) (m+1) := λ x hm,
  by unfold cycle_of_aux list.nth_le; rw [nth_cycle_of_aux_eq_pow, pow_succ', mul_apply]

lemma pow_apply_eq_self_of_apply_eq_self_nat {f : perm α} {x : α} (n : ℕ) (hfx : f x = x) :
  (f ^ n) x = x :=
by induction n; [refl, rw [pow_succ, mul_apply, n_ih, hfx]]

def support_equiv_gpowers [fintype α] {f : perm α} (hf : is_cycle f) : gpowers f ≃ {x | x ∈ f.support} :=
let ⟨x, hx⟩ := classical.indefinite_description _ hf in
{ to_fun := λ g, let i := classical.some g.2 in ⟨(f ^ i) x,
    mem_support.2 (mt (injective.eq_iff (f ^ -i).bijective.1).2 $
      begin
        rw [← mul_apply, ← mul_apply, ← mul_apply, ← gpow_add, neg_add_self, gpow_zero];
        rw [← gpow_one f] {occs := occurrences.pos [2]},
        rw [← gpow_add, ← gpow_add, neg_add_eq_sub, sub_add_cancel, gpow_one],
        exact hx.1
      end)⟩,
  inv_fun := λ x, begin end  }

lemma order_of_eq_card_support [fintype α] (f : perm α) : order_of f = f.support.card :=
begin
  rw [order_eq_card_gpowers, ← set.card_fintype_of_finset f.support (@mem_support _ _ _ f)],
  refine @fintype.card_congr _ _ (id _) (id _)
  { to_fun := λ ⟨g, h⟩,
    inv_fun := _,
    left_inv := _,
    right_inv := _  },

end

def cycle_of_list [fintype α] (f : perm α) (x : α) : list α :=
cycle_of_aux f (nat.find (exists_pow_apply_eq_self f x)) x

lemma cycle_of_list_eq_cons [fintype α] (f : perm α) (x : α) : cycle_of_list f x =
  x :: cycle_of_aux f (nat.find (exists_pow_apply_eq_self f x) - 1) (f x) :=
begin
  unfold cycle_of_list,
  cases h : nat.find (exists_pow_apply_eq_self f x),
  { exact absurd h (nat.pos_iff_ne_zero.1 $ (nat.find_spec (exists_pow_apply_eq_self f x)).1) },
  { simp [cycle_of_aux] }
end

def cycle_length [fintype α] (f : perm α) (x : α) : ℕ := (cycle_of_list f x).length

lemma cycle_length_pos [fintype α] (f : perm α) (x : α) : cycle_length f x > 0 :=
by rw [cycle_length, cycle_of_list, length_cycle_of_aux];
  exact (nat.find_spec (exists_pow_apply_eq_self f x)).1

@[simp] lemma pow_cycle_length_apply [fintype α] (f : perm α) (x : α) : (f ^ cycle_length f x) x = x :=
by rw [cycle_length, cycle_of_list, length_cycle_of_aux];
  exact (nat.find_spec (exists_pow_apply_eq_self f x)).2

@[simp] lemma length_cycle_of_list [fintype α] (f : perm α) (x : α) :
  (cycle_of_list f x).length = cycle_length f x := rfl

@[simp] lemma nth_cycle_of_list_eq_pow [fintype α] (f : perm α) (x : α) {n : ℕ} (hn : n < cycle_length f x) :
  (cycle_of_list f x).nth_le n hn = (f ^ n) x := nth_cycle_of_aux_eq_pow _ _ hn

open list

def cycle_list_factors [fintype α] (f : perm α) : Π l : list α, list (list α)
| []       := []
| (x :: l) := let m := cycle_of_list f x in
  have wf : ((x :: l : list α).diff (cycle_of_list f x)).length < (x :: l : list α).length :=
  calc ((x :: l : list α).diff (cycle_of_list f x)).length =
    list.length (list.diff l (cycle_of_aux f (nat.find _ - 1) (f x))) :
    by rw [cycle_of_list_eq_cons, list.diff_cons, list.erase_cons_head]
  ... ≤ l.length : list.length_le_of_sublist (diff_sublist _ _)
   ... < (x :: l : list α).length : nat.lt_succ_self _,
  if f x = x then cycle_list_factors ((x :: l : list α).diff m)
  else m :: cycle_list_factors ((x :: l : list α).diff m)
using_well_founded {dec_tac := tactic.assumption,
  rel_tac := λ _ _ , `[exact ⟨_, measure_wf list.length⟩]}

meta instance [fintype α] [has_repr α] : has_repr (perm α) :=
⟨λ f, repr (cycle_list_factors f (quot.unquot (@univ α _).1))⟩

instance zmod_has_repr (n : ℕ+) : has_repr (zmod n) := fin.has_repr n

-- instance (n : ℕ+) : has_coe ℕ (zmod n) := by apply_instance

#eval (let p := 11 in let q := 3 in
       ({ to_fun := λ x : zmod ⟨p * q, dec_trivial⟩,
         (↑((x.1 % p * q) % (p * q) + x.1 / p : ℕ) : zmod ⟨p * q, dec_trivial⟩),
         inv_fun := sorry,
         left_inv := sorry,
         right_inv := sorry } : perm (zmod ⟨p * q, dec_trivial⟩)))

def list_to_perm : Π (l : list α), perm α
| []        := 1
| [x]       := 1
| (x::y::l) := swap x y * list_to_perm (y :: l)

@[simp] lemma list_to_perm_eq_swap (x y : α) : list_to_perm [x,y] = swap x y := rfl

lemma list_to_perm_pow {l : list α} {x : α} (h : (x :: l : list α).nodup) {n : ℕ}
  (hn : n < (x::l : list α).length) :
  (list_to_perm (x :: l) ^ n) x = (x :: l : list α).nth_le n hn :=
begin
  induction l with y l ih,
  { have hn : n = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ hn),
    subst hn,
    rw [list_to_perm, one_pow]; refl },
  rw [list_to_perm],

end

def cycle_of [fintype α] (f : perm α) (x : α) : perm α := list_to_perm (cycle_of_list f x)

@[simp] lemma cycle_of_apply_self [fintype α] (f : perm α) (x : α) : cycle_of f x x = f x :=
begin
  rw cycle_of,

end

lemma cycle_of_is_cycle [fintype α] (f : perm α) (x : α) (h : f x ≠ x) : is_cycle (cycle_of f x) :=
⟨begin end, begin end⟩

#eval list_to_perm ([1,2,3,4,3] : list (fin 5))

def list_to_cycle_append : Π (l₁ l₂ : list α), list_to_cycle_aux (l₁ ++ l₂) =
  list_to_cycle_aux l₁ ∘ list_to_cycle_aux l₂
| []      l₂ := rfl
| [a] l₂ := begin

end

lemma list_to_cycle_reverse : ∀ (l : list α) (x y w z : α), z ≠ x → z ≠ y → z ≠ w →
 list_to_cycle_aux (x :: l ++ [y]) (list_to_cycle_aux (x :: l ++ [w] : list α).reverse z) = z
| []     x y w z := λ hzx hzy, by simp [list_to_cycle_aux]; split_ifs; cc
| (a::l) x y w z := λ hzx hzy hzw,
list.reverse_rec_on l (by simp [list_to_cycle_aux]; split_ifs; cc)
(λ l b _, begin
  simp only [reverse_cons, reverse_append, nil_append, reverse_nil, cons_append],
  unfold list_to_cycle_aux,
  split_ifs,
  cc <|> simp [*, list_to_cycle_aux],
end)

-- def list_to_cycle' (l : list α) : l.nodup → perm α :=
-- list.reverse_rec_on l (λ _, 1) (λ l, list.cases_on l (λ _ _ _, 1)
-- $ λ x l y _ h,
-- have hx : (x::l : list α).nodup := (list.nodup_of_nodup_append_left h),
-- have hy : (l ++ [y]).nodup := by rw list.cons_append at h;
--   exact list.nodup_of_nodup_cons h,
-- let f := list_to_cycle_aux (x :: l ++ [y]) in
-- let g := list_to_cycle_aux (x :: l ++ [y]).reverse in
-- { to_fun := λ n, if n = y then x else f n,
--   inv_fun := λ n, if n = x then y else g n,
--   left_inv := λ n, begin dsimp, split_ifs, cc, end,
--   right_inv := sorry })

-- #eval ((list_to_cycle' ([1,2,3] : list (fin 6)) sorry) * list_to_cycle' [2,3,0,4] sorry) * swap 0 5
-- def list_to_cycle2 : Π l : list α, l.nodup → perm α
-- | []     := λ h, 1
-- | (x::l) := λ h,
-- { to_fun := λ x, list.nth_le (x::l) (((list.index_of x l : ℕ) : zmod l.length.succ) + 1).val
--     (((list.index_of x l : ℕ) : zmod l.length.succ) + 1).2,
--   inv_fun := λ x, list.nth_le (x::l) ((list.index_of x l : zmod l.length.succ) - 1).val
--     ((list.index_of x l : zmod l.length.succ) - 1).2,
--   left_inv := λ x, begin dsimp, rw index_of_nth_le  end,
--   right_inv := sorry }

-- def list_to_cycle (l : list α) (hl : l.nodup) : perm α :=
-- { to_fun := λ x, if h : x ∈ l then begin
--     have := list.index_of x l,
--     have := list.ind
--   end else x,
--   inv_fun := λ x, if h : x ∈ l then begin end else x,
--   left_inv := sorry,
--   right_inv := sorry }

def list_to_cycle (l : list α) : l.nodup → perm α :=
list.cases_on l (λ _, 1) (λ x l, list.reverse_rec_on l (λ _ , 1)
(λ m y,
list.reverse_rec_on m (λ _ _, swap x y)
(λ n z f h ih,
have hyx : y ≠ x := sorry,
let f := h sorry in
have hfax : ∀ a : α, f a = x ↔ a = z := sorry,
{ to_fun := λ a, if a = z then y else if a = y then x else f a,
  inv_fun := λ a, if a = x then y else if a = y then z else f⁻¹ a,
  left_inv := λ a, begin simp, split_ifs, end,
  right_inv := sorry })))

end equiv.perm


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.equiv.denumerable
import order.preorder_hom
import data.nat.lattice

/-!
# Relation embeddings from the naturals

This file allows translation from monotone functions `ℕ → α` to order embeddings `ℕ ↪ α` and
defines the limit value of an eventually-constant sequence.

## Main declarations

* `nat_lt`/`nat_gt`: Make an order embedding `ℕ ↪ α` from an increasing/decreasing function `ℕ → α`.
* `monotonic_sequence_limit`: The limit of an eventually-constant monotone sequence `ℕ →ₘ α`.
* `monotonic_sequence_limit_index`: The index of the first occurence of `monotonic_sequence_limit`
  in the sequence.
-/
namespace rel_embedding

variables {α : Type*} {r : α → α → Prop} [is_strict_order α r]

/-- If `f` is a strictly `r`-increasing sequence, then this returns `f` as an order embedding. -/
def nat_lt (f : ℕ → α) (H : ∀ n : ℕ, r (f n) (f (n + 1))) :
  ((<) : ℕ → ℕ → Prop) ↪r r :=
of_monotone f $ λ a b h, begin
  induction b with b IH, {exact (nat.not_lt_zero _ h).elim},
  cases nat.lt_succ_iff_lt_or_eq.1 h with h e,
  { exact trans (IH h) (H _) },
  { subst b, apply H }
end

@[simp]
lemma nat_lt_apply {f : ℕ → α} {H : ∀ n : ℕ, r (f n) (f (n + 1))} {n : ℕ} :
  nat_lt f H n = f n :=
rfl

/-- If `f` is a strictly `r`-decreasing sequence, then this returns `f` as an order embedding. -/
def nat_gt (f : ℕ → α) (H : ∀ n : ℕ, r (f (n + 1)) (f n)) :
  ((>) : ℕ → ℕ → Prop) ↪r r :=
by haveI := is_strict_order.swap r; exact rel_embedding.swap (nat_lt f H)

theorem well_founded_iff_no_descending_seq :
  well_founded r ↔ is_empty (((>) : ℕ → ℕ → Prop) ↪r r) :=
⟨λ ⟨h⟩, ⟨λ ⟨f, o⟩,
  suffices ∀ a, acc r a → ∀ n, a ≠ f n, from this (f 0) (h _) 0 rfl,
  λ a ac, begin
    induction ac with a _ IH, intros n h, subst a,
    exact IH (f (n+1)) (o.2 (nat.lt_succ_self _)) _ rfl
  end⟩,
λ E, ⟨λ a, classical.by_contradiction $ λ na,
  let ⟨f, h⟩ := classical.axiom_of_choice $
    show ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
    from λ ⟨x, h⟩, classical.by_contradiction $ λ hn, h $
      ⟨_, λ y h, classical.by_contradiction $ λ na, hn ⟨⟨y, na⟩, h⟩⟩ in
  E.elim' (nat_gt (λ n, (f^[n] ⟨a, na⟩).1) $ λ n,
    by { rw [function.iterate_succ'], apply h })⟩⟩

end rel_embedding

namespace nat
variables (s : set ℕ) [decidable_pred (∈ s)] [infinite s]

/-- An order embedding from `ℕ` to itself with a specified range -/
def order_embedding_of_set : ℕ ↪o ℕ :=
(rel_embedding.order_embedding_of_lt_embedding
  (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _))).trans
  (order_embedding.subtype s)

/-- `nat.subtype.of_nat` as an order isomorphism between `ℕ` and an infinite decidable subset. -/
noncomputable def subtype.order_iso_of_nat  :
  ℕ ≃o s :=
rel_iso.of_surjective (rel_embedding.order_embedding_of_lt_embedding
  (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _)))
  nat.subtype.of_nat_surjective

variable {s}

@[simp]
lemma order_embedding_of_set_apply {n : ℕ} : order_embedding_of_set s n = subtype.of_nat s n :=
rfl

@[simp]
lemma subtype.order_iso_of_nat_apply {n : ℕ} :
  subtype.order_iso_of_nat s n = subtype.of_nat s n :=
by { simp [subtype.order_iso_of_nat] }

variable (s)

@[simp]
lemma order_embedding_of_set_range : set.range (nat.order_embedding_of_set s) = s :=
begin
  ext x,
  rw [set.mem_range, nat.order_embedding_of_set],
  split; intro h,
  { obtain ⟨y, rfl⟩ := h,
    simp },
  { refine ⟨(nat.subtype.order_iso_of_nat s).symm ⟨x, h⟩, _⟩,
    simp only [rel_embedding.coe_trans, rel_embedding.order_embedding_of_lt_embedding_apply,
      rel_embedding.nat_lt_apply, function.comp_app, order_embedding.subtype_apply],
    rw [← subtype.order_iso_of_nat_apply, order_iso.apply_symm_apply, subtype.coe_mk] }
end

end nat

theorem exists_increasing_or_nonincreasing_subseq' {α : Type*} (r : α → α → Prop) (f : ℕ → α) :
  ∃ (g : ℕ ↪o ℕ), (∀ n : ℕ, r (f (g n)) (f (g (n + 1)))) ∨
    (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
begin
  classical,
  let bad : set ℕ := { m | ∀ n, m < n → ¬ r (f m) (f n) },
  by_cases hbad : infinite bad,
  { haveI := hbad,
    refine ⟨nat.order_embedding_of_set bad, or.intro_right _ (λ m n mn, _)⟩,
    have h := set.mem_range_self m,
    rw nat.order_embedding_of_set_range bad at h,
    exact h _ ((order_embedding.lt_iff_lt _).2 mn) },
  { rw [set.infinite_coe_iff, set.infinite, not_not] at hbad,
    obtain ⟨m, hm⟩ : ∃ m, ∀ n, m ≤ n → ¬ n ∈ bad,
    { by_cases he : hbad.to_finset.nonempty,
      { refine ⟨(hbad.to_finset.max' he).succ, λ n hn nbad, nat.not_succ_le_self _
        (hn.trans (hbad.to_finset.le_max' n (hbad.mem_to_finset.2 nbad)))⟩ },
      { exact ⟨0, λ n hn nbad, he ⟨n, hbad.mem_to_finset.2 nbad⟩⟩ } },
    have h : ∀ (n : ℕ), ∃ (n' : ℕ), n < n' ∧ r (f (n + m)) (f (n' + m)),
    { intro n,
      have h := hm _ (le_add_of_nonneg_left n.zero_le),
      simp only [exists_prop, not_not, set.mem_set_of_eq, not_forall] at h,
      obtain ⟨n', hn1, hn2⟩ := h,
      obtain ⟨x, hpos, rfl⟩ := exists_pos_add_of_lt hn1,
      refine ⟨n + x, add_lt_add_left hpos n, _⟩,
      rw [add_assoc, add_comm x m, ← add_assoc],
      exact hn2 },
    let g' : ℕ → ℕ := @nat.rec (λ _, ℕ) m (λ n gn, nat.find (h gn)),
    exact ⟨(rel_embedding.nat_lt (λ n, g' n + m)
      (λ n, nat.add_lt_add_right (nat.find_spec (h (g' n))).1 m)).order_embedding_of_lt_embedding,
      or.intro_left _ (λ n, (nat.find_spec (h (g' n))).2)⟩ }
end

theorem exists_increasing_or_nonincreasing_subseq
  {α : Type*} (r : α → α → Prop) [is_trans α r] (f : ℕ → α) :
  ∃ (g : ℕ ↪o ℕ), (∀ m n : ℕ, m < n → r (f (g m)) (f (g n))) ∨
    (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
begin
  obtain ⟨g, hr | hnr⟩ := exists_increasing_or_nonincreasing_subseq' r f,
  { refine ⟨g, or.intro_left _ (λ m n mn, _)⟩,
    obtain ⟨x, rfl⟩ := le_iff_exists_add.1 (nat.succ_le_iff.2 mn),
    induction x with x ih,
    { apply hr },
    { apply is_trans.trans _ _ _ _ (hr _),
      exact ih (lt_of_lt_of_le m.lt_succ_self (nat.le_add_right _ _)) } },
  { exact ⟨g, or.intro_right _ hnr⟩ }
end

/-- The "monotone chain condition" below is sometimes a convenient form of well foundedness. -/
lemma well_founded.monotone_chain_condition (α : Type*) [partial_order α] :
  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →ₘ α), ∃ n, ∀ m, n ≤ m → a n = a m :=
begin
  split; intros h,
  { rw well_founded.well_founded_iff_has_max' at h,
    intros a, have hne : (set.range a).nonempty, { use a 0, simp, },
    obtain ⟨x, ⟨n, hn⟩, range_bounded⟩ := h _ hne,
    use n, intros m hm, rw ← hn at range_bounded, symmetry,
    apply range_bounded (a m) (set.mem_range_self _) (a.monotone hm), },
  { rw rel_embedding.well_founded_iff_no_descending_seq, refine ⟨λ a, _⟩,
    obtain ⟨n, hn⟩ := h (a.swap : ((<) : ℕ → ℕ → Prop) →r ((<) : α → α → Prop)).to_preorder_hom,
    exact n.succ_ne_self.symm (rel_embedding.to_preorder_hom_injective _ (hn _ n.le_succ)), },
end

/-- Given an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a partially-ordered
type, `monotonic_sequence_limit_index a` is the least natural number `n` for which `aₙ` reaches the
constant value. For sequences that are not eventually constant, `monotonic_sequence_limit_index a`
is defined, but is a junk value. -/
noncomputable def monotonic_sequence_limit_index {α : Type*} [partial_order α] (a : ℕ →ₘ α) : ℕ :=
Inf { n | ∀ m, n ≤ m → a n = a m }

/-- The constant value of an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a
partially-ordered type. -/
noncomputable def monotonic_sequence_limit {α : Type*} [partial_order α] (a : ℕ →ₘ α) :=
a (monotonic_sequence_limit_index a)

lemma well_founded.supr_eq_monotonic_sequence_limit {α : Type*} [complete_lattice α]
  (h : well_founded ((>) : α → α → Prop)) (a : ℕ →ₘ α) :
  (⨆ m, a m) = monotonic_sequence_limit a :=
begin
  suffices : (⨆ (m : ℕ), a m) ≤ monotonic_sequence_limit a,
  { exact le_antisymm this (le_supr a _), },
  apply supr_le,
  intros m,
  by_cases hm : m ≤ monotonic_sequence_limit_index a,
  { exact a.monotone hm, },
  { replace hm := le_of_not_le hm,
    let S := { n | ∀ m, n ≤ m → a n = a m },
    have hInf : Inf S ∈ S,
    { refine nat.Inf_mem _, rw well_founded.monotone_chain_condition at h, exact h a, },
    change Inf S ≤ m at hm,
    change a m ≤ a (Inf S),
    rw hInf m hm, },
end


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/
import set_theory.ordinal.arithmetic
import topology.algebra.order.basic

/-!
### Topology of ordinals

We prove some miscellaneous results involving the order topology of ordinals.

### Main results

* `ordinal.is_closed_iff_sup` / `ordinal.is_closed_iff_bsup`: A set of ordinals is closed iff it's
  closed under suprema.
* `ordinal.is_normal_iff_strict_mono_and_continuous`: A characterization of normal ordinal
  functions.
* `ordinal.enum_ord_is_normal_iff_is_closed`: The function enumerating the ordinals of a set is
  normal iff the set is closed.
-/

noncomputable theory

universes u v

open cardinal order

namespace ordinal

variables {s : set ordinal.{u}} {a : ordinal.{u}}

instance : topological_space ordinal.{u} :=
preorder.topology ordinal.{u}

instance : order_topology ordinal.{u} :=
⟨rfl⟩

theorem is_open_singleton_iff : is_open ({a} : set ordinal) ↔ ¬ is_limit a :=
begin
  refine ⟨λ h ha, _, λ ha, _⟩,
  { obtain ⟨b, c, hbc, hbc'⟩ := (mem_nhds_iff_exists_Ioo_subset'
      ⟨0, ordinal.pos_iff_ne_zero.2 ha.1⟩ ⟨_, lt_succ a⟩).1 (h.mem_nhds rfl),
    have hba := ha.2 b hbc.1,
    exact hba.ne (hbc' ⟨lt_succ b, hba.trans hbc.2⟩) },
  { rcases zero_or_succ_or_limit a with rfl | ⟨b, hb⟩ | ha',
    { convert is_open_gt' (1 : ordinal),
      ext,
      exact ordinal.lt_one_iff_zero.symm },
    { convert @is_open_Ioo _ _ _ _ b (a + 1),
      ext c,
      refine ⟨λ hc, _, _⟩,
      { rw set.mem_singleton_iff.1 hc,
        refine ⟨_, lt_succ a⟩,
        rw hb,
        exact lt_succ b },
      { rintro ⟨hc, hc'⟩,
        apply le_antisymm (le_of_lt_succ hc'),
        rw hb,
        exact succ_le_of_lt hc } },
    { exact (ha ha').elim } }
end

theorem is_open_iff : is_open s ↔ ∀ o ∈ s, is_limit o → ∃ a < o, set.Ioo a o ⊆ s :=
begin
  classical,
  refine ⟨_, λ h, _⟩,
  { rw is_open_iff_generate_intervals,
    intros h o hos ho,
    have ho₀ := ordinal.pos_iff_ne_zero.2 ho.1,
    induction h with t ht t u ht hu ht' hu' t ht H,
    { rcases ht with ⟨a, rfl | rfl⟩,
      { exact ⟨a, hos, λ b hb, hb.1⟩ },
      { exact ⟨0, ho₀, λ b hb, hb.2.trans hos⟩ } },
    { exact ⟨0, ho₀, λ b _, set.mem_univ b⟩ },
    { rcases ht' hos.1 with ⟨a, ha, ha'⟩,
      rcases hu' hos.2 with ⟨b, hb, hb'⟩,
      exact ⟨_, max_lt ha hb, λ c hc, ⟨
        ha' ⟨(le_max_left a b).trans_lt hc.1, hc.2⟩,
        hb' ⟨(le_max_right a b).trans_lt hc.1, hc.2⟩⟩⟩ },
    { rcases hos with ⟨u, hu, hu'⟩,
      rcases H u hu hu' with ⟨a, ha, ha'⟩,
      exact ⟨a, ha, λ b hb, ⟨u, hu, ha' hb⟩⟩ } },
  { let f : s → set ordinal := λ o,
      if ho : is_limit o.val
      then set.Ioo (classical.some (h o.val o.prop ho)) (o + 1)
      else {o.val},
    have : ∀ a, is_open (f a) := λ a, begin
      change is_open (dite _ _ _),
      split_ifs,
      { exact is_open_Ioo },
      { rwa is_open_singleton_iff }
    end,
    convert is_open_Union this,
    ext o,
    refine ⟨λ ho, set.mem_Union.2 ⟨⟨o, ho⟩, _⟩, _⟩,
    { split_ifs with ho',
      { refine ⟨_, lt_succ o⟩,
        cases classical.some_spec (h o ho ho') with H,
        exact H },
      { exact set.mem_singleton o } },
    { rintro ⟨t, ⟨a, ht⟩, hoa⟩,
      change dite _ _ _ = t at ht,
      split_ifs at ht with ha;
      subst ht,
      { cases classical.some_spec (h a.val a.prop ha) with H has,
        rcases lt_or_eq_of_le (le_of_lt_succ hoa.2) with hoa' | rfl,
        { exact has ⟨hoa.1, hoa'⟩ },
        { exact a.prop } },
      { convert a.prop } } }
end

theorem mem_closure_iff_sup : a ∈ closure s ↔ ∃ {ι : Type u} [nonempty ι] (f : ι → ordinal),
  (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
begin
  refine mem_closure_iff.trans ⟨λ h, _, _⟩,
  { by_cases has : a ∈ s,
    { exact ⟨punit, by apply_instance, λ _, a, λ _, has, sup_const a⟩ },
    { have H := λ b (hba : b < a), h _ (@is_open_Ioo _ _ _ _ b (a + 1)) ⟨hba, lt_succ a⟩,
      let f : a.out.α → ordinal := λ i, classical.some (H (typein (<) i) (typein_lt_self i)),
      have hf : ∀ i, f i ∈ set.Ioo (typein (<) i) (a + 1) ∩ s :=
        λ i, classical.some_spec (H _ _),
      rcases eq_zero_or_pos a with rfl | ha₀,
      { rcases h _ (is_open_singleton_iff.2 not_zero_is_limit) rfl with ⟨b, hb, hb'⟩,
        rw set.mem_singleton_iff.1 hb at *,
        exact (has hb').elim },
      refine ⟨_, out_nonempty_iff_ne_zero.2 (ordinal.pos_iff_ne_zero.1 ha₀), f,
        λ i, (hf i).2, le_antisymm (sup_le (λ i, le_of_lt_succ (hf i).1.2)) _⟩,
      by_contra' h,
      cases H _ h with b hb,
      rcases eq_or_lt_of_le (le_of_lt_succ hb.1.2) with rfl | hba,
      { exact has hb.2 },
      { have : b < f (enum (<) b (by rwa type_lt)) := begin
          have := (hf (enum (<) b (by rwa type_lt))).1.1,
          rwa typein_enum at this
        end,
        have : b ≤ sup.{u u} f := this.le.trans (le_sup f _),
        exact this.not_lt hb.1.1 } } },
  { rintro ⟨ι, ⟨i⟩, f, hf, rfl⟩ t ht hat,
    cases eq_zero_or_pos (sup.{u u} f) with ha₀ ha₀,
    { rw ha₀ at hat,
      use [0, hat],
      convert hf i,
      exact (sup_eq_zero_iff.1 ha₀ i).symm },
    rcases (mem_nhds_iff_exists_Ioo_subset' ⟨0, ha₀⟩ ⟨_, lt_succ _⟩).1 (ht.mem_nhds hat) with
      ⟨b, c, ⟨hab, hac⟩, hbct⟩,
    cases lt_sup.1 hab with i hi,
    exact ⟨_, hbct ⟨hi, (le_sup.{u u} f i).trans_lt hac⟩, hf i⟩ }
end

theorem mem_closed_iff_sup (hs : is_closed s) :
  a ∈ s ↔ ∃ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
  (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
by rw [←mem_closure_iff_sup, hs.closure_eq]

theorem mem_closure_iff_bsup :
  a ∈ closure s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
mem_closure_iff_sup.trans ⟨
  λ ⟨ι, ⟨i⟩, f, hf, ha⟩, ⟨_, λ h, (type_eq_zero_iff_is_empty.1 h).elim i, bfamily_of_family f,
    λ i hi, hf _, by rwa bsup_eq_sup⟩,
  λ ⟨o, ho, f, hf, ha⟩, ⟨_, out_nonempty_iff_ne_zero.2 ho, family_of_bfamily o f,
    λ i, hf _ _, by rwa sup_eq_bsup⟩⟩

theorem mem_closed_iff_bsup (hs : is_closed s) :
  a ∈ s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
by rw [←mem_closure_iff_bsup, hs.closure_eq]

theorem is_closed_iff_sup :
  is_closed s ↔ ∀ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
  (∀ i, f i ∈ s) → sup.{u u} f ∈ s :=
begin
  use λ hs ι hι f hf, (mem_closed_iff_sup hs).2 ⟨ι, hι, f, hf, rfl⟩,
  rw ←closure_subset_iff_is_closed,
  intros h x hx,
  rcases mem_closure_iff_sup.1 hx with ⟨ι, hι, f, hf, rfl⟩,
  exact h hι f hf
end

theorem is_closed_iff_bsup :
  is_closed s ↔ ∀ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) → bsup.{u u} o f ∈ s :=
begin
  rw is_closed_iff_sup,
  refine ⟨λ H o ho f hf, H (out_nonempty_iff_ne_zero.2 ho) _ _, λ  H ι hι f hf, _⟩,
  { exact λ i, hf _ _ },
  { rw ←bsup_eq_sup,
    apply H (type_ne_zero_iff_nonempty.2 hι),
    exact λ i hi, hf _ }
end

theorem is_limit_of_mem_frontier (ha : a ∈ frontier s) : is_limit a :=
begin
  simp only [frontier_eq_closure_inter_closure, set.mem_inter_iff, mem_closure_iff] at ha,
  by_contra h,
  rw ←is_open_singleton_iff at h,
  rcases ha.1 _ h rfl with ⟨b, hb, hb'⟩,
  rcases ha.2 _ h rfl with ⟨c, hc, hc'⟩,
  rw set.mem_singleton_iff at *,
  subst hb, subst hc,
  exact hc' hb'
end

theorem is_normal_iff_strict_mono_and_continuous (f : ordinal.{u} → ordinal.{u}) :
  is_normal f ↔ strict_mono f ∧ continuous f :=
begin
  refine ⟨λ h, ⟨h.strict_mono, _⟩, _⟩,
  { rw continuous_def,
    intros s hs,
    rw is_open_iff at *,
    intros o ho ho',
    rcases hs _ ho (h.is_limit ho') with ⟨a, ha, has⟩,
    rw [←is_normal.bsup_eq.{u u} h ho', lt_bsup] at ha,
    rcases ha with ⟨b, hb, hab⟩,
    exact ⟨b, hb, λ c hc,
      set.mem_preimage.2 (has ⟨hab.trans (h.strict_mono hc.1), h.strict_mono hc.2⟩)⟩ },
  { rw is_normal_iff_strict_mono_limit,
    rintro ⟨h, h'⟩,
    refine ⟨h, λ o ho a h, _⟩,
    suffices : o ∈ (f ⁻¹' set.Iic a), from set.mem_preimage.1 this,
    rw mem_closed_iff_sup (is_closed.preimage h' (@is_closed_Iic _ _ _ _  a)),
    exact ⟨_, out_nonempty_iff_ne_zero.2 ho.1, typein (<),
      λ i, h _ (typein_lt_self i), sup_typein_limit ho.2⟩ }
end

theorem enum_ord_is_normal_iff_is_closed (hs : s.unbounded (<)) :
  is_normal (enum_ord s) ↔ is_closed s :=
begin
  have Hs := enum_ord_strict_mono hs,
  refine ⟨λ h, is_closed_iff_sup.2 (λ ι hι f hf, _),
    λ h, (is_normal_iff_strict_mono_limit _).2 ⟨Hs, λ a ha o H, _⟩⟩,
  { let g : ι → ordinal.{u} := λ i, (enum_ord_order_iso hs).symm ⟨_, hf i⟩,
    suffices : enum_ord s (sup.{u u} g) = sup.{u u} f,
    { rw ←this, exact enum_ord_mem hs _ },
    rw is_normal.sup.{u u u} h g hι,
    congr, ext,
    change ((enum_ord_order_iso hs) _).val = f x,
    rw order_iso.apply_symm_apply },
  { rw is_closed_iff_bsup at h,
    suffices : enum_ord s a ≤ bsup.{u u} a (λ b < a, enum_ord s b), from this.trans (bsup_le H),
    cases enum_ord_surjective hs _ (h ha.1 (λ b hb, enum_ord s b) (λ b hb, enum_ord_mem hs b))
      with b hb,
    rw ←hb,
    apply Hs.monotone,
    by_contra' hba,
    apply (Hs (lt_succ b)).not_le,
    rw hb,
    exact le_bsup.{u u} _ _ (ha.2 _ hba) }
end

end ordinal


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

import linear_algebra.projective_space.basic

/-!
# Subspaces of Projective Space

In this file we define subspaces of a projective space, and show that the subspaces of a projective
space form a complete lattice under inclusion.

## Implementation Details

A subspace of a projective space ℙ K V is defined to be a structure consisting of a subset of
ℙ K V such that if two nonzero vectors in V determine points in ℙ K V which are in the subset, and
the sum of the two vectors is nonzero, then the point determined by the sum of the two vectors is
also in the subset.

## Results

- There is a Galois insertion between the subsets of points of a projective space
  and the subspaces of the projective space, which is given by taking the span of the set of points.
- The subspaces of a projective space form a complete lattice under inclusion.

# Future Work
- Show that there is a one-to-one order-preserving correspondence between subspaces of a
  projective space and the submodules of the underlying vector space.
-/

variables (K V : Type*) [field K] [add_comm_group V] [module K V]

namespace projectivization

/-- A subspace of a projective space is a structure consisting of a set of points such that:
If two nonzero vectors determine points which are in the set, and the sum of the two vectors is
nonzero, then the point determined by the sum is also in the set. -/
@[ext] structure subspace :=
(carrier : set (ℙ K V))
(mem_add' (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
  mk K v hv ∈ carrier → mk K w hw ∈ carrier → mk K (v + w) (hvw) ∈ carrier)

namespace subspace

variables {K V}

instance : set_like (subspace K V) (ℙ K V) :=
{ coe := carrier,
  coe_injective' := λ A B, by { cases A, cases B, simp } }

@[simp]
lemma mem_carrier_iff (A : subspace K V) (x : ℙ K V) : x ∈ A.carrier ↔ x ∈ A := iff.refl _

lemma mem_add (T : subspace K V) (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
  projectivization.mk K v hv ∈ T → projectivization.mk K w hw ∈ T →
  projectivization.mk K (v + w) (hvw) ∈ T :=
  T.mem_add' v w hv hw hvw

/-- The span of a set of points in a projective space is defined inductively to be the set of points
which contains the original set, and contains all points determined by the (nonzero) sum of two
nonzero vectors, each of which determine points in the span. -/
inductive span_carrier (S : set (ℙ K V)) : set (ℙ K V)
| of (x : ℙ K V) (hx : x ∈ S) : span_carrier x
| mem_add (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
    span_carrier (projectivization.mk K v hv) → span_carrier (projectivization.mk K w hw) →
    span_carrier (projectivization.mk K (v + w) (hvw))

/-- The span of a set of points in projective space is a subspace. -/
def span (S : set (ℙ K V)) : subspace K V :=
{ carrier := span_carrier S,
  mem_add' := λ v w hv hw hvw,
    span_carrier.mem_add v w hv hw hvw }

/-- The span of a set of points contains the set of points. -/
lemma subset_span (S : set (ℙ K V)) : S ⊆ span S := λ x hx, span_carrier.of _ hx

/-- The span of a set of points is a Galois insertion between sets of points of a projective space
and subspaces of the projective space. -/
def gi : galois_insertion (span : set (ℙ K V) → subspace K V) coe :=
{ choice := λ S hS, span S,
  gc := λ A B, ⟨λ h, le_trans (subset_span _) h, begin
    intros h x hx,
    induction hx,
    { apply h, assumption },
    { apply B.mem_add, assumption' }
  end⟩,
  le_l_u := λ S, subset_span _,
  choice_eq := λ _ _, rfl }

/-- The span of a subspace is the subspace. -/
@[simp] lemma span_coe (W : subspace K V) : span ↑W = W := galois_insertion.l_u_eq gi W

/-- The infimum of two subspaces exists. -/
instance has_inf : has_inf (subspace K V) :=
⟨λ A B, ⟨A ⊓ B, λ v w hv hw hvw h1 h2,
  ⟨A.mem_add _ _ hv hw _ h1.1 h2.1, B.mem_add _ _ hv hw _ h1.2 h2.2⟩⟩⟩

/-- Infimums of arbitrary collections of subspaces exist. -/
instance has_Inf : has_Inf (subspace K V) :=
⟨λ A, ⟨Inf (coe '' A), λ v w hv hw hvw h1 h2 t, begin
  rintro ⟨s, hs, rfl⟩,
  exact s.mem_add v w hv hw _ (h1 s ⟨s, hs, rfl⟩) (h2 s ⟨s, hs, rfl⟩),
end⟩⟩

/-- The subspaces of a projective space form a complete lattice. -/
instance : complete_lattice (subspace K V) :=
{ inf_le_left := λ A B x hx, by exact hx.1,
  inf_le_right := λ A B x hx, by exact hx.2,
  le_inf := λ A B C h1 h2 x hx, ⟨h1 hx, h2 hx⟩,
  ..(infer_instance : has_inf _),
  ..complete_lattice_of_Inf (subspace K V)
  begin
    refine λ s, ⟨λ a ha x hx, (hx _ ⟨a, ha, rfl⟩), λ a ha x hx E, _⟩,
    rintros ⟨E, hE, rfl⟩,
    exact (ha hE hx)
  end }

instance subspace_inhabited : inhabited (subspace K V) :=
{ default := ⊤ }

/-- The span of the empty set is the bottom of the lattice of subspaces. -/
@[simp] lemma span_empty : span (∅ : set (ℙ K V)) = ⊥ := gi.gc.l_bot

/-- The span of the entire projective space is the top of the lattice of subspaces. -/
@[simp] lemma span_univ : span (set.univ : set (ℙ K V)) = ⊤ :=
by { rw [eq_top_iff, set_like.le_def], intros x hx, exact subset_span _ (set.mem_univ x) }

/-- The span of a set of points is contained in a subspace if and only if the set of points is
contained in the subspace. -/
lemma span_le_subspace_iff {S : set (ℙ K V)} {W : subspace K V} : span S ≤ W ↔ S ⊆ W :=
gi.gc S W

/-- If a set of points is a subset of another set of points, then its span will be contained in the
span of that set. -/
@[mono] lemma monotone_span : monotone (span : set (ℙ K V) → subspace K V) := gi.gc.monotone_l

lemma subset_span_trans {S T U : set (ℙ K V)} (hST : S ⊆ span T) (hTU : T ⊆ span U) :
  S ⊆ span U :=
gi.gc.le_u_l_trans hST hTU

/-- The supremum of two subspaces is equal to the span of their union. -/
lemma span_union (S T : set (ℙ K V)) : span (S ∪ T) = span S ⊔ span T := (@gi K V _ _ _).gc.l_sup

/-- The supremum of a collection of subspaces is equal to the span of the union of the
collection. -/
lemma span_Union {ι} (s : ι → set (ℙ K V)) : span (⋃ i, s i) = ⨆ i, span (s i) :=
(@gi K V _ _ _).gc.l_supr

/-- The supremum of a subspace and the span of a set of points is equal to the span of the union of
the subspace and the set of points. -/
lemma sup_span {S : set (ℙ K V)} {W : subspace K V} : W ⊔ span S = span (W ∪ S) :=
by rw [span_union, span_coe]

/-- A point in a projective space is contained in the span of a set of points if and only if the
point is contained in all subspaces of the projective space which contain the set of points. -/
lemma mem_span {S : set (ℙ K V)} (u : ℙ K V) : u ∈ span S ↔ ∀ (W : subspace K V), S ⊆ W → u ∈ W :=
by { simp_rw ← span_le_subspace_iff, exact ⟨λ hu W hW, hW hu, λ W, W (span S) (le_refl _)⟩ }

/-- The span of a set of points in a projective space is equal to the infimum of the collection of
subspaces which contain the set. -/
lemma span_eq_Inf {S : set (ℙ K V)} : span S = Inf {W | S ⊆ W} :=
begin
  ext,
  simp_rw [mem_carrier_iff, mem_span x],
  refine ⟨λ hx, _, λ hx W hW, _⟩,
  { rintros W ⟨T, ⟨hT, rfl⟩⟩, exact (hx T hT) },
  { exact (@Inf_le _ _ {W : subspace K V | S ⊆ ↑W} W hW) x hx },
end

/-- If a set of points in projective space is contained in a subspace, and that subspace is
contained in the span of the set of points, then the span of the set of points is equal to
the subspace. -/
lemma span_eq_of_le {S : set (ℙ K V)} {W : subspace K V} (hS : S ⊆ W) (hW : W ≤ span S) :
  span S = W :=
le_antisymm (span_le_subspace_iff.mpr hS) hW

/-- The spans of two sets of points in a projective space are equal if and only if each set of
points is contained in the span of the other set. -/
lemma span_eq_span_iff {S T : set (ℙ K V)} : span S = span T ↔ S ⊆ span T ∧ T ⊆ span S :=
⟨λ h, ⟨h ▸ subset_span S, h.symm ▸ subset_span T⟩,
  λ h, le_antisymm (span_le_subspace_iff.2 h.1) (span_le_subspace_iff.2 h.2)⟩

end subspace

end projectivization


import algebra.big_operators.order
import data.nat.totient
import group_theory.order_of_element
import tactic.group group_theory.subgroup

universe u
variables {α : Type u} {a : α}

section cyclic

open_locale big_operators

local attribute [instance] set_fintype

open subgroup

/-- A group is called *cyclic* if it is generated by a single element. -/
class is_cyclic (α : Type u) [group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ gpowers g)

class is_add_cyclic (α : Type u) [add_group α] : Prop :=
(exists_generator [] : ∃ g : α, ∀ x, x ∈ add_subgroup.gmultiples g)

attribute [to_additive is_add_cyclic] is_cyclic

@[priority 100]
instance is_cyclic_of_subsingleton [group α] [subsingleton α] : is_cyclic α :=
⟨⟨1, λ x, by { rw subsingleton.elim x 1, exact mem_gpowers 1 }⟩⟩

attribute [to_additive is_add_cyclic_of_subsingleton] is_cyclic_of_subsingleton

/-
@[priority 100]
instance is_add_cyclic_of_subsingleton [add_group α] [subsingleton α] : is_add_cyclic α :=
⟨⟨0, λ x, by { rw subsingleton.elim x 0, exact add_subgroup.mem_gmultiples 0 }⟩⟩
-/

/-- A cyclic group is always commutative. This is not an `instance` because often we have a better
proof of `comm_group`. -/
def is_cyclic.comm_group [hg : group α] [is_cyclic α] : comm_group α :=
{ mul_comm := λ x y, show x * y = y * x,
    from let ⟨g, hg⟩ := is_cyclic.exists_generator α in
    let ⟨n, hn⟩ := hg x in let ⟨m, hm⟩ := hg y in
    hm ▸ hn ▸ gpow_mul_comm _ _ _,
  ..hg }

/-- A addititive cyclic group is always commutative. This is not an `instance` because often we have a better
proof of `comm_group`. -/
def is_cyclic.add_comm_group [hg : add_group α] [is_add_cyclic α] : add_comm_group α :=
{ add_comm := λ x y, show x + y = y + x,
    from let ⟨g, hg⟩ := is_add_cyclic.exists_generator α in
    let ⟨n, hn⟩ := hg x in let ⟨m, hm⟩ := hg y in
    hm ▸ hn ▸ gsmul_add_comm _ _ _,
  ..hg }

variables [group α]

lemma monoid_hom.map_cyclic {G : Type*} [group G] [h : is_cyclic G] (σ : G →* G) :
  ∃ m : ℤ, ∀ g : G, σ g = g ^ m :=
begin
  obtain ⟨h, hG⟩ := is_cyclic.exists_generator G,
  obtain ⟨m, hm⟩ := hG (σ h),
  use m,
  intro g,
  obtain ⟨n, rfl⟩ := hG g,
  rw [monoid_hom.map_gpow, ←hm, ←gpow_mul, ←gpow_mul'],
end

lemma monoid_hom.map_add_cyclic {G : Type*} [add_group G] [h : is_add_cyclic G] (σ : G →+ G) :
  ∃ m : ℤ, ∀ g : G, σ g = m • g :=
begin
  obtain ⟨h, hG⟩ := is_add_cyclic.exists_generator G,
  obtain ⟨m, hm⟩ := hG (σ h),
  use m,
  intro g,
  obtain ⟨n, rfl⟩ := hG g,
  rw [add_monoid_hom.map_gsmul, ←hm, ←gsmul_mul', ←gsmul_mul', mul_comm],
end

attribute [to_additive monoid_hom.map_add_cyclic] monoid_hom.map_cyclic

@[to_additive is_add_cyclic_of_order_of_eq_card] lemma is_cyclic_of_order_of_eq_card
  [fintype α] (x : α) (hx : order_of x = fintype.card α) : is_cyclic α :=
begin
  classical,
  use x,
  simp_rw ← set_like.mem_coe,
  rw ← set.eq_univ_iff_forall,
  apply set.eq_of_subset_of_card_le (set.subset_univ _),
  rw [fintype.card_congr (equiv.set.univ α), ← hx, order_eq_card_gpowers],
end

variables (β : Type*)
/-- **Order of an Add Subgroup** -/
lemma card_add_subgroup_dvd_card [add_group β] [fintype β] (s : add_subgroup β) [fintype s] :
  fintype.card s ∣ fintype.card β :=
by haveI := classical.prop_decidable; simp [add_subgroup.card_eq_card_quotient_add_card_add_subgroup s]

/-- A finite group of prime order is cyclic. -/
lemma is_cyclic_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_cyclic α :=
⟨begin
  obtain ⟨g, hg⟩ : ∃ g : α, g ≠ 1,
  from fintype.exists_ne_of_one_lt_card (by { rw h, exact hp.1.one_lt }) 1,
  classical, -- for fintype (subgroup.gpowers g)
  have : fintype.card (subgroup.gpowers g) ∣ p,
  { rw ←h,
    apply card_subgroup_dvd_card },
  rw nat.dvd_prime hp.1 at this,
  cases this,
  { rw fintype.card_eq_one_iff at this,
    cases this with t ht,
    suffices : g = 1,
    { contradiction },
    have hgt := ht ⟨g, by { change g ∈ subgroup.gpowers g, exact subgroup.mem_gpowers g }⟩,
    rw [←ht 1] at hgt,
    change (⟨_, _⟩ : subgroup.gpowers g) = ⟨_, _⟩ at hgt,
    simpa using hgt },
  { use g,
    intro x,
    rw [←h] at this,
    rw subgroup.eq_top_of_card_eq _ this,
    exact subgroup.mem_top _ }
end⟩

/-- A finite group of prime order is cyclic. -/
lemma is_add_cyclic_of_prime_card {α : Type u} [add_group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_add_cyclic α :=
⟨begin
  obtain ⟨g, hg⟩ : ∃ g : α, g ≠ 0,
  from fintype.exists_ne_of_one_lt_card (by { rw h, exact hp.1.one_lt }) 0,
  classical, -- for fintype (subgroup.gpowers g)
  have : fintype.card (add_subgroup.gmultiples g) ∣ p,
  { rw ←h,
    apply card_add_subgroup_dvd_card },
  rw nat.dvd_prime hp.1 at this,
  cases this,
  { rw fintype.card_eq_one_iff at this,
    cases this with t ht,
    suffices : g = 0,
    { contradiction },
    have hgt := ht ⟨g, by { change g ∈ add_subgroup.gmultiples g, exact add_subgroup.mem_gmultiples g }⟩,
    rw [←ht 0] at hgt,
    change (⟨_, _⟩ : add_subgroup.gmultiples g) = ⟨_, _⟩ at hgt,
    simpa using hgt },
  { use g,
    intro x,
    rw [←h] at this,
    rw add_subgroup.eq_top_of_card_eq _ this,
    exact add_subgroup.mem_top _ }
end⟩

attribute [to_additive is_add_cyclic_of_prime_card] is_cyclic_of_prime_card

@[to_additive order_of_eq_card_of_forall_mem_gmultiples_add] lemma order_of_eq_card_of_forall_mem_gpowers [fintype α]
  {g : α} (hx : ∀ x, x ∈ gpowers g) : order_of g = fintype.card α :=
by { classical, rw [← fintype.card_congr (equiv.set.univ α), order_eq_card_gpowers],
  simp [hx], apply fintype.card_of_finset', simp, intro x, exact hx x}

@[to_additive bot.is_add_cyclic] instance bot.is_cyclic {α : Type u} [group α] : is_cyclic (⊥ : subgroup α) :=
⟨⟨1, λ x, ⟨0, subtype.eq $ eq.symm (subgroup.mem_bot.1 x.2)⟩⟩⟩

instance subgroup.is_cyclic {α : Type u} [group α] [is_cyclic α] (H : subgroup α) : is_cyclic H :=
by haveI := classical.prop_decidable; exact
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
if hx : ∃ (x : α), x ∈ H ∧ x ≠ (1 : α) then
  let ⟨x, hx₁, hx₂⟩ := hx in
  let ⟨k, hk⟩ := hg x in
  have hex : ∃ n : ℕ, 0 < n ∧ g ^ n ∈ H,
    from ⟨k.nat_abs, nat.pos_of_ne_zero
      (λ h, hx₂ $ by rw [← hk, int.eq_zero_of_nat_abs_eq_zero h, gpow_zero]),
        match k, hk with
        | (k : ℕ), hk := by rw [int.nat_abs_of_nat, ← gpow_coe_nat, hk]; exact hx₁
        | -[1+ k], hk := by rw [int.nat_abs_of_neg_succ_of_nat,
          ← subgroup.inv_mem_iff H]; simp * at *
        end⟩,
  ⟨⟨⟨g ^ nat.find hex, (nat.find_spec hex).2⟩,
    λ ⟨x, hx⟩, let ⟨k, hk⟩ := hg x in
      have hk₁ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ gpowers (g ^ nat.find hex),
        from ⟨k / nat.find hex, by rw [← gpow_coe_nat, gpow_mul]⟩,
      have hk₂ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ H,
        by { rw gpow_mul, apply H.gpow_mem, exact_mod_cast (nat.find_spec hex).2 },
      have hk₃ : g ^ (k % nat.find hex) ∈ H,
        from (subgroup.mul_mem_cancel_right H hk₂).1 $
          by rw [← gpow_add, int.mod_add_div, hk]; exact hx,
      have hk₄ : k % nat.find hex = (k % nat.find hex).nat_abs,
        by rw int.nat_abs_of_nonneg (int.mod_nonneg _
          (int.coe_nat_ne_zero_iff_pos.2 (nat.find_spec hex).1)),
      have hk₅ : g ^ (k % nat.find hex ).nat_abs ∈ H,
        by rwa [← gpow_coe_nat, ← hk₄],
      have hk₆ : (k % (nat.find hex : ℤ)).nat_abs = 0,
        from by_contradiction (λ h,
          nat.find_min hex (int.coe_nat_lt.1 $ by rw [← hk₄];
            exact int.mod_lt_of_pos _ (int.coe_nat_pos.2 (nat.find_spec hex).1))
          ⟨nat.pos_of_ne_zero h, hk₅⟩),
      ⟨k / (nat.find hex : ℤ), subtype.ext_iff_val.2 begin
        suffices : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) = x,
        { simpa [gpow_mul] },
        rw [int.mul_div_cancel' (int.dvd_of_mod_eq_zero (int.eq_zero_of_nat_abs_eq_zero hk₆)), hk]
      end⟩⟩⟩
else
  have H = (⊥ : subgroup α), from subgroup.ext $ λ x, ⟨λ h, by simp at *; tauto,
    λ h, by rw [subgroup.mem_bot.1 h]; exact H.one_mem⟩,
  by clear _let_match; substI this; apply_instance

-- not quite done
instance subgroup.is_add_cyclic {α : Type u} [add_group α] [is_add_cyclic α] (H : add_subgroup α) : is_add_cyclic H :=
by haveI := classical.prop_decidable; exact
let ⟨g, hg⟩ := is_add_cyclic.exists_generator α in
if hx : ∃ (x : α), x ∈ H ∧ x ≠ (0 : α) then
  let ⟨x, hx₁, hx₂⟩ := hx in
  let ⟨k, hk⟩ := hg x in
  have hex : ∃ n : ℕ, 0 < n ∧ n • g ∈ H,
    from ⟨k.nat_abs, nat.pos_of_ne_zero
      (λ h, hx₂ $ by {rw [← hk, int.eq_zero_of_nat_abs_eq_zero h], simp only, rw zero_gsmul}),
        match k, hk with
        | (k : ℕ), hk := begin rw [int.nat_abs_of_nat, ← gsmul_coe_nat], simp only at hk, rw hk; exact hx₁ end
        | -[1+ k], hk := begin rw int.nat_abs_of_neg_succ_of_nat, simp only at hk, rw ← add_subgroup.neg_mem_iff H, rw add_subgroup.neg_mem_iff; simp * at * end
        end⟩,
  ⟨⟨⟨g ^ nat.find hex, (nat.find_spec hex).2⟩,
    λ ⟨x, hx⟩, let ⟨k, hk⟩ := hg x in
      have hk₁ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ gpowers (g ^ nat.find hex),
        from ⟨k / nat.find hex, by rw [← gpow_coe_nat, gpow_mul]⟩,
      have hk₂ : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) ∈ H,
        by { rw gpow_mul, apply H.gpow_mem, exact_mod_cast (nat.find_spec hex).2 },
      have hk₃ : g ^ (k % nat.find hex) ∈ H,
        from (subgroup.mul_mem_cancel_right H hk₂).1 $
          by rw [← gpow_add, int.mod_add_div, hk]; exact hx,
      have hk₄ : k % nat.find hex = (k % nat.find hex).nat_abs,
        by rw int.nat_abs_of_nonneg (int.mod_nonneg _
          (int.coe_nat_ne_zero_iff_pos.2 (nat.find_spec hex).1)),
      have hk₅ : g ^ (k % nat.find hex ).nat_abs ∈ H,
        by rwa [← gpow_coe_nat, ← hk₄],
      have hk₆ : (k % (nat.find hex : ℤ)).nat_abs = 0,
        from by_contradiction (λ h,
          nat.find_min hex (int.coe_nat_lt.1 $ by rw [← hk₄];
            exact int.mod_lt_of_pos _ (int.coe_nat_pos.2 (nat.find_spec hex).1))
          ⟨nat.pos_of_ne_zero h, hk₅⟩),
      ⟨k / (nat.find hex : ℤ), subtype.ext_iff_val.2 begin
        suffices : g ^ ((nat.find hex : ℤ) * (k / nat.find hex)) = x,
        { simpa [gpow_mul] },
        rw [int.mul_div_cancel' (int.dvd_of_mod_eq_zero (int.eq_zero_of_nat_abs_eq_zero hk₆)), hk]
      end⟩⟩⟩
else
  have H = (⊥ : subgroup α), from subgroup.ext $ λ x, ⟨λ h, by simp at *; tauto,
    λ h, by rw [subgroup.mem_bot.1 h]; exact H.one_mem⟩,
  by clear _let_match; substI this; apply_instance

#exit

open finset nat

section classical

open_locale classical

lemma is_cyclic.card_pow_eq_one_le [decidable_eq α] [fintype α] [is_cyclic α] {n : ℕ}
  (hn0 : 0 < n) : (univ.filter (λ a : α, a ^ n = 1)).card ≤ n :=
let ⟨g, hg⟩ := is_cyclic.exists_generator α in
calc (univ.filter (λ a : α, a ^ n = 1)).card
  ≤ ((gpowers (g ^ (fintype.card α / (gcd n (fintype.card α))))) : set α).to_finset.card :
  card_le_of_subset (λ x hx, let ⟨m, hm⟩ := show x ∈ submonoid.powers g,
    from mem_powers_iff_mem_gpowers.2 $ hg x in
    set.mem_to_finset.2 ⟨(m / (fintype.card α / (gcd n (fintype.card α))) : ℕ),
      have hgmn : g ^ (m * gcd n (fintype.card α)) = 1,
        by rw [pow_mul, hm, ← pow_gcd_card_eq_one_iff]; exact (mem_filter.1 hx).2,
      begin
        rw [gpow_coe_nat, ← pow_mul, nat.mul_div_cancel_left', hm],
        refine dvd_of_mul_dvd_mul_right (gcd_pos_of_pos_left (fintype.card α) hn0) _,
        conv {to_lhs,
          rw [nat.div_mul_cancel (gcd_dvd_right _ _), ← order_of_eq_card_of_forall_mem_gpowers hg]},
        exact order_of_dvd_of_pow_eq_one hgmn
      end⟩)
... ≤ n :
  let ⟨m, hm⟩ := gcd_dvd_right n (fintype.card α) in
  have hm0 : 0 < m, from nat.pos_of_ne_zero $
    λ hm0, by { rw [hm0, mul_zero, fintype.card_eq_zero_iff] at hm, exact hm.elim' 1 },
  begin
    rw [← fintype.card_of_finset' _ (λ _, set.mem_to_finset), ← order_eq_card_gpowers,
        order_of_pow g, order_of_eq_card_of_forall_mem_gpowers hg],
    rw [hm] {occs := occurrences.pos [2,3]},
    rw [nat.mul_div_cancel_left _  (gcd_pos_of_pos_left _ hn0), gcd_mul_left_left,
      hm, nat.mul_div_cancel _ hm0],
    exact le_of_dvd hn0 (gcd_dvd_left _ _)
  end

end classical

lemma is_cyclic.exists_monoid_generator [fintype α]
[is_cyclic α] : ∃ x : α, ∀ y : α, y ∈ submonoid.powers x :=
by { simp_rw [mem_powers_iff_mem_gpowers], exact is_cyclic.exists_generator α }

section

variables [decidable_eq α] [fintype α]

lemma is_cyclic.image_range_order_of (ha : ∀ x : α, x ∈ gpowers a) :
  finset.image (λ i, a ^ i) (range (order_of a)) = univ :=
begin
  simp_rw [←set_like.mem_coe] at ha,
  simp only [image_range_order_of, set.eq_univ_iff_forall.mpr ha],
  convert set.to_finset_univ
end

lemma is_cyclic.image_range_card (ha : ∀ x : α, x ∈ gpowers a) :
  finset.image (λ i, a ^ i) (range (fintype.card α)) = univ :=
by rw [← order_of_eq_card_of_forall_mem_gpowers ha, is_cyclic.image_range_order_of ha]

end

section totient

variables [decidable_eq α] [fintype α]
(hn : ∀ n : ℕ, 0 < n → (univ.filter (λ a : α, a ^ n = 1)).card ≤ n)

include hn

lemma card_pow_eq_one_eq_order_of_aux (a : α) :
  (finset.univ.filter (λ b : α, b ^ order_of a = 1)).card = order_of a :=
le_antisymm
  (hn _ (order_of_pos a))
  (calc order_of a = @fintype.card (gpowers a) (id _) : order_eq_card_gpowers
    ... ≤ @fintype.card (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
    (fintype.of_finset _ (λ _, iff.rfl)) :
      @fintype.card_le_of_injective (gpowers a)
        (↑(univ.filter (λ b : α, b ^ order_of a = 1)) : set α)
        (id _) (id _) (λ b, ⟨b.1, mem_filter.2 ⟨mem_univ _,
          let ⟨i, hi⟩ := b.2 in
          by rw [← hi, ← gpow_coe_nat, ← gpow_mul, mul_comm, gpow_mul, gpow_coe_nat,
            pow_order_of_eq_one, one_gpow]⟩⟩) (λ _ _ h, subtype.eq (subtype.mk.inj h))
    ... = (univ.filter (λ b : α, b ^ order_of a = 1)).card : fintype.card_of_finset _ _)

open_locale nat -- use φ for nat.totient

private lemma card_order_of_eq_totient_aux₁ :
  ∀ {d : ℕ}, d ∣ fintype.card α → 0 < (univ.filter (λ a : α, order_of a = d)).card →
  (univ.filter (λ a : α, order_of a = d)).card = φ d
| 0     := λ hd hd0,
let ⟨a, ha⟩ := card_pos.1 hd0 in absurd (mem_filter.1 ha).2 $ ne_of_gt $ order_of_pos a
| (d+1) := λ hd hd0,
let ⟨a, ha⟩ := card_pos.1 hd0 in
have ha : order_of a = d.succ, from (mem_filter.1 ha).2,
have h : ∑ m in (range d.succ).filter (∣ d.succ),
    (univ.filter (λ a : α, order_of a = m)).card =
    ∑ m in (range d.succ).filter (∣ d.succ), φ m, from
  finset.sum_congr rfl
    (λ m hm, have hmd : m < d.succ, from mem_range.1 (mem_filter.1 hm).1,
      have hm : m ∣ d.succ, from (mem_filter.1 hm).2,
      card_order_of_eq_totient_aux₁ (hm.trans hd) (finset.card_pos.2
        ⟨a ^ (d.succ / m), mem_filter.2 ⟨mem_univ _,
          by { rw [order_of_pow a, ha, gcd_eq_right (div_dvd_of_dvd hm),
                nat.div_div_self hm (succ_pos _)] }⟩⟩)),
have hinsert : insert d.succ ((range d.succ).filter (∣ d.succ))
    = (range d.succ.succ).filter (∣ d.succ),
  from (finset.ext $ λ x, ⟨λ h, (mem_insert.1 h).elim (λ h, by simp [h, range_succ])
    (by clear _let_match; simp [range_succ]; tauto),
     by clear _let_match; simp [range_succ] {contextual := tt}; tauto⟩),
have hinsert₁ : d.succ ∉ (range d.succ).filter (∣ d.succ),
  by simp [mem_range, zero_le_one, le_succ],
(add_left_inj (∑ m in (range d.succ).filter (∣ d.succ),
  (univ.filter (λ a : α, order_of a = m)).card)).1
  (calc _ = ∑ m in insert d.succ (filter (∣ d.succ) (range d.succ)),
        (univ.filter (λ a : α, order_of a = m)).card :
    eq.symm (finset.sum_insert (by simp [mem_range, zero_le_one, le_succ]))
  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ),
      (univ.filter (λ a : α, order_of a = m)).card :
    sum_congr hinsert (λ _ _, rfl)
  ... = (univ.filter (λ a : α, a ^ d.succ = 1)).card :
    sum_card_order_of_eq_card_pow_eq_one (succ_pos d)
  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ), φ m :
    ha ▸ (card_pow_eq_one_eq_order_of_aux hn a).symm ▸ (sum_totient _).symm
  ... = _ : by rw [h, ← sum_insert hinsert₁];
      exact finset.sum_congr hinsert.symm (λ _ _, rfl))

lemma card_order_of_eq_totient_aux₂ {d : ℕ} (hd : d ∣ fintype.card α) :
  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
by_contradiction $ λ h,
have h0 : (univ.filter (λ a : α , order_of a = d)).card = 0 :=
  not_not.1 (mt pos_iff_ne_zero.2 (mt (card_order_of_eq_totient_aux₁ hn hd) h)),
let c := fintype.card α in
have hc0 : 0 < c, from fintype.card_pos_iff.2 ⟨1⟩,
lt_irrefl c $
  calc c = (univ.filter (λ a : α, a ^ c = 1)).card :
    congr_arg card $ by simp [finset.ext_iff, c]
  ... = ∑ m in (range c.succ).filter (∣ c),
      (univ.filter (λ a : α, order_of a = m)).card :
    (sum_card_order_of_eq_card_pow_eq_one hc0).symm
  ... = ∑ m in ((range c.succ).filter (∣ c)).erase d,
      (univ.filter (λ a : α, order_of a = m)).card :
    eq.symm (sum_subset (erase_subset _ _) (λ m hm₁ hm₂,
      have m = d, by simp at *; cc,
      by simp [*, finset.ext_iff] at *; exact h0))
  ... ≤ ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
    sum_le_sum (λ m hm,
      have hmc : m ∣ c, by simp at hm; tauto,
      (imp_iff_not_or.1 (card_order_of_eq_totient_aux₁ hn hmc)).elim
        (λ h, by simp [nat.le_zero_iff.1 (le_of_not_gt h), nat.zero_le])
        (λ h, by rw h))
  ... < φ d + ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
    lt_add_of_pos_left _ (totient_pos (nat.pos_of_ne_zero
      (λ h, pos_iff_ne_zero.1 hc0 (eq_zero_of_zero_dvd $ h ▸ hd))))
  ... = ∑ m in insert d (((range c.succ).filter (∣ c)).erase d), φ m :
    eq.symm (sum_insert (by simp))
  ... = ∑ m in (range c.succ).filter (∣ c), φ m : finset.sum_congr
      (finset.insert_erase (mem_filter.2 ⟨mem_range.2 (lt_succ_of_le (le_of_dvd hc0 hd)), hd⟩))
                           (λ _ _, rfl)
  ... = c : sum_totient _

lemma is_cyclic_of_card_pow_eq_one_le : is_cyclic α :=
have (univ.filter (λ a : α, order_of a = fintype.card α)).nonempty,
from (card_pos.1 $
  by rw [card_order_of_eq_totient_aux₂ hn dvd_rfl];
  exact totient_pos (fintype.card_pos_iff.2 ⟨1⟩)),
let ⟨x, hx⟩ := this in
is_cyclic_of_order_of_eq_card x (finset.mem_filter.1 hx).2

end totient

lemma is_cyclic.card_order_of_eq_totient [is_cyclic α] [fintype α]
  {d : ℕ} (hd : d ∣ fintype.card α) : (univ.filter (λ a : α, order_of a = d)).card = totient d :=
begin
  classical,
  apply card_order_of_eq_totient_aux₂ (λ n, is_cyclic.card_pow_eq_one_le) hd
end

/-- A finite group of prime order is simple. -/
lemma is_simple_group_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
  (h : fintype.card α = p) : is_simple_group α :=
⟨begin
  have h' := nat.prime.one_lt (fact.out p.prime),
  rw ← h at h',
  haveI := fintype.one_lt_card_iff_nontrivial.1 h',
  apply exists_pair_ne α,
end, λ H Hn, begin
  classical,
  have hcard := card_subgroup_dvd_card H,
  rw [h, dvd_prime (fact.out p.prime)] at hcard,
  refine hcard.imp (λ h1, _) (λ hp, _),
  { haveI := fintype.card_le_one_iff_subsingleton.1 (le_of_eq h1),
    apply eq_bot_of_subsingleton },
  { exact eq_top_of_card_eq _ (hp.trans h.symm) }
end⟩

end cyclic

section quotient_center

open subgroup

variables {G : Type*} {H : Type*} [group G] [group H]

/-- A group is commutative if the quotient by the center is cyclic.
  Also see `comm_group_of_cycle_center_quotient` for the `comm_group` instance -/
lemma commutative_of_cyclic_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) (a b : G) : a * b = b * a :=
let ⟨⟨x, y, (hxy : f y = x)⟩, (hx : ∀ a : f.range, a ∈ gpowers _)⟩ :=
  is_cyclic.exists_generator f.range in
let ⟨m, hm⟩ := hx ⟨f a, a, rfl⟩ in
let ⟨n, hn⟩ := hx ⟨f b, b, rfl⟩ in
have hm : x ^ m = f a, by simpa [subtype.ext_iff] using hm,
have hn : x ^ n = f b, by simpa [subtype.ext_iff] using hn,
have ha : y ^ (-m) * a ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_gpow, hxy, gpow_neg, hm, inv_mul_self]),
have hb : y ^ (-n) * b ∈ center G,
  from hf (by rw [f.mem_ker, f.map_mul, f.map_gpow, hxy, gpow_neg, hn, inv_mul_self]),
calc a * b = y ^ m * ((y ^ (-m) * a) * y ^ n) * (y ^ (-n) * b) : by simp [mul_assoc]
... = y ^ m * (y ^ n * (y ^ (-m) * a)) * (y ^ (-n) * b) : by rw [mem_center_iff.1 ha]
... = y ^ m * y ^ n * y ^ (-m) * (a * (y ^ (-n) * b)) : by simp [mul_assoc]
... = y ^ m * y ^ n * y ^ (-m) * ((y ^ (-n) * b) * a) : by rw [mem_center_iff.1 hb]
... = b * a : by group

/-- A group is commutative if the quotient by the center is cyclic. -/
def comm_group_of_cycle_center_quotient [is_cyclic H] (f : G →* H)
  (hf : f.ker ≤ center G) : comm_group G :=
{ mul_comm := commutative_of_cyclic_center_quotient f hf,
  ..show group G, by apply_instance }

end quotient_center

namespace is_simple_group

section comm_group
variables [comm_group α] [is_simple_group α]

@[priority 100]
instance : is_cyclic α :=
begin
  cases subsingleton_or_nontrivial α with hi hi; haveI := hi,
  { apply is_cyclic_of_subsingleton },
  { obtain ⟨g, hg⟩ := exists_ne (1 : α),
    refine ⟨⟨g, λ x, _⟩⟩,
    cases is_simple_lattice.eq_bot_or_eq_top (subgroup.gpowers g) with hb ht,
    { exfalso,
      apply hg,
      rw [← subgroup.mem_bot, ← hb],
      apply subgroup.mem_gpowers },
    { rw ht,
      apply subgroup.mem_top } }
end

theorem prime_card [fintype α] : (fintype.card α).prime :=
begin
  have h0 : 0 < fintype.card α := fintype.card_pos_iff.2 (by apply_instance),
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator α,
  refine ⟨fintype.one_lt_card_iff_nontrivial.2 infer_instance, λ n hn, _⟩,
  refine (is_simple_lattice.eq_bot_or_eq_top (subgroup.gpowers (g ^ n))).symm.imp _ _,
  { intro h,
    have hgo := order_of_pow g,
    rw [order_of_eq_card_of_forall_mem_gpowers hg, nat.gcd_eq_right_iff_dvd.1 hn,
      order_of_eq_card_of_forall_mem_gpowers, eq_comm,
      nat.div_eq_iff_eq_mul_left (nat.pos_of_dvd_of_pos hn h0) hn] at hgo,
    { exact (mul_left_cancel' (ne_of_gt h0) ((mul_one (fintype.card α)).trans hgo)).symm },
    { intro x,
      rw h,
      exact subgroup.mem_top _ } },
  { intro h,
    apply le_antisymm (nat.le_of_dvd h0 hn),
    rw ← order_of_eq_card_of_forall_mem_gpowers hg,
    apply order_of_le_of_pow_eq_one (nat.pos_of_dvd_of_pos hn h0),
    rw [← subgroup.mem_bot, ← h],
    exact subgroup.mem_gpowers _ }
end

end comm_group

end is_simple_group

theorem comm_group.is_simple_iff_is_cyclic_and_prime_card [fintype α] [comm_group α] :
  is_simple_group α ↔ is_cyclic α ∧ (fintype.card α).prime :=
begin
  split,
  { introI h,
    exact ⟨is_simple_group.is_cyclic, is_simple_group.prime_card⟩ },
  { rintro ⟨hc, hp⟩,
    haveI : fact (fintype.card α).prime := ⟨hp⟩,
    exact is_simple_group_of_prime_card rfl }
end


import .set
-- Singles

open set

universes u v w

open_locale classical
variables {α : Type*}

lemma mem_coe_inj_iff {e f : α} :
  ({e} : set α) = ({f}  : set α) ↔ e = f :=
by {exact singleton_eq_singleton_iff}

lemma singleton_nonmem_iff {e : α} {X : set α} :
  e ∉ X ↔ ¬({e} : set α) ⊆ X :=
by rw [not_iff_not, singleton_subset_iff]

lemma singleton_ne_empty (e : α) :
  ({e} : set α) ≠ ∅ :=
λ h, by {rw set.ext_iff at h, exact not_mem_empty e ((h e).mp (by simp))}

@[simp] lemma singleton_nonmem_compl_self (e : α) :
  e ∉ ({e} : set α)ᶜ :=
λ h, by {rw ←singleton_subset_iff at h, from singleton_ne_empty e (subset_own_compl h)}

lemma subset_of_mem_of_subset {e : α} {X Y : set α} (h : e ∈ X) (h' : X ⊆ Y) :
  {e} ⊆ Y :=
singleton_subset_iff.mpr (mem_of_mem_of_subset h h')

lemma union_subset_of_mem_of_mem {e f : α} {X : set α} :
  e ∈ X → f ∈ X → ({e} ∪ {f} : set α) ⊆ X :=
λ he hf, by {refine union_subset _ _, tidy}

lemma union_singleton_subset_of_subset_mem {X Y : set α} {e : α} :
  X ⊆ Y → e ∈ Y → X ∪ {e} ⊆ Y :=
by {rw ←singleton_subset_iff, apply union_subset }

lemma ne_empty_has_mem {X : set α}  :
  X ≠ ∅ → ∃ e, e ∈ X :=
by {rw [ne_empty_iff_nonempty, nonempty_def], from id}

lemma ne_empty_iff_has_mem {X : set α} :
  X ≠ ∅ ↔ ∃ e, e ∈ X :=
⟨λ h, ne_empty_has_mem h, λ h, λ hb, by {cases h with e he, rw hb at he, exact not_mem_empty e he}⟩

lemma ne_univ_iff_has_nonmem {X : set α} :
  X ≠ univ ↔ ∃ e, e ∉ X :=
by {rw [←not_forall, not_iff_not], refine ⟨λ h x, _, λ h, _⟩, rw h, from mem_univ x, ext, tidy}

lemma nested_singletons_eq {e f: α} (hef : ({e} : set α) ⊆ ({f} : set α)) :
   e = f :=
by rwa [singleton_subset_iff, mem_singleton_iff] at hef

lemma nonmem_disjoint {e : α} {X : set α} :
  e ∉ X → ({e} ∩ X : set α) = ∅ :=
by tidy

@[simp] lemma set.sep_eq_empty_iff {P : α → Prop} :
  {x | P x} = ∅ ↔ ∀ x, ¬P x :=
by {rw ext_iff, simp, }

@[simp] lemma set.sep_in_eq_empty_iff {P : α → Prop} {X : set α} :
  {x ∈ X | P x} = ∅ ↔ ∀ x ∈ X, ¬P x :=
by {rw ext_iff, simp, }

lemma set.empty_iff_has_no_mem {X : set α} :
  X = ∅ ↔ ∀ x, x ∉ X :=
by {split, rintro rfl, simp, intro h, ext, simp, exact h x,   }

lemma nonmem_disjoint_iff {e : α} {X : set α} :
  e ∉ X ↔ {e} ∩ X = ∅ :=
by {refine ⟨λ h, nonmem_disjoint h, λ h he, _⟩,
  rw [←singleton_subset_iff, subset_iff_inter_eq_left,h] at he,
  exact singleton_ne_empty e he.symm,}

lemma inter_distinct_singles {e f : α} :
  e ≠ f → ({e} ∩ {f} : set α) = ∅ :=
λ hef, nonmem_disjoint (λ h, hef (nested_singletons_eq (singleton_subset_iff.mpr h)))

lemma mem_union_of_mem_left {e : α} {X : set α} (Y : set α) (h : e ∈ X) :
  e ∈ X ∪ Y :=
mem_of_mem_of_subset h (subset_union_left X Y)

lemma mem_union_of_mem_right {e : α} {X : set α} (Y : set α) (h : e ∈ Y) :
  e ∈ X ∪ Y :=
mem_of_mem_of_subset h (subset_union_right X Y)

lemma singleton_nonmem_compl_self_iff {X : set α} {e : α} :
  e ∉ Xᶜ ↔ e ∈ X  :=
by {rw ←mem_compl_iff, rw [compl_compl]}

lemma mem_union_iff {e : α} {X Y : set α} :
  e ∈ X ∪ Y ↔ e ∈ X ∨ e ∈ Y :=
by simp only [mem_union_eq]

lemma nonmem_inter_iff {e : α} {X Y : set α} :
   e ∉ X ∩ Y ↔ e ∉ X ∨ e ∉ Y :=
by rw [←mem_compl_iff, compl_inter, mem_union_iff, mem_compl_iff, mem_compl_iff]

lemma mem_diff_iff {e : α} {X Y : set α} :
  e ∈ X \ Y ↔ e ∈ X ∧ e ∉ Y :=
by simp only [mem_diff]

lemma subset_iff_elems_contained {X Y : set α} :
  X ⊆ Y ↔ ∀ e, e ∈ X → e ∈ Y :=
by refl

lemma mem_of_subset {X Y: set α} {e : α} :
  X ⊆ Y → e ∈ X → e ∈ Y :=
λ h he, subset_iff_elems_contained.mp h e he

lemma nonmem_of_nonmem_diff {X Y : set α} {e : α} :
  e ∉ X \ Y → e ∉ Y → e ∉ X :=
by tidy

lemma nonmem_diff_of_nonmem {X : set α} (Y : set α){e : α} :
  e ∉ X → e ∉ X\Y :=
by tidy

lemma nonmem_diff_of_mem (X : set α) {Y : set α } {e : α} (h : e ∈ Y) :
  e ∉ X \ Y :=
by tidy

lemma nonmem_of_nonmem_supset {s t : set α} {e : α} :
   e ∉ t → s ⊆ t → e ∉ s :=
by tidy

lemma eq_iff_same_elems {X Y : set α} :
  X = Y ↔ ∀ e, e ∈ X ↔ e ∈ Y :=
⟨λ h e, by rw h, λ h, by {ext, from h x}⟩

lemma nonmem_removal (X : set α) (e : α) :
  e ∉ X \ {e} :=
by tidy

lemma subset_of_removal {X Y : set α} {e : α} :
  X ⊆ Y → e ∉ X → X ⊆ Y \ {e} :=
by tidy

lemma subset_of_subset_add_nonmem {X Y: set α} {e : α} :
  X ⊆ Y ∪ {e} → e ∉ X → X ⊆ Y :=
begin
  intros hXY heX,
  simp only [subset_iff_inter_eq_left] at hXY ⊢,
  rw [nonmem_disjoint_iff, inter_comm] at heX,
  rw [inter_distrib_left, heX, union_empty] at hXY,
  from hXY,
end

lemma removal_subset_of {X Y : set α} {e : α} :
  X ⊆ Y ∪ {e} → X \ {e} ⊆ Y :=
begin
  intro h,
  simp only [subset_iff_inter_eq_left, diff_eq] at h ⊢,
  nth_rewrite 1 ← h,
  rw [inter_distrib_left, inter_distrib_right, inter_assoc _ {e}, inter_right_comm _ _ Y],
  simp only [inter_compl_self, union_empty, inter_empty],
end

lemma ssub_of_add_compl {X : set α} {e : α} :
  e ∈ Xᶜ → X ⊂ X ∪ {e} :=
begin
  refine λ hXe, ssubset_of_subset_ne (subset_union_left _ _) _, intro h, rw [h, compl_union] at hXe,
  cases hXe, solve_by_elim,
end

lemma ssub_of_add_nonmem {X : set α} {e : α} :
  e ∉ X → X ⊂ X ∪ {e} :=
λ hXe, ssub_of_add_compl (by {rwa mem_compl_iff })

lemma ssubset_of_add_nonmem_iff {X : set α} {e : α} :
  e ∉ X ↔ X ⊂ X ∪ {e} :=
by {refine ⟨λ h, ssub_of_add_nonmem h, λ h, λ hex, _⟩,
    rw [←singleton_subset_iff, subset_iff_union_eq_left, union_comm] at hex,
    rw hex at h,
    exact ssubset_irrefl _ h}

lemma ssubset_iff_subset_mem_diff {X Y : set α}:
  X ⊂ Y ↔ (X ⊆ Y) ∧ ∃ y, y ∈ Y ∧ y ∉ X :=
begin
  rw ssubset_iff_subset_not_supset, convert iff.rfl,
  rw [← iff_iff_eq, iff_not_comm, not_exists], tidy,
end

lemma union_mem_singleton {X : set α} {e : α} :
  e ∈ X → X ∪ {e} = X :=
λ h, by {tidy,}

lemma remove_nonmem {X : set α } {e : α} (he : e ∉ X) :
  X \ {e} = X :=
by tidy

lemma mem_diff_ssubset {X Y : set α} :
  X ⊂ Y → ∃ e, e ∈ Y \ X :=
λ h, ssubset_diff_nonempty h

lemma mem_only_larger_ssubset {X Y : set α} :
  X ⊂ Y → ∃ e, e ∈ Y ∧ e ∉ X :=
λ h, by {have := mem_diff_ssubset h, simp_rw mem_diff_iff at this, assumption}

lemma nonmem_of_mem_disjoint {e : α} {X Y : set α} (he : e ∈ X) (hXY : X ∩ Y = ∅) :
  e ∉ Y :=
λ hf, by {have h := set.mem_inter he hf,  rw hXY at h, exact not_mem_empty e h,  }

lemma compl_single_remove {X : set α} {e : α} :
  e ∈ X → (X \ {e})ᶜ = Xᶜ ∪ {e} :=
λ _, by rw [diff_eq, compl_inter, compl_compl]

lemma remove_union_mem_singleton {X : set α} {e : α} :
  e ∈ X → (X \ {e}) ∪ {e} = X :=
λ heX, by {rw [←singleton_subset_iff, subset_iff_union_eq_left,union_comm] at heX,
          rw [diff_eq, union_distrib_right, compl_union_self, inter_univ, heX]}

lemma exists_mem_diff_of_finite_infinite {X Y : set α} (hX : X.finite) (hY : Y.infinite) :
  ∃ e ∈ Y, e ∉ X :=
by {by_contra hn, push_neg at hn, exact hY (hX.subset hn)}

lemma add_remove_nonmem {X : set α} {e : α} :
  e ∉ X → (X ∪ {e}) \ {e} = X :=
begin
  intro h,
  rw [←mem_compl_iff, ←singleton_subset_iff, subset_iff_union_eq_left] at h,
  rw [diff_eq, inter_distrib_right],
  simp only [inter_compl_self, union_empty],
  rw [←compl_compl_inter_left, inter_comm, compl_inj_iff] at h,
  from h,
end

lemma compl_nonempty_iff_exists_nonmem {s : set α}:
  sᶜ.nonempty ↔ ∃ x, x ∉ s :=
by tidy

lemma subset_of_remove_mem_diff {X Y: set α} {e : α} (hXY : X ⊆ Y) (he : e ∈ Y \ X) :
  X ⊆ Y \ {e} :=
begin
  intros x hx, rw [mem_diff, mem_singleton_iff] at *,
  exact ⟨mem_of_mem_of_subset hx hXY, by {rintro ⟨rfl⟩, exact he.2 hx,}⟩,
end

lemma subset_remove_nonmem_of_subset {X Y : set α} {e : α} (hXY : X ⊆ Y) (he : e ∉ X) :
  X ⊆ Y \ {e} :=
λ x hx, by {simp, refine ⟨hXY hx, λ h, _⟩, rw h at hx, exact he hx}

lemma remove_single_subset' (X : set α) (e : α) :
  X \ {e} ⊆ X :=
diff_subset X {e}

lemma nonmem_of_subset_remove_single (X : set α) (e : α) :
  X ⊆ X \ {e} → e ∉ X :=
by {rw diff_eq, tidy}

lemma ne_of_mem_diff {X : set α} {e f: α} (h : e ∈ X \ {f}) :
  e ≠ f :=
λ h', by {rw h' at h, apply nonmem_removal _ _ h,}

lemma ssubset_of_remove_mem {X : set α} {e : α} (heX : e ∈ X) :
   X \ {e} ⊂ X :=
ssubset_of_subset_ne
  (diff_subset _ _)
  (λ h, by {rw [ext_iff] at h, specialize h e, rw mem_diff at h, tauto,  })

lemma add_from_nonempty_diff {X Y : set α} :
  X ⊂ Y ↔ ∃ e : α, e ∉ X ∧ X ∪ {e} ⊆ Y :=
begin
  refine ⟨λ h,_, λ h, ssubset_of_subset_ne _ (λ hne, _)⟩,
  cases nonempty_def.mp (ssubset_diff_nonempty h) with e he,
  { rw mem_diff at he, exact ⟨e, he.2,union_subset h.1 (singleton_subset_iff.mpr he.1)⟩, },
  { rcases h with ⟨e, h, h'⟩, exact subset.trans (subset_union_left _ _) h', },
  rcases h with ⟨e, h,h'⟩,  rw ←hne at h',
  exact ssubset_irrefl _ (subset.lt_of_lt_of_le (ssub_of_add_nonmem h) h'),
end

lemma aug_of_ssubset {X Y : set α} :
  X ⊂ Y → ∃ Z (e : α), X ⊆ Z ∧ Z ⊂ Y ∧ Z ∪ {e} = Y :=
begin
  intro hXY,
  rcases mem_only_larger_ssubset hXY with ⟨e, ⟨heY, heX⟩⟩,
  refine ⟨Y \ {e}, e, ⟨subset_of_removal hXY.1 heX ,⟨ _, _⟩ ⟩⟩,
  from ssubset_of_remove_mem heY,
  from remove_union_mem_singleton heY,
end

lemma exchange_comm {X : set α} {e f : α} (hef : e ≠ f):
  (X \ {e}) ∪ {f} = (X ∪ {f}) \ {e} :=
begin
  ext, simp only [mem_union, mem_diff, mem_singleton_iff],
  rcases em (x = e) with (rfl | hxe); rcases em (x = f) with (rfl | hxf),
  exact false.elim (hef rfl), simpa, simpa, tauto,
end

lemma pair_eq_union (e f : α) :
  ({e,f} : set α) = {e} ∪ {f} :=
by {ext, simp, tauto, }

lemma singleton_subset_pair_left (e f : α) :
  ({e} : set α) ⊆ {e,f} :=
λ x, or.intro_left _

lemma singleton_subset_pair_right (e f : α) :
  ({f} : set α) ⊆ {e,f} :=
λ x, or.intro_right _

lemma singleton_ssubset_pair_left {e f : α} (h : e ≠ f) :
  ({e} : set α) ⊂ {e,f} :=
by {rw [pair_comm, ssubset_iff_insert], refine ⟨f,_,subset_refl _⟩, tauto, }

lemma singleton_ssubset_pair_right {e f : α} (h : e ≠ f) :
  ({f} : set α) ⊂ {e,f} :=
by {rw [ssubset_iff_insert], refine ⟨e,_,subset_refl _⟩, tauto, }

lemma union_singletons_eq_pair {e f : α} :
  ({e} : set α) ∪ ({f} : set α) = {e,f} :=
singleton_union

lemma remove_remove_single (X : set α) (e f : α) :
  X \ {e} \ {f} = X \ {e,f} :=
by rw [diff_diff, union_singletons_eq_pair]

lemma subset_singleton_eq_singleton_or_empty {e : α} {X : set α} :
  X ⊆ {e} → X = ∅ ∨ X = {e} :=
begin
  rw subset_singleton_iff,  intro h',
  by_cases h'' : e ∈ X,
  right,
  { ext, rw ←singleton_subset_iff at h'', exact ⟨λ h, h' _ h, λ h, mem_of_mem_of_subset h h''⟩, },
  left,
  ext, simp only [set.mem_empty_eq, iff_false],
  exact λ h, h'' (by rwa ←(h' _ h)),
end

lemma subset_singleton_iff_self_or_empty {e : α} {X : set α} :
  X ⊆ {e} ↔ X = ∅ ∨ X = {e} :=
begin
  refine ⟨λ h, subset_singleton_eq_singleton_or_empty h, λ h, _⟩,
  rcases h with (rfl | rfl); simp,
end

lemma ssubset_singleton_iff_empty {e : α} {X : set α} :
  X ⊂ {e} ↔ X = ∅ :=
begin
  rw [ssubset_iff_subset_ne, subset_singleton_iff_self_or_empty],
  exact ⟨λ h, by tauto, λ h, ⟨by {left, assumption}, by {rw h, apply (singleton_ne_empty e).symm}⟩⟩,
end

lemma ssubset_pair {e f : α} {X : set α} :
  X ⊂ {e,f} → X = ∅ ∨ (X = {e}) ∨ (X = {f}) :=
begin
  intro h, rw [ssubset_iff_subset_ne, ←union_singletons_eq_pair] at h,
  cases h with hs hne, rw [subset_iff_inter_eq_left, inter_distrib_left] at hs,
  cases subset_singleton_eq_singleton_or_empty (inter_subset_right X {e}),
  rw [h, empty_union, ←subset_iff_inter_eq_left] at hs,
  cases subset_singleton_eq_singleton_or_empty hs,
  exact or.inl h_1, apply or.inr, exact or.inr h_1,
  rw [inter_comm, ←subset_iff_inter_eq_left] at h, apply or.inr,
  cases subset_singleton_eq_singleton_or_empty (inter_subset_right X {f}),
  rw [h_1, union_empty, ←subset_iff_inter_eq_left] at hs,  exact or.inl (subset.antisymm hs h),
  rw [subset_iff_inter_eq_left, inter_comm] at h,
  rw [h_1, h] at hs, exfalso, exact hne hs.symm,
end

lemma pair_subset_iff {e f : α} {X : set α} :
  {e,f} ⊆ X ↔ e ∈ X ∧ f ∈ X :=
by {refine ⟨λ h, ⟨_,_⟩, λ h, λ x hx, _⟩,
  repeat {apply singleton_subset_iff.mp, apply subset.trans _ h, simp, },
  simp only [set.mem_insert_iff, set.mem_singleton_iff] at hx,
  rcases hx with (rfl | rfl); tauto,   }


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration

import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.ennreal
import formal_ml.sum
import formal_ml.lattice
import formal_ml.measurable_space
import formal_ml.classical
import data.equiv.list

noncomputable def set.characteristic {α:Type*} (S:set α):α → ennreal := S.indicator (λ _, (1:ennreal))

@[simp]
lemma set.characteristic.of_mem {α:Type*} {S:set α} {a:α}:a∈ S → S.characteristic a = 1 :=
begin
  intros h,
  simp [set.characteristic, h],
end

@[simp]
lemma set.characteristic.of_not_mem {α:Type*} {S:set α} {a:α}:a∉ S → S.characteristic a = 0 :=
begin
  intros h,
  simp [set.characteristic, h],
end

--α → ennreal := S.indicator (λ _, (1:ennreal))

lemma set.characteristic.subset {α:Type*} {S T:set α} (h:S⊆ T):S.characteristic ≤ T.characteristic :=
begin
  intros a,
  cases classical.em (a ∈ S) with h1 h1;
  cases classical.em (a ∈ T) with h2 h2; simp [h1, h2],
  { apply le_refl _ },
  apply h2,
  apply h,
  apply h1,
end

lemma set.characteristic.prod {α β:Type*} {A:set α} {B:set β} {a:α} {b:β}:
(A.prod B).characteristic (a, b) = (A.characteristic a) * (B.characteristic b) :=
begin
  cases classical.em (a ∈ A) with h1 h1;
  cases classical.em (b ∈ B) with h2 h2; simp [h1, h2],
end

lemma set.characteristic.Union {α:Type*} {S:ℕ → set α}:
((⋃ (n:ℕ), S n).characteristic) ≤ (∑' (n:ℕ), (S n).characteristic) :=
begin
  intro x,
  rw ennreal.tsum_apply,
  cases classical.em (x ∈ (⋃ (n:ℕ), S n)) with h1 h1; simp [h1],
  simp at h1,
  cases h1 with i h1,
  have h2 : (S i).characteristic x = 1,
  { simp [h1] },
  rw ← h2,
  apply ennreal.le_tsum
end

lemma measure_theory.lintegral_characteristic {α:Type*} [Mα:measurable_space α]
(μ:measure_theory.measure α) (S:set α): measurable_set S →
  (∫⁻ (a : α), S.characteristic a ∂μ) = μ S :=
begin
  intros h,
  simp [set.characteristic],
  rw measure_theory.lintegral_indicator,
  simp,
  apply h,
end

lemma measurable.characteristic {α:Type*} [Mα:measurable_space α]
 (S:set α): measurable_set S →
  measurable (S.characteristic) := begin
  intros h,
  simp [set.characteristic],
  apply measurable.indicator,
  simp,
  apply h,
end