import data.equiv.basic -- bijections with inverses
import tactic -- we want to use tactics

open set

/-- Definition of a partition as a collection of disjoint nonempty
  subsets of X whose union is X-/
@[ext] structure partition (X : Type) :=
(C : set (set X))
(Hnonempty : ∀ c ∈ C, c ≠ ∅)
(Hcover : ∀ x, ∃ c ∈ C, x ∈ c)
(Hunique : ∀ c d ∈ C, c ∩ d ≠ ∅ → c = d)

/-- Equivalence class for a binary relation -/
def equivalence_class {X : Type} (R : X → X → Prop) (x : X) := {y : X | R x y}

/-- x is in the equivalence class of x -/
lemma mem_class {X : Type} {R : X → X → Prop} (HR : equivalence R) (x : X) :
  x ∈ equivalence_class R x :=
begin
  sorry
end

/-- There is a bijection between equivalence relations on X and partitions of X -/
example (X : Type) : {R : X → X → Prop // equivalence R} ≃ partition X :=
-- The map in one direction: given a relation, use the set of equivalence classes.
{ to_fun := λ R, {
    C := { S : set X | ∃ x : X, S = equivalence_class R x},
-- I claim that this is a partition.
    Hnonempty := begin -- equiv classes are nonempty
      sorry,
    end,
    Hcover := begin -- they cover
      sorry,
    end,
    Hunique := begin -- and distinct equiv classes are disjoint
      sorry
    end },
-- The map the other way: given a partition, say two elements are related
-- if there's a set in the partition that they both lie in.
  inv_fun := λ P, ⟨λ x y, ∃ c ∈ P.C, x ∈ c ∧ y ∈ c, ⟨
    -- Claim this is an equivalence relation.
    begin -- reflexive
      change ∀ (x : X), ∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ x ∈ c,
      sorry,
    end,
    begin -- symmetric
      change ∀ (x y : X), (∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ y ∈ c) →
        (∃ (d : set X) (H : d ∈ P.C), y ∈ d ∧ x ∈ d),
      sorry,
    end,
    begin -- transitive
      change ∀ (x y z : X),
        (∃ (c : set X) (H : c ∈ P.C), x ∈ c ∧ y ∈ c) →
        (∃ (d : set X) (H : d ∈ P.C), y ∈ d ∧ z ∈ d) →
        (∃ (e : set X) (H : e ∈ P.C), x ∈ e ∧ z ∈ e),
      sorry,
    end
  ⟩⟩,
  -- Furthermore, I claim that these two constructions are inverse to each other.
  left_inv := begin
    sorry,
  end,
  -- (in both directions)
  right_inv := begin
    sorry,
  end }


theorem impNot {p q : Prop} : p → ¬ q ↔ ¬ (p ∧ q) :=
  ⟨ λ hpq h => hpq h.1 h.2, λ h hp hq => h <| And.intro hp hq ⟩

theorem Exists.impNot {p q : α → Prop} : (∃ x, p x → ¬ q x) ↔ ∃ x, ¬ (p x ∧ q x) := by
  apply Iff.intro
  intro h
  cases h with | intro x hx =>
  { exact ⟨ x, λ hs => hx hs.1 hs.2 ⟩ }
  intro h
  cases h with | intro x hx =>
  { exact ⟨ x, λ hpx hqx => hx <| And.intro hpx hqx ⟩ }

namespace Classical

theorem contrapositive {p q : Prop} : (¬ q → ¬ p) → p → q :=
  λ hqp hp => match em q with
    | Or.inl h => h
    | Or.inr h => False.elim <| hqp h hp

theorem notNot {p : Prop} : ¬ ¬ p ↔ p := by
  apply Iff.intro
  { intro hp; cases em p with
    | inl   => assumption
    | inr h => exact False.elim <| hp h }
  { exact λ hp hnp => False.elim <| hnp hp }

theorem notForall {p : α → Prop} : (¬ ∀ x, p x) → ∃ x, ¬ p x := by
  { apply contrapositive; intro hx; rw notNot; intro x;
    cases em (p x); { assumption }
      { apply False.elim <| hx <| Exists.intro x _; assumption } }

theorem notAnd {p q : Prop} : p ∧ ¬ q ↔ ¬ (p → q) := by
  apply Iff.intro
  { exact λ h himp => h.2 <| himp h.1 }
  { intro h; apply And.intro;
    { revert h; apply contrapositive; rw notNot;
      exact λ hnp hp => False.elim <| hnp hp }
    { exact λ hq => h <| λ _ => hq } }

theorem Exists.notAnd {p q : α → Prop} :
  (∃ x, p x ∧ ¬ q x) ↔ ∃ x, ¬ (p x → q x) := by
  apply Iff.intro
  { intro h;
    let ⟨ x, ⟨ hp, hnq ⟩ ⟩ := h;
    exact Exists.intro x λ h => hnq <| h hp }
  { intro h;
    let ⟨ x, hx ⟩ := h;
    apply Exists.intro x;
    apply And.intro;
    { revert hx; apply contrapositive;
      exact λ hpx hpq => hpq λ hp => False.elim <| hpx hp }
    { revert hx; apply contrapositive;
      rw [notNot, notNot]; exact λ h _ => h } }

end Classical

def Set (α : Type u) := α → Prop

def setOf (p : α → Prop) : Set α := p

namespace Set

instance : EmptyCollection (Set α) := ⟨ λ x => False ⟩

variables {α : Type u} {s : Set α}

def mem (a : α) (s : Set α) := s a

infix:55 "∈" => Set.mem
notation:55 x "∉" s => ¬ x ∈ s

instance : CoeSort (Set α) (Type u) where
  coe s := Subtype s

theorem ext {s t : Set α} (h : ∀ x, x ∈ s ↔ x ∈ t) : s = t :=
  funext <| λ x => propext <| h x

-- Declaring the index category
declare_syntax_cat index
syntax ident : index
syntax ident ":" term : index
syntax ident "∈" term : index

-- Notation for sets
syntax "{" index "|" term "}" : term

macro_rules
| `({ $x:ident : $t | $p }) => `(setOf (λ ($x:ident : $t) => $p))
| `({ $x:ident | $p }) => `(setOf (λ ($x:ident) => $p))
| `({ $x:ident ∈ $s | $p }) => `(setOf (λ $x => $x ∈ $s → $p))

def union (s t : Set α) : Set α := { x : α | x ∈ s ∨ x ∈ t }

def inter (s t : Set α) : Set α := { x : α | x ∈ s ∧ x ∈ t }

theorem unionDef (s t : Set α) : union s t = λ x => s x ∨ t x := rfl

theorem interDef (s t : Set α) : inter s t = λ x => s x ∧ t x := rfl

infix:60 "∪" => Set.union
infix:60 "∩" => Set.inter

def Union (s : Set (Set α)) : Set α := { x : α | ∃ t : Set α, t ∈ s → t x }

def Inter (s : Set (Set α)) : Set α := { x : α | ∀ t : Set α, t ∈ s → t x }

def UnionDef (s : Set (Set α)) : Union s = λ x => ∃ t : Set α, t ∈ s → t x := rfl

def InterDef (s : Set (Set α)) : Inter s = λ x => ∀ t : Set α, t ∈ s → t x := rfl

syntax "⋃" index "," term : term
syntax "⋂" index "," term : term

macro_rules
| `(⋃ $s:ident ∈ $c, $s) => `(Union $c)
| `(⋂ $s:ident ∈ $c, $s) => `(Inter $c)

-- variables {s : Set (Set α)}

-- #check ⋂ t ∈ s, t

-- Notation for ∀ x ∈ s, p and ∃ x ∈ s, p
syntax "∀" index "," term : term
syntax "∃" index "," term : term

macro_rules
| `(∀ $x:ident ∈ $s, $p) => `(∀ $x:ident, $x ∈ $s → $p)
| `(∃ $x:ident ∈ $s, $p) => `(∃ $x:ident, $x ∈ $s ∧ $p)

def Subset (s t : Set α) := ∀ x ∈ s, x ∈ t

infix:50 "⊆" => Subset

theorem Subset.def {s t : Set α} : s ⊆ t ↔ ∀ x ∈ s, x ∈ t := Iff.rfl

namespace Subset

theorem refl {s : Set α} : s ⊆ s := λ _ hx => hx

theorem trans {s t v : Set α} (hst : s ⊆ t) (htv : t ⊆ v) : s ⊆ t :=
  λ x hx => hst x hx

theorem antisymm {s t : Set α} (hst : s ⊆ t) (hts : t ⊆ s) : s = t :=
  Set.ext λ x => ⟨ λ hx => hst x hx, λ hx => hts x hx ⟩

theorem antisymmIff {s t : Set α} : s = t ↔ s ⊆ t ∧ t ⊆ s :=
  ⟨ by { intro hst; subst hst; exact ⟨ refl, refl ⟩ },
    λ ⟨ hst, hts ⟩ => antisymm hst hts ⟩

-- ↓ Uses classical logic
theorem notSubset : ¬ s ⊆ t ↔ ∃ x ∈ s, x ∉ t := by
  apply Iff.intro;
  { intro hst;
    rw Classical.Exists.notAnd;
    apply Classical.notForall;
    exact λ h => hst λ x hx => h x hx }
  { intro h hst;
    let ⟨ x, ⟨ hxs, hxt ⟩ ⟩ := h;
    exact hxt <| hst x hxs }

end Subset

theorem memEmptySet {x : α} (h : x ∈ ∅) : False := h

@[simp] theorem memEmptySetIff : (∃ (x : α), x ∈ ∅) ↔ False :=
  Iff.intro (λ h => h.2) False.elim

@[simp] theorem setOfFalse : { a : α | False } = ∅ := rfl

def univ : Set α := { x | True }

@[simp] theorem memUniv (x : α) : x ∈ univ := True.intro

theorem Subset.subsetUniv {s : Set α} : s ⊆ univ := λ x _ => memUniv x

theorem Subset.univSubsetIff {s : Set α} : univ ⊆ s ↔ univ = s := by
  apply Iff.intro λ hs => Subset.antisymm hs Subset.subsetUniv
  { intro h; subst h; exact Subset.refl }

theorem eqUnivIff {s : Set α} : s = univ ↔ ∀ x, x ∈ s := by
  apply Iff.intro
  { intro h x; subst h; exact memUniv x }
  { exact λ h => ext λ x => Iff.intro (λ _ => memUniv _) λ _ => h x }

/-! ### Unions and Intersections -/

macro "extia" x:term : tactic => `(tactic| apply ext; intro $x; apply Iff.intro)

theorem unionSelf {s : Set α} : s ∪ s = s := by
  extia x
  { intro hx; cases hx; assumption; assumption }
  { exact Or.inl }

theorem unionEmpty {s : Set α} : s ∪ ∅ = s := by
  extia x
  { intro hx; cases hx with
    | inl   => assumption
    | inr h => exact False.elim <| memEmptySet h }
  { exact Or.inl }

theorem unionSymm {s t : Set α} : s ∪ t = t ∪ s := by
  extia x
  allGoals { intro hx; cases hx with
             | inl hx => exact Or.inr hx
             | inr hx => exact Or.inl hx }

theorem emptyUnion {s : Set α} : ∅ ∪ s = s := by
  rw unionSymm; exact unionEmpty

theorem unionAssoc {s t w : Set α} : s ∪ t ∪ w = s ∪ (t ∪ w) := by
  extia x
  { intro hx; cases hx with
    | inr hx   => exact Or.inr <| Or.inr hx
    | inl hx   => cases hx with
      | inr hx => exact Or.inr <| Or.inl hx
      | inl hx => exact Or.inl hx }
  { intro hx; cases hx with
    | inl hx   => exact Or.inl <| Or.inl hx
    | inr hx   => cases hx with
      | inr hx => exact Or.inr hx
      | inl hx => exact Or.inl <| Or.inr hx }

end Set


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.set.intervals
import data.set.finite
import data.pnat.intervals

/-!
# fintype instances for intervals

We provide `fintype` instances for `Ico l u`, for `l u : ℕ`, and for `l u : ℤ`.
-/

namespace set

instance Ico_ℕ_fintype (l u : ℕ) : fintype (Ico l u) :=
fintype.of_finset (finset.Ico l u) $
  (λ n, by { simp only [mem_Ico, finset.Ico.mem], })

@[simp] lemma Ico_ℕ_card (l u : ℕ) : fintype.card (Ico l u) = u - l :=
calc fintype.card (Ico l u) = (finset.Ico l u).card : fintype.card_of_finset _ _
                        ... = u - l                 : finset.Ico.card l u

instance Ico_pnat_fintype (l u : ℕ+) : fintype (Ico l u) :=
fintype.of_finset (pnat.Ico l u) $
  (λ n, by { simp only [mem_Ico, pnat.Ico.mem], })

@[simp] lemma Ico_pnat_card (l u : ℕ+) : fintype.card (Ico l u) = u - l :=
calc fintype.card (Ico l u) = (pnat.Ico l u).card : fintype.card_of_finset _ _
                        ... = u - l               : pnat.Ico.card l u

instance Ico_ℤ_fintype (l u : ℤ) : fintype (Ico l u) :=
fintype.of_finset (finset.Ico_ℤ l u) $
  (λ n, by { simp only [mem_Ico, finset.Ico_ℤ.mem], })

@[simp] lemma Ico_ℤ_card (l u : ℤ) : fintype.card (Ico l u) = (u - l).to_nat :=
calc fintype.card (Ico l u) = (finset.Ico_ℤ l u).card : fintype.card_of_finset _ _
                        ... = (u - l).to_nat          : finset.Ico_ℤ.card l u

lemma Ico_ℤ_finite (l u : ℤ) : set.finite (Ico l u) := ⟨set.Ico_ℤ_fintype l u⟩
lemma Ioo_ℤ_finite (l u : ℤ) : set.finite (Ioo l u) := Ico_ℤ_finite (l + 1) u
lemma Icc_ℤ_finite (l u : ℤ) : set.finite (Icc l u) :=
begin
  convert Ico_ℤ_finite l (u + 1),
  ext,
  simp only [int.lt_add_one_iff, iff_self, mem_Ico, mem_Icc],
end
lemma Ioc_ℤ_finite (l u : ℤ) : set.finite (Ioc l u) := Icc_ℤ_finite (l + 1) u

-- TODO other useful instances: fin n, zmod?

end set


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.finset.powerset
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Lattice
import Mathlib.Data.Multiset.Powerset

/-!
# The powerset of a finset
-/

namespace Finset

open Function Multiset

variable {α : Type _} {s t : Finset α}

/-! ### powerset -/

section Powerset

/-- When `s` is a finset, `s.powerset` is the finset of all subsets of `s` (seen as finsets). -/
def powerset (s : Finset α) : Finset (Finset α) :=
  ⟨(s.1.powerset.pmap Finset.mk) fun _t h => nodup_of_le (mem_powerset.1 h) s.nodup,
    s.nodup.powerset.pmap fun _a _ha _b _hb => congr_arg Finset.val⟩
#align finset.powerset Finset.powerset

@[simp]
theorem mem_powerset {s t : Finset α} : s ∈ powerset t ↔ s ⊆ t := by
  cases s
  simp [powerset, mem_mk, mem_pmap, mk.injEq, mem_powerset, exists_prop, exists_eq_right,
    ← val_le_iff]
#align finset.mem_powerset Finset.mem_powerset

@[simp, norm_cast]
theorem coe_powerset (s : Finset α) :
    (s.powerset : Set (Finset α)) = ((↑) : Finset α → Set α) ⁻¹' (s : Set α).powerset :=
  by
  ext
  simp
#align finset.coe_powerset Finset.coe_powerset

--Porting note: remove @[simp], simp can prove it

--Porting note: remove @[simp], simp can prove it
theorem mem_powerset_self (s : Finset α) : s ∈ powerset s :=
  mem_powerset.2 Subset.rfl
#align finset.mem_powerset_self Finset.mem_powerset_self

theorem powerset_nonempty (s : Finset α) : s.powerset.Nonempty :=
  ⟨∅, empty_mem_powerset _⟩
#align finset.powerset_nonempty Finset.powerset_nonempty

@[simp]
theorem powerset_mono {s t : Finset α} : powerset s ⊆ powerset t ↔ s ⊆ t :=
  ⟨fun h => mem_powerset.1 <| h <| mem_powerset_self _, fun st _u h =>
    mem_powerset.2 <| Subset.trans (mem_powerset.1 h) st⟩
#align finset.powerset_mono Finset.powerset_mono

theorem powerset_injective : Injective (powerset : Finset α → Finset (Finset α)) :=
  (injective_of_le_imp_le _) powerset_mono.1
#align finset.powerset_injective Finset.powerset_injective

@[simp]
theorem powerset_inj : powerset s = powerset t ↔ s = t :=
  powerset_injective.eq_iff
#align finset.powerset_inj Finset.powerset_inj

@[simp]
theorem powerset_empty : (∅ : Finset α).powerset = {∅} :=
  rfl
#align finset.powerset_empty Finset.powerset_empty

@[simp]
theorem powerset_eq_singleton_empty : s.powerset = {∅} ↔ s = ∅ := by
  rw [← powerset_empty, powerset_inj]
#align finset.powerset_eq_singleton_empty Finset.powerset_eq_singleton_empty

/-- **Number of Subsets of a Set** -/
@[simp]
theorem card_powerset (s : Finset α) : card (powerset s) = 2 ^ card s :=
  (card_pmap _ _ _).trans (Multiset.card_powerset s.1)
#align finset.card_powerset Finset.card_powerset

theorem not_mem_of_mem_powerset_of_not_mem {s t : Finset α} {a : α} (ht : t ∈ s.powerset)
    (h : a ∉ s) : a ∉ t := by
  apply mt _ h
  apply mem_powerset.1 ht
#align finset.not_mem_of_mem_powerset_of_not_mem Finset.not_mem_of_mem_powerset_of_not_mem

theorem powerset_insert [DecidableEq α] (s : Finset α) (a : α) :
    powerset (insert a s) = s.powerset ∪ s.powerset.image (insert a) :=
  by
  ext t
  simp only [exists_prop, mem_powerset, mem_image, mem_union, subset_insert_iff]
  by_cases h : a ∈ t
  · constructor
    · exact fun H => Or.inr ⟨_, H, insert_erase h⟩
    · intro H
      cases' H with H H
      · exact Subset.trans (erase_subset a t) H
      · rcases H with ⟨u, hu⟩
        rw [← hu.2]
        exact Subset.trans (erase_insert_subset a u) hu.1
  · have : ¬∃ u : Finset α, u ⊆ s ∧ insert a u = t := by simp [Ne.symm (ne_insert_of_not_mem _ _ h)]
    simp [Finset.erase_eq_of_not_mem h, this]
#align finset.powerset_insert Finset.powerset_insert

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for any subset. -/
instance decidableExistsOfDecidableSubsets {s : Finset α} {p : ∀ (t) (_ : t ⊆ s), Prop}
    [∀ (t) (h : t ⊆ s), Decidable (p t h)] : Decidable (∃ (t : _)(h : t ⊆ s), p t h) :=
  decidable_of_iff (∃ (t : _)(hs : t ∈ s.powerset), p t (mem_powerset.1 hs))
    ⟨fun ⟨t, _, hp⟩ => ⟨t, _, hp⟩, fun ⟨t, hs, hp⟩ => ⟨t, mem_powerset.2 hs, hp⟩⟩
#align finset.decidable_exists_of_decidable_subsets Finset.decidableExistsOfDecidableSubsets

/-- For predicate `p` decidable on subsets, it is decidable whether `p` holds for every subset. -/
instance decidableForallOfDecidableSubsets {s : Finset α} {p : ∀ (t) (_ : t ⊆ s), Prop}
    [∀ (t) (h : t ⊆ s), Decidable (p t h)] : Decidable (∀ (t) (h : t ⊆ s), p t h) :=
  decidable_of_iff (∀ (t) (h : t ∈ s.powerset), p t (mem_powerset.1 h))
    ⟨fun h t hs => h t (mem_powerset.2 hs), fun h _ _ => h _ _⟩
#align finset.decidable_forall_of_decidable_subsets Finset.decidableForallOfDecidableSubsets

/-- A version of `Finset.decidableExistsOfDecidableSubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidableExistsOfDecidableSubsets' {s : Finset α} {p : Finset α → Prop}
    (hu : ∀ (t) (_h : t ⊆ s), Decidable (p t)) : Decidable (∃ (t : _)(_h : t ⊆ s), p t) :=
  @Finset.decidableExistsOfDecidableSubsets _ _ _ hu
#align finset.decidable_exists_of_decidable_subsets' Finset.decidableExistsOfDecidableSubsets'

/-- A version of `Finset.decidableForallOfDecidableSubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidableForallOfDecidableSubsets' {s : Finset α} {p : Finset α → Prop}
    (hu : ∀ (t) (_h : t ⊆ s), Decidable (p t)) : Decidable (∀ (t) (_h : t ⊆ s), p t) :=
  @Finset.decidableForallOfDecidableSubsets _ _ _ hu
#align finset.decidable_forall_of_decidable_subsets' Finset.decidableForallOfDecidableSubsets'

end Powerset

section Ssubsets

variable [DecidableEq α]

/-- For `s` a finset, `s.ssubsets` is the finset comprising strict subsets of `s`. -/
def ssubsets (s : Finset α) : Finset (Finset α) :=
  erase (powerset s) s
#align finset.ssubsets Finset.ssubsets

@[simp]
theorem mem_ssubsets {s t : Finset α} : t ∈ s.ssubsets ↔ t ⊂ s := by
  rw [ssubsets, mem_erase, mem_powerset, ssubset_iff_subset_ne, and_comm]
#align finset.mem_ssubsets Finset.mem_ssubsets

theorem empty_mem_ssubsets {s : Finset α} (h : s.Nonempty) : ∅ ∈ s.ssubsets :=
  by
  rw [mem_ssubsets, ssubset_iff_subset_ne]
  exact ⟨empty_subset s, h.ne_empty.symm⟩
#align finset.empty_mem_ssubsets Finset.empty_mem_ssubsets
/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for any ssubset. -/
instance decidableExistsOfDecidableSsubsets {s : Finset α} {p : ∀ (t) (_ : t ⊂ s), Prop}
    [∀ (t) (h : t ⊂ s), Decidable (p t h)] : Decidable (∃ t h, p t h) :=
  decidable_of_iff (∃ (t : _)(hs : t ∈ s.ssubsets), p t (mem_ssubsets.1 hs))
    ⟨fun ⟨t, _, hp⟩ => ⟨t, _, hp⟩, fun ⟨t, hs, hp⟩ => ⟨t, mem_ssubsets.2 hs, hp⟩⟩
#align finset.decidable_exists_of_decidable_ssubsets Finset.decidableExistsOfDecidableSsubsets

/-- For predicate `p` decidable on ssubsets, it is decidable whether `p` holds for every ssubset. -/
instance decidableForallOfDecidableSsubsets {s : Finset α} {p : ∀ (t) (_ : t ⊂ s), Prop}
    [∀ (t) (h : t ⊂ s), Decidable (p t h)] : Decidable (∀ t h, p t h) :=
  decidable_of_iff (∀ (t) (h : t ∈ s.ssubsets), p t (mem_ssubsets.1 h))
    ⟨fun h t hs => h t (mem_ssubsets.2 hs), fun h _ _ => h _ _⟩
#align finset.decidable_forall_of_decidable_ssubsets Finset.decidableForallOfDecidableSsubsets

/-- A version of `Finset.decidableExistsOfDecidableSsubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidableExistsOfDecidableSsubsets' {s : Finset α} {p : Finset α → Prop}
    (hu : ∀ (t) (_h : t ⊂ s), Decidable (p t)) : Decidable (∃ (t : _)(_h : t ⊂ s), p t) :=
  @Finset.decidableExistsOfDecidableSsubsets _ _ _ _ hu
#align finset.decidable_exists_of_decidable_ssubsets' Finset.decidableExistsOfDecidableSsubsets'

/-- A version of `Finset.decidableForallOfDecidableSsubsets` with a non-dependent `p`.
Typeclass inference cannot find `hu` here, so this is not an instance. -/
def decidableForallOfDecidableSsubsets' {s : Finset α} {p : Finset α → Prop}
    (hu : ∀ (t) (_h : t ⊂ s), Decidable (p t)) : Decidable (∀ (t) (_h : t ⊂ s), p t) :=
  @Finset.decidableForallOfDecidableSsubsets _ _ _ _ hu
#align finset.decidable_forall_of_decidable_ssubsets' Finset.decidableForallOfDecidableSsubsets'

end Ssubsets

section PowersetLen

/-- Given an integer `n` and a finset `s`, then `powersetLen n s` is the finset of subsets of `s`
of cardinality `n`. -/
def powersetLen (n : ℕ) (s : Finset α) : Finset (Finset α) :=
  ⟨((s.1.powersetLen n).pmap Finset.mk) fun _t h => nodup_of_le (mem_powersetLen.1 h).1 s.2,
    s.2.powersetLen.pmap fun _a _ha _b _hb => congr_arg Finset.val⟩
#align finset.powerset_len Finset.powersetLen

/-- **Formula for the Number of Combinations** -/
theorem mem_powersetLen {n} {s t : Finset α} : s ∈ powersetLen n t ↔ s ⊆ t ∧ card s = n := by
  cases s; simp [powersetLen, val_le_iff.symm]
#align finset.mem_powerset_len Finset.mem_powersetLen

@[simp]
theorem powersetLen_mono {n} {s t : Finset α} (h : s ⊆ t) : powersetLen n s ⊆ powersetLen n t :=
  fun _u h' => mem_powersetLen.2 <| And.imp (fun h₂ => Subset.trans h₂ h) id (mem_powersetLen.1 h')
#align finset.powerset_len_mono Finset.powersetLen_mono

/-- **Formula for the Number of Combinations** -/
@[simp]
theorem card_powersetLen (n : ℕ) (s : Finset α) : card (powersetLen n s) = Nat.choose (card s) n :=
  (card_pmap _ _ _).trans (Multiset.card_powersetLen n s.1)
#align finset.card_powerset_len Finset.card_powersetLen

@[simp]
theorem powersetLen_zero (s : Finset α) : Finset.powersetLen 0 s = {∅} :=
  by
  ext; rw [mem_powersetLen, mem_singleton, card_eq_zero]
  refine'
    ⟨fun h => h.2, fun h => by
      rw [h]
      exact ⟨empty_subset s, rfl⟩⟩
#align finset.powerset_len_zero Finset.powersetLen_zero

@[simp]
theorem powersetLen_empty (n : ℕ) {s : Finset α} (h : s.card < n) : powersetLen n s = ∅ :=
  Finset.card_eq_zero.mp (by rw [card_powersetLen, Nat.choose_eq_zero_of_lt h])
#align finset.powerset_len_empty Finset.powersetLen_empty

theorem powersetLen_eq_filter {n} {s : Finset α} :
    powersetLen n s = (powerset s).filter fun x => x.card = n :=
  by
  ext
  simp [mem_powersetLen]
#align finset.powerset_len_eq_filter Finset.powersetLen_eq_filter

theorem powersetLen_succ_insert [DecidableEq α] {x : α} {s : Finset α} (h : x ∉ s) (n : ℕ) :
    powersetLen n.succ (insert x s) = powersetLen n.succ s ∪ (powersetLen n s).image (insert x) :=
  by
  rw [powersetLen_eq_filter, powerset_insert, filter_union, ← powersetLen_eq_filter]
  congr
  rw [powersetLen_eq_filter, image_filter]
  congr 1
  ext t
  simp only [mem_powerset, mem_filter, Function.comp_apply, and_congr_right_iff]
  intro ht
  have : x ∉ t := fun H => h (ht H)
  simp [card_insert_of_not_mem this, Nat.succ_inj']
#align finset.powerset_len_succ_insert Finset.powersetLen_succ_insert

theorem powersetLen_nonempty {n : ℕ} {s : Finset α} (h : n ≤ s.card) :
    (powersetLen n s).Nonempty := by
  classical
    induction' s using Finset.induction_on with x s hx IH generalizing n
    · rw [card_empty, le_zero_iff] at h
      rw [h, powersetLen_zero]
      exact Finset.singleton_nonempty _
    · cases n
      · simp
      · rw [card_insert_of_not_mem hx, Nat.succ_le_succ_iff] at h
        rw [powersetLen_succ_insert hx]
        refine' Nonempty.mono _ ((IH h).image (insert x))
        exact subset_union_right _ _
#align finset.powerset_len_nonempty Finset.powersetLen_nonempty

@[simp]
theorem powersetLen_self (s : Finset α) : powersetLen s.card s = {s} :=
  by
  ext
  rw [mem_powersetLen, mem_singleton]
  constructor
  · exact fun ⟨hs, hc⟩ => eq_of_subset_of_card_le hs hc.ge
  · rintro rfl
    simp
#align finset.powerset_len_self Finset.powersetLen_self

theorem pairwise_disjoint_powersetLen (s : Finset α) :
    Pairwise fun i j => Disjoint (s.powersetLen i) (s.powersetLen j) := fun _i _j hij =>
  Finset.disjoint_left.mpr fun _x hi hj =>
    hij <| (mem_powersetLen.mp hi).2.symm.trans (mem_powersetLen.mp hj).2
#align finset.pairwise_disjoint_powerset_len Finset.pairwise_disjoint_powersetLen

theorem powerset_card_disjUnionᵢ (s : Finset α) :
    Finset.powerset s =
      (range (s.card + 1)).disjUnionᵢ (fun i => powersetLen i s)
        (s.pairwise_disjoint_powersetLen.set_pairwise _) :=
  by
  refine' ext fun a => ⟨fun ha => _, fun ha => _⟩
  · rw [mem_disjUnionᵢ]
    exact
      ⟨a.card, mem_range.mpr (Nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))),
        mem_powersetLen.mpr ⟨mem_powerset.mp ha, rfl⟩⟩
  · rcases mem_disjUnionᵢ.mp ha with ⟨i, _hi, ha⟩
    exact mem_powerset.mpr (mem_powersetLen.mp ha).1
#align finset.powerset_card_disj_Union Finset.powerset_card_disjUnionᵢ

theorem powerset_card_bunionᵢ [DecidableEq (Finset α)] (s : Finset α) :
    Finset.powerset s = (range (s.card + 1)).bunionᵢ fun i => powersetLen i s := by
  simpa only [disjUnionᵢ_eq_bunionᵢ] using powerset_card_disjUnionᵢ s
#align finset.powerset_card_bUnion Finset.powerset_card_bunionᵢ

theorem powerset_len_sup [DecidableEq α] (u : Finset α) (n : ℕ) (hn : n < u.card) :
    (powersetLen n.succ u).sup id = u := by
  apply le_antisymm
  · simp_rw [Finset.sup_le_iff, mem_powersetLen]
    rintro x ⟨h, -⟩
    exact h
  · rw [sup_eq_bunionᵢ, le_iff_subset, subset_iff]
    cases' (Nat.succ_le_of_lt hn).eq_or_lt with h' h'
    · simp [h']
    · intro x hx
      simp only [mem_bunionᵢ, exists_prop, id.def]
      obtain ⟨t, ht⟩ : ∃ t, t ∈ powersetLen n (u.erase x) := powersetLen_nonempty
        (le_trans (Nat.le_pred_of_lt hn) pred_card_le_card_erase)
      · refine' ⟨insert x t, _, mem_insert_self _ _⟩
        rw [← insert_erase hx, powersetLen_succ_insert (not_mem_erase _ _)]
        exact mem_union_right _ (mem_image_of_mem _ ht)
#align finset.powerset_len_sup Finset.powerset_len_sup

@[simp]
theorem powersetLen_card_add (s : Finset α) {i : ℕ} (hi : 0 < i) :
    s.powersetLen (s.card + i) = ∅ :=
  Finset.powersetLen_empty _ (lt_add_of_pos_right (Finset.card s) hi)
#align finset.powerset_len_card_add Finset.powersetLen_card_add

@[simp]
theorem map_val_val_powersetLen (s : Finset α) (i : ℕ) :
    (s.powersetLen i).val.map Finset.val = s.1.powersetLen i := by
  simp [Finset.powersetLen, map_pmap, pmap_eq_map, map_id']
#align finset.map_val_val_powerset_len Finset.map_val_val_powersetLen

theorem powersetLen_map {β : Type _} (f : α ↪ β) (n : ℕ) (s : Finset α) :
    powersetLen n (s.map f) = (powersetLen n s).map (mapEmbedding f).toEmbedding :=
  ext <| fun t => by
    simp only [card_map, mem_powersetLen, le_eq_subset, gt_iff_lt, mem_map, mapEmbedding_apply]
    constructor
    . classical
      intro h
      have : map f (filter (fun x => (f x ∈ t)) s) = t := by
        ext x
        simp only [mem_map, mem_filter, decide_eq_true_eq]
        exact ⟨fun ⟨_y, ⟨_hy₁, hy₂⟩, hy₃⟩ => hy₃ ▸ hy₂,
          fun hx => let ⟨y, hy⟩ := mem_map.1 (h.1 hx); ⟨y, ⟨hy.1, hy.2 ▸ hx⟩, hy.2⟩⟩
      refine' ⟨_, _, this⟩
      rw [← card_map f, this, h.2]; simp
    . rintro ⟨a, ⟨has, rfl⟩, rfl⟩
      simp [*]
#align finset.powerset_len_map Finset.powersetLen_map

end PowersetLen

end Finset


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johan Commelin
-/
import data.polynomial.field_division
import ring_theory.integral_closure
import ring_theory.polynomial.gauss_lemma

/-!
# Minimal polynomials

This file defines the minimal polynomial of an element `x` of an `A`-algebra `B`,
under the assumption that x is integral over `A`.

After stating the defining property we specialize to the setting of field extensions
and derive some well-known properties, amongst which the fact that minimal polynomials
are irreducible, and uniquely determined by their defining property.

-/

open_locale classical
open polynomial set function

variables {A B : Type*}

section min_poly_def
variables (A) [comm_ring A] [ring B] [algebra A B]

/--
Suppose `x : B`, where `B` is an `A`-algebra.

The minimal polynomial `minpoly A x` of `x`
is a monic polynomial with coefficients in `A` of smallest degree that has `x` as its root,
if such exists (`is_integral A x`) or zero otherwise.

For example, if `V` is a `𝕜`-vector space for some field `𝕜` and `f : V →ₗ[𝕜] V` then
the minimal polynomial of `f` is `minpoly 𝕜 f`.
-/
noncomputable def minpoly (x : B) : polynomial A :=
if hx : is_integral A x then well_founded.min degree_lt_wf _ hx else 0

end min_poly_def

namespace minpoly

section ring
variables [comm_ring A] [ring B] [algebra A B]
variables {x : B}

/-- A minimal polynomial is monic. -/
lemma monic (hx : is_integral A x) : monic (minpoly A x) :=
by { delta minpoly, rw dif_pos hx, exact (well_founded.min_mem degree_lt_wf _ hx).1 }

/-- A minimal polynomial is nonzero. -/
lemma ne_zero [nontrivial A] (hx : is_integral A x) : minpoly A x ≠ 0 :=
ne_zero_of_monic (monic hx)

lemma eq_zero (hx : ¬ is_integral A x) : minpoly A x = 0 :=
dif_neg hx

variables (A x)

/-- An element is a root of its minimal polynomial. -/
@[simp] lemma aeval : aeval x (minpoly A x) = 0 :=
begin
  delta minpoly, split_ifs with hx,
  { exact (well_founded.min_mem degree_lt_wf _ hx).2 },
  { exact aeval_zero _ }
end

lemma mem_range_of_degree_eq_one (hx : (minpoly A x).degree = 1) : x ∈ (algebra_map A B).range :=
begin
  have h : is_integral A x,
  { by_contra h,
    rw [eq_zero h, degree_zero, ←with_bot.coe_one] at hx,
    exact (ne_of_lt (show ⊥ < ↑1, from with_bot.bot_lt_coe 1) hx) },
  have key := minpoly.aeval A x,
  rw [eq_X_add_C_of_degree_eq_one hx, (minpoly.monic h).leading_coeff, C_1, one_mul, aeval_add,
      aeval_C, aeval_X, ←eq_neg_iff_add_eq_zero, ←ring_hom.map_neg] at key,
  exact ⟨-(minpoly A x).coeff 0, key.symm⟩,
end

/-- The defining property of the minimal polynomial of an element `x`:
it is the monic polynomial with smallest degree that has `x` as its root. -/
lemma min {p : polynomial A} (pmonic : p.monic) (hp : polynomial.aeval x p = 0) :
  degree (minpoly A x) ≤ degree p :=
begin
  delta minpoly, split_ifs with hx,
  { exact le_of_not_lt (well_founded.not_lt_min degree_lt_wf _ hx ⟨pmonic, hp⟩) },
  { simp only [degree_zero, bot_le] }
end

end ring

section integral_domain

variables [integral_domain A]

section ring

variables [ring B] [algebra A B] [nontrivial B]
variables {x : B}

/-- The degree of a minimal polynomial, as a natural number, is positive. -/
lemma nat_degree_pos (hx : is_integral A x) : 0 < nat_degree (minpoly A x) :=
begin
  rw pos_iff_ne_zero,
  intro ndeg_eq_zero,
  have eq_one : minpoly A x = 1,
  { rw eq_C_of_nat_degree_eq_zero ndeg_eq_zero, convert C_1,
    simpa only [ndeg_eq_zero.symm] using (monic hx).leading_coeff },
  simpa only [eq_one, alg_hom.map_one, one_ne_zero] using aeval A x
end

/-- The degree of a minimal polynomial is positive. -/
lemma degree_pos (hx : is_integral A x) : 0 < degree (minpoly A x) :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos hx)

/-- If `B/A` is an injective ring extension, and `a` is an element of `A`,
then the minimal polynomial of `algebra_map A B a` is `X - C a`. -/
lemma eq_X_sub_C_of_algebra_map_inj [nontrivial A]
  (a : A) (hf : function.injective (algebra_map A B)) :
  minpoly A (algebra_map A B a) = X - C a :=
begin
  have hdegle : (minpoly A (algebra_map A B a)).nat_degree ≤ 1,
  { apply with_bot.coe_le_coe.1,
    rw [←degree_eq_nat_degree (ne_zero (@is_integral_algebra_map A B _ _ _ a)),
      with_top.coe_one, ←degree_X_sub_C a],
    refine min A (algebra_map A B a) (monic_X_sub_C a) _,
    simp only [aeval_C, aeval_X, alg_hom.map_sub, sub_self] },
  have hdeg : (minpoly A (algebra_map A B a)).degree = 1,
  { apply (degree_eq_iff_nat_degree_eq (ne_zero (@is_integral_algebra_map A B _ _ _ a))).2,
    apply le_antisymm hdegle (nat_degree_pos (@is_integral_algebra_map A B _ _ _ a)) },
  have hrw := eq_X_add_C_of_degree_eq_one hdeg,
  simp only [monic (@is_integral_algebra_map A B _ _ _ a), one_mul,
    monic.leading_coeff, ring_hom.map_one] at hrw,
  have h0 : (minpoly A (algebra_map A B a)).coeff 0 = -a,
  { have hroot := aeval A (algebra_map A B a),
    rw [hrw, add_comm] at hroot,
    simp only [aeval_C, aeval_X, aeval_add] at hroot,
    replace hroot := eq_neg_of_add_eq_zero hroot,
    rw [←ring_hom.map_neg _ a] at hroot,
    exact (hf hroot) },
  rw hrw,
  simp only [h0, ring_hom.map_neg, sub_eq_add_neg],
end

variables (A x)

/-- A minimal polynomial is not a unit. -/
lemma not_is_unit : ¬ is_unit (minpoly A x) :=
begin
  by_cases hx : is_integral A x,
  { assume H, exact (ne_of_lt (degree_pos hx)).symm (degree_eq_zero_of_is_unit H) },
  { delta minpoly, rw dif_neg hx, simp only [not_is_unit_zero, not_false_iff] }
end

end ring

section domain

variables [domain B] [algebra A B]
variables {x : B}

/-- If `a` strictly divides the minimal polynomial of `x`, then `x` cannot be a root for `a`. -/
lemma aeval_ne_zero_of_dvd_not_unit_minpoly {a : polynomial A} (hx : is_integral A x)
  (hamonic : a.monic) (hdvd : dvd_not_unit a (minpoly A x)) :
  polynomial.aeval x a ≠ 0 :=
begin
  intro ha,
  refine not_lt_of_ge (minpoly.min A x hamonic ha) _,
  obtain ⟨hzeroa, b, hb_nunit, prod⟩ := hdvd,
  have hbmonic : b.monic,
  { rw monic.def,
    have := monic hx,
    rwa [monic.def, prod, leading_coeff_mul, monic.def.mp hamonic, one_mul] at this },
  have hzerob : b ≠ 0 := hbmonic.ne_zero,
  have degbzero : 0 < b.nat_degree,
  { apply nat.pos_of_ne_zero,
    intro h,
    have h₁ := eq_C_of_nat_degree_eq_zero h,
    rw [←h, ←leading_coeff, monic.def.1 hbmonic, C_1] at h₁,
    rw h₁ at hb_nunit,
    have := is_unit_one,
    contradiction },
  rw [prod, degree_mul, degree_eq_nat_degree hzeroa, degree_eq_nat_degree hzerob],
  exact_mod_cast lt_add_of_pos_right _ degbzero,
end

/-- A minimal polynomial is irreducible. -/
lemma irreducible (hx : is_integral A x) : irreducible (minpoly A x) :=
begin
  cases irreducible_or_factor (minpoly A x) (not_is_unit A x) with hirr hred,
  { exact hirr },
  exfalso,
  obtain ⟨a, b, ha_nunit, hb_nunit, hab_eq⟩ := hred,
  have coeff_prod : a.leading_coeff * b.leading_coeff = 1,
  { rw [←monic.def.1 (monic hx), ←hab_eq],
    simp only [leading_coeff_mul] },
  have hamonic : (a * C b.leading_coeff).monic,
  { rw monic.def,
    simp only [coeff_prod, leading_coeff_mul, leading_coeff_C] },
  have hbmonic : (b * C a.leading_coeff).monic,
  { rw [monic.def, mul_comm],
    simp only [coeff_prod, leading_coeff_mul, leading_coeff_C] },
  have prod : minpoly A x = (a * C b.leading_coeff) * (b * C a.leading_coeff),
  { symmetry,
    calc a * C b.leading_coeff * (b * C a.leading_coeff)
        = a * b * (C a.leading_coeff * C b.leading_coeff) : by ring
    ... = a * b * (C (a.leading_coeff * b.leading_coeff)) : by simp only [ring_hom.map_mul]
    ... = a * b : by rw [coeff_prod, C_1, mul_one]
    ... = minpoly A x : hab_eq },
  have hzero := aeval A x,
  rw [prod, aeval_mul, mul_eq_zero] at hzero,
  cases hzero,
  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hamonic _ hzero,
    exact ⟨hamonic.ne_zero, _, mt is_unit_of_mul_is_unit_left hb_nunit, prod⟩ },
  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hbmonic _ hzero,
    rw mul_comm at prod,
    exact ⟨hbmonic.ne_zero, _, mt is_unit_of_mul_is_unit_left ha_nunit, prod⟩ },
end

end domain

end integral_domain

section field
variables [field A]

section ring
variables [ring B] [algebra A B]
variables {x : B}

variables (A x)

/-- If an element `x` is a root of a nonzero polynomial `p`,
then the degree of `p` is at least the degree of the minimal polynomial of `x`. -/
lemma degree_le_of_ne_zero
  {p : polynomial A} (pnz : p ≠ 0) (hp : polynomial.aeval x p = 0) :
  degree (minpoly A x) ≤ degree p :=
calc degree (minpoly A x) ≤ degree (p * C (leading_coeff p)⁻¹) :
    min A x (monic_mul_leading_coeff_inv pnz) (by simp [hp])
  ... = degree p : degree_mul_leading_coeff_inv p pnz

/-- The minimal polynomial of an element `x` is uniquely characterized by its defining property:
if there is another monic polynomial of minimal degree that has `x` as a root,
then this polynomial is equal to the minimal polynomial of `x`. -/
lemma unique {p : polynomial A}
  (pmonic : p.monic) (hp : polynomial.aeval x p = 0)
  (pmin : ∀ q : polynomial A, q.monic → polynomial.aeval x q = 0 → degree p ≤ degree q) :
  p = minpoly A x :=
begin
  have hx : is_integral A x := ⟨p, pmonic, hp⟩,
  symmetry, apply eq_of_sub_eq_zero,
  by_contra hnz,
  have := degree_le_of_ne_zero A x hnz (by simp [hp]),
  contrapose! this,
  apply degree_sub_lt _ (ne_zero hx),
  { rw [(monic hx).leading_coeff, pmonic.leading_coeff] },
  { exact le_antisymm (min A x pmonic hp)
      (pmin (minpoly A x) (monic hx) (aeval A x)) }
end

/-- If an element `x` is a root of a polynomial `p`,
then the minimal polynomial of `x` divides `p`. -/
lemma dvd {p : polynomial A} (hp : polynomial.aeval x p = 0) : minpoly A x ∣ p :=
begin
  by_cases hp0 : p = 0,
  { simp only [hp0, dvd_zero] },
  have hx : is_integral A x,
  { rw ← is_algebraic_iff_is_integral, exact ⟨p, hp0, hp⟩ },
  rw ← dvd_iff_mod_by_monic_eq_zero (monic hx),
  by_contra hnz,
  have := degree_le_of_ne_zero A x hnz _,
  { contrapose! this,
    exact degree_mod_by_monic_lt _ (monic hx) (ne_zero hx) },
  { rw ← mod_by_monic_add_div p (monic hx) at hp,
    simpa using hp }
end

lemma dvd_map_of_is_scalar_tower (A K : Type*) {R : Type*} [comm_ring A] [field K] [comm_ring R]
  [algebra A K] [algebra A R] [algebra K R] [is_scalar_tower A K R] (x : R) :
  minpoly K x ∣ (minpoly A x).map (algebra_map A K) :=
by { refine minpoly.dvd K x _, rw [← is_scalar_tower.aeval_apply, minpoly.aeval] }

variables {A x}

theorem unique' [nontrivial B] {p : polynomial A} (hp1 : _root_.irreducible p)
  (hp2 : polynomial.aeval x p = 0) (hp3 : p.monic) : p = minpoly A x :=
let ⟨q, hq⟩ := dvd A x hp2 in
eq_of_monic_of_associated hp3 (monic ⟨p, ⟨hp3, hp2⟩⟩) $
mul_one (minpoly A x) ▸ hq.symm ▸ associated_mul_mul (associated.refl _) $
associated_one_iff_is_unit.2 $ (hp1.is_unit_or_is_unit hq).resolve_left $ not_is_unit A x

/-- If `y` is the image of `x` in an extension, their minimal polynomials coincide.

We take `h : y = algebra_map L T x` as an argument because `rw h` typically fails
since `is_integral R y` depends on y.
-/
lemma eq_of_algebra_map_eq {K S T : Type*} [field K] [comm_ring S] [comm_ring T]
  [algebra K S] [algebra K T] [algebra S T]
  [is_scalar_tower K S T] (hST : function.injective (algebra_map S T))
  {x : S} {y : T} (hx : is_integral K x) (h : y = algebra_map S T x) :
  minpoly K x = minpoly K y :=
minpoly.unique _ _ (minpoly.monic hx)
  (by rw [h, ← is_scalar_tower.algebra_map_aeval, minpoly.aeval, ring_hom.map_zero])
  (λ q q_monic root_q, minpoly.min _ _ q_monic
    (is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero K S T hST
      (h ▸ root_q : polynomial.aeval (algebra_map S T x) q = 0)))

section gcd_domain

/-- For GCD domains, the minimal polynomial over the ring is the same as the minimal polynomial
over the fraction field. -/
lemma gcd_domain_eq_field_fractions {A K R : Type*} [integral_domain A]
  [gcd_monoid A] [field K] [integral_domain R] (f : fraction_map A K) [algebra f.codomain R]
  [algebra A R] [is_scalar_tower A f.codomain R] {x : R} (hx : is_integral A x) :
  minpoly f.codomain x = (minpoly A x).map (localization_map.to_ring_hom f) :=
begin
  refine (unique' _ _ _).symm,
  { exact (polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map f
  (polynomial.monic.is_primitive (monic hx))).1 (irreducible hx) },
  { have htower := is_scalar_tower.aeval_apply A f.codomain R x (minpoly A x),
    simp only [localization_map.algebra_map_eq, aeval] at htower,
    exact htower.symm },
  { exact monic_map _ (monic hx) }
end

/-- The minimal polynomial over `ℤ` is the same as the minimal polynomial over `ℚ`. -/
--TODO use `gcd_domain_eq_field_fractions` directly when localizations are defined
-- in terms of algebras instead of `ring_hom`s
lemma over_int_eq_over_rat {A : Type*} [integral_domain A] {x : A} [hℚA : algebra ℚ A]
  (hx : is_integral ℤ x) :
  minpoly ℚ x = map (int.cast_ring_hom ℚ) (minpoly ℤ x) :=
begin
  refine (unique' _ _ _).symm,
  { exact (is_primitive.int.irreducible_iff_irreducible_map_cast
  (polynomial.monic.is_primitive (monic hx))).1 (irreducible hx) },
  { have htower := is_scalar_tower.aeval_apply ℤ ℚ A x (minpoly ℤ x),
    simp only [localization_map.algebra_map_eq, aeval] at htower,
    exact htower.symm },
  { exact monic_map _ (monic hx) }
end

/-- For GCD domains, the minimal polynomial divides any primitive polynomial that has the integral
element as root. -/
lemma gcd_domain_dvd {A K R : Type*}
  [integral_domain A] [gcd_monoid A] [field K] [integral_domain R]
  (f : fraction_map A K) [algebra f.codomain R] [algebra A R] [is_scalar_tower A f.codomain R]
  {x : R} (hx : is_integral A x)
  {P : polynomial A} (hprim : is_primitive P) (hroot : polynomial.aeval x P = 0) :
  minpoly A x ∣ P :=
begin
  apply (is_primitive.dvd_iff_fraction_map_dvd_fraction_map f
    (monic.is_primitive (monic hx)) hprim ).2,
  rw [← gcd_domain_eq_field_fractions f hx],
  refine dvd _ _ _,
  rwa [← localization_map.algebra_map_eq, ← is_scalar_tower.aeval_apply]
end

/-- The minimal polynomial over `ℤ` divides any primitive polynomial that has the integral element
as root. -/
-- TODO use `gcd_domain_dvd` directly when localizations are defined in terms of algebras
-- instead of `ring_hom`s
lemma integer_dvd {A : Type*} [integral_domain A] [algebra ℚ A] {x : A} (hx : is_integral ℤ x)
  {P : polynomial ℤ} (hprim : is_primitive P) (hroot : polynomial.aeval x P = 0) :
  minpoly ℤ x ∣ P :=
begin
  apply (is_primitive.int.dvd_iff_map_cast_dvd_map_cast _ _
    (monic.is_primitive (monic hx)) hprim ).2,
  rw [← over_int_eq_over_rat hx],
  refine dvd _ _ _,
  rwa [(int.cast_ring_hom ℚ).ext_int (algebra_map ℤ ℚ), ← is_scalar_tower.aeval_apply]
end

end gcd_domain

variables (B) [nontrivial B]

/-- If `B/K` is a nontrivial algebra over a field, and `x` is an element of `K`,
then the minimal polynomial of `algebra_map K B x` is `X - C x`. -/
lemma eq_X_sub_C (a : A) : minpoly A (algebra_map A B a) = X - C a :=
eq_X_sub_C_of_algebra_map_inj a (algebra_map A B).injective

lemma eq_X_sub_C' (a : A) : minpoly A a = X - C a := eq_X_sub_C A a

variables (A)

/-- The minimal polynomial of `0` is `X`. -/
@[simp] lemma zero : minpoly A (0:B) = X :=
by simpa only [add_zero, C_0, sub_eq_add_neg, neg_zero, ring_hom.map_zero]
  using eq_X_sub_C B (0:A)

/-- The minimal polynomial of `1` is `X - 1`. -/
@[simp] lemma one : minpoly A (1:B) = X - 1 :=
by simpa only [ring_hom.map_one, C_1, sub_eq_add_neg] using eq_X_sub_C B (1:A)

end ring

section domain
variables [domain B] [algebra A B]
variables {x : B}

/-- A minimal polynomial is prime. -/
lemma prime (hx : is_integral A x) : prime (minpoly A x) :=
begin
  refine ⟨ne_zero hx, not_is_unit A x, _⟩,
  rintros p q ⟨d, h⟩,
  have :    polynomial.aeval x (p*q) = 0 := by simp [h, aeval A x],
  replace : polynomial.aeval x p = 0 ∨ polynomial.aeval x q = 0 := by simpa,
  exact or.imp (dvd A x) (dvd A x) this
end

/-- If `L/K` is a field extension and an element `y` of `K` is a root of the minimal polynomial
of an element `x ∈ L`, then `y` maps to `x` under the field embedding. -/
lemma root {x : B} (hx : is_integral A x) {y : A} (h : is_root (minpoly A x) y) :
  algebra_map A B y = x :=
have key : minpoly A x = X - C y :=
eq_of_monic_of_associated (monic hx) (monic_X_sub_C y) (associated_of_dvd_dvd
  (dvd_symm_of_irreducible (irreducible_X_sub_C y) (irreducible hx) (dvd_iff_is_root.2 h))
  (dvd_iff_is_root.2 h)),
by { have := aeval A x, rwa [key, alg_hom.map_sub, aeval_X, aeval_C, sub_eq_zero, eq_comm] at this }

/-- The constant coefficient of the minimal polynomial of `x` is `0` if and only if `x = 0`. -/
@[simp] lemma coeff_zero_eq_zero (hx : is_integral A x) : coeff (minpoly A x) 0 = 0 ↔ x = 0 :=
begin
  split,
  { intro h,
    have zero_root := zero_is_root_of_coeff_zero_eq_zero h,
    rw ← root hx zero_root,
    exact ring_hom.map_zero _ },
  { rintro rfl, simp }
end

/-- The minimal polynomial of a nonzero element has nonzero constant coefficient. -/
lemma coeff_zero_ne_zero (hx : is_integral A x) (h : x ≠ 0) : coeff (minpoly A x) 0 ≠ 0 :=
by { contrapose! h, simpa only [hx, coeff_zero_eq_zero] using h }

end domain

end field

end minpoly


import data.real.basic
open function

/-
# Chapter 6 : Functions

## Level 5

A classical result in composition of functions.
Now going the other way around.
-/

/- Lemma
If composition of $f$ and $g$ is injective, then $f$ is injective.
-/
theorem composition_injective
    (X Y Z : set ℝ) (f : X → Y) (g : Y → Z) : injective (g ∘ f) → injective f :=
begin
    intros h a b ha,
    have applyg : g (f a) = g (f a), refl,
    rw ha at applyg {occs := occurrences.pos [2]},
    apply h,
    exact applyg, done
end


import game.limits.L01defs
import game.limits.seq_limitTimesConst

namespace xena -- hide

notation `|` x `|` := abs x -- hide

/-
Use the previous results to obtain linearity.
-/

/- Lemma
If $\lim_{n \to \infty} a_n = \alpha$ and $\lim_{n \to \infty} b_n = \beta$
and $c$ is a constant, then
$\lim_{n \to \infty} ( c * a_n + c * b_n) = c \alpha + c \beta$
-/
lemma lim_linear (a : ℕ → ℝ) (b : ℕ → ℝ) (α β c d : ℝ)
    (ha : is_limit a α) (hb : is_limit b β) :
    is_limit ( λ n, c * (a n) + d * (b n) ) (c * α + d * β) :=
begin
    apply lim_add,
    exact lim_times_const a α c ha,
    exact lim_times_const b β d hb,
    done
end

end xena -- hide


/- LoVe Demo 5: Inductive Predicates -/

import .love04_functional_programming_demo

namespace LoVe

/- Introductory Example -/

inductive even : ℕ → Prop
| zero    : even 0
| add_two : ∀n, even n → even (n + 2)

/- Logical Symbols -/

#print false
#print true
#print and
#print or
#print Exists
#print eq

#check nat.le.dest

lemma nat.le.dest2 :
  ∀n m : ℕ, n ≤ m → ∃k, k + n = m :=
begin
  intros n m h_gt,
  cases @nat.le.dest n m h_gt with k nk_eq_m,
  use k,
  linarith
end

/- Example: Full Binary Trees -/

#check btree

inductive is_full {α : Type} : btree α → Prop
| empty : is_full empty
| node (a : α) (l r : btree α) (hl : is_full l) (hr : is_full r)
    (empty_iff : l = empty ↔ r = empty) :
  is_full (node a l r)

inductive is_full₂ {α : Type} : btree α → Prop
| empty : is_full₂ empty
| node : ∀(a : α) (l r : btree α), is_full₂ l → is_full₂ r →
    (l = empty ↔ r = empty) →
  is_full₂ (node a l r)

lemma is_full_singleton {α : Type} (a : α) :
  is_full (node a empty empty) :=
begin
  apply is_full.node,
  repeat { apply is_full.empty },
  refl
end

lemma is_full_t0 :
  is_full t0 :=
is_full_singleton _

lemma is_full_t1 :
  is_full t1 :=
is_full_singleton _

lemma is_full_t2 :
  is_full t2 :=
begin
  rw t2,
  apply is_full.node,
  { exact is_full_t0 },
  { exact is_full_t1 },
  { simp [t0, t1] }
end

lemma is_full_mirror {α : Type} :
  ∀t : btree α, is_full t → is_full (mirror t)
| empty        := by intro; assumption
| (node a l r) :=
  begin
    intro full_t,
    cases full_t,
    rw mirror,
    apply is_full.node,
    repeat { apply is_full_mirror, assumption },
    simp [mirror_eq_empty_iff, *]
  end

lemma is_full_mirror₂ {α : Type} :
  ∀t : btree α, is_full t → is_full (mirror t)
| _ is_full.empty :=
  begin
    rw mirror,
    exact is_full.empty
  end
| _ (is_full.node a l r hl hr empty_iff) :=
  begin
    rw mirror,
    apply is_full.node,
    repeat { apply is_full_mirror₂, assumption },
    simp [mirror_eq_empty_iff, *]
  end

lemma is_full_node_iff {α : Type} (a : α) (l r : btree α) :
  is_full (node a l r) ↔
  is_full l ∧ is_full r ∧ (l = empty ↔ r = empty) :=
begin
  apply iff.intro,
  { intro h,
    cases h,
    cc },
  { intro h,
    apply is_full.node,
    repeat { cc } }
end

lemma is_full_mirror₃ {α : Type} :
  ∀t : btree α, is_full t → is_full (mirror t)
| _ is_full.empty                        :=
  by rw mirror; exact is_full.empty
| _ (is_full.node a l r hl hr empty_iff) :=
  by simp [mirror, is_full_node_iff, is_full_mirror₃ l hl,
    is_full_mirror₃ r hr, mirror_eq_empty_iff, empty_iff]

/- Example: Sorted Lists -/

inductive sorted : list ℕ → Prop
| nil : sorted []
| single {x : ℕ} : sorted [x]
| two_or_more {x y : ℕ} {xs : list ℕ} (xy : x ≤ y)
    (yxs : sorted (y :: xs)) :
  sorted (x :: y :: xs)

example :
  sorted [] :=
sorted.nil

example :
  sorted [2] :=
sorted.single

example :
  sorted [3, 5] :=
begin
  apply sorted.two_or_more,
  { linarith },
  { exact sorted.single }
end

example :
  sorted [3, 5] :=
sorted.two_or_more (by linarith) sorted.single

example :
  sorted [7, 9, 9, 11] :=
sorted.two_or_more (by linarith)
  (sorted.two_or_more (by linarith)
    (sorted.two_or_more (by linarith)
      sorted.single))

example :
  ¬ sorted [17, 13] :=
assume h : sorted [17, 13],
have 17 ≤ 13 :=
  match h with
  | sorted.two_or_more xy yxs := xy
  end,
have ¬ (17 ≤ 13) := by linarith,
show false, from by cc

/- Example: Well-formed and Ground First-Order Terms -/

inductive term (α β : Type) : Type
| var {} : β → term
| fn     : α → list term → term

export term (var fn)

inductive well_formed {α β : Type} (arity : α → ℕ) :
  term α β → Prop
| var (x : β) : well_formed (var x)
| fn (f : α) (ts : list (term α β))
    (hargs : ∀t ∈ ts, well_formed t)
    (hlen : list.length ts = arity f) :
  well_formed (fn f ts)

inductive variable_free {α β : Type} : term α β → Prop
| fn (f : α) (ts : list (term α β))
    (hargs : ∀t ∈ ts, variable_free t) :
  variable_free (fn f ts)

/- Example: Reflexive Transitive Closure -/

inductive rtc {α : Type} (r : α → α → Prop) : α → α → Prop
| base (a b : α) : r a b → rtc a b
| refl (a : α) : rtc a a
| trans (a b c : α) : rtc a b → rtc b c → rtc a c

lemma rtc_rtc_iff_rtc {α : Type} (r : α → α → Prop) (a b : α) :
  rtc (rtc r) a b ↔ rtc r a b :=
begin
  apply iff.intro,
  { intro h,
    induction h,
    case rtc.base : x y {
      assumption },
    case rtc.refl : x {
      apply rtc.refl },
    case rtc.trans : x y z {
      apply rtc.trans,
      assumption,
      assumption } },
  { intro h,
    apply rtc.base,
    assumption }
end

lemma rtc_rtc_eq_rtc {α : Type} (r : α → α → Prop) :
  rtc (rtc r) = rtc r :=
begin
  apply funext,
  intro a,
  apply funext,
  intro b,
  apply propext,
  apply rtc_rtc_iff_rtc
end

/- New Tactics -/

example {α : Type} (a b c d : α) (f : α → α → α)
    (hab : a = c) (hcd : b = d) :
  f a b = f c d :=
by cc

example (i : ℤ) (hagt : i > 5) :
  2 * i > 8 :=
by linarith

example (i : ℤ) :
  1 + (i + -1) = i :=
by norm_num

end LoVe


import data.real.basic
import lib.attempt

namespace challenges

-- basic definitions
def upper_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, s ≤ b }
def lower_bounds (S : set ℝ) : set ℝ := { b | ∀s ∈ S, b ≤ s }
def is_least (S : set ℝ) (l : ℝ) : Prop := l ∈ S ∧ l ∈ lower_bounds S
def is_lub (S : set ℝ) (l : ℝ) : Prop := is_least (upper_bounds S) l

/-- A set has at most one least upper bound -/
theorem challenge2 (S : set ℝ) (a b : ℝ) (ha : is_lub S a) (hb : is_lub S b) : a = b :=
attempt begin
  unfold is_lub is_least upper_bounds lower_bounds at *,
  cases ha with ha1 ha2,
  cases hb with hb1 hb2,
  unfold set_of has_mem.mem set.mem at *,
  have hab := ha2 b hb1,
  have hba := hb2 a ha1,
  -- suggest,
  exact le_antisymm (ha2 b hb1) (hb2 a ha1),
end $
begin
  exact le_antisymm (ha.2 b hb.1) (hb.2 a ha.1),
end

end challenges


import .lovelib

/-! # LoVe Homework 1: Definitions and Statements

Homework must be done individually.

Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (1 points): Snoc

1.1 (1 point). Define the function `snoc` that appends a single element to the
end of a list. Your function should be defined by recursion and not using `++`
(`list.append`). -/

def snoc {α : Type} : list α → α → list α
| list.nil a := [a]
| (list.cons head tail) a := list.cons head (snoc tail a)

/-! 1.2 (0 point). Convince yourself that your definition of `snoc` works by
testing it on a few examples. -/

#reduce snoc [1] 2
-- invoke `#reduce` or `#eval` here

/-! ## Question 2 (3 points): Map

2.1 (1 point). Define a generic `map` function that applies a function to every
element in a list. -/

def map {α : Type} {β : Type} (f : α → β) : list α → list β
| list.nil := list.nil
| (list.cons head tail) := list.cons (f head) (map tail)

/-! 2.2 (2 points). State (without proving them) the so-called functorial
properties of `map` as lemmas. Schematically:

     map (λx, x) xs = xs
     map (λx, g (f x)) xs = map g (map f xs)

Try to give meaningful names to your lemmas. Also, make sure to state the second
property as generally as possible, for arbitrary types. -/

-- enter your lemma statements here

/-! ## Question 3 (5 points): λ-Terms

We start by declaring four new opaque types. -/

constants α β γ δ : Type

/-! 3.1 (2 points). Complete the following definitions, by providing terms with
the expected type.

Please use reasonable names for the bound variables, e.g., `a : α`, `b : β`,
`c : γ`.

Hint: A procedure for doing so systematically is described in Section 1.1.4 of
the Hitchhiker's Guide. As explained there, you can use `_` as a placeholder
while constructing a term. By hovering over `_`, you will see the current
logical context. -/

def B : (α → β) → (γ → α) → γ → β :=
λf g a, f (g a)

def S : (α → β → γ) → (α → β) → α → γ :=
λf g a, f a (g a)

def more_nonsense : ((α → β) → γ → δ) → γ → β → δ :=
λf a b, f (λg, b) a

def even_more_nonsense : (α → β) → (α → γ) → α → β → γ :=
λf g a b, g a

/-! 3.2 (1 point). Complete the following definition.

This one looks more difficult, but it should be fairly straightforward if you
follow the procedure described in the Hitchhiker's Guide.

Note: Peirce is pronounced like the English word "purse". -/

def weak_peirce : ((((α → β) → α) → α) → β) → β :=
sorry

/-! 3.3 (2 points). Show the typing derivation for your definition of `B` above,
using ASCII or Unicode art. You might find the characters `–` (to draw
horizontal bars) and `⊢` useful.

Feel free to introduce abbreviations to avoid repeating large contexts `Γ`. -/

-- write your solution here

end LoVe


import data.set
import .src_17_even_odd_further

open set function

namespace mth1001

section pre_image
/-
Suppose `f : α → β` is a function from a type `α` to a type `β`. Suppose
`B` is a set on `β`. The *preimage* of `B` under `f` is `{x : α | f x ∈ B}`.
It is denoted `f⁻¹ B` in matheamtics and either `preimage f B` or `f⁻¹' B` in Lean.

WARNING: `f⁻¹ B` is a *set*. It is related to, but is not the same thing as the inverse of `f`.
-/

section pre_image_examples
/-
As an example, consider `g : ℤ → ℕ` given by `g n := |n| + 1`. Let `T := {1, 3, 5}`. Then the
preimage of `T` under `g` is the set `{0, 2, -2, 4, -4}`.
-/

def g (n : ℤ) : ℕ := int.nat_abs n + 1
def T : set ℕ := {1, 3, 5}

lemma eq_or_eq_neg_of_nat_abs_eq {x : ℤ} {y : ℕ}: int.nat_abs x = y → (x = y) ∨ (x = -y) :=
λ h, h ▸ (h ▸ (int.nat_abs_eq x))

example : g⁻¹' T = {0, 2, -2, 4, -4} :=
begin
  ext, unfold T,
  split,
  { unfold preimage,
    intro h,
    rw mem_set_of_eq at h,
    unfold g at h,
    rcases h with h | h | h | ⟨⟨⟩⟩,
    { rcases (eq_or_eq_neg_of_nat_abs_eq (nat.succ_inj h)) with rfl | rfl;
      simp, },
    { rcases (eq_or_eq_neg_of_nat_abs_eq (nat.succ_inj h)) with rfl | rfl;
      simp, },
    { rw (int.eq_zero_of_nat_abs_eq_zero (nat.succ_inj h)), simp, }, },
  { intro h,
    finish, },
end

/-
As an example, conisder `f : ℤ → ℤ` defined by `f n = n + 1`. Let `B` be the set of even integers.
We'll show the preimage of `B` under `f` is the set of odd integers
-/

def f (n : ℤ) : ℤ := n + 1
def B := {y : ℤ | even y}
def C := {m : ℤ | odd m}

example : f⁻¹' B = C :=
begin
  ext, -- Assume `x ∈ ℤ`. We must show `x ∈ f⁻¹' B ↔ x ∈ C`.
  split,
  { rintro ⟨b, h⟩, -- Assume `b : ℤ` and `h : f x = 2 * b`. We must show `x ∈ C`.
    unfold f at h, -- By defintion, `h : f x = 2 * b`.
    use (b - 1), -- It suffices to prove `x = 2 * b + 1`.
    linarith, }, -- The goal follows by linear arithmetic.
  { rintro ⟨c, h⟩, -- Assume `c : ℤ` and `h : x = 2 * c + `. We must show `x ∈ f⁻¹' B`.
    have h₂ : f x ∈ B,
    { rw h,
      unfold f,
      use (c + 1),
      linarith, },
    unfold preimage,
    rw mem_set_of_eq,
    exact h₂, },
end

end pre_image_examples

section pre_image_theorems

variable {α : Type*}
variable {β : Type*}

#check preimage_inter

/-
The following proof uses the power of `rintro` to decompose intersections, etc.
Note that, unlike images, intersections are preserved by the preimage.
-/
theorem preimage_inter {B C : set β} {f : α → β} : f⁻¹' (B ∩ C) = f⁻¹' B ∩ f⁻¹' C :=
begin
  ext, -- Assume `x : ℤ`. It suffices to prove `x ∈ f⁻¹' (B ∩ C) ↔ x ∈ f⁻¹' B ∩ f⁻¹' C`.
  split, -- Decompose the `↔` proof into two implication proofs.
  { rintro ⟨hb, hc⟩, -- Assume `hb : f x ∈ B` and `hc : f x ∈ B`. STP `x ∈ f⁻¹' B ∩ f⁻¹' C`.
    exact and.intro hb hc, }, -- This follows by `∧` introduction on `hb` and `hc`.
  { rintro ⟨hb, hc⟩, -- Assume `hb : x ∈ f⁻¹' B` and `hc : x ∈ f⁻¹' C`. STP `x ∈ f⁻¹' B ∩ C`.
    exact and.intro hb hc, } -- The goal follows by `∧` introduction on `hb` and `hc`.
end

/-
In fact, as the same tactic applies to both subgoals after the split above, the proof can be
shortened using the `;` combinator:
-/
example {B C : set β} {f : α → β} : f⁻¹' (B ∩ C) = f⁻¹' B ∩ f⁻¹' C :=
begin
  ext, -- Assume `x : ℤ`. It suffices to prove `x ∈ f⁻¹' (B ∩ C) ↔ x ∈ f⁻¹' B ∩ f⁻¹' C`.
  split; -- Decompose the `↔` proof into two implication proofs.
  { rintro ⟨hb, hc⟩, exact and.intro hb hc, },
end

-- Exercise 144:
-- The preimage of a union is the union of preimages.
theorem preimage_union {B C : set β} {f : α → β} : f⁻¹' (B ∪ C) = f⁻¹' B ∪ f⁻¹' C :=
begin
  sorry
end

end pre_image_theorems

end pre_image

end mth1001


/-
Copyright (c) 2020 Benjamin Davidson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Benjamin Davidson
-/
import analysis.special_functions.trigonometric.arctan_deriv

/-! ### Leibniz's Series for Pi -/

namespace real

open filter set
open_locale classical big_operators topological_space real
local notation `|`x`|` := abs x

/-- This theorem establishes **Leibniz's series for `π`**: The alternating sum of the reciprocals
  of the odd numbers is `π/4`. Note that this is a conditionally rather than absolutely convergent
  series. The main tool that this proof uses is the Mean Value Theorem (specifically avoiding the
  Fundamental Theorem of Calculus).

  Intuitively, the theorem holds because Leibniz's series is the Taylor series of `arctan x`
  centered about `0` and evaluated at the value `x = 1`. Therefore, much of this proof consists of
  reasoning about a function
    `f := arctan x - ∑ i in finset.range k, (-(1:ℝ))^i * x^(2*i+1) / (2*i+1)`,
  the difference between `arctan` and the `k`-th partial sum of its Taylor series. Some ingenuity is
  required due to the fact that the Taylor series is not absolutely convergent at `x = 1`.

  This proof requires a bound on `f 1`, the key idea being that `f 1` can be split as the sum of
  `f 1 - f u` and `f u`, where `u` is a sequence of values in [0,1], carefully chosen such that
  each of these two terms can be controlled (in different ways).

  We begin the proof by (1) introducing that sequence `u` and then proving that another sequence
  constructed from `u` tends to `0` at `+∞`. After (2) converting the limit in our goal to an
  inequality, we (3) introduce the auxiliary function `f` defined above. Next, we (4) compute the
  derivative of `f`, denoted by `f'`, first generally and then on each of two subintervals of [0,1].
  We then (5) prove a bound for `f'`, again both generally as well as on each of the two
  subintervals. Finally, we (6) apply the Mean Value Theorem twice, obtaining bounds on `f 1 - f u`
  and `f u - f 0` from the bounds on `f'` (note that `f 0 = 0`). -/
theorem tendsto_sum_pi_div_four :
  tendsto (λ k, ∑ i in finset.range k, ((-(1:ℝ))^i / (2*i+1))) at_top (𝓝 (π/4)) :=
begin
  rw [tendsto_iff_norm_tendsto_zero, ← tendsto_zero_iff_norm_tendsto_zero],
  -- (1) We introduce a useful sequence `u` of values in [0,1], then prove that another sequence
  --     constructed from `u` tends to `0` at `+∞`
  let u := λ k : ℕ, (k:nnreal) ^ (-1 / (2 * (k:ℝ) + 1)),
  have H : tendsto (λ k : ℕ, (1:ℝ) - (u k) + (u k) ^ (2 * (k:ℝ) + 1)) at_top (𝓝 0),
  { convert (((tendsto_rpow_div_mul_add (-1) 2 1 two_ne_zero.symm).neg.const_add 1).add
      tendsto_inv_at_top_zero).comp tendsto_coe_nat_at_top_at_top,
    { ext k,
      simp only [nnreal.coe_nat_cast, function.comp_app, nnreal.coe_rpow],
      rw [← rpow_mul (nat.cast_nonneg k) ((-1)/(2*(k:ℝ)+1)) (2*(k:ℝ)+1),
         @div_mul_cancel _ _ _ (2*(k:ℝ)+1)
            (by { norm_cast, simp only [nat.succ_ne_zero, not_false_iff] }), rpow_neg_one k,
          sub_eq_add_neg] },
    { simp only [add_zero, add_right_neg] } },
  -- (2) We convert the limit in our goal to an inequality
  refine squeeze_zero_norm _ H,
  intro k,
  -- Since `k` is now fixed, we henceforth denote `u k` as `U`
  let U := u k,
  -- (3) We introduce an auxiliary function `f`
  let b := λ (i:ℕ) x, (-(1:ℝ))^i * x^(2*i+1) / (2*i+1),
  let f := λ x, arctan x - (∑ i in finset.range k, b i x),
  suffices f_bound : |f 1 - f 0| ≤ (1:ℝ) - U + U ^ (2 * (k:ℝ) + 1),
  { rw ← norm_neg,
    convert f_bound,
    simp only [f], simp [b] },
  -- We show that `U` is indeed in [0,1]
  have hU1 : (U:ℝ) ≤ 1,
  { by_cases hk : k = 0,
    { simpa only [U, hk] using zero_rpow_le_one _ },
    { exact rpow_le_one_of_one_le_of_nonpos (by { norm_cast, exact nat.succ_le_iff.mpr
        (nat.pos_of_ne_zero hk) }) (le_of_lt (@div_neg_of_neg_of_pos _ _ (-(1:ℝ)) (2*k+1)
          (neg_neg_iff_pos.mpr zero_lt_one) (by { norm_cast, exact nat.succ_pos' }))) } },
  have hU2 := nnreal.coe_nonneg U,
  -- (4) We compute the derivative of `f`, denoted by `f'`
  let f' := λ x : ℝ, (-x^2) ^ k / (1 + x^2),
  have has_deriv_at_f : ∀ x, has_deriv_at f (f' x) x,
  { intro x,
    have has_deriv_at_b : ∀ i ∈ finset.range k, (has_deriv_at (b i) ((-x^2)^i) x),
    { intros i hi,
      convert has_deriv_at.const_mul ((-1:ℝ)^i / (2*i+1)) (@has_deriv_at.pow _ _ _ _ _ (2*i+1)
        (has_deriv_at_id x)),
      { ext y,
        simp only [b, id.def],
        ring },
      { simp only [nat.add_succ_sub_one, add_zero, mul_one, id.def, nat.cast_bit0, nat.cast_add,
                  nat.cast_one, nat.cast_mul],
        rw [← mul_assoc, @div_mul_cancel _ _ _ (2*(i:ℝ)+1) (by { norm_cast, linarith }),
            pow_mul x 2 i, ← mul_pow (-1) (x^2) i],
        ring_nf } },
    convert (has_deriv_at_arctan x).sub (has_deriv_at.sum has_deriv_at_b),
    have g_sum :=
      @geom_sum_eq _ _ (-x^2) ((neg_nonpos.mpr (sq_nonneg x)).trans_lt zero_lt_one).ne k,
    simp only [geom_sum, f'] at g_sum ⊢,
    rw [g_sum, ← neg_add' (x^2) 1, add_comm (x^2) 1, sub_eq_add_neg, neg_div', neg_div_neg_eq],
    ring },
  have hderiv1 : ∀ x ∈ Icc (U:ℝ) 1, has_deriv_within_at f (f' x) (Icc (U:ℝ) 1) x :=
    λ x hx, (has_deriv_at_f x).has_deriv_within_at,
  have hderiv2 : ∀ x ∈ Icc 0 (U:ℝ), has_deriv_within_at f (f' x) (Icc 0 (U:ℝ)) x :=
    λ x hx, (has_deriv_at_f x).has_deriv_within_at,
  -- (5) We prove a general bound for `f'` and then more precise bounds on each of two subintervals
  have f'_bound : ∀ x ∈ Icc (-1:ℝ) 1, |f' x| ≤ |x|^(2*k),
  { intros x hx,
    rw [abs_div, is_absolute_value.abv_pow abs (-x^2) k, abs_neg, is_absolute_value.abv_pow abs x 2,
       tactic.ring_exp.pow_e_pf_exp rfl rfl],
    refine div_le_of_nonneg_of_le_mul (abs_nonneg _) (pow_nonneg (abs_nonneg _) _) _,
    refine le_mul_of_one_le_right (pow_nonneg (abs_nonneg _) _) _,
    rw abs_of_nonneg ((add_nonneg zero_le_one (sq_nonneg x)) : (0 : ℝ) ≤ _),
    exact (le_add_of_nonneg_right (sq_nonneg x) : (1 : ℝ) ≤ _) },
  have hbound1 : ∀ x ∈ Ico (U:ℝ) 1, |f' x| ≤ 1,
  { rintros x ⟨hx_left, hx_right⟩,
    have hincr := pow_le_pow_of_le_left (le_trans hU2 hx_left) (le_of_lt hx_right) (2*k),
    rw [one_pow (2*k), ← abs_of_nonneg (le_trans hU2 hx_left)] at hincr,
    rw ← abs_of_nonneg (le_trans hU2 hx_left) at hx_right,
    linarith [f'_bound x (mem_Icc.mpr (abs_le.mp (le_of_lt hx_right)))] },
  have hbound2 : ∀ x ∈ Ico 0 (U:ℝ), |f' x| ≤ U ^ (2*k),
  { rintros x ⟨hx_left, hx_right⟩,
    have hincr := pow_le_pow_of_le_left hx_left (le_of_lt hx_right) (2*k),
    rw ← abs_of_nonneg hx_left at hincr hx_right,
    rw ← abs_of_nonneg hU2 at hU1 hx_right,
    linarith [f'_bound x (mem_Icc.mpr (abs_le.mp (le_trans (le_of_lt hx_right) hU1)))] },
  -- (6) We twice apply the Mean Value Theorem to obtain bounds on `f` from the bounds on `f'`
  have mvt1 :=
    norm_image_sub_le_of_norm_deriv_le_segment' hderiv1 hbound1 _ (right_mem_Icc.mpr hU1),
  have mvt2 :=
    norm_image_sub_le_of_norm_deriv_le_segment' hderiv2 hbound2 _ (right_mem_Icc.mpr hU2),
  -- The following algebra is enough to complete the proof
  calc |f 1 - f 0| = |(f 1 - f U) + (f U - f 0)| : by ring_nf
               ... ≤ 1 * (1-U) + U^(2*k) * (U - 0) : le_trans (abs_add (f 1 - f U) (f U - f 0))
                                                      (add_le_add mvt1 mvt2)
               ... = 1 - U + U^(2*k) * U : by ring
               ... = 1 - (u k) + (u k)^(2*(k:ℝ)+1) : by { rw [← pow_succ' (U:ℝ) (2*k)], norm_cast },
end

end real


/-
Copyright (c) 2023 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import ring_theory.localization.module
import ring_theory.norm

/-!

# Field/algebra norm and localization

This file contains results on the combination of `algebra.norm` and `is_localization`.

## Main results

 * `algebra.norm_localization`: let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M`
  of `R S` respectively. Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R`
  if `S` is free as `R`-module

## Tags

field norm, algebra norm, localization

-/

open_locale non_zero_divisors

variables (R : Type*) {S : Type*} [comm_ring R] [comm_ring S] [algebra R S]
variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [algebra R Rₘ] [comm_ring Sₘ] [algebra S Sₘ]
variables (M : submonoid R)
variables [is_localization M Rₘ] [is_localization (algebra.algebra_map_submonoid S M) Sₘ]
variables [algebra Rₘ Sₘ] [algebra R Sₘ] [is_scalar_tower R Rₘ Sₘ] [is_scalar_tower R S Sₘ]
include M

/-- Let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M` of `R S` respectively.
Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R` if `S` is free as `R`-module.
-/
lemma algebra.norm_localization [module.free R S] [module.finite R S] (a : S) :
  algebra.norm Rₘ (algebra_map S Sₘ a) = algebra_map R Rₘ (algebra.norm R a) :=
begin
  casesI subsingleton_or_nontrivial R,
  { haveI : subsingleton Rₘ := module.subsingleton R Rₘ,
    simp },
  let b := module.free.choose_basis R S,
  letI := classical.dec_eq (module.free.choose_basis_index R S),
  rw [algebra.norm_eq_matrix_det (b.localization_localization Rₘ M Sₘ),
      algebra.norm_eq_matrix_det b, ring_hom.map_det],
  congr,
  ext i j,
  simp only [matrix.map_apply, ring_hom.map_matrix_apply, algebra.left_mul_matrix_eq_repr_mul,
      basis.localization_localization_apply, ← _root_.map_mul],
  apply basis.localization_localization_repr_algebra_map
end


import tactic

/-

Упражнения в этом файле взяты из курса Formalising Mathematics:
https://github.com/ImperialCollegeLondon/formalising-mathematics/blob/master/src/week_1/Part_D_relations.lean

Рассмотрим тип `α` и бинарные отношения над `α`: `R : α → α → Prop`.
Для бинарных отношений в Lean определены понятия рефлексивности, симметричности и транзитивности:

`reflexive R := ∀ (x : α), R x x`
`symmetric R := ∀ ⦃x y : α⦄, R x y → R y x`
`transitive R := ∀ ⦃x y z : α⦄, R x y → R y z → R x z`

Отношение `R` является отношением эквивалентности, если оно удовлетворяет всем трем определенным выше утверждениям:

`equivalence R := reflexive R ∧ symmetric R ∧ transitive R`

В этом файле мы докажем, что существует биекция между отношениями эквивалентности на типе `α` и разбиениями элементов `α` на подмножества (чтобы не путаться, будем называть их блоками).

Определим тип разбиений элементов типа `α`. Разбиение состоит из четырех элементов:
1) `C : set (set α)` - множество блоков.
2) `Hnonempty` - доказательство того, что все блоки непусты.
3) `Hcover` - доказательство того, что любой элемент `a : α` лежит в каком-то блоке.
4) `Hdisjoint` - доказательство того, что разные блоки не пересекаются.

Ключевое слово `structure` задает тип с одним конструктором (он сгенерируется с названием `partition.mk`) и именными "полями". Если `P : partition α`, то можно писать `P.C`, `P.Hnonempty` и остальные.
-/

@[ext] structure partition (α : Type) :=
(C : set (set α))
(Hnonempty : ∀ X ∈ C, (X : set α).nonempty)
(Hcover : ∀ a, ∃ X ∈ C, a ∈ X)
(Hdisjoint : ∀ X Y ∈ C, (X ∩ Y : set α).nonempty → X = Y)

namespace partition

variables {α : Type} {P : partition α} {X Y : set α}

-- `X.nonempty` (или `set.nonempty X`) означает, что существует элемент, принадлежащий множеству `X`
lemma nonempty_def : X.nonempty ↔ ∃ a, a ∈ X :=
begin
  refl,
end

/-- Если `a` содержится в двух блоках `X` и `Y` -/
theorem eq_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a : α} (haX : a ∈ X)
  (haY : a ∈ Y) : X = Y :=
begin
  apply P.Hdisjoint X Y hX hY,
  use [a, haX, haY],
end

theorem mem_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a b : α}
  (haX : a ∈ X) (haY : a ∈ Y) (hbX : b ∈ X) : b ∈ Y :=
begin
  have heq := eq_of_mem hX hY haX haY,
  rwa heq at hbX,
end

end partition

section equivalence_classes

variables {α : Type} (R : α → α → Prop) (hR : equivalence R)

-- Классом эквивалентности `a` назовем множество таких `b`, что `R b a`
def cl (a : α) := {b : α | R b a}

-- По определению, `b` лежит в классе эквивалентности `a`, если `R b a`
lemma mem_cl_iff {a b : α} : b ∈ cl R a ↔ R b a :=
begin
  refl
end

-- `a` принадлежит классу эквивалентности `a`
lemma mem_cl_self (hR : equivalence R) (a : α) : a ∈ cl R a :=
begin
  -- Чтобы использовать рефлексивность `R`, нужно распаковать `hR`
  -- Это можно сделать с помощью `rcases`: `rcases hR with ⟨hrefl, hsymm, htrans⟩`, или
  -- `obtain ⟨hrefl, hsymm, htrans⟩ := hR`
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  exact hrefl a,
end

-- Если `a` лежит в классе `b`, то весь класс `a` - подмножество класса `b`
lemma cl_sub_cl_of_mem_cl {a b : α} (hR : equivalence R) : a ∈ cl R b → cl R a ⊆ cl R b :=
begin
  rcases hR with ⟨hrefl, hsymm, htrans⟩,
  rintro h x Rxa,
  exact htrans Rxa h,
end

-- Напоминание: `set.subset.antisymm : X ⊆ Y → Y ⊆ X → X = Y`
lemma cl_eq_cl_of_mem_cl {a b : α} (hR : equivalence R) : a ∈ cl R b → cl R a = cl R b :=
begin
  intro h,
  apply set.subset.antisymm,
  refine cl_sub_cl_of_mem_cl R hR h,
  refine cl_sub_cl_of_mem_cl R hR _,
  exact hR.2.1 h,
end

end equivalence_classes

open partition

-- Чтобы доказать эквивалентность двух типов `X ≃ Y`, нужно построить преобразование `X → Y`, обратное преобразование `Y → X`, а также доказать, что эти два преобразования взаимнообратны

-- Далее внутри будут огромные и страшные цели, но мы их будем менять на эквивалентные с помощью тактик `change` и `show`
--

example (α : Type) : {R : α → α → Prop // equivalence R} ≃ partition α :=
{ -- Преобразуем отношение эквивалентности `R`в разбиение:
  to_fun := λ R, {
    -- Возьмем за `C` множество классов эквивалентности всех элементов типа `α` по отношению R
    C := { B : set α | ∃ x : α, B = cl R.1 x},
    -- Докажем, что такое множество блоков является разбиением. Для этого нужно доказать три свойства разбиений: `Hnonempty`, `Hcover` и `Hdisjoint`. Докажем их:
    Hnonempty := begin
      -- Любый класс эквивалентности непуст.
      cases R with R hR,
      change ∀ (X : set α), (∃ (a : α), X = cl R a) → X.nonempty,
      rintro X ⟨a, rfl⟩,
      -- Крутой хак: вместо того, чтобы гипотезу вида `A = B` сохранять в переменную, можно в `rintro` и `rcases` написать `rfl` вместо названия, и (если это корректно), во всех местах `A` заменится на `B` и уйдет из контекста
      use a,
      apply mem_cl_self R hR,
    end,
    Hcover := begin
      -- Каждый элемент типа `α` содержится хотя бы в одном классе эквивалентности.
      cases R with R hR,
      change ∀ (a : α), ∃ (X : set α) (H : ∃ (b : α), X = cl R b), a ∈ X,
      intro a,
      use [cl R a],
      refine ⟨⟨a, rfl⟩, mem_cl_self R hR _⟩,
    end,
    Hdisjoint := begin
      -- Если два класса эквивалентности пересекаются, то они равны.
      cases R with R hR,
      change ∀ (X Y : set α), (∃ (a : α), X = cl R a) →
        (∃ (b : α), Y = cl _ b) → (X ∩ Y).nonempty → X = Y,
      rintro _ _ ⟨a, rfl⟩ ⟨b, rfl⟩ ⟨c, ⟨Rac, Rbc⟩⟩,
      apply cl_eq_cl_of_mem_cl R hR,
      rcases hR with ⟨hrefl, hsymm, htrans⟩,
      refine htrans _ Rbc,
      refine hsymm Rac,
    end },
  -- Теперь построим отношение эквивалентности по разбиению
  inv_fun := λ P,
    -- Определим бинарное отношение `R`:
    -- `R a b` если любой блок, содержащий `a`, также содержит `b`.
    ⟨λ a b, ∀ X ∈ P.C, a ∈ X → b ∈ X, begin
      -- Докажем, что это отношение эквивалентности
    split,
    { -- Оно рефлексивно
      unfold reflexive,
      rintro x A hA xA,
      exact xA,
    },
    split,
    { -- Оно симметрично
      unfold symmetric,
      rintro x y hxy X hX yX,
      obtain ⟨Y, hY, xY⟩ := P.Hcover x,
      specialize hxy Y hY xY,
      have h := eq_of_mem hX hY yX hxy,
      rwa h,
    },
    { -- Оно транзитивно
      unfold transitive,
      show ∀ (a b c : α),
        (∀ (X : set α), X ∈ P.C → a ∈ X → b ∈ X) →
        (∀ (X : set α), X ∈ P.C → b ∈ X → c ∈ X) →
         ∀ (X : set α), X ∈ P.C → a ∈ X → c ∈ X,
      rintro a b c hab hbc X hX aX,
      apply hbc X hX,
      apply hab X hX,
      exact aX,
    }
  end⟩,
  -- Если начать с отношения `R` и сделать оба преобразования, снова получится `R`
  left_inv := begin
    rintro ⟨R, hR⟩,
    -- Страшная цель, но она эквивалентна следующей:
    suffices h : (λ (a b : α), ∀ (c : α), a ∈ cl R c → b ∈ cl R c) = R,
    simpa using h,
    -- ... и теперь докажем, что два отношения совпадают, тактика `ext` превратит цель в равенство для конкретных `a` и `b`
    ext a b,

    split, {
      intro h,
      specialize h a (mem_cl_self _ hR _),
      apply hR.2.1, -- симметричность
      exact h,
    }, {
      rintro hab c Rac,
      -- упростим всё до вида R _ _
      rw [cl, set.mem_set_of_eq] at *,
      -- hR.2.2 - транзитивность
      apply hR.2.2 (hR.2.1 hab) Rac,
    }
  end,
  -- Аналогично, если начать с разбиения и сделать два преобразования, получится то же разбиение
  right_inv := begin
    intro P,
    ext X,
    show (∃ (a : α), X = cl _ a) ↔ X ∈ P.C,
    dsimp only,
    split, {
      rintro ⟨a, ha⟩,
      obtain ⟨Y, hY, aY⟩ := P.Hcover a,
      -- Достаточно показать, что `X` это то же самое, что блок `Y`, покрывающий `a`
      suffices hXY : X = Y, {
        rwa hXY,
      },
      subst ha,
      ext t, split, {
        intro ht,
        -- Теперь, когда есть элемент типа t ∈ <страшное выражение>, его можно упростить
        -- `squeeze_simp` покажет минимальное множество использованных лемм и предложит заменить на `simp only [...]`
        -- такое применение предпочтительно, потому что в будущем множество лемм для `simp` может измениться, и старые доказательства сломаются
        -- также часто нетерминальные (те, что не закрывают цель) `simp` не слишком одобряются, поэтому предпочитают `simp only`
        squeeze_simp [cl] at ht,
        obtain ⟨Z, hZ, tZ⟩ := P.Hcover t,
        have aZ := ht Z hZ tZ,
        -- a ∈ Y ∧ a ∈ Z → Y = Z
        have hYZ := eq_of_mem hY hZ aY aZ,
        rwa hYZ,
      }, {
        simp [cl],
        rintro tY Z hZ tZ,
        refine mem_of_mem hY hZ tY tZ aY,
      }
    }, {
      intro hX,
      obtain ⟨a, aX⟩ := P.Hnonempty X hX,
      use a,
      ext t, split, {
        simp [cl],
        rintro tX Y hY tY,
        refine mem_of_mem hX hY tX tY aX,
      }, {
        simp [cl],
        intro h,
        obtain ⟨Y, hY, tY⟩ := P.Hcover t,
        refine mem_of_mem hY hX _ aX tY,
        -- осталось ⊢ a ∈ Y
        apply h Y hY tY,
      }
    }
  end }


import subgroup.cyclic

/- In this file we will define the commutator and some lemmas about it. -/

namespace mygroup

open_locale classical

open mygroup.subgroup mygroup.quotient group_hom function set

variables {G : Type} [group G]

/-- The commutator of two elements `a`, `b` of a group `G` is `a * b * a⁻¹ * b⁻¹`-/
def commutator (a b : G) := a * b * a ⁻¹ * b⁻¹

@[simp] lemma commutator_def {a b : G} : commutator a b = a * b * a⁻¹ * b⁻¹ := rfl

def commutators (G : Type) [group G] := { c | ∃ a b : G, c = commutator a b }

@[simp] lemma commutators_def : commutators G =
  { c | ∃ a b : G, c = commutator a b } := rfl

@[simp] lemma mem_commutators_iff (x : G) : x ∈ commutators G ↔
  ∃ a b : G, x = commutator a b := iff.rfl

-- To show that the subgroup generated by the set of commutators is normal, we
-- first need a more general lemma for showing normal'ness' of closures, i.e.
-- the fact that the closure is normal if the set is closed under conjugation

-- We will use the induction principle on closure of subgroups

namespace subgroup

/-- The closure of an invariant set is also invariant under conjugation -/
lemma closure_normal {s : set G} (hs : ∀ t ∈ s, ∀ g : G, g * t * g⁻¹ ∈ s) :
  ∀ t ∈ closure s, ∀ g : G, g * t * g⁻¹ ∈ closure s :=
begin
  intros t ht g,
  apply closure_induction ht,
    exact λ x hx, le_closure _ (hs x hx g),
    simp [one_mem],
    intros x y hx hy,
    conv_lhs
      { congr, congr, skip, congr,
        rw [show x = x * g⁻¹ * g, by simp [group.mul_assoc]] },
    rw [show g * (x * g⁻¹ * g * y) * g⁻¹ = g * x * g⁻¹ * (g * y * g⁻¹),
        by simp [group.mul_assoc]],
    refine mul_mem _ hx hy,
    intros x hx, refine (inv_mem_iff _).1 _,
    simpa [← group.mul_assoc],
end

/-- The commutator is the normal subgroup generated by the set of commutators -/
def commutator_normal (G : Type) [group G] : normal G :=
{ conj_mem' :=
  begin
    intros n hn g,
    refine closure_normal _ _ hn _,
    rintro t ⟨a, b, rfl⟩ g,
    rw [commutator_def, show g * (a * b * a⁻¹ * b⁻¹) * g⁻¹ =
          g * a * g⁻¹ * (g * b * g⁻¹) * (g * a * g⁻¹)⁻¹ * (g * b * g⁻¹)⁻¹,
          by simp [group.mul_assoc]],
    exact ⟨g * a * g⁻¹, (g * b * g⁻¹), rfl⟩,
  end .. closure $ commutators G }

/-- A group `G` the abelian if and only if the commutator subgroup is `{1}`-/
lemma comm_group_iff : (commutator_normal G : set G) = {1} ↔ @commutative G (*) :=
begin
  split, intros h a b,
    { change (closure (commutators G) : set G) = _ at h,
      have : {c : G | ∃ (a b : G), c = commutator a b} = {1},
        apply subset.antisymm, rw ← h, exact le_closure _,
        rw singleton_subset_iff, exact ⟨a, a⁻¹, by simp⟩,
      rw eq_singleton_iff_unique_mem at this,
      rw [← group.mul_right_cancel_iff (a⁻¹ * b⁻¹),
          (this.right (a * b * (a⁻¹ * b⁻¹))
          ⟨a, b, by simp [group.mul_assoc]⟩).symm],
      simp [group.mul_assoc] },
    { intros h, apply subset.antisymm,
      { change closure (commutators G) ≤ trivial,
        rw closure_le, rintro _ ⟨a, b, rfl⟩, rw [commutator_def, h a b, mem_coe'],
        simp [group.mul_assoc, subgroup.trivial, ← mem_coe] },
      { intros x hx, rw mem_singleton_iff at hx, subst hx, exact one_mem _ } }
end

lemma comm_group_iff' : (commutator_normal G : subgroup G) = ⊥ ↔
  @commutative G (*) :=
begin
  rw ← comm_group_iff,
  split; intro h,
    { change (commutator_normal G).carrier = _,
      change (commutator_normal G).to_subgroup = _ at h,
      rw [h, bot_eq_trivial], refl },
    { apply ext', rw bot_eq_trivial, exact h }
end

lemma commutator_normal_eq_bot_iff :
  (commutator_normal G : subgroup G) = ⊥ ↔ commutators G = {1} :=
begin
  change closure (commutators G) = _ ↔ _,
  rw eq_bot_iff,
  split; intro h,
    { ext, split; intro hx,
        { change x ∈ subgroup.trivial.carrier,
          rw ← bot_eq_trivial,
          exact h (le_closure _ hx) },
        { exact hx.symm ▸ ⟨1, 1, by simp⟩ } },
    { rw [closure_le, h],
      intros x hx, rw mem_singleton_iff at hx,
      subst hx, exact one_mem _ }
end

/-- Given the group homomorphism `f : G → H` where `H` is a abelian, for all `x`
  in the commutators of `G`, `f x = 1` -/
lemma map_commutators_eq_one {H : Type} [comm_group H] (f : G →* H) :
  ∀ x ∈ commutators G, f x = 1 :=
begin
  intros x hx,
  rw mem_commutators_iff at hx,
  rcases hx with ⟨a, b, rfl⟩,
  simp [group.mul_comm],
end

lemma closure_eq_kernel_of_map_eq_one {H : Type} [group H]
  {f : G →* H} {S : set G} (hS : ∀ s ∈ S, f s = 1) : closure S ≤ kernel f :=
begin
  intros x hx,
  erw mem_closure_iff at hx,
  specialize hx (comap f ⊥) _,
  rw mem_comap' at hx,
  change f x = 1,
  rw [← mem_singleton_iff, ← bot_eq_singleton_one],
  exact hx,
  intros s hs,
  erw mem_comap',
  rw mem_bot_iff,
  exact hS s hs,
end

lemma map_le_iff_le_comap {H : Type} [group H]
  {f : G →* H} {S : subgroup G} {T : subgroup H} :
  map f S ≤ T ↔ S ≤ comap f T :=
begin
  split; intro h,
    { intros x hx, erw mem_comap',
      apply h, erw mem_map,
      refine ⟨x, hx, rfl⟩ },
    { intros x hx,
      erw mem_map at hx,
      rcases hx with ⟨y, hy, rfl⟩,
      erw ← mem_comap',
      exact h hy }
end

lemma kernel_eq_comap_bot {H : Type} [group H] (f : G →* H) :
  (kernel f : subgroup G) = comap f ⊥ :=
by ext; erw [mem_kernel, ← mem_bot_iff, mem_comap']

lemma map_commutator_normal_le_bot {H : Type} [comm_group H] (f : G →* H) :
  map f (commutator_normal G) ≤ ⊥ :=
begin
  rw map_le_iff_le_comap,
  convert closure_eq_kernel_of_map_eq_one (map_commutators_eq_one f),
  exact (kernel_eq_comap_bot f).symm
end

end subgroup

-- Disadvantage with using bundled normal: we don't have a lattice structure for
-- normal subgroups

-- ⊢ commutators G ⊆ ↑N ↔ commutators (G /ₘ N) = {1}
-- Consider mk : G → G /ₘ N is a surjective homomorphism with the kernel N,
-- so the goal is saying the commutators is in the kernel iff the
-- commutators of G /ₘ N  is 1, i.e. we need to show that
-- commutators (G /ₘ N) ⊆ quotient.mk N '' commutators G
lemma quotient.comm_iff_commutators_subset (N : normal G) :
  commutators G ⊆ N ↔ @commutative (G /ₘ N) (*) :=
begin
  rw [← subgroup.comm_group_iff', subgroup.commutator_normal_eq_bot_iff],
  have : commutators (G /ₘ N) ⊆  quotient.mk N '' commutators G,
    rintro x ⟨a, b, rfl⟩,
    rcases exists_mk a with ⟨a, rfl⟩,
    rcases exists_mk b with ⟨b, rfl⟩,
    exact ⟨commutator a b, ⟨a, b, rfl⟩, rfl⟩,
  conv_lhs { rw ← @kernel_mk _ _ N },
  split; intro h,
    { apply subset.antisymm,
        { refine subset.trans this (λ _ hx, _),
          rcases hx with ⟨x, hx, rfl⟩,
          rw [mem_singleton_iff, ← mem_kernel],
          exact h hx },
        { intros x hx,
          rw mem_singleton_iff at hx,
          rw hx, exact ⟨1, 1, by simp⟩ } },
    { rintro _ ⟨a, b, rfl⟩,
      change _ ∈ (mk N).kernel,
      rw [mem_kernel, ← mem_singleton_iff, ← h],
      exact ⟨a, b, rfl⟩ }
end

/-- For all `N : normal G`, if it contains the comutator subgroup, then
  `G /ₘ N` is abelian. -/
theorem quotient.comm_iff_commutators_le (N : normal G) :
  subgroup.commutator_normal G ≤ N ↔ @commutative (G /ₘ N) (*) :=
show closure (commutators G) ≤ _ ↔ _,
  by rw [← quotient.comm_iff_commutators_subset, closure_le]; refl

/-- A subgroup is normal if it comatins the commutators -/
def normal.of_subset_commutators (H : subgroup G) (hH : commutators G ⊆ H) :=
  normal.of_subgroup H
begin
  intros n hn g,
  rw [show g * n * g⁻¹ = g * n * g⁻¹ * n⁻¹ * n, by simp [group.mul_assoc]],
  exact mul_mem _ (hH ⟨g, n, rfl⟩) hn
end

def group.comm_group_of (G : Type) [group G] (hG : @commutative G (*)) :
  comm_group G := { mul_comm := hG, .. ‹group G› }

/-- The Abelianization of a group is the group quotiented out by its commutator
  normal subgroup -/
def abelianization (G : Type) [group G] := G /ₘ subgroup.commutator_normal G

-- The Abelianization of a group is commutative
instance := group.comm_group_of (G /ₘ subgroup.commutator_normal G)
  ((quotient.comm_iff_commutators_subset _).1 (le_closure _))

namespace abelianization

variables {H : Type} [comm_group H]

def lift (f : G →* H) := quotient.lift f (subgroup.commutator_normal G)
begin
  convert subgroup.map_le_iff_le_comap.1
    (subgroup.map_commutator_normal_le_bot f),
  exact subgroup.kernel_eq_comap_bot f
end

@[simp] lemma lift_def (f : G →* H) :
  (lift f ∘* quotient.mk (subgroup.commutator_normal G)) = f := by ext; refl

/-- The universal property of Abelianization of Groups -/
lemma lift.exists_unique (H : Type) [comm_group H] (f : G →* H) :
  ∃! F : (G /ₘ subgroup.commutator_normal G) →* H,
  f = (F ∘* quotient.mk (subgroup.commutator_normal G)) :=
⟨abelianization.lift f, by simp, by rintros F rfl; tidy⟩

end abelianization

end mygroup


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.fintype.powerset
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Card
import Mathlib.Data.Finset.Powerset

/-!
# fintype instance for `Set α`, when `α` is a fintype
-/

variable {α : Type _}

open Finset

instance Finset.fintype [Fintype α] : Fintype (Finset α) :=
  ⟨univ.powerset, fun _ => Finset.mem_powerset.2 (Finset.subset_univ _)⟩
#align finset.fintype Finset.fintype

@[simp]
theorem Fintype.card_finset [Fintype α] : Fintype.card (Finset α) = 2 ^ Fintype.card α :=
  Finset.card_powerset Finset.univ
#align fintype.card_finset Fintype.card_finset

@[simp]
theorem Finset.powerset_univ [Fintype α] : (univ : Finset α).powerset = univ :=
  coe_injective <| by simp [-coe_eq_univ]
#align finset.powerset_univ Finset.powerset_univ

@[simp]
theorem Finset.powerset_eq_univ [Fintype α] {s : Finset α} : s.powerset = univ ↔ s = univ := by
  rw [← Finset.powerset_univ, powerset_inj]
#align finset.powerset_eq_univ Finset.powerset_eq_univ

theorem Finset.mem_powerset_len_univ_iff [Fintype α] {s : Finset α} {k : ℕ} :
    s ∈ powersetLen k (univ : Finset α) ↔ card s = k :=
  mem_powersetLen.trans <| and_iff_right <| subset_univ _
#align finset.mem_powerset_len_univ_iff Finset.mem_powerset_len_univ_iff

@[simp]
theorem Finset.univ_filter_card_eq (α : Type _) [Fintype α] (k : ℕ) :
    ((Finset.univ : Finset (Finset α)).filter fun s => s.card = k) = Finset.univ.powersetLen k :=
  by
  ext
  simp [Finset.mem_powersetLen]
#align finset.univ_filter_card_eq Finset.univ_filter_card_eq

@[simp]
theorem Fintype.card_finset_len [Fintype α] (k : ℕ) :
    Fintype.card { s : Finset α // s.card = k } = Nat.choose (Fintype.card α) k := by
  simp [Fintype.subtype_card, Finset.card_univ]
#align fintype.card_finset_len Fintype.card_finset_len

instance Set.fintype [Fintype α] : Fintype (Set α) :=
  ⟨(@Finset.univ α _).powerset.map ⟨(↑), coe_injective⟩, fun s => by
    classical
      refine' mem_map.2 ⟨Finset.univ.filter s, Finset.mem_powerset.2 (Finset.subset_univ _), _⟩
      apply (coe_filter _ _).trans
      simp
      rfl⟩
#align set.fintype Set.fintype

-- Not to be confused with `Set.Finite`, the predicate
instance Set.finite' [Finite α] : Finite (Set α) := by
  cases nonempty_fintype α
  infer_instance
#align set.finite' Set.finite'

@[simp]
theorem Fintype.card_set [Fintype α] : Fintype.card (Set α) = 2 ^ Fintype.card α :=
  (Finset.card_map _).trans (Finset.card_powerset _)
#align fintype.card_set Fintype.card_set