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

! This file was ported from Lean 3 source module data.list.sort
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.OfFn
import Mathbin.Data.List.Perm

/-!
# Sorting algorithms on lists

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

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

open List.Perm

universe uu

namespace List

/-!
### The predicate `list.sorted`
-/

section Sorted

variable {α : Type uu} {r : α → α → Prop} {a : α} {l : List α}

#print List.Sorted /-
/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def Sorted :=
  @Pairwise
#align list.sorted List.Sorted
-/

#print List.decidableSorted /-
instance decidableSorted [DecidableRel r] (l : List α) : Decidable (Sorted r l) :=
  List.instDecidablePairwise _
#align list.decidable_sorted List.decidableSorted
-/

#print List.sorted_nil /-
@[simp]
theorem sorted_nil : Sorted r [] :=
  Pairwise.nil
#align list.sorted_nil List.sorted_nil
-/

#print List.Sorted.of_cons /-
theorem Sorted.of_cons : Sorted r (a :: l) → Sorted r l :=
  Pairwise.of_cons
#align list.sorted.of_cons List.Sorted.of_cons
-/

#print List.Sorted.tail /-
theorem Sorted.tail {r : α → α → Prop} {l : List α} (h : Sorted r l) : Sorted r l.tail :=
  h.tail
#align list.sorted.tail List.Sorted.tail
-/

#print List.rel_of_sorted_cons /-
theorem rel_of_sorted_cons {a : α} {l : List α} : Sorted r (a :: l) → ∀ b ∈ l, r a b :=
  rel_of_pairwise_cons
#align list.rel_of_sorted_cons List.rel_of_sorted_cons
-/

#print List.sorted_cons /-
@[simp]
theorem sorted_cons {a : α} {l : List α} : Sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ Sorted r l :=
  pairwise_cons
#align list.sorted_cons List.sorted_cons
-/

#print List.Sorted.nodup /-
protected theorem Sorted.nodup {r : α → α → Prop} [IsIrrefl α r] {l : List α} (h : Sorted r l) :
    Nodup l :=
  h.Nodup
#align list.sorted.nodup List.Sorted.nodup
-/

#print List.eq_of_perm_of_sorted /-
theorem eq_of_perm_of_sorted [IsAntisymm α r] {l₁ l₂ : List α} (p : l₁ ~ l₂) (s₁ : Sorted r l₁)
    (s₂ : Sorted r l₂) : l₁ = l₂ :=
  by
  induction' s₁ with a l₁ h₁ s₁ IH generalizing l₂
  · exact p.nil_eq
  · have : a ∈ l₂ := p.subset (mem_cons_self _ _)
    rcases mem_split this with ⟨u₂, v₂, rfl⟩
    have p' := (perm_cons a).1 (p.trans perm_middle)
    obtain rfl := IH p' (s₂.sublist <| by simp)
    change a :: u₂ ++ v₂ = u₂ ++ ([a] ++ v₂)
    rw [← append_assoc]
    congr
    have : ∀ (x : α) (h : x ∈ u₂), x = a := fun x m =>
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _)) (h₁ _ (by simp [m]))
    rw [(@eq_replicate _ a (length u₂ + 1) (a :: u₂)).2,
          (@eq_replicate _ a (length u₂ + 1) (u₂ ++ [a])).2] <;>
        constructor <;>
      simp [iff_true_intro this, or_comm']
#align list.eq_of_perm_of_sorted List.eq_of_perm_of_sorted
-/

#print List.sublist_of_subperm_of_sorted /-
theorem sublist_of_subperm_of_sorted [IsAntisymm α r] {l₁ l₂ : List α} (p : l₁ <+~ l₂)
    (s₁ : l₁.Sorted r) (s₂ : l₂.Sorted r) : l₁ <+ l₂ :=
  by
  let ⟨_, h, h'⟩ := p
  rwa [← eq_of_perm_of_sorted h (s₂.sublist h') s₁]
#align list.sublist_of_subperm_of_sorted List.sublist_of_subperm_of_sorted
-/

#print List.sorted_singleton /-
@[simp]
theorem sorted_singleton (a : α) : Sorted r [a] :=
  pairwise_singleton _ _
#align list.sorted_singleton List.sorted_singleton
-/

#print List.Sorted.rel_nthLe_of_lt /-
theorem Sorted.rel_nthLe_of_lt {l : List α} (h : l.Sorted r) {a b : ℕ} (ha : a < l.length)
    (hb : b < l.length) (hab : a < b) : r (l.nthLe a ha) (l.nthLe b hb) :=
  List.pairwise_iff_nthLe.1 h a b hb hab
#align list.sorted.rel_nth_le_of_lt List.Sorted.rel_nthLe_of_lt
-/

#print List.Sorted.rel_nthLe_of_le /-
theorem Sorted.rel_nthLe_of_le [IsRefl α r] {l : List α} (h : l.Sorted r) {a b : ℕ}
    (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) : r (l.nthLe a ha) (l.nthLe b hb) :=
  by
  cases' eq_or_lt_of_le hab with H H
  · subst H
    exact refl _
  · exact h.rel_nth_le_of_lt _ _ H
#align list.sorted.rel_nth_le_of_le List.Sorted.rel_nthLe_of_le
-/

#print List.Sorted.rel_of_mem_take_of_mem_drop /-
theorem Sorted.rel_of_mem_take_of_mem_drop {l : List α} (h : List.Sorted r l) {k : ℕ} {x y : α}
    (hx : x ∈ List.take k l) (hy : y ∈ List.drop k l) : r x y :=
  by
  obtain ⟨iy, hiy, rfl⟩ := nth_le_of_mem hy
  obtain ⟨ix, hix, rfl⟩ := nth_le_of_mem hx
  rw [nth_le_take', nth_le_drop']
  rw [length_take] at hix
  exact h.rel_nth_le_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
#align list.sorted.rel_of_mem_take_of_mem_drop List.Sorted.rel_of_mem_take_of_mem_drop
-/

end Sorted

section Monotone

variable {n : ℕ} {α : Type uu} [Preorder α] {f : Fin n → α}

/- warning: list.monotone_iff_of_fn_sorted -> List.monotone_iff_ofFn_sorted is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] {f : (Fin n) -> α}, Iff (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.partialOrder n)) _inst_1 f) (List.Sorted.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) (List.ofFn.{u1} α n f))
but is expected to have type
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] {f : (Fin n) -> α}, Iff (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.instPartialOrderFin n)) _inst_1 f) (List.Sorted.{u1} α (fun (x._@.Mathlib.Data.List.Sort._hyg.1422 : α) (x._@.Mathlib.Data.List.Sort._hyg.1424 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Data.List.Sort._hyg.1422 x._@.Mathlib.Data.List.Sort._hyg.1424) (List.ofFn.{u1} α n f))
Case conversion may be inaccurate. Consider using '#align list.monotone_iff_of_fn_sorted List.monotone_iff_ofFn_sortedₓ'. -/
/-- A tuple is monotone if and only if the list obtained from it is sorted. -/
theorem monotone_iff_ofFn_sorted : Monotone f ↔ (ofFn f).Sorted (· ≤ ·) :=
  by
  simp_rw [sorted, pairwise_iff_nth_le, length_of_fn, nth_le_of_fn', monotone_iff_forall_lt]
  exact ⟨fun h i j hj hij => h <| fin.mk_lt_mk.mpr hij, fun h ⟨i, _⟩ ⟨j, hj⟩ hij => h i j hj hij⟩
#align list.monotone_iff_of_fn_sorted List.monotone_iff_ofFn_sorted

/- warning: list.monotone.of_fn_sorted -> Monotone.ofFn_sorted is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] {f : (Fin n) -> α}, (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.partialOrder n)) _inst_1 f) -> (List.Sorted.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) (List.ofFn.{u1} α n f))
but is expected to have type
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] {f : (Fin n) -> α}, (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.instPartialOrderFin n)) _inst_1 f) -> (List.Sorted.{u1} α (fun (x._@.Mathlib.Data.List.Sort._hyg.1381 : α) (x._@.Mathlib.Data.List.Sort._hyg.1383 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Data.List.Sort._hyg.1381 x._@.Mathlib.Data.List.Sort._hyg.1383) (List.ofFn.{u1} α n f))
Case conversion may be inaccurate. Consider using '#align list.monotone.of_fn_sorted Monotone.ofFn_sortedₓ'. -/
/-- The list obtained from a monotone tuple is sorted. -/
theorem Monotone.ofFn_sorted (h : Monotone f) : (ofFn f).Sorted (· ≤ ·) :=
  monotone_iff_ofFn_sorted.1 h
#align list.monotone.of_fn_sorted Monotone.ofFn_sorted

end Monotone

section Sort

variable {α : Type uu} (r : α → α → Prop) [DecidableRel r]

-- mathport name: «expr ≼ »
local infixl:50 " ≼ " => r

/-! ### Insertion sort -/

section InsertionSort

#print List.orderedInsert /-
/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp]
def orderedInsert (a : α) : List α → List α
  | [] => [a]
  | b :: l => if a ≼ b then a :: b :: l else b :: ordered_insert l
#align list.ordered_insert List.orderedInsert
-/

#print List.insertionSort /-
/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp]
def insertionSort : List α → List α
  | [] => []
  | b :: l => orderedInsert r b (insertion_sort l)
#align list.insertion_sort List.insertionSort
-/

#print List.orderedInsert_nil /-
@[simp]
theorem orderedInsert_nil (a : α) : [].orderedInsert r a = [a] :=
  rfl
#align list.ordered_insert_nil List.orderedInsert_nil
-/

#print List.orderedInsert_length /-
theorem orderedInsert_length : ∀ (L : List α) (a : α), (L.orderedInsert r a).length = L.length + 1
  | [], a => rfl
  | hd :: tl, a => by
    dsimp [ordered_insert]
    split_ifs <;> simp [ordered_insert_length]
#align list.ordered_insert_length List.orderedInsert_length
-/

#print List.orderedInsert_eq_take_drop /-
/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
theorem orderedInsert_eq_take_drop (a : α) :
    ∀ l : List α,
      l.orderedInsert r a = (l.takeWhile fun b => ¬a ≼ b) ++ a :: l.dropWhileₓ fun b => ¬a ≼ b
  | [] => rfl
  | b :: l => by
    dsimp only [ordered_insert]
    split_ifs <;> simp [take_while, drop_while, *]
#align list.ordered_insert_eq_take_drop List.orderedInsert_eq_take_drop
-/

#print List.insertionSort_cons_eq_take_drop /-
theorem insertionSort_cons_eq_take_drop (a : α) (l : List α) :
    insertionSort r (a :: l) =
      ((insertionSort r l).takeWhile fun b => ¬a ≼ b) ++
        a :: (insertionSort r l).dropWhileₓ fun b => ¬a ≼ b :=
  orderedInsert_eq_take_drop r a _
#align list.insertion_sort_cons_eq_take_drop List.insertionSort_cons_eq_take_drop
-/

section Correctness

open Perm

#print List.perm_orderedInsert /-
theorem perm_orderedInsert (a) : ∀ l : List α, orderedInsert r a l ~ a :: l
  | [] => Perm.refl _
  | b :: l => by
    by_cases a ≼ b <;> [simp [ordered_insert, h],
      simpa [ordered_insert, h] using ((perm_ordered_insert l).cons _).trans (perm.swap _ _ _)]
#align list.perm_ordered_insert List.perm_orderedInsert
-/

#print List.orderedInsert_count /-
theorem orderedInsert_count [DecidableEq α] (L : List α) (a b : α) :
    count a (L.orderedInsert r b) = count a L + if a = b then 1 else 0 :=
  by
  rw [(L.perm_ordered_insert r b).count_eq, count_cons]
  split_ifs <;> simp only [Nat.succ_eq_add_one, add_zero]
#align list.ordered_insert_count List.orderedInsert_count
-/

#print List.perm_insertionSort /-
theorem perm_insertionSort : ∀ l : List α, insertionSort r l ~ l
  | [] => Perm.nil
  | b :: l => by
    simpa [insertion_sort] using (perm_ordered_insert _ _ _).trans ((perm_insertion_sort l).cons b)
#align list.perm_insertion_sort List.perm_insertionSort
-/

variable {r}

#print List.Sorted.insertionSort_eq /-
/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
theorem Sorted.insertionSort_eq : ∀ {l : List α} (h : Sorted r l), insertionSort r l = l
  | [], _ => rfl
  | [a], _ => rfl
  | a :: b :: l, h =>
    by
    rw [insertion_sort, sorted.insertion_sort_eq, ordered_insert, if_pos]
    exacts[rel_of_sorted_cons h _ (Or.inl rfl), h.tail]
#align list.sorted.insertion_sort_eq List.Sorted.insertionSort_eq
-/

section TotalAndTransitive

variable [IsTotal α r] [IsTrans α r]

#print List.Sorted.orderedInsert /-
theorem Sorted.orderedInsert (a : α) : ∀ l, Sorted r l → Sorted r (orderedInsert r a l)
  | [], h => sorted_singleton a
  | b :: l, h => by
    by_cases h' : a ≼ b
    · simpa [ordered_insert, h', h] using fun b' bm => trans h' (rel_of_sorted_cons h _ bm)
    · suffices ∀ b' : α, b' ∈ ordered_insert r a l → r b b' by
        simpa [ordered_insert, h', h.of_cons.ordered_insert l]
      intro b' bm
      cases' show b' = a ∨ b' ∈ l by simpa using (perm_ordered_insert _ _ _).Subset bm with be bm
      · subst b'
        exact (total_of r _ _).resolve_left h'
      · exact rel_of_sorted_cons h _ bm
#align list.sorted.ordered_insert List.Sorted.orderedInsert
-/

variable (r)

#print List.sorted_insertionSort /-
/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertionSort : ∀ l, Sorted r (insertionSort r l)
  | [] => sorted_nil
  | a :: l => (sorted_insertion_sort l).orderedInsert a _
#align list.sorted_insertion_sort List.sorted_insertionSort
-/

end TotalAndTransitive

end Correctness

end InsertionSort

/-! ### Merge sort -/

section MergeSort

#print List.split /-
-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation
/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp]
def split : List α → List α × List α
  | [] => ([], [])
  | a :: l =>
    let (l₁, l₂) := split l
    (a :: l₂, l₁)
#align list.split List.split
-/

#print List.split_cons_of_eq /-
theorem split_cons_of_eq (a : α) {l l₁ l₂ : List α} (h : split l = (l₁, l₂)) :
    split (a :: l) = (a :: l₂, l₁) := by rw [split, h] <;> rfl
#align list.split_cons_of_eq List.split_cons_of_eq
-/

#print List.length_split_le /-
theorem length_split_le :
    ∀ {l l₁ l₂ : List α}, split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
  | [], _, _, rfl => ⟨Nat.le_refl 0, Nat.le_refl 0⟩
  | a :: l, l₁', l₂', h => by
    cases' e : split l with l₁ l₂
    injection (split_cons_of_eq _ e).symm.trans h; substs l₁' l₂'
    cases' length_split_le e with h₁ h₂
    exact ⟨Nat.succ_le_succ h₂, Nat.le_succ_of_le h₁⟩
#align list.length_split_le List.length_split_le
-/

#print List.length_split_lt /-
theorem length_split_lt {a b} {l l₁ l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) :
    length l₁ < length (a :: b :: l) ∧ length l₂ < length (a :: b :: l) :=
  by
  cases' e : split l with l₁' l₂'
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h; substs l₁ l₂
  cases' length_split_le e with h₁ h₂
  exact ⟨Nat.succ_le_succ (Nat.succ_le_succ h₁), Nat.succ_le_succ (Nat.succ_le_succ h₂)⟩
#align list.length_split_lt List.length_split_lt
-/

#print List.perm_split /-
theorem perm_split : ∀ {l l₁ l₂ : List α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
  | [], _, _, rfl => Perm.refl _
  | a :: l, l₁', l₂', h => by
    cases' e : split l with l₁ l₂
    injection (split_cons_of_eq _ e).symm.trans h; substs l₁' l₂'
    exact ((perm_split e).trans perm_append_comm).cons a
#align list.perm_split List.perm_split
-/

#print List.merge /-
/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : List α → List α → List α
  | [], l' => l'
  | l, [] => l
  | a :: l, b :: l' => if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'
#align list.merge List.merge
-/

include r

#print List.mergeSort /-
/-- Implementation of a merge sort algorithm to sort a list. -/
def mergeSort : List α → List α
  | [] => []
  | [a] => [a]
  | a :: b :: l => by
    cases' e : split (a :: b :: l) with l₁ l₂
    cases' length_split_lt e with h₁ h₂
    exact merge r (merge_sort l₁) (merge_sort l₂)termination_by'
  ⟨_, InvImage.wf length Nat.lt_wfRel⟩
#align list.merge_sort List.mergeSort
-/

#print List.mergeSort_cons_cons /-
theorem mergeSort_cons_cons {a b} {l l₁ l₂ : List α} (h : split (a :: b :: l) = (l₁, l₂)) :
    mergeSort r (a :: b :: l) = merge r (mergeSort r l₁) (mergeSort r l₂) :=
  by
  suffices
    ∀ (L : List α) (h1),
      @And.ndrec (fun a a (_ : length l₁ < length l + 1 + 1 ∧ length l₂ < length l + 1 + 1) => L) h1
          h1 =
        L
    by
    simp [merge_sort, h]
    apply this
  intros
  cases h1
  rfl
#align list.merge_sort_cons_cons List.mergeSort_cons_cons
-/

section Correctness

#print List.perm_merge /-
theorem perm_merge : ∀ l l' : List α, merge r l l' ~ l ++ l'
  | [], [] => by simp [merge]
  | [], b :: l' => by simp [merge]
  | a :: l, [] => by simp [merge]
  | a :: l, b :: l' => by
    by_cases a ≼ b
    · simpa [merge, h] using perm_merge _ _
    · suffices b :: merge r (a :: l) l' ~ a :: (l ++ b :: l') by simpa [merge, h]
      exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _))
#align list.perm_merge List.perm_merge
-/

#print List.perm_mergeSort /-
theorem perm_mergeSort : ∀ l : List α, mergeSort r l ~ l
  | [] => by simp [merge_sort]
  | [a] => by simp [merge_sort]
  | a :: b :: l => by
    cases' e : split (a :: b :: l) with l₁ l₂
    cases' length_split_lt e with h₁ h₂
    rw [merge_sort_cons_cons r e]
    apply (perm_merge r _ _).trans
    exact
      ((perm_merge_sort l₁).append (perm_merge_sort l₂)).trans (perm_split e).symm termination_by'
  ⟨_, InvImage.wf length Nat.lt_wfRel⟩
#align list.perm_merge_sort List.perm_mergeSort
-/

#print List.length_mergeSort /-
@[simp]
theorem length_mergeSort (l : List α) : (mergeSort r l).length = l.length :=
  (perm_mergeSort r _).length_eq
#align list.length_merge_sort List.length_mergeSort
-/

section TotalAndTransitive

variable {r} [IsTotal α r] [IsTrans α r]

#print List.Sorted.merge /-
theorem Sorted.merge : ∀ {l l' : List α}, Sorted r l → Sorted r l' → Sorted r (merge r l l')
  | [], [], h₁, h₂ => by simp [merge]
  | [], b :: l', h₁, h₂ => by simpa [merge] using h₂
  | a :: l, [], h₁, h₂ => by simpa [merge] using h₁
  | a :: l, b :: l', h₁, h₂ => by
    by_cases a ≼ b
    · suffices ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b' by
        simpa [merge, h, h₁.of_cons.merge h₂]
      intro b' bm
      rcases show b' = b ∨ b' ∈ l ∨ b' ∈ l' by
          simpa [or_left_comm] using (perm_merge _ _ _).Subset bm with
        (be | bl | bl')
      · subst b'
        assumption
      · exact rel_of_sorted_cons h₁ _ bl
      · exact trans h (rel_of_sorted_cons h₂ _ bl')
    · suffices ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b' by
        simpa [merge, h, h₁.merge h₂.of_cons]
      intro b' bm
      have ba : b ≼ a := (total_of r _ _).resolve_left h
      rcases show b' = a ∨ b' ∈ l ∨ b' ∈ l' by simpa using (perm_merge _ _ _).Subset bm with
        (be | bl | bl')
      · subst b'
        assumption
      · exact trans ba (rel_of_sorted_cons h₁ _ bl)
      · exact rel_of_sorted_cons h₂ _ bl'
#align list.sorted.merge List.Sorted.merge
-/

variable (r)

#print List.sorted_mergeSort /-
theorem sorted_mergeSort : ∀ l : List α, Sorted r (mergeSort r l)
  | [] => by simp [merge_sort]
  | [a] => by simp [merge_sort]
  | a :: b :: l => by
    cases' e : split (a :: b :: l) with l₁ l₂
    cases' length_split_lt e with h₁ h₂
    rw [merge_sort_cons_cons r e]
    exact (sorted_merge_sort l₁).merge (sorted_merge_sort l₂)termination_by'
  ⟨_, InvImage.wf length Nat.lt_wfRel⟩
#align list.sorted_merge_sort List.sorted_mergeSort
-/

#print List.mergeSort_eq_self /-
theorem mergeSort_eq_self [IsAntisymm α r] {l : List α} : Sorted r l → mergeSort r l = l :=
  eq_of_perm_of_sorted (perm_mergeSort _ _) (sorted_mergeSort _ _)
#align list.merge_sort_eq_self List.mergeSort_eq_self
-/

#print List.mergeSort_eq_insertionSort /-
theorem mergeSort_eq_insertionSort [IsAntisymm α r] (l : List α) :
    mergeSort r l = insertionSort r l :=
  eq_of_perm_of_sorted ((perm_mergeSort r l).trans (perm_insertionSort r l).symm)
    (sorted_mergeSort r l) (sorted_insertionSort r l)
#align list.merge_sort_eq_insertion_sort List.mergeSort_eq_insertionSort
-/

end TotalAndTransitive

end Correctness

#print List.mergeSort_nil /-
@[simp]
theorem mergeSort_nil : [].mergeSort r = [] := by rw [List.mergeSort]
#align list.merge_sort_nil List.mergeSort_nil
-/

#print List.mergeSort_singleton /-
@[simp]
theorem mergeSort_singleton (a : α) : [a].mergeSort r = [a] := by rw [List.mergeSort]
#align list.merge_sort_singleton List.mergeSort_singleton
-/

end MergeSort

end Sort

-- try them out!
--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]
--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]
end List


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.pointwise
import linear_algebra.span

/-! # Pointwise instances on `submodule`s

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

This file provides:

* `submodule.has_pointwise_neg`

and the actions

* `submodule.pointwise_distrib_mul_action`
* `submodule.pointwise_mul_action_with_zero`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.

## Implementation notes

Most of the lemmas in this file are direct copies of lemmas from
`group_theory/submonoid/pointwise.lean`.
-/

variables {α : Type*} {R : Type*} {M : Type*}

open_locale pointwise

namespace submodule

section neg

section semiring
variables [semiring R] [add_comm_group M] [module R M]

/-- The submodule with every element negated. Note if `R` is a ring and not just a semiring, this
is a no-op, as shown by `submodule.neg_eq_self`.

Recall that When `R` is the semiring corresponding to the nonnegative elements of `R'`,
`submodule R' M` is the type of cones of `M`. This instance reflects such cones about `0`.

This is available as an instance in the `pointwise` locale. -/
protected def has_pointwise_neg : has_neg (submodule R M) :=
{ neg := λ p,
  { carrier := -(p : set M),
    smul_mem' := λ r m hm, set.mem_neg.2 $ smul_neg r m ▸ p.smul_mem r $ set.mem_neg.1 hm,
    ..(- p.to_add_submonoid) } }

localized "attribute [instance] submodule.has_pointwise_neg" in pointwise
open_locale pointwise

@[simp] lemma coe_set_neg (S : submodule R M) : ↑(-S) = -(S : set M) := rfl

@[simp] lemma neg_to_add_submonoid (S : submodule R M) :
  (-S).to_add_submonoid = -S.to_add_submonoid := rfl

@[simp]

/-- `submodule.has_pointwise_neg` is involutive.

This is available as an instance in the `pointwise` locale. -/
protected def has_involutive_pointwise_neg : has_involutive_neg (submodule R M) :=
{ neg := has_neg.neg,
  neg_neg := λ S, set_like.coe_injective $ neg_neg _ }

localized "attribute [instance] submodule.has_involutive_pointwise_neg" in pointwise

@[simp] lemma neg_le_neg (S T : submodule R M) : -S ≤ -T ↔ S ≤ T :=
set_like.coe_subset_coe.symm.trans set.neg_subset_neg

lemma neg_le (S T : submodule R M) : -S ≤ T ↔ S ≤ -T :=
set_like.coe_subset_coe.symm.trans set.neg_subset

/-- `submodule.has_pointwise_neg` as an order isomorphism. -/
def neg_order_iso : submodule R M ≃o submodule R M :=
{ to_equiv := equiv.neg _,
  map_rel_iff' := neg_le_neg }

lemma closure_neg (s : set M) : span R (-s) = -(span R s) :=
begin
  apply le_antisymm,
  { rw [span_le, coe_set_neg, ←set.neg_subset, neg_neg],
    exact subset_span },
  { rw [neg_le, span_le, coe_set_neg, ←set.neg_subset],
    exact subset_span }
end

@[simp]
lemma neg_inf (S T : submodule R M) : -(S ⊓ T) = (-S) ⊓ (-T) :=
set_like.coe_injective set.inter_neg

@[simp]
lemma neg_sup (S T : submodule R M) : -(S ⊔ T) = (-S) ⊔ (-T) :=
(neg_order_iso : submodule R M ≃o submodule R M).map_sup S T

@[simp]
lemma neg_bot : -(⊥ : submodule R M) = ⊥ :=
set_like.coe_injective $ (set.neg_singleton 0).trans $ congr_arg _ neg_zero

@[simp]
lemma neg_top : -(⊤ : submodule R M) = ⊤ :=
set_like.coe_injective $ set.neg_univ

@[simp]
lemma neg_infi {ι : Sort*} (S : ι → submodule R M) : -(⨅ i, S i) = ⨅ i, -S i :=
(neg_order_iso : submodule R M ≃o submodule R M).map_infi _

@[simp]
lemma neg_supr {ι : Sort*} (S : ι → submodule R M) : -(⨆ i, S i) = ⨆ i, -(S i) :=
(neg_order_iso : submodule R M ≃o submodule R M).map_supr _

end semiring

open_locale pointwise

@[simp] lemma neg_eq_self [ring R] [add_comm_group M] [module R M] (p : submodule R M) : -p = p :=
ext $ λ _, p.neg_mem_iff

end neg

variables [semiring R] [add_comm_monoid M] [module R M]

instance pointwise_add_comm_monoid : add_comm_monoid (submodule R M) :=
{ add := (⊔),
  add_assoc := λ _ _ _, sup_assoc,
  zero := ⊥,
  zero_add := λ _, bot_sup_eq,
  add_zero := λ _, sup_bot_eq,
  add_comm := λ _ _, sup_comm }

@[simp] lemma add_eq_sup (p q : submodule R M) : p + q = p ⊔ q := rfl
@[simp] lemma zero_eq_bot : (0 : submodule R M) = ⊥ := rfl

instance : canonically_ordered_add_monoid (submodule R M) :=
{ zero := 0,
  bot := ⊥,
  add := (+),
  add_le_add_left := λ a b, sup_le_sup_left,
  exists_add_of_le := λ a b h, ⟨b, (sup_eq_right.2 h).symm⟩,
  le_self_add := λ a b, le_sup_left,
  ..submodule.pointwise_add_comm_monoid,
  ..submodule.complete_lattice }

section
variables [monoid α] [distrib_mul_action α M] [smul_comm_class α R M]

/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_distrib_mul_action : distrib_mul_action α (submodule R M) :=
{ smul := λ a S, S.map (distrib_mul_action.to_linear_map R M a : M →ₗ[R] M),
  one_smul := λ S,
    (congr_arg (λ f : module.End R M, S.map f) (linear_map.ext $ by exact one_smul α)).trans
      S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f : module.End R M, S.map f) (linear_map.ext $ by exact mul_smul _ _)).trans
      (S.map_comp _ _),
  smul_zero := λ a, map_bot _,
  smul_add := λ a S₁ S₂, map_sup _ _ _ }

localized "attribute [instance] submodule.pointwise_distrib_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : submodule R M) : ↑(a • S) = a • (S : set M) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : submodule R M) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

@[simp] lemma pointwise_smul_to_add_subgroup {R M : Type*}
  [ring R] [add_comm_group M] [distrib_mul_action α M] [module R M] [smul_comm_class α R M]
  (a : α) (S : submodule R M) :
  (a • S).to_add_subgroup = a • S.to_add_subgroup := rfl

lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M))

/-- See also `submodule.smul_bot`. -/
@[simp] lemma smul_bot' (a : α) : a • (⊥ : submodule R M) = ⊥ := map_bot _
/-- See also `submodule.smul_sup`. -/
lemma smul_sup' (a : α) (S T : submodule R M) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
lemma smul_span (a : α) (s : set M) : a • span R s = span R (a • s) := map_span _ _
lemma span_smul (a : α) (s : set M) : span R (a • s) = a • span R s := eq.symm (span_image _).symm

instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ M] [smul_comm_class αᵐᵒᵖ R M]
  [is_central_scalar α M] :
  is_central_scalar α (submodule R M) :=
⟨λ a S, congr_arg (λ f : module.End R M, S.map f) $ linear_map.ext $ by exact op_smul_eq_smul _⟩

@[simp] lemma smul_le_self_of_tower {α : Type*}
  [semiring α] [module α R] [module α M] [smul_comm_class α R M] [is_scalar_tower α R M]
  (a : α) (S : submodule R M) : a • S ≤ S :=
begin
  rintro y ⟨x, hx, rfl⟩,
  exact smul_of_tower_mem _ a hx,
end

end

section
variables [semiring α] [module α M] [smul_comm_class α R M]
/-- The action on a submodule corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale.

This is a stronger version of `submodule.pointwise_distrib_mul_action`. Note that `add_smul` does
not hold so this cannot be stated as a `module`. -/
protected def pointwise_mul_action_with_zero : mul_action_with_zero α (submodule R M) :=
{ zero_smul := λ S,
    (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact zero_smul α)).trans S.map_zero,
  .. submodule.pointwise_distrib_mul_action }

localized "attribute [instance] submodule.pointwise_mul_action_with_zero" in pointwise

end

end submodule


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

/-!
# Intervals in `pi`-space

In this we prove various simple lemmas about intervals in `Π i, α i`. Closed intervals (`Ici x`,
`Iic x`, `Icc x y`) are equal to products of their projections to `α i`, while (semi-)open intervals
usually include the corresponding products as proper subsets.
-/

variables {ι : Type*} {α : ι → Type*}

namespace set

section pi_preorder

variables [Π i, preorder (α i)] (x y : Π i, α i)

@[simp] lemma pi_univ_Ici : pi univ (λ i, Ici (x i)) = Ici x :=
ext $ λ y, by simp [pi.le_def]

@[simp] lemma pi_univ_Iic : pi univ (λ i, Iic (x i)) = Iic x :=
ext $ λ y, by simp [pi.le_def]

@[simp] lemma pi_univ_Icc : pi univ (λ i, Icc (x i) (y i)) = Icc x y :=
ext $ λ y, by simp [pi.le_def, forall_and_distrib]

lemma piecewise_mem_Icc {s : set ι} [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, α i}
  (h₁ : ∀ i ∈ s, f₁ i ∈ Icc (g₁ i) (g₂ i)) (h₂ : ∀ i ∉ s, f₂ i ∈ Icc (g₁ i) (g₂ i)) :
  s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
⟨le_piecewise (λ i hi, (h₁ i hi).1) (λ i hi, (h₂ i hi).1),
  piecewise_le (λ i hi, (h₁ i hi).2) (λ i hi, (h₂ i hi).2)⟩

lemma piecewise_mem_Icc' {s : set ι} [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, α i}
  (h₁ : f₁ ∈ Icc g₁ g₂) (h₂ : f₂ ∈ Icc g₁ g₂) :
  s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
piecewise_mem_Icc (λ i hi, ⟨h₁.1 _, h₁.2 _⟩) (λ i hi, ⟨h₂.1 _, h₂.2 _⟩)

section nonempty

variable [nonempty ι]

lemma pi_univ_Ioi_subset : pi univ (λ i, Ioi (x i)) ⊆ Ioi x :=
λ z hz, ⟨λ i, le_of_lt $ hz i trivial,
  λ h, nonempty.elim ‹nonempty ι› $ λ i, (h i).not_lt (hz i trivial)⟩

lemma pi_univ_Iio_subset : pi univ (λ i, Iio (x i)) ⊆ Iio x :=
@pi_univ_Ioi_subset ι (λ i, order_dual (α i)) _ x _

lemma pi_univ_Ioo_subset : pi univ (λ i, Ioo (x i) (y i)) ⊆ Ioo x y :=
λ x hx, ⟨pi_univ_Ioi_subset _ $ λ i hi, (hx i hi).1, pi_univ_Iio_subset _ $ λ i hi, (hx i hi).2⟩

lemma pi_univ_Ioc_subset : pi univ (λ i, Ioc (x i) (y i)) ⊆ Ioc x y :=
λ x hx, ⟨pi_univ_Ioi_subset _ $ λ i hi, (hx i hi).1, λ i, (hx i trivial).2⟩

lemma pi_univ_Ico_subset : pi univ (λ i, Ico (x i) (y i)) ⊆ Ico x y :=
λ x hx, ⟨λ i, (hx i trivial).1, pi_univ_Iio_subset _ $ λ i hi, (hx i hi).2⟩

end nonempty

variable [decidable_eq ι]

open function (update)

lemma pi_univ_Ioc_update_left {x y : Π i, α i} {i₀ : ι} {m : α i₀} (hm : x i₀ ≤ m) :
  pi univ (λ i, Ioc (update x i₀ m i) (y i)) = {z | m < z i₀} ∩ pi univ (λ i, Ioc (x i) (y i)) :=
begin
  have : Ioc m (y i₀) = Ioi m ∩ Ioc (x i₀) (y i₀),
    by rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, ← inter_assoc,
      inter_eq_self_of_subset_left (Ioi_subset_Ioi hm)],
  simp_rw [univ_pi_update i₀ _ _ (λ i z, Ioc z (y i)), ← pi_inter_compl ({i₀} : set ι),
    singleton_pi', ← inter_assoc, this],
  refl
end

lemma pi_univ_Ioc_update_right {x y : Π i, α i} {i₀ : ι} {m : α i₀} (hm : m ≤ y i₀) :
  pi univ (λ i, Ioc (x i) (update y i₀ m i)) = {z | z i₀ ≤ m} ∩ pi univ (λ i, Ioc (x i) (y i)) :=
begin
  have : Ioc (x i₀) m = Iic m ∩ Ioc (x i₀) (y i₀),
    by rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, inter_left_comm,
      inter_eq_self_of_subset_left (Iic_subset_Iic.2 hm)],
  simp_rw [univ_pi_update i₀ y m (λ i z, Ioc (x i) z), ← pi_inter_compl ({i₀} : set ι),
    singleton_pi', ← inter_assoc, this],
  refl
end

lemma disjoint_pi_univ_Ioc_update_left_right {x y : Π i, α i} {i₀ : ι} {m : α i₀} :
  disjoint (pi univ (λ i, Ioc (x i) (update y i₀ m i)))
    (pi univ (λ i, Ioc (update x i₀ m i) (y i))) :=
begin
  rintro z ⟨h₁, h₂⟩,
  refine (h₁ i₀ (mem_univ _)).2.not_lt _,
  simpa only [function.update_same] using (h₂ i₀ (mem_univ _)).1
end

end pi_preorder

variables [decidable_eq ι] [Π i, linear_order (α i)]

open function (update)

lemma pi_univ_Ioc_update_union (x y : Π i, α i) (i₀ : ι) (m : α i₀) (hm : m ∈ Icc (x i₀) (y i₀)) :
  pi univ (λ i, Ioc (x i) (update y i₀ m i)) ∪ pi univ (λ i, Ioc (update x i₀ m i) (y i)) =
    pi univ (λ i, Ioc (x i) (y i)) :=
by simp_rw [pi_univ_Ioc_update_left hm.1, pi_univ_Ioc_update_right hm.2,
  ← union_inter_distrib_right, ← set_of_or, le_or_lt, set_of_true, univ_inter]

/-- If `x`, `y`, `x'`, and `y'` are functions `Π i : ι, α i`, then
the set difference between the box `[x, y]` and the product of the open intervals `(x' i, y' i)`
is covered by the union of the following boxes: for each `i : ι`, we take
`[x, update y i (x' i)]` and `[update x i (y' i), y]`.

E.g., if `x' = x` and `y' = y`, then this lemma states that the difference between a closed box
`[x, y]` and the corresponding open box `{z | ∀ i, x i < z i < y i}` is covered by the union
of the faces of `[x, y]`. -/
lemma Icc_diff_pi_univ_Ioo_subset (x y x' y' : Π i, α i) :
  Icc x y \ pi univ (λ i, Ioo (x' i) (y' i)) ⊆
    (⋃ i : ι, Icc x (update y i (x' i))) ∪ ⋃ i : ι, Icc (update x i (y' i)) y :=
begin
  rintros a ⟨⟨hxa, hay⟩, ha'⟩,
  simpa [le_update_iff, update_le_iff, hxa, hay, hxa _, hay _, ← exists_or_distrib,
    not_and_distrib] using ha'
end

/-- If `x`, `y`, `z` are functions `Π i : ι, α i`, then
the set difference between the box `[x, z]` and the product of the intervals `(y i, z i]`
is covered by the union of the boxes `[x, update z i (y i)]`.

E.g., if `x = y`, then this lemma states that the difference between a closed box
`[x, y]` and the product of half-open intervals `{z | ∀ i, x i < z i ≤ y i}` is covered by the union
of the faces of `[x, y]` adjacent to `x`. -/
lemma Icc_diff_pi_univ_Ioc_subset (x y z : Π i, α i) :
  Icc x z \ pi univ (λ i, Ioc (y i) (z i)) ⊆ ⋃ i : ι, Icc x (update z i (y i)) :=
begin
  rintros a ⟨⟨hax, haz⟩, hay⟩,
  simpa [not_and_distrib, hax, le_update_iff, haz _] using hay
end

end set


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

import data.zmod.basic
import group_theory.index
import group_theory.group_action.conj_act
import group_theory.perm.cycle_type
import group_theory.quotient_group

/-!
# p-groups

This file contains a proof that if `G` is a `p`-group acting on a finite set `α`,
then the number of fixed points of the action is congruent mod `p` to the cardinality of `α`.
It also contains proofs of some corollaries of this lemma about existence of fixed points.
-/

open_locale big_operators

open fintype mul_action

variables (p : ℕ) (G : Type*) [group G]

/-- A p-group is a group in which every element has prime power order -/
def is_p_group : Prop := ∀ g : G, ∃ k : ℕ, g ^ (p ^ k) = 1

variables {p} {G}

namespace is_p_group

lemma iff_order_of [hp : fact p.prime] :
  is_p_group p G ↔ ∀ g : G, ∃ k : ℕ, order_of g = p ^ k :=
forall_congr (λ g, ⟨λ ⟨k, hk⟩, exists_imp_exists (by exact λ j, Exists.snd)
  ((nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hk)),
  exists_imp_exists (λ k hk, by rw [←hk, pow_order_of_eq_one])⟩)

lemma of_card [fintype G] {n : ℕ} (hG : card G = p ^ n) : is_p_group p G :=
λ g, ⟨n, by rw [←hG, pow_card_eq_one]⟩

lemma of_bot : is_p_group p (⊥ : subgroup G) :=
of_card (subgroup.card_bot.trans (pow_zero p).symm)

lemma iff_card [fact p.prime] [fintype G] :
  is_p_group p G ↔ ∃ n : ℕ, card G = p ^ n :=
begin
  have hG : 0 < card G := card_pos_iff.mpr has_one.nonempty,
  refine ⟨λ h, _, λ ⟨n, hn⟩, of_card hn⟩,
  suffices : ∀ q ∈ nat.factors (card G), q = p,
  { use (card G).factors.length,
    rw [←list.prod_repeat, ←list.eq_repeat_of_mem this, nat.prod_factors hG] },
  intros q hq,
  obtain ⟨hq1, hq2⟩ := (nat.mem_factors hG).mp hq,
  haveI : fact q.prime := ⟨hq1⟩,
  obtain ⟨g, hg⟩ := equiv.perm.exists_prime_order_of_dvd_card q hq2,
  obtain ⟨k, hk⟩ := (iff_order_of.mp h) g,
  exact (hq1.pow_eq_iff.mp (hg.symm.trans hk).symm).1.symm,
end

section G_is_p_group

variables (hG : is_p_group p G)

include hG

lemma of_injective {H : Type*} [group H] (ϕ : H →* G) (hϕ : function.injective ϕ) :
  is_p_group p H :=
begin
  simp_rw [is_p_group, ←hϕ.eq_iff, ϕ.map_pow, ϕ.map_one],
  exact λ h, hG (ϕ h),
end

lemma to_subgroup (H : subgroup G) : is_p_group p H :=
hG.of_injective H.subtype subtype.coe_injective

lemma of_surjective {H : Type*} [group H] (ϕ : G →* H) (hϕ : function.surjective ϕ) :
  is_p_group p H :=
begin
  refine λ h, exists.elim (hϕ h) (λ g hg, exists_imp_exists (λ k hk, _) (hG g)),
  rw [←hg, ←ϕ.map_pow, hk, ϕ.map_one],
end

lemma to_quotient (H : subgroup G) [H.normal] :
  is_p_group p (G ⧸ H) :=
hG.of_surjective (quotient_group.mk' H) quotient.surjective_quotient_mk'

lemma of_equiv {H : Type*} [group H] (ϕ : G ≃* H) : is_p_group p H :=
hG.of_surjective ϕ.to_monoid_hom ϕ.surjective

variables [hp : fact p.prime]

include hp

lemma index (H : subgroup G) [fintype (G ⧸ H)] :
  ∃ n : ℕ, H.index = p ^ n :=
begin
  obtain ⟨n, hn⟩ := iff_card.mp (hG.to_quotient H.normal_core),
  obtain ⟨k, hk1, hk2⟩ := (nat.dvd_prime_pow hp.out).mp ((congr_arg _
    (H.normal_core.index_eq_card.trans hn)).mp (subgroup.index_dvd_of_le H.normal_core_le)),
  exact ⟨k, hk2⟩,
end

variables {α : Type*} [mul_action G α]

lemma card_orbit (a : α) [fintype (orbit G a)] :
  ∃ n : ℕ, card (orbit G a) = p ^ n :=
begin
  let ϕ := orbit_equiv_quotient_stabilizer G a,
  haveI := fintype.of_equiv (orbit G a) ϕ,
  rw [card_congr ϕ, ←subgroup.index_eq_card],
  exact hG.index (stabilizer G a),
end

variables (α) [fintype α] [fintype (fixed_points G α)]

/-- If `G` is a `p`-group acting on a finite set `α`, then the number of fixed points
  of the action is congruent mod `p` to the cardinality of `α` -/
lemma card_modeq_card_fixed_points : card α ≡ card (fixed_points G α) [MOD p] :=
begin
  classical,
  calc card α = card (Σ y : quotient (orbit_rel G α), {x // quotient.mk' x = y}) :
    card_congr (equiv.sigma_preimage_equiv (@quotient.mk' _ (orbit_rel G α))).symm
  ... = ∑ a : quotient (orbit_rel G α), card {x // quotient.mk' x = a} : card_sigma _
  ... ≡ ∑ a : fixed_points G α, 1 [MOD p] : _
  ... = _ : by simp; refl,
  rw [←zmod.eq_iff_modeq_nat p, nat.cast_sum, nat.cast_sum],
  have key : ∀ x, card {y // (quotient.mk' y : quotient (orbit_rel G α)) = quotient.mk' x} =
    card (orbit G x) := λ x, by simp only [quotient.eq']; congr,
  refine eq.symm (finset.sum_bij_ne_zero (λ a _ _, quotient.mk' a.1) (λ _ _ _, finset.mem_univ _)
    (λ a₁ a₂ _ _ _ _ h, subtype.eq ((mem_fixed_points' α).mp a₂.2 a₁.1 (quotient.exact' h)))
      (λ b, quotient.induction_on' b (λ b _ hb, _)) (λ a ha _, by
      { rw [key, mem_fixed_points_iff_card_orbit_eq_one.mp a.2] })),
  obtain ⟨k, hk⟩ := hG.card_orbit b,
  have : k = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p)
    (by rwa [pow_one, ←hk, ←nat.modeq_zero_iff_dvd, ←zmod.eq_iff_modeq_nat, ←key])))),
  exact ⟨⟨b, mem_fixed_points_iff_card_orbit_eq_one.2 $ by rw [hk, this, pow_zero]⟩,
    finset.mem_univ _, (ne_of_eq_of_ne nat.cast_one one_ne_zero), rfl⟩,
end

/-- If a p-group acts on `α` and the cardinality of `α` is not a multiple
  of `p` then the action has a fixed point. -/
lemma nonempty_fixed_point_of_prime_not_dvd_card (hpα : ¬ p ∣ card α) :
  (fixed_points G α).nonempty :=
@set.nonempty_of_nonempty_subtype _ _ begin
rw [←card_pos_iff, pos_iff_ne_zero],
  contrapose! hpα,
  rw [←nat.modeq_zero_iff_dvd, ←hpα],
  exact hG.card_modeq_card_fixed_points α,
end

/-- If a p-group acts on `α` and the cardinality of `α` is a multiple
  of `p`, and the action has one fixed point, then it has another fixed point. -/
lemma exists_fixed_point_of_prime_dvd_card_of_fixed_point
  (hpα : p ∣ card α) {a : α} (ha : a ∈ fixed_points G α) :
  ∃ b, b ∈ fixed_points G α ∧ a ≠ b :=
have hpf : p ∣ card (fixed_points G α) :=
  nat.modeq_zero_iff_dvd.mp ((hG.card_modeq_card_fixed_points α).symm.trans hpα.modeq_zero_nat),
have hα : 1 < card (fixed_points G α) :=
  (fact.out p.prime).one_lt.trans_le (nat.le_of_dvd (card_pos_iff.2 ⟨⟨a, ha⟩⟩) hpf),
let ⟨⟨b, hb⟩, hba⟩ := exists_ne_of_one_lt_card hα ⟨a, ha⟩ in
⟨b, hb, λ hab, hba (by simp_rw [hab])⟩

lemma center_nontrivial [nontrivial G] [fintype G] : nontrivial (subgroup.center G) :=
begin
  classical,
  have := (hG.of_equiv conj_act.to_conj_act).exists_fixed_point_of_prime_dvd_card_of_fixed_point G,
  rw conj_act.fixed_points_eq_center at this,
  obtain ⟨g, hg⟩ := this _ (subgroup.center G).one_mem,
  { exact ⟨⟨1, ⟨g, hg.1⟩, mt subtype.ext_iff.mp hg.2⟩⟩ },
  { obtain ⟨n, hn⟩ := is_p_group.iff_card.mp hG,
    rw hn,
    apply dvd_pow_self,
    rintro rfl,
    exact (fintype.one_lt_card).ne' hn },
end

lemma bot_lt_center [nontrivial G] [fintype G] : ⊥ < subgroup.center G :=
begin
  haveI := center_nontrivial hG,
  classical,
  exact bot_lt_iff_ne_bot.mpr ((subgroup.center G).one_lt_card_iff_ne_bot.mp fintype.one_lt_card),
end

end G_is_p_group

lemma to_le {H K : subgroup G} (hK : is_p_group p K) (hHK : H ≤ K) : is_p_group p H :=
hK.of_injective (subgroup.inclusion hHK) (λ a b h, subtype.ext (show _, from subtype.ext_iff.mp h))

lemma to_inf_left {H K : subgroup G} (hH : is_p_group p H) : is_p_group p (H ⊓ K : subgroup G) :=
hH.to_le inf_le_left

lemma to_inf_right {H K : subgroup G} (hK : is_p_group p K) : is_p_group p (H ⊓ K : subgroup G) :=
hK.to_le inf_le_right

lemma map {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : G →* K) : is_p_group p (H.map ϕ) :=
begin
  rw [←H.subtype_range, monoid_hom.map_range],
  exact hH.of_surjective (ϕ.restrict H).range_restrict (ϕ.restrict H).range_restrict_surjective,
end

lemma comap_of_ker_is_p_group {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : is_p_group p ϕ.ker) : is_p_group p (H.comap ϕ) :=
begin
  intro g,
  obtain ⟨j, hj⟩ := hH ⟨ϕ g.1, g.2⟩,
  rw [subtype.ext_iff, H.coe_pow, subtype.coe_mk, ←ϕ.map_pow] at hj,
  obtain ⟨k, hk⟩ := hϕ ⟨g.1 ^ p ^ j, hj⟩,
  rwa [subtype.ext_iff, ϕ.ker.coe_pow, subtype.coe_mk, ←pow_mul, ←pow_add] at hk,
  exact ⟨j + k, by rwa [subtype.ext_iff, (H.comap ϕ).coe_pow]⟩,
end

lemma comap_of_injective {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : function.injective ϕ) : is_p_group p (H.comap ϕ) :=
begin
  apply hH.comap_of_ker_is_p_group ϕ,
  rw ϕ.ker_eq_bot_iff.mpr hϕ,
  exact is_p_group.of_bot,
end

lemma to_sup_of_normal_right {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [K.normal] : is_p_group p (H ⊔ K : subgroup G) :=
begin
  rw [←quotient_group.ker_mk K, ←subgroup.comap_map_eq],
  apply (hH.map (quotient_group.mk' K)).comap_of_ker_is_p_group,
  rwa quotient_group.ker_mk,
end

lemma to_sup_of_normal_left {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [H.normal] : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right hK hH)

lemma to_sup_of_normal_right' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : H ≤ K.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
let hHK' := to_sup_of_normal_right (hH.of_equiv (subgroup.comap_subtype_equiv_of_le hHK).symm)
  (hK.of_equiv (subgroup.comap_subtype_equiv_of_le subgroup.le_normalizer).symm) in
((congr_arg (λ H : subgroup K.normalizer, is_p_group p H)
  (subgroup.sup_subgroup_of_eq hHK subgroup.le_normalizer)).mp hHK').of_equiv
  (subgroup.comap_subtype_equiv_of_le (sup_le hHK subgroup.le_normalizer))

lemma to_sup_of_normal_left' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : K ≤ H.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right' hK hH hHK)

end is_p_group


import game.sets.sets_level04 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type --hide

/-
# Chapter 1 : Sets

## Level 5
-/

/-
If `h : ∀ (x : X), x ∈ A → x ∈ B` then `h` is a function which takes
a term `x` of type `X` as input, and also a proof that `x ∈ A`, and outputs a
proof that `x ∈ B`. If you want to run this function `h` on some term `a : X`
then any of the following work:

```
have h2 := h a,
replace h := h a,
specialize h a
```

The first one preserves `h` and creates a new hypothesis `h2`. The others
replace `h` with `h : a ∈ A → a ∈ B`.
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq B \iff A \cap B = A.$$
-/

theorem subset_iff_inter_eq (A : set X) (B : set X) : A ⊆ B ↔ A = A ∩ B :=
begin
  rw subset_iff,
  rw ext_iff,
  split,
  intro h,
  intro j,
  specialize h j,
  simp_rw mem_inter_iff,
  tauto!,

  intro h,
  intro j,
  specialize h j,
  simp_rw mem_inter_iff at h,
  tauto!,

end

-- begin hide
-- theorem subset_iff_intersection_eq' (A : set X) (B : set X) : A ⊆ B ↔ A ∩ B = A :=
-- begin
--   rw subset_iff,
--   rw eq_iff,
--   apply forall_congr, -- clever trick
--   intro x,
--   rw mem_inter_iff, -- no longer under a binder
--   tauto!
-- end
-- end hide

end xena -- hide


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

General properties of binary operations.
-/

import ..init
universes u v w
hott_theory

namespace hott
open function
namespace binary
section
variable {A : Type _}
variables (op₁ : A → A → A) (inv : A → A) (one : A)

local notation a * b := op₁ a b
local notation a ⁻¹  := inv a

@[hott] def commutative        := Πa b, a * b = b * a
@[hott] def associative        := Πa b c, (a * b) * c = a * (b * c)
@[hott] def left_identity      := Πa, one * a = a
@[hott] def right_identity     := Πa, a * one = a
@[hott] def left_inverse       := Πa, a⁻¹ * a = one
@[hott] def right_inverse      := Πa, a * a⁻¹ = one
@[hott] def left_cancelative   := Πa b c, a * b = a * c → b = c
@[hott] def right_cancelative  := Πa b c, a * b = c * b → a = c

@[hott] def inv_op_cancel_left  := Πa b, a⁻¹ * (a * b) = b
@[hott] def op_inv_cancel_left  := Πa b, a * (a⁻¹ * b) = b
@[hott] def inv_op_cancel_right  := Πa b, a * b⁻¹ * b =  a
@[hott] def op_inv_cancel_right  := Πa b, a * b * b⁻¹ = a

variable (op₂ : A → A → A)

local notation a + b := op₂ a b

@[hott] def left_distributive  := Πa b c, a * (b + c) = a * b + a * c
@[hott] def right_distributive  := Πa b c, (a + b) * c = a * c + b * c

@[hott] def right_commutative  {B : Type _} (f : B → A → B) :=
Π b a₁ a₂, f (f b a₁) a₂ = f (f b a₂) a₁
@[hott] def left_commutative  {B : Type _}  (f : A → B → B) :=
Π a₁ a₂ b, f a₁ (f a₂ b) = f a₂ (f a₁ b)
end

section
variable {A : Type _}
variable {f : A → A → A}
variable H_comm : commutative f
variable H_assoc : associative f
local infixl `*` := f
@[hott] theorem left_comm : left_commutative f :=
λ a b c, calc
  a*(b*c) = (a*b)*c  : (H_assoc _ _ _)⁻¹
    ...   = (b*a)*c  : ap (λ x, x*c) (H_comm _ _)
    ...   = b*(a*c)  : H_assoc _ _ _

@[hott] theorem right_comm : right_commutative f :=
λ a b c, calc
  (a*b)*c = a*(b*c) : H_assoc _ _ _
    ...   = a*(c*b) : ap (λ x, a*x) (H_comm _ _)
    ...   = (a*c)*b : (H_assoc _ _ _)⁻¹

@[hott] theorem comm4 (a b c d : A) : a*b*(c*d) = a*c*(b*d) :=
calc
  a*b*(c*d) = a*b*c*d   : (H_assoc _ _ _)⁻¹
    ...     = a*c*b*d   : ap (λx, x*d) (right_comm H_comm H_assoc _ _ _)
    ...     = a*c*(b*d) : H_assoc _ _ _
end

section
variable {A : Type _}
variable {f : A → A → A}
variable H_assoc : associative f
local infixl `*` := f
@[hott] theorem assoc4helper (a b c d) : (a*b)*(c*d) = a*((b*c)*d) :=
calc
  (a*b)*(c*d) = a*(b*(c*d)) : H_assoc _ _ _
          ... = a*((b*c)*d) : ap (λ x, a*x) (H_assoc _ _ _)⁻¹ᵖ
end

@[hott] def right_commutative_compose_right
  {A B : Type _} (f : A → A → A) (g : B → A) (rcomm : right_commutative f) : right_commutative (compose_right f g) :=
λ a b₁ b₂, (rcomm _ _ _)

@[hott] def left_commutative_compose_left
  {A B : Type _} (f : A → A → A) (g : B → A) (lcomm : left_commutative f) : left_commutative (compose_left f g) :=
λ a b₁ b₂, (lcomm _ _ _)
end binary

open eq
namespace is_equiv
@[hott] def inv_preserve_binary {A B : Type _} (f : A → B) [H : is_equiv f]
  (mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), f (mA a a') = mB (f a) (f a'))
  (b b' : B) : f⁻¹ᶠ (mB b b') = mA (f⁻¹ᶠ b) (f⁻¹ᶠ b') :=
begin
  have H2 : f⁻¹ᶠ (mB (f (f⁻¹ᶠ b)) (f (f⁻¹ᶠ b'))) = f⁻¹ᶠ (f (mA (f⁻¹ᶠ b) (f⁻¹ᶠ b'))), from
  ap f⁻¹ᶠ (H _ _)⁻¹ᵖ,
  rwr [right_inv f, right_inv f, left_inv f] at H2, rwr H2
end

@[hott] def preserve_binary_of_inv_preserve {A B : Type _} (f : A → B) [H : is_equiv f]
  (mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), f⁻¹ᶠ (mB b b') = mA (f⁻¹ᶠ b) (f⁻¹ᶠ b'))
  (a a' : A) : f (mA a a') = mB (f a) (f a') :=
begin
  have H2 : f (mA (f⁻¹ᶠ (f a)) (f⁻¹ᶠ (f a'))) = f (f⁻¹ᶠ (mB (f a) (f a'))), from ap f (H _ _)⁻¹ᵖ,
  rwr [right_inv f, left_inv f, left_inv f] at H2, rwr H2
end
end is_equiv
namespace equiv
open hott.is_equiv
@[hott] def inv_preserve_binary {A B : Type _} (f : A ≃ B)
  (mA : A → A → A) (mB : B → B → B) (H : Π(a a' : A), f (mA a a') = mB (f a) (f a'))
  (b b' : B) : f⁻¹ᶠ (mB b b') = mA (f⁻¹ᶠ b) (f⁻¹ᶠ b') :=
inv_preserve_binary f mA mB H b b'

@[hott] def preserve_binary_of_inv_preserve {A B : Type _} (f : A ≃ B)
  (mA : A → A → A) (mB : B → B → B) (H : Π(b b' : B), f⁻¹ᶠ (mB b b') = mA (f⁻¹ᶠ b) (f⁻¹ᶠ b'))
  (a a' : A) : f (mA a a') = mB (f a) (f a') :=
preserve_binary_of_inv_preserve f mA mB H a a'
end equiv
end hott