-- Exercises from Theorem Proving in Lean 4

-- ===============================
--   3. Propositions and Proofs
-- ===============================

namespace chap3noclassic

  -- No tactics, working with the tools introduced so far for now.

  variable (p q r : Prop)

  -- commutativity of ∧ and ∨
  example : p ∧ q ↔ q ∧ p := Iff.intro
    (λ (And.intro hp hq) => And.intro hq hp)
    (λ (And.intro hq hp) => And.intro hp hq)

  example : p ∨ q ↔ q ∨ p :=
    let swap := λ {pr1 pr2 : Prop} (h : pr1 ∨ pr2) => Or.elim h Or.inr Or.inl;
    Iff.intro swap swap

  -- associativity of ∧ and ∨
  example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := Iff.intro
    (λ (And.intro (And.intro hp hq) hr) => ⟨hp, ⟨hq, hr⟩⟩)
    (λ (And.intro hp (And.intro hq hr)) => ⟨⟨hp, hq⟩, hr⟩)

  example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := Iff.intro
    (λ h => Or.elim h
      (λ h₁ => Or.elim h₁ Or.inl (λ hq => Or.inr (Or.inl hq)))
      (λ hr => Or.inr (Or.inr hr)))
    (λ h => Or.elim h (λ hp => Or.inl (Or.inl hp)) (λ hqr => Or.elim hqr (λ hq => Or.inl (Or.inr hq)) Or.inr))

  -- distributivity
  example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := Iff.intro
    (λ (And.intro hp hqr) => Or.elim hqr (λ hq => Or.inl ⟨hp, hq⟩) (λ hr => Or.inr ⟨hp, hr⟩))
    (λ h => Or.elim h
      (λ (And.intro hp hq) => ⟨hp, Or.inl hq⟩)
      (λ (And.intro hp hr) => ⟨hp, Or.inr hr⟩))

  example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := Iff.intro
    (λ h => Or.elim h
      (λ hp => And.intro (Or.inl hp) (Or.inl hp))
      (λ hqr => And.intro (Or.inr hqr.left) (Or.inr hqr.right)))
    (λ (And.intro hpq hpr) => Or.elim hpq Or.inl (λ hq => Or.elim hpr Or.inl (λ hr => Or.inr ⟨hq, hr⟩)))

  -- other properties
  example : (p → (q → r)) ↔ (p ∧ q → r) := Iff.intro
    (λ hptoqtor => λ (And.intro hp hq) => hptoqtor hp hq)
    (λ h hp hq => h ⟨hp, hq⟩)

  example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := Iff.intro
    (λ h => And.intro (λ hp => h (Or.inl hp)) (λ hq => h (Or.inr hq)))
    (λ (And.intro h1 h2) hpq => Or.elim hpq h1 h2)

  example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := Iff.intro
    (λ h => And.intro (λ hp => h (Or.inl hp)) (λ hq => h (Or.inr hq)))
    (λ (And.intro hnp hnq) hpq => Or.elim hpq (λ hp => hnp hp) (λ hq => hnq hq))

  example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    λ hnpq (And.intro hp hq) =>
    Or.elim hnpq (λ hnp => hnp hp) (λ hnq => hnq hq)

  example : ¬(p ∧ ¬p) := λ (And.intro hp hnp) => hnp hp

  example : p ∧ ¬q → ¬(p → q) := λ (And.intro hp hnq) hptoq => hnq (hptoq hp)

  theorem t2 : ¬p → (p → q) := λ hnp hp => False.elim (hnp hp)

  example : (¬p ∨ q) → (p → q) := λ h hp => Or.elim h (λ hnp => False.elim $ hnp hp) id

  example : p ∨ False ↔ p := Iff.intro (λ h => Or.elim h id False.elim) Or.inl

  example : p ∧ False ↔ False := Iff.intro (λ (And.intro _ contra) => False.elim contra) False.elim

  example : (p → q) → (¬q → ¬p) := λ hpq hnq hp => hnq (hpq hp)

  theorem noNegIff : ¬(p ↔ ¬p) := λ h =>
    let l := Iff.mp h;
    let r := Iff.mpr h;
    let hnp: ¬p := λ hp => (l hp) hp;
    hnp $ r hnp

end chap3noclassic

namespace chap3classic

  open Classical

  variable (p q r : Prop)

  example : (p → q ∨ r) → ((p → q) ∨ (p → r)) := λ h => @byCases p _
    (λ hp => Or.elim (h hp) (λ hq => Or.inl (λ _ => hq)) (λ hr => Or.inr (λ _ => hr)))
    (λ hnp => Or.inl $ λ hp => False.elim $ hnp hp)

  example : ¬(p ∧ q) → ¬p ∨ ¬q := λ hn => @byCases p _
    (λ hp => @byCases q _ (λ hq => False.elim $ hn ⟨hp, hq⟩) Or.inr)
    Or.inl

  theorem t1 : ¬(p → q) → p ∧ ¬q := λ h => @byCases p _
    (λ hp => ⟨hp, λ hq => h $ λ _ => hq⟩ )
    (λ hnp => False.elim $ h $ chap3noclassic.t2 _ _ hnp)

  example : (p → q) → (¬p ∨ q) := λ hpq => @byCases p _ (λ hp => Or.inr $ hpq hp) Or.inl

  example : (¬q → ¬p) → (p → q) := λ h hp => byContradiction (λ hnq => ((h hnq) hp))

  example : p ∨ ¬p := em p

  example : (((p → q) → p) → p) := λ h => @byCases (p → q) _
    (λ hpq => h hpq)
    (λ hnpq => (t1 p q hnpq).left)

end chap3classic

-- ===============================
--   4. Quantifiers and Equality
-- ===============================

namespace chap4pt1

variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := Iff.intro
  (λ h => ⟨ λ hx => (h hx).left, λ hx => (h hx).right ⟩)
  (λ ⟨hpx, hqx⟩ hx => ⟨hpx hx, hqx hx⟩)

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := λ h1 h2 a => h1 a $ h2 a

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := λ h hx => match h with
| (Or.inl hpx) => Or.inl $ hpx hx
| (Or.inr hqx) => Or.inr $ hqx hx

end chap4pt1

namespace chap4pt2

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : α → ((∀ _x : α, r) ↔ r) := λ a => Iff.intro
  (λ ator => ator a)
  (λ dis _ => dis)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := Iff.intro
  (λ h => @Classical.byCases r _
    Or.inr
    (λ hnr =>
      suffices ∀ (x : α), p x from Or.inl this
      λ hx => Or.elim (h hx) id (λ hr => False.elim $ hnr hr)))
  (λ h hx => Or.elim h (λ hl => Or.inl $ hl hx) Or.inr)

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := Iff.intro
  (λ h hr hx => h hx hr)
  (λ h hx hr => h hr hx)

end chap4pt2

namespace chap4pt3

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False := chap3noclassic.noNegIff (shaves barber barber) (h barber)

end chap4pt3

namespace chap4pt4

def even (n : Nat) : Prop := ∃ (m : Nat), n = 2 * m

def prime (n : Nat) : Prop := n > 1 ∧ ¬∃ m k, m < n ∧ k < n ∧ n = m * k

def infinitely_many_primes : Prop := ∀ (n : Nat), ∃ m, m > n ∧ prime m

def Fermat_prime (n : Nat) : Prop := ∃ m, n = 2^2^m + 1

def infinitely_many_Fermat_primes : Prop := ∀ (n : Nat), ∃ m, m > n ∧ Fermat_prime m

def odd (n : Nat) : Prop := ¬even n

def goldbach_conjecture : Prop := ∀ (n : Nat), n > 2 → even n → ∃ a b, prime a ∧ prime b ∧ a + b = n

def Goldbach's_weak_conjecture : Prop := ∀ n, n > 5 → odd n → ∃ a b c, prime a ∧ prime b ∧ prime c ∧ a + b + c = n

def Fermat's_last_theorem : Prop := ¬∃ (a b c n : Nat), n > 2 ∧ a^n + b^n = c^n

end chap4pt4

namespace chap4pt5

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ _x : α, r) → r := λ ⟨_, hr⟩ => hr

example (a : α) : r → (∃ _x : α, r) := λ hr => ⟨a, hr⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := Iff.intro
  (λ ⟨hx, ⟨hpx, hr⟩⟩ => ⟨⟨hx, hpx⟩, hr⟩ )
  (λ ⟨⟨hx, hpx⟩, hr⟩ => ⟨hx, ⟨hpx, hr⟩⟩)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := Iff.intro
  (λ ⟨hx, h⟩ => Or.elim h (λ hpx => Or.inl ⟨hx, hpx⟩) (λ hqx => Or.inr ⟨hx, hqx⟩))
  (λ h => Or.elim h (λ ⟨hx, hpx⟩ => ⟨hx, Or.inl hpx⟩) (λ ⟨hx, hqx⟩ => ⟨hx, Or.inr hqx⟩))

---

open Classical

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := Iff.intro
  (λ h ⟨hx, hnpx⟩ => hnpx $ h hx)
  (λ h hx => byContradiction $ λ hnpx => h ⟨hx, hnpx⟩)

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := Iff.intro
  (λ ⟨hx, hpx⟩ hcontra => hcontra hx hpx)
  (λ h => byContradiction $ λ hne =>
    suffices ∀ x, ¬ p x from h this
    λ a hpa => hne ⟨a, hpa⟩)

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := Iff.intro
  (λ h hx hpx => h ⟨hx, hpx⟩ )
  (λ h ⟨hx, hpx⟩  => (h hx) hpx)

theorem t2 : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := Iff.intro
  (λ h => byContradiction $ λ hne => h $ λ x => byContradiction $ λ hnpx => hne ⟨x, hnpx⟩)
  (λ ⟨hx, hnpx⟩ h => hnpx (h hx))

---

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := Iff.intro
  (λ h ⟨hx, hpx⟩  => h hx hpx)
  (λ h hx hpx => h ⟨hx, hpx⟩)

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := Iff.intro
  (λ ⟨hx, hpxtor⟩ h => hpxtor $ h hx)
  (λ h => @byCases (∀ x, p x) _
    (λ h1 => ⟨a, λ _ => h h1⟩)
    (λ hnotallx => byContradiction $ λ hne =>
      let ⟨hx, hnpx⟩ : ∃ x, ¬ p x := (t2 _ _).mp hnotallx
      hne ⟨hx, λ hpx => False.elim $ hnpx hpx⟩))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := Iff.intro
  (λ ⟨hx, hrpx⟩ hr => ⟨hx, hrpx hr⟩ )
  (λ h => @byCases r _
    (λ hr => let ⟨x, px⟩ := h hr; ⟨x, λ _ => px⟩)
    (λ hnr => ⟨a, λ hr => False.elim $ hnr hr⟩))

end chap4pt5

namespace chap5pt2

example (p q r : Prop) (hp : p) : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  repeat (first | assumption | (apply Or.inl ; assumption) | apply Or.inr | constructor)

end chap5pt2

namespace chap7pt2

open List

variable {α : Type}

def length : List α → Nat := λ xs =>
match xs with
| nil => 0
| cons _ xs => Nat.succ $ length xs

theorem length_nil : length (@nil α) = 0 := rfl

theorem length_cons {x : α} {xs : List α} : length (x :: xs) = Nat.succ (length xs) := rfl

theorem length_append (s t : List α) : length (s ++ t) = length s + length t := by
  induction s with
  | nil => simp only [nil_append, length_nil, Nat.zero_add]
  | cons x xs ih => rw [length_cons, Nat.succ_add, cons_append, length_cons, ih]

theorem length_reverse {xs : List α} : length (reverse xs) = length xs := by
  induction xs with
  | nil => rfl
  | cons x xs ih => rw [reverse_cons, length_append, length_cons, length_nil, length_cons, ih]

theorem double_reverse {xs : List α} : reverse (reverse xs) = xs := by
  induction xs with
  | nil => rfl
  | cons x xs ih => rw [reverse_cons, reverse_append, ih]; rfl

end chap7pt2

namespace chap7pt3

inductive Expr : Type where
| const : Nat → Expr
| var : Nat → Expr
| plus : Expr → Expr → Expr
| times : Expr → Expr → Expr

open Expr

def eval : Expr → (Nat → Nat) → Nat := λ expr env =>
  match expr with
  | const n => n
  | var n => env n
  | plus s t => (eval s env) + (eval t env)
  | times s t => (eval s env) * (eval t env)

end chap7pt3


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.monad.limits
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Monad.Adjunction
import Mathbin.CategoryTheory.Adjunction.Limits
import Mathbin.CategoryTheory.Limits.Shapes.Terminal

/-!
# Limits and colimits in the category of algebras

This file shows that the forgetful functor `forget T : algebra T ⥤ C` for a monad `T : C ⥤ C`
creates limits and creates any colimits which `T` preserves.
This is used to show that `algebra T` has any limits which `C` has, and any colimits which `C` has
and `T` preserves.
This is generalised to the case of a monadic functor `D ⥤ C`.

## TODO

Dualise for the category of coalgebras and comonadic left adjoints.
-/

namespace CategoryTheory

open Category

open CategoryTheory.Limits

universe v u v₁ v₂ u₁ u₂

-- morphism levels before object levels. See note [category_theory universes].
namespace Monad

variable {C : Type u₁} [Category.{v₁} C]

variable {T : Monad C}

variable {J : Type u} [Category.{v} J]

namespace ForgetCreatesLimits

variable (D : J ⥤ Algebra T) (c : Cone (D ⋙ T.forget)) (t : IsLimit c)

/-- (Impl) The natural transformation used to define the new cone -/
@[simps]
def γ : D ⋙ T.forget ⋙ ↑T ⟶ D ⋙ T.forget where app j := (D.obj j).a
#align category_theory.monad.forget_creates_limits.γ CategoryTheory.Monad.ForgetCreatesLimits.γ

/-- (Impl) This new cone is used to construct the algebra structure -/
@[simps π_app]
def newCone : Cone (D ⋙ forget T) where
  pt := T.obj c.pt
  π := (Functor.constComp _ _ ↑T).inv ≫ whiskerRight c.π T ≫ γ D
#align category_theory.monad.forget_creates_limits.new_cone CategoryTheory.Monad.ForgetCreatesLimits.newCone

/-- The algebra structure which will be the apex of the new limit cone for `D`. -/
@[simps]
def conePoint : Algebra T where
  a := c.pt
  a := t.lift (newCone D c)
  unit' :=
    t.hom_ext fun j =>
      by
      rw [category.assoc, t.fac, new_cone_π_app, ← T.η.naturality_assoc, functor.id_map,
        (D.obj j).Unit]
      dsimp; simp
  -- See library note [dsimp, simp]
  assoc' :=
    t.hom_ext fun j =>
      by
      rw [category.assoc, category.assoc, t.fac (new_cone D c), new_cone_π_app, ←
        functor.map_comp_assoc, t.fac (new_cone D c), new_cone_π_app, ← T.μ.naturality_assoc,
        (D.obj j).and_assoc, functor.map_comp, category.assoc]
      rfl
#align category_theory.monad.forget_creates_limits.cone_point CategoryTheory.Monad.ForgetCreatesLimits.conePoint

/-- (Impl) Construct the lifted cone in `algebra T` which will be limiting. -/
@[simps]
def liftedCone : Cone D where
  pt := conePoint D c t
  π :=
    { app := fun j => { f := c.π.app j }
      naturality' := fun X Y f => by
        ext1
        dsimp
        erw [c.w f]
        simp }
#align category_theory.monad.forget_creates_limits.lifted_cone CategoryTheory.Monad.ForgetCreatesLimits.liftedCone

/-- (Impl) Prove that the lifted cone is limiting. -/
@[simps]
def liftedConeIsLimit : IsLimit (liftedCone D c t)
    where
  lift s :=
    { f := t.lift ((forget T).mapCone s)
      h' :=
        t.hom_ext fun j => by
          dsimp
          rw [category.assoc, category.assoc, t.fac, new_cone_π_app, ← functor.map_comp_assoc,
            t.fac, functor.map_cone_π_app]
          apply (s.π.app j).h }
  uniq s m J := by
    ext1
    apply t.hom_ext
    intro j
    simpa [t.fac ((forget T).mapCone s) j] using congr_arg algebra.hom.f (J j)
#align category_theory.monad.forget_creates_limits.lifted_cone_is_limit CategoryTheory.Monad.ForgetCreatesLimits.liftedConeIsLimit

end ForgetCreatesLimits

-- Theorem 5.6.5 from [Riehl][riehl2017]
/-- The forgetful functor from the Eilenberg-Moore category creates limits. -/
noncomputable instance forgetCreatesLimits : CreatesLimitsOfSize (forget T)
    where CreatesLimitsOfShape J 𝒥 :=
    {
      CreatesLimit := fun D =>
        creates_limit_of_reflects_iso fun c t =>
          { liftedCone := forget_creates_limits.lifted_cone D c t
            validLift := cones.ext (iso.refl _) fun j => (id_comp _).symm
            makesLimit := forget_creates_limits.lifted_cone_is_limit _ _ _ } }
#align category_theory.monad.forget_creates_limits CategoryTheory.Monad.forgetCreatesLimits

/-- `D ⋙ forget T` has a limit, then `D` has a limit. -/
theorem hasLimit_of_comp_forget_hasLimit (D : J ⥤ Algebra T) [HasLimit (D ⋙ forget T)] :
    HasLimit D :=
  hasLimit_of_created D (forget T)
#align category_theory.monad.has_limit_of_comp_forget_has_limit CategoryTheory.Monad.hasLimit_of_comp_forget_hasLimit

namespace ForgetCreatesColimits

-- Let's hide the implementation details in a namespace
variable {D : J ⥤ Algebra T} (c : Cocone (D ⋙ forget T)) (t : IsColimit c)

-- We have a diagram D of shape J in the category of algebras, and we assume that we are given a
-- colimit for its image D ⋙ forget T under the forgetful functor, say its apex is L.
-- We'll construct a colimiting coalgebra for D, whose carrier will also be L.
-- To do this, we must find a map TL ⟶ L. Since T preserves colimits, TL is also a colimit.
-- In particular, it is a colimit for the diagram `(D ⋙ forget T) ⋙ T`
-- so to construct a map TL ⟶ L it suffices to show that L is the apex of a cocone for this diagram.
-- In other words, we need a natural transformation from const L to `(D ⋙ forget T) ⋙ T`.
-- But we already know that L is the apex of a cocone for the diagram `D ⋙ forget T`, so it
-- suffices to give a natural transformation `((D ⋙ forget T) ⋙ T) ⟶ (D ⋙ forget T)`:
/-- (Impl)
The natural transformation given by the algebra structure maps, used to construct a cocone `c` with
apex `colimit (D ⋙ forget T)`.
 -/
@[simps]
def γ : (D ⋙ forget T) ⋙ ↑T ⟶ D ⋙ forget T where app j := (D.obj j).a
#align category_theory.monad.forget_creates_colimits.γ CategoryTheory.Monad.ForgetCreatesColimits.γ

/-- (Impl)
A cocone for the diagram `(D ⋙ forget T) ⋙ T` found by composing the natural transformation `γ`
with the colimiting cocone for `D ⋙ forget T`.
-/
@[simps]
def newCocone : Cocone ((D ⋙ forget T) ⋙ ↑T)
    where
  pt := c.pt
  ι := γ ≫ c.ι
#align category_theory.monad.forget_creates_colimits.new_cocone CategoryTheory.Monad.ForgetCreatesColimits.newCocone

variable [PreservesColimit (D ⋙ forget T) (T : C ⥤ C)]

/-- (Impl)
Define the map `λ : TL ⟶ L`, which will serve as the structure of the coalgebra on `L`, and
we will show is the colimiting object. We use the cocone constructed by `c` and the fact that
`T` preserves colimits to produce this morphism.
-/
@[reducible]
def lambda : ((T : C ⥤ C).mapCocone c).pt ⟶ c.pt :=
  (isColimitOfPreserves _ t).desc (newCocone c)
#align category_theory.monad.forget_creates_colimits.lambda CategoryTheory.Monad.ForgetCreatesColimits.lambda

/-- (Impl) The key property defining the map `λ : TL ⟶ L`. -/
theorem commuting (j : J) : (T : C ⥤ C).map (c.ι.app j) ≫ lambda c t = (D.obj j).a ≫ c.ι.app j :=
  (isColimitOfPreserves _ t).fac (newCocone c) j
#align category_theory.monad.forget_creates_colimits.commuting CategoryTheory.Monad.ForgetCreatesColimits.commuting

variable [PreservesColimit ((D ⋙ forget T) ⋙ ↑T) (T : C ⥤ C)]

/-- (Impl)
Construct the colimiting algebra from the map `λ : TL ⟶ L` given by `lambda`. We are required to
show it satisfies the two algebra laws, which follow from the algebra laws for the image of `D` and
our `commuting` lemma.
-/
@[simps]
def coconePoint : Algebra T where
  a := c.pt
  a := lambda c t
  unit' := by
    apply t.hom_ext
    intro j
    rw [show c.ι.app j ≫ T.η.app c.X ≫ _ = T.η.app (D.obj j).a ≫ _ ≫ _ from
        T.η.naturality_assoc _ _,
      commuting, algebra.unit_assoc (D.obj j)]
    dsimp; simp
  -- See library note [dsimp, simp]
  assoc' :=
    by
    refine' (is_colimit_of_preserves _ (is_colimit_of_preserves _ t)).hom_ext fun j => _
    rw [functor.map_cocone_ι_app, functor.map_cocone_ι_app,
      show (T : C ⥤ C).map ((T : C ⥤ C).map _) ≫ _ ≫ _ = _ from T.μ.naturality_assoc _ _, ←
      functor.map_comp_assoc, commuting, functor.map_comp, category.assoc, commuting]
    apply (D.obj j).assoc_assoc _
#align category_theory.monad.forget_creates_colimits.cocone_point CategoryTheory.Monad.ForgetCreatesColimits.coconePoint

/-- (Impl) Construct the lifted cocone in `algebra T` which will be colimiting. -/
@[simps]
def liftedCocone : Cocone D where
  pt := coconePoint c t
  ι :=
    { app := fun j =>
        { f := c.ι.app j
          h' := commuting _ _ _ }
      naturality' := fun A B f => by
        ext1
        dsimp
        rw [comp_id]
        apply c.w }
#align category_theory.monad.forget_creates_colimits.lifted_cocone CategoryTheory.Monad.ForgetCreatesColimits.liftedCocone

/-- (Impl) Prove that the lifted cocone is colimiting. -/
@[simps]
def liftedCoconeIsColimit : IsColimit (liftedCocone c t)
    where
  desc s :=
    { f := t.desc ((forget T).mapCocone s)
      h' :=
        (isColimitOfPreserves (T : C ⥤ C) t).hom_ext fun j =>
          by
          dsimp
          rw [← functor.map_comp_assoc, ← category.assoc, t.fac, commuting, category.assoc, t.fac]
          apply algebra.hom.h }
  uniq s m J := by
    ext1
    apply t.hom_ext
    intro j
    simpa using congr_arg algebra.hom.f (J j)
#align category_theory.monad.forget_creates_colimits.lifted_cocone_is_colimit CategoryTheory.Monad.ForgetCreatesColimits.liftedCoconeIsColimit

end ForgetCreatesColimits

open ForgetCreatesColimits

-- TODO: the converse of this is true as well
/-- The forgetful functor from the Eilenberg-Moore category for a monad creates any colimit
which the monad itself preserves.
-/
noncomputable instance forgetCreatesColimit (D : J ⥤ Algebra T)
    [PreservesColimit (D ⋙ forget T) (T : C ⥤ C)]
    [PreservesColimit ((D ⋙ forget T) ⋙ ↑T) (T : C ⥤ C)] : CreatesColimit D (forget T) :=
  createsColimitOfReflectsIso fun c t =>
    { liftedCocone :=
        { pt := coconePoint c t
          ι :=
            { app := fun j =>
                { f := c.ι.app j
                  h' := commuting _ _ _ }
              naturality' := fun A B f => by
                ext1
                dsimp
                erw [comp_id, c.w] } }
      validLift := Cocones.ext (Iso.refl _) (by tidy)
      makesColimit := liftedCoconeIsColimit _ _ }
#align category_theory.monad.forget_creates_colimit CategoryTheory.Monad.forgetCreatesColimit

noncomputable instance forgetCreatesColimitsOfShape [PreservesColimitsOfShape J (T : C ⥤ C)] :
    CreatesColimitsOfShape J (forget T) where CreatesColimit K := by infer_instance
#align category_theory.monad.forget_creates_colimits_of_shape CategoryTheory.Monad.forgetCreatesColimitsOfShape

noncomputable instance forgetCreatesColimits [PreservesColimitsOfSize.{v, u} (T : C ⥤ C)] :
    CreatesColimitsOfSize.{v, u} (forget T) where CreatesColimitsOfShape J 𝒥₁ := by infer_instance
#align category_theory.monad.forget_creates_colimits CategoryTheory.Monad.forgetCreatesColimits

/-- For `D : J ⥤ algebra T`, `D ⋙ forget T` has a colimit, then `D` has a colimit provided colimits
of shape `J` are preserved by `T`.
-/
theorem forget_creates_colimits_of_monad_preserves [PreservesColimitsOfShape J (T : C ⥤ C)]
    (D : J ⥤ Algebra T) [HasColimit (D ⋙ forget T)] : HasColimit D :=
  hasColimit_of_created D (forget T)
#align category_theory.monad.forget_creates_colimits_of_monad_preserves CategoryTheory.Monad.forget_creates_colimits_of_monad_preserves

end Monad

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

variable {J : Type u} [Category.{v} J]

instance comp_comparison_forget_hasLimit (F : J ⥤ D) (R : D ⥤ C) [MonadicRightAdjoint R]
    [HasLimit (F ⋙ R)] :
    HasLimit ((F ⋙ Monad.comparison (Adjunction.ofRightAdjoint R)) ⋙ Monad.forget _) :=
  @hasLimitOfIso _ _ _ _ (F ⋙ R) _ _
    (isoWhiskerLeft F (Monad.comparisonForget (Adjunction.ofRightAdjoint R)).symm)
#align category_theory.comp_comparison_forget_has_limit CategoryTheory.comp_comparison_forget_hasLimit

instance comp_comparison_hasLimit (F : J ⥤ D) (R : D ⥤ C) [MonadicRightAdjoint R]
    [HasLimit (F ⋙ R)] : HasLimit (F ⋙ Monad.comparison (Adjunction.ofRightAdjoint R)) :=
  Monad.hasLimit_of_comp_forget_hasLimit (F ⋙ Monad.comparison (Adjunction.ofRightAdjoint R))
#align category_theory.comp_comparison_has_limit CategoryTheory.comp_comparison_hasLimit

/-- Any monadic functor creates limits. -/
noncomputable def monadicCreatesLimits (R : D ⥤ C) [MonadicRightAdjoint R] :
    CreatesLimitsOfSize.{v, u} R :=
  createsLimitsOfNatIso (Monad.comparisonForget (Adjunction.ofRightAdjoint R))
#align category_theory.monadic_creates_limits CategoryTheory.monadicCreatesLimits

/-- The forgetful functor from the Eilenberg-Moore category for a monad creates any colimit
which the monad itself preserves.
-/
noncomputable def monadicCreatesColimitOfPreservesColimit (R : D ⥤ C) (K : J ⥤ D)
    [MonadicRightAdjoint R] [PreservesColimit (K ⋙ R) (leftAdjoint R ⋙ R)]
    [PreservesColimit ((K ⋙ R) ⋙ leftAdjoint R ⋙ R) (leftAdjoint R ⋙ R)] : CreatesColimit K R :=
  by
  apply creates_colimit_of_nat_iso (monad.comparison_forget (adjunction.of_right_adjoint R))
  apply CategoryTheory.compCreatesColimit _ _
  infer_instance
  let i : (K ⋙ monad.comparison (adjunction.of_right_adjoint R)) ⋙ monad.forget _ ≅ K ⋙ R :=
    functor.associator _ _ _ ≪≫
      iso_whisker_left K (monad.comparison_forget (adjunction.of_right_adjoint R))
  apply CategoryTheory.Monad.forgetCreatesColimit _
  · dsimp
    refine' preserves_colimit_of_iso_diagram _ i.symm
  · dsimp
    refine' preserves_colimit_of_iso_diagram _ (iso_whisker_right i (left_adjoint R ⋙ R)).symm
#align category_theory.monadic_creates_colimit_of_preserves_colimit CategoryTheory.monadicCreatesColimitOfPreservesColimit

/-- A monadic functor creates any colimits of shapes it preserves. -/
noncomputable def monadicCreatesColimitsOfShapeOfPreservesColimitsOfShape (R : D ⥤ C)
    [MonadicRightAdjoint R] [PreservesColimitsOfShape J R] : CreatesColimitsOfShape J R :=
  haveI : preserves_colimits_of_shape J (left_adjoint R ⋙ R) :=
    by
    apply CategoryTheory.Limits.compPreservesColimitsOfShape _ _
    apply (adjunction.left_adjoint_preserves_colimits (adjunction.of_right_adjoint R)).1
    infer_instance
  ⟨fun K => monadic_creates_colimit_of_preserves_colimit _ _⟩
#align category_theory.monadic_creates_colimits_of_shape_of_preserves_colimits_of_shape CategoryTheory.monadicCreatesColimitsOfShapeOfPreservesColimitsOfShape

/-- A monadic functor creates colimits if it preserves colimits. -/
noncomputable def monadicCreatesColimitsOfPreservesColimits (R : D ⥤ C) [MonadicRightAdjoint R]
    [PreservesColimitsOfSize.{v, u} R] : CreatesColimitsOfSize.{v, u} R
    where CreatesColimitsOfShape J 𝒥₁ :=
    monadic_creates_colimits_of_shape_of_preserves_colimits_of_shape _
#align category_theory.monadic_creates_colimits_of_preserves_colimits CategoryTheory.monadicCreatesColimitsOfPreservesColimits

section

theorem hasLimit_of_reflective (F : J ⥤ D) (R : D ⥤ C) [HasLimit (F ⋙ R)] [Reflective R] :
    HasLimit F :=
  haveI := monadicCreatesLimits.{v, u} R
  has_limit_of_created F R
#align category_theory.has_limit_of_reflective CategoryTheory.hasLimit_of_reflective

/-- If `C` has limits of shape `J` then any reflective subcategory has limits of shape `J`. -/
theorem hasLimitsOfShape_of_reflective [HasLimitsOfShape J C] (R : D ⥤ C) [Reflective R] :
    HasLimitsOfShape J D :=
  { HasLimit := fun F => hasLimit_of_reflective F R }
#align category_theory.has_limits_of_shape_of_reflective CategoryTheory.hasLimitsOfShape_of_reflective

/-- If `C` has limits then any reflective subcategory has limits. -/
theorem has_limits_of_reflective (R : D ⥤ C) [HasLimitsOfSize.{v, u} C] [Reflective R] :
    HasLimitsOfSize.{v, u} D :=
  { HasLimitsOfShape := fun J 𝒥₁ => has_limits_of_shape_of_reflective R }
#align category_theory.has_limits_of_reflective CategoryTheory.has_limits_of_reflective

/-- If `C` has colimits of shape `J` then any reflective subcategory has colimits of shape `J`. -/
theorem hasColimitsOfShape_of_reflective (R : D ⥤ C) [Reflective R] [HasColimitsOfShape J C] :
    HasColimitsOfShape J D :=
  {
    HasColimit := fun F =>
      by
      let c := (left_adjoint R).mapCocone (colimit.cocone (F ⋙ R))
      letI : preserves_colimits_of_shape J _ :=
        (adjunction.of_right_adjoint R).leftAdjointPreservesColimits.1
      let t : is_colimit c := is_colimit_of_preserves (left_adjoint R) (colimit.is_colimit _)
      apply has_colimit.mk ⟨_, (is_colimit.precompose_inv_equiv _ _).symm t⟩
      apply
        (iso_whisker_left F (as_iso (adjunction.of_right_adjoint R).counit) : _) ≪≫ F.right_unitor }
#align category_theory.has_colimits_of_shape_of_reflective CategoryTheory.hasColimitsOfShape_of_reflective

/-- If `C` has colimits then any reflective subcategory has colimits. -/
theorem has_colimits_of_reflective (R : D ⥤ C) [Reflective R] [HasColimitsOfSize.{v, u} C] :
    HasColimitsOfSize.{v, u} D :=
  { HasColimitsOfShape := fun J 𝒥 => has_colimits_of_shape_of_reflective R }
#align category_theory.has_colimits_of_reflective CategoryTheory.has_colimits_of_reflective

/-- The reflector always preserves terminal objects. Note this in general doesn't apply to any other
limit.
-/
noncomputable def leftAdjointPreservesTerminalOfReflective (R : D ⥤ C) [Reflective R] :
    PreservesLimitsOfShape (Discrete.{v} PEmpty) (leftAdjoint R)
    where PreservesLimit K := by
    let F := Functor.empty.{v} D
    apply preserves_limit_of_iso_diagram _ (functor.empty_ext (F ⋙ R) _)
    fconstructor; intro c h; haveI : has_limit (F ⋙ R) := ⟨⟨⟨c, h⟩⟩⟩
    haveI : has_limit F := has_limit_of_reflective F R
    apply is_limit_change_empty_cone D (limit.is_limit F)
    apply (as_iso ((adjunction.of_right_adjoint R).counit.app _)).symm.trans
    · apply (left_adjoint R).mapIso
      letI := monadicCreatesLimits.{v, v} R
      let this := (CategoryTheory.preservesLimitOfCreatesLimitAndHasLimit F R).preserves
      apply (this (limit.is_limit F)).conePointUniqueUpToIso h
    infer_instance
#align category_theory.left_adjoint_preserves_terminal_of_reflective CategoryTheory.leftAdjointPreservesTerminalOfReflective

end

end CategoryTheory


-- Prueba por inducción 2: ∀ m n k : ℕ, (m + n) + k = m + (n + k)
-- ==============================================================

-- ----------------------------------------------------
-- Ej. 1. Sean m, n y k números naturales. Demostrar que
--    (m + n) + k = m + (n + k)
-- ----------------------------------------------------

import tactic

open nat

variables (m n k : ℕ)

-- 1ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k' HI,
  { rw nat.add_zero,
    rw nat.add_zero, },
  { rw add_succ,
    rw HI,
    rw add_succ, },
end

-- 2ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k' HI,
  { rw [nat.add_zero, nat.add_zero], },
  { rw [add_succ, HI, add_succ], },
end

-- 3ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k HI,
  { simp, },
  { simp [add_succ, HI], },
end

-- 4ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k HI,
  { simp only [add_zero], },
  { simp only [add_succ, HI], },
end

-- 5ª demostración
example : (m + n) + k = m + (n + k) :=
by induction k;
   simp only [*, add_zero, add_succ]

-- 6ª demostración
example : (m + n) + k = m + (n + k) :=
by induction k;
   simp [*, add_succ]

-- 7ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k HI,
  { calc
      (m + n) + 0
          = m + n       : by rw nat.add_zero
      ... = m + (n + 0) : by rw nat.add_zero, },
  { calc
      (m + n) + succ k
          = succ ((m + n) + k) : by rw add_succ
      ... = succ (m + (n + k)) : by rw HI
      ... = m + succ (n + k)   : by rw add_succ
      ... = m + (n + succ k)   : by rw add_succ, },
end

-- 8ª demostración
example : (m + n) + k = m + (n + k) :=
begin
  induction k with k HI,
  { calc
      (m + n) + 0 = m + (n + 0) : rfl, },
  { calc
      (m + n) + succ k
          = succ ((m + n) + k) : rfl
      ... = succ (m + (n + k)) : by rw HI
      ... = m + succ (n + k)   : rfl
      ... = m + (n + succ k)   : rfl, },
end

-- 9ª demostración
example : (m + n) + k = m + (n + k) :=
nat.rec_on k
  ( show (m + n) + 0 = m + (n + 0), from rfl )
  ( assume k,
    assume HI : (m + n) + k = m + (n + k),
    show (m + n) + succ k = m + (n + succ k), from
      calc
        (m + n) + succ k
            = succ ((m + n) + k) : rfl
        ... = succ (m + (n + k)) : by rw HI
        ... = m + succ (n + k)   : rfl
        ... = m + (n + succ k)   : rfl )

-- 10ª demostración
example : (m + n) + k = m + (n + k) :=
nat.rec_on k rfl (λ k HI, by simp only [add_succ, HI])

-- 11ª demostración
example : (m + n) + k = m + (n + k) :=
-- by library_search
add_assoc m n k

-- 12ª demostración
example : (m + n) + k = m + (n + k) :=
-- by hint
by finish

-- 13ª demostración
example : (m + n) + k = m + (n + k) :=
by linarith

-- 14ª demostración
example : (m + n) + k = m + (n + k) :=
by nlinarith

-- 15ª demostración
example : (m + n) + k = m + (n + k) :=
by omega

-- 16ª demostración
example : (m + n) + k = m + (n + k) :=
by ring

-- 17ª demostración
lemma asociativa_suma :
  ∀ k : ℕ, (m + n) + k = m + (n + k)
| 0       := rfl
| (k + 1) := congr_arg succ (asociativa_suma k)

-- 18ª demostración
lemma asociativa_suma2 :
  ∀ k : ℕ, (m + n) + k = m + (n + k)
| 0       := by simp
| (k + 1) := by simp [add_succ, asociativa_suma2 k]

-- 19ª demostración
lemma asociativa_suma3 :
  ∀ k : ℕ, (m + n) + k = m + (n + k)
| 0       := by simp only [nat.add_zero]
| (k + 1) := by simp only [nat.add_zero, add_succ, asociativa_suma3 k]


import algebra.big_operators

-- Sum of an arithmetic series

open finset

theorem t068 : ∀ (n : ℕ), (finset.range n).sum (λi, i) = (n * (n - 1)) / 2
:= sum_range_id


-- Dominio de discurso
variable A : Type

lemma Example1 (P Q : A → Prop) :
(∀ x, P x → Q x) → (∀ x, P x) → (∀ x, Q x) :=
begin
    intros hpq hp,
    intro a,
    apply hpq,  -- lines below can be replaced by apply ((hpq a) (hp a))
    apply hp
end

lemma Example2 (P Q : A → Prop) :
(∀ x, P x ∧ Q x) ↔ (∀ x, P x) ∧ (∀ x, Q x) :=
begin
    apply iff.intro,
        -- [-->]
        intro hpq,
        apply and.intro,
            intro x, apply and.left (hpq x),
            intro x, apply and.right (hpq x),
        -- [<--]
        intro hpq,
        intro x,
        apply and.intro,
            apply ((and.left hpq) x),
            apply ((and.right hpq) x)
end

lemma Example3 (P Q : A → Prop) :
(∃ x, P x ∧ Q x) → (∃ x, P x) :=
begin
    intro hpq,
    apply (exists.elim hpq), intros a ha,
    apply exists.intro a,
    apply (and.left ha)
end


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario Carneiro,
  Michael Howes
-/
import group_theory.subgroup
import deprecated.submonoid

open set function

variables {G : Type*} {H : Type*} {A : Type*} {a a₁ a₂ b c: G}

section group
variables [group G] [add_group A]

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
class is_add_subgroup (s : set A) extends is_add_submonoid s : Prop :=
(neg_mem {a} : a ∈ s → -a ∈ s)

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
@[to_additive]
class is_subgroup (s : set G) extends is_submonoid s : Prop :=
(inv_mem {a} : a ∈ s → a⁻¹ ∈ s)

@[to_additive]
lemma is_subgroup.div_mem {s : set G} [is_subgroup s] {x y : G} (hx : x ∈ s) (hy : y ∈ s) :
  x / y ∈ s :=
by simpa only [div_eq_mul_inv] using is_submonoid.mul_mem hx (is_subgroup.inv_mem hy)

lemma additive.is_add_subgroup
  (s : set G) [is_subgroup s] : @is_add_subgroup (additive G) _ s :=
@is_add_subgroup.mk (additive G) _ _ (additive.is_add_submonoid _)
  (@is_subgroup.inv_mem _ _ _ _)

theorem additive.is_add_subgroup_iff
  {s : set G} : @is_add_subgroup (additive G) _ s ↔ is_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_subgroup.mk G _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by exactI additive.is_add_subgroup _⟩

lemma multiplicative.is_subgroup
  (s : set A) [is_add_subgroup s] : @is_subgroup (multiplicative A) _ s :=
@is_subgroup.mk (multiplicative A) _ _ (multiplicative.is_submonoid _)
  (@is_add_subgroup.neg_mem _ _ _ _)

theorem multiplicative.is_subgroup_iff
  {s : set A} : @is_subgroup (multiplicative A) _ s ↔ is_add_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_add_subgroup.mk A _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by exactI multiplicative.is_subgroup _⟩

/-- The group structure on a subgroup coerced to a type. -/
@[to_additive "The additive group structure on an additive subgroup coerced to a type."]
def subtype.group {s : set G} [is_subgroup s] : group s :=
{ inv := λ x, ⟨(x:G)⁻¹, is_subgroup.inv_mem x.2⟩,
  mul_left_inv := λ x, subtype.eq $ mul_left_inv x.1,
  div := λ x y, ⟨(x / y : G), is_subgroup.div_mem x.2 y.2⟩,
  div_eq_mul_inv := λ x y, subtype.ext $ div_eq_mul_inv x.1 y.1,
  .. subtype.monoid }

/-- The commutative group structure on a commutative subgroup coerced to a type. -/
@[to_additive "The additive commutative group structure
 on a additive commutative subgroup coerced to a type."]
def subtype.comm_group {G : Type*} [comm_group G] {s : set G} [is_subgroup s] : comm_group s :=
{ .. subtype.group, .. subtype.comm_monoid }

section
local attribute [instance] subtype.group subtype.add_group

@[simp, norm_cast, to_additive]
lemma is_subgroup.coe_inv {s : set G} [is_subgroup s] (a : s) : ((a⁻¹ : s) : G) = a⁻¹ := rfl
attribute [norm_cast] is_add_subgroup.coe_neg

@[simp, norm_cast] lemma is_subgroup.coe_gpow {s : set G} [is_subgroup s] (a : s) (n : ℤ) :
  ((a ^ n : s) : G) = a ^ n :=
by induction n; simp [is_submonoid.coe_pow a]

@[simp, norm_cast] lemma is_add_subgroup.gsmul_coe {s : set A} [is_add_subgroup s] (a : s) (n : ℤ) :
  ((n • a : s) : A) = n • a :=
by induction n; simp [is_add_submonoid.smul_coe a]
attribute [to_additive gsmul_coe] is_subgroup.coe_gpow

end

@[to_additive of_add_neg]
theorem is_subgroup.of_div (s : set G)
  (one_mem : (1:G) ∈ s) (div_mem : ∀{a b:G}, a ∈ s → b ∈ s → a * b⁻¹ ∈ s) :
  is_subgroup s :=
have inv_mem : ∀a, a ∈ s → a⁻¹ ∈ s, from
  assume a ha,
  have 1 * a⁻¹ ∈ s, from div_mem one_mem ha,
  by simpa,
{ inv_mem := inv_mem,
  mul_mem := assume a b ha hb,
    have a * b⁻¹⁻¹ ∈ s, from div_mem ha (inv_mem b hb),
    by simpa,
  one_mem := one_mem }

theorem is_add_subgroup.of_sub (s : set A)
  (zero_mem : (0:A) ∈ s) (sub_mem : ∀{a b:A}, a ∈ s → b ∈ s → a - b ∈ s) :
  is_add_subgroup s :=
is_add_subgroup.of_add_neg s zero_mem
  (λ x y hx hy, by simpa only [sub_eq_add_neg] using sub_mem hx hy)

@[to_additive]
instance is_subgroup.inter (s₁ s₂ : set G) [is_subgroup s₁] [is_subgroup s₂] :
  is_subgroup (s₁ ∩ s₂) :=
{ inv_mem := λ x hx, ⟨is_subgroup.inv_mem hx.1, is_subgroup.inv_mem hx.2⟩ }

@[to_additive]
instance is_subgroup.Inter {ι : Sort*} (s : ι → set G) [h : ∀ y : ι, is_subgroup (s y)] :
  is_subgroup (set.Inter s) :=
{ inv_mem := λ x h, set.mem_Inter.2 $ λ y, is_subgroup.inv_mem (set.mem_Inter.1 h y) }

@[to_additive]
lemma is_subgroup_Union_of_directed {ι : Type*} [hι : nonempty ι]
  (s : ι → set G) [∀ i, is_subgroup (s i)]
  (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
  is_subgroup (⋃i, s i) :=
{ inv_mem := λ a ha,
    let ⟨i, hi⟩ := set.mem_Union.1 ha in
    set.mem_Union.2 ⟨i, is_subgroup.inv_mem hi⟩,
  to_is_submonoid := is_submonoid_Union_of_directed s directed }

def gpowers (x : G) : set G := set.range ((^) x : ℤ → G)
def gmultiples (x : A) : set A := set.range (λ i, gsmul i x)
attribute [to_additive gmultiples] gpowers

instance gpowers.is_subgroup (x : G) : is_subgroup (gpowers x) :=
{ one_mem := ⟨(0:ℤ), by simp⟩,
  mul_mem := assume x₁ x₂ ⟨i₁, h₁⟩ ⟨i₂, h₂⟩, ⟨i₁ + i₂, by simp [gpow_add, *]⟩,
  inv_mem := assume x₀ ⟨i, h⟩, ⟨-i, by simp [h.symm]⟩ }

instance gmultiples.is_add_subgroup (x : A) : is_add_subgroup (gmultiples x) :=
multiplicative.is_subgroup_iff.1 $ gpowers.is_subgroup _
attribute [to_additive] gpowers.is_subgroup

lemma is_subgroup.gpow_mem {a : G} {s : set G} [is_subgroup s] (h : a ∈ s) : ∀{i:ℤ}, a ^ i ∈ s
| (n : ℕ) := by { rw [gpow_coe_nat], exact is_submonoid.pow_mem h }
| -[1+ n] := by { rw [gpow_neg_succ_of_nat], exact is_subgroup.inv_mem (is_submonoid.pow_mem h) }

lemma is_add_subgroup.gsmul_mem {a : A} {s : set A} [is_add_subgroup s] :
  a ∈ s → ∀{i:ℤ}, gsmul i a ∈ s :=
@is_subgroup.gpow_mem (multiplicative A) _ _ _ (multiplicative.is_subgroup _)

lemma gpowers_subset {a : G} {s : set G} [is_subgroup s] (h : a ∈ s) : gpowers a ⊆ s :=
λ x hx, match x, hx with _, ⟨i, rfl⟩ := is_subgroup.gpow_mem h end

lemma gmultiples_subset {a : A} {s : set A} [is_add_subgroup s] (h : a ∈ s) : gmultiples a ⊆ s :=
@gpowers_subset (multiplicative A) _ _ _ (multiplicative.is_subgroup _) h

attribute [to_additive gmultiples_subset] gpowers_subset

lemma mem_gpowers {a : G} : a ∈ gpowers a := ⟨1, by simp⟩
lemma mem_gmultiples {a : A} : a ∈ gmultiples a := ⟨1, by simp⟩
attribute [to_additive mem_gmultiples] mem_gpowers

end group

namespace is_subgroup
open is_submonoid
variables [group G] (s : set G) [is_subgroup s]

@[to_additive]
lemma inv_mem_iff : a⁻¹ ∈ s ↔ a ∈ s :=
⟨λ h, by simpa using inv_mem h, inv_mem⟩

@[to_additive]
lemma mul_mem_cancel_right (h : a ∈ s) : b * a ∈ s ↔ b ∈ s :=
⟨λ hba, by simpa using mul_mem hba (inv_mem h), λ hb, mul_mem hb h⟩

@[to_additive]
lemma mul_mem_cancel_left (h : a ∈ s) : a * b ∈ s ↔ b ∈ s :=
⟨λ hab, by simpa using mul_mem (inv_mem h) hab, mul_mem h⟩

end is_subgroup

class normal_add_subgroup [add_group A] (s : set A) extends is_add_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : A, g + n + -g ∈ s)

@[to_additive]
class normal_subgroup [group G] (s : set G) extends is_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : G, g * n * g⁻¹ ∈ s)

@[to_additive]
lemma normal_subgroup_of_comm_group [comm_group G] (s : set G) [hs : is_subgroup s] :
  normal_subgroup s :=
{ normal := λ n hn g, by rwa [mul_right_comm, mul_right_inv, one_mul],
  ..hs }

lemma additive.normal_add_subgroup [group G]
  (s : set G) [normal_subgroup s] : @normal_add_subgroup (additive G) _ s :=
@normal_add_subgroup.mk (additive G) _ _
  (@additive.is_add_subgroup G _ _ _)
  (@normal_subgroup.normal _ _ _ _)

theorem additive.normal_add_subgroup_iff [group G]
  {s : set G} : @normal_add_subgroup (additive G) _ s ↔ normal_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @normal_subgroup.mk G _ _ (additive.is_add_subgroup_iff.1 h₁) @h₂,
  λ h, by exactI additive.normal_add_subgroup _⟩

lemma multiplicative.normal_subgroup [add_group A]
  (s : set A) [normal_add_subgroup s] : @normal_subgroup (multiplicative A) _ s :=
@normal_subgroup.mk (multiplicative A) _ _
  (@multiplicative.is_subgroup A _ _ _)
  (@normal_add_subgroup.normal _ _ _ _)

theorem multiplicative.normal_subgroup_iff [add_group A]
  {s : set A} : @normal_subgroup (multiplicative A) _ s ↔ normal_add_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @normal_add_subgroup.mk A _ _ (multiplicative.is_subgroup_iff.1 h₁) @h₂,
  λ h, by exactI multiplicative.normal_subgroup _⟩

namespace is_subgroup
variable [group G]

-- Normal subgroup properties
@[to_additive]
lemma mem_norm_comm {s : set G} [normal_subgroup s] {a b : G} (hab : a * b ∈ s) : b * a ∈ s :=
have h : a⁻¹ * (a * b) * a⁻¹⁻¹ ∈ s, from normal_subgroup.normal (a * b) hab a⁻¹,
by simp at h; exact h

@[to_additive]
lemma mem_norm_comm_iff {s : set G} [normal_subgroup s] {a b : G} : a * b ∈ s ↔ b * a ∈ s :=
⟨mem_norm_comm, mem_norm_comm⟩

/-- The trivial subgroup -/
@[to_additive]
def trivial (G : Type*) [group G] : set G := {1}

@[simp, to_additive]
lemma mem_trivial {g : G} : g ∈ trivial G ↔ g = 1 :=
mem_singleton_iff

@[to_additive]
instance trivial_normal : normal_subgroup (trivial G) :=
by refine {..}; simp [trivial] {contextual := tt}

@[to_additive]
lemma eq_trivial_iff {s : set G} [is_subgroup s] :
  s = trivial G ↔ (∀ x ∈ s, x = (1 : G)) :=
by simp only [set.ext_iff, is_subgroup.mem_trivial];
  exact ⟨λ h x, (h x).1, λ h x, ⟨h x, λ hx, hx.symm ▸ is_submonoid.one_mem⟩⟩

@[to_additive]
instance univ_subgroup : normal_subgroup (@univ G) :=
by refine {..}; simp

@[to_additive add_center]
def center (G : Type*) [group G] : set G := {z | ∀ g, g * z = z * g}

@[to_additive mem_add_center]
lemma mem_center {a : G} : a ∈ center G ↔ ∀g, g * a = a * g := iff.rfl

@[to_additive add_center_normal]
instance center_normal : normal_subgroup (center G) :=
{ one_mem := by simp [center],
  mul_mem := assume a b ha hb g,
    by rw [←mul_assoc, mem_center.2 ha g, mul_assoc, mem_center.2 hb g, ←mul_assoc],
  inv_mem := assume a ha g,
    calc
      g * a⁻¹ = a⁻¹ * (g * a) * a⁻¹ : by simp [ha g]
      ...     = a⁻¹ * g             : by rw [←mul_assoc, mul_assoc]; simp,
  normal := assume n ha g h,
    calc
      h * (g * n * g⁻¹) = h * n           : by simp [ha g, mul_assoc]
      ...               = g * g⁻¹ * n * h : by rw ha h; simp
      ...               = g * n * g⁻¹ * h : by rw [mul_assoc g, ha g⁻¹, ←mul_assoc] }

@[to_additive add_normalizer]
def normalizer (s : set G) : set G :=
{g : G | ∀ n, n ∈ s ↔ g * n * g⁻¹ ∈ s}

@[to_additive]
instance normalizer_is_subgroup (s : set G) : is_subgroup (normalizer s) :=
{ one_mem := by simp [normalizer],
  mul_mem := λ a b (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s)
    (hb : ∀ n, n ∈ s ↔ b * n * b⁻¹ ∈ s) n,
    by rw [mul_inv_rev, ← mul_assoc, mul_assoc a, mul_assoc a, ← ha, ← hb],
  inv_mem := λ a (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s) n,
    by rw [ha (a⁻¹ * n * a⁻¹⁻¹)];
    simp [mul_assoc] }

@[to_additive subset_add_normalizer]
lemma subset_normalizer (s : set G) [is_subgroup s] : s ⊆ normalizer s :=
λ g hg n, by rw [is_subgroup.mul_mem_cancel_right _ ((is_subgroup.inv_mem_iff _).2 hg),
  is_subgroup.mul_mem_cancel_left _ hg]

local attribute [instance] subtype.group
/-- Every subgroup is a normal subgroup of its normalizer -/
@[to_additive add_normal_in_add_normalizer]
instance normal_in_normalizer (s : set G) [is_subgroup s] :
  normal_subgroup (subtype.val ⁻¹' s : set (normalizer s)) :=
{ one_mem := show (1 : G) ∈ s, from is_submonoid.one_mem,
  mul_mem := λ a b ha hb, show (a * b : G) ∈ s, from is_submonoid.mul_mem ha hb,
  inv_mem := λ a ha, show (a⁻¹ : G) ∈ s, from is_subgroup.inv_mem ha,
  normal := λ a ha ⟨m, hm⟩, (hm a).1 ha }

end is_subgroup

-- Homomorphism subgroups
namespace is_group_hom
open is_submonoid is_subgroup
open is_mul_hom (map_mul)

@[to_additive]
def ker [group H] (f : G → H) : set G := preimage f (trivial H)

@[to_additive]
lemma mem_ker [group H] (f : G → H) {x : G} : x ∈ ker f ↔ f x = 1 :=
mem_trivial

variables [group G] [group H]

@[to_additive]
lemma one_ker_inv (f : G → H) [is_group_hom f] {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
begin
  rw [map_mul f, map_inv f] at h,
  rw [←inv_inv (f b), eq_inv_of_mul_eq_one h]
end

@[to_additive]
lemma one_ker_inv' (f : G → H) [is_group_hom f] {a b : G} (h : f (a⁻¹ * b) = 1) : f a = f b :=
begin
  rw [map_mul f, map_inv f] at h,
  apply inv_injective,
  rw eq_inv_of_mul_eq_one h
end

@[to_additive]
lemma inv_ker_one (f : G → H) [is_group_hom f] {a b : G} (h : f a = f b) : f (a * b⁻¹) = 1 :=
have f a * (f b)⁻¹ = 1, by rw [h, mul_right_inv],
by rwa [←map_inv f, ←map_mul f] at this

@[to_additive]
lemma inv_ker_one' (f : G → H) [is_group_hom f] {a b : G} (h : f a = f b) : f (a⁻¹ * b) = 1 :=
have (f a)⁻¹ * f b = 1, by rw [h, mul_left_inv],
by rwa [←map_inv f, ←map_mul f] at this

@[to_additive]
lemma one_iff_ker_inv (f : G → H) [is_group_hom f] (a b : G) : f a = f b ↔ f (a * b⁻¹) = 1 :=
⟨inv_ker_one f, one_ker_inv f⟩

@[to_additive]
lemma one_iff_ker_inv' (f : G → H) [is_group_hom f] (a b : G) : f a = f b ↔ f (a⁻¹ * b) = 1 :=
⟨inv_ker_one' f, one_ker_inv' f⟩

@[to_additive]
lemma inv_iff_ker (f : G → H) [w : is_group_hom f] (a b : G) : f a = f b ↔ a * b⁻¹ ∈ ker f :=
by rw [mem_ker]; exact one_iff_ker_inv _ _ _

@[to_additive]
lemma inv_iff_ker' (f : G → H) [w : is_group_hom f] (a b : G) : f a = f b ↔ a⁻¹ * b ∈ ker f :=
by rw [mem_ker]; exact one_iff_ker_inv' _ _ _

@[to_additive]
instance image_subgroup (f : G → H) [is_group_hom f] (s : set G) [is_subgroup s] :
  is_subgroup (f '' s) :=
{ mul_mem := assume a₁ a₂ ⟨b₁, hb₁, eq₁⟩ ⟨b₂, hb₂, eq₂⟩,
             ⟨b₁ * b₂, mul_mem hb₁ hb₂, by simp [eq₁, eq₂, map_mul f]⟩,
  one_mem := ⟨1, one_mem, map_one f⟩,
  inv_mem := assume a ⟨b, hb, eq⟩, ⟨b⁻¹, inv_mem hb, by rw map_inv f; simp *⟩ }

@[to_additive]
instance range_subgroup (f : G → H) [is_group_hom f] : is_subgroup (set.range f) :=
@set.image_univ _ _ f ▸ is_group_hom.image_subgroup f set.univ

local attribute [simp] one_mem inv_mem mul_mem normal_subgroup.normal

@[to_additive]
instance preimage (f : G → H) [is_group_hom f] (s : set H) [is_subgroup s] :
  is_subgroup (f ⁻¹' s) :=
by refine {..}; simp [map_mul f, map_one f, map_inv f, @inv_mem H _ s] {contextual:=tt}

@[to_additive]
instance preimage_normal (f : G → H) [is_group_hom f] (s : set H) [normal_subgroup s] :
  normal_subgroup (f ⁻¹' s) :=
⟨by simp [map_mul f, map_inv f] {contextual:=tt}⟩

@[to_additive]
instance normal_subgroup_ker (f : G → H) [is_group_hom f] : normal_subgroup (ker f) :=
is_group_hom.preimage_normal f (trivial H)

@[to_additive]
lemma injective_of_trivial_ker (f : G → H) [is_group_hom f] (h : ker f = trivial G) :
  function.injective f :=
begin
  intros a₁ a₂ hfa,
  simp [ext_iff, ker, is_subgroup.trivial] at h,
  have ha : a₁ * a₂⁻¹ = 1, by rw ←h; exact inv_ker_one f hfa,
  rw [eq_inv_of_mul_eq_one ha, inv_inv a₂]
end

@[to_additive]
lemma trivial_ker_of_injective (f : G → H) [is_group_hom f] (h : function.injective f) :
  ker f = trivial G :=
set.ext $ assume x, iff.intro
  (assume hx,
    suffices f x = f 1, by simpa using h this,
    by simp [map_one f]; rwa [mem_ker] at hx)
  (by simp [mem_ker, is_group_hom.map_one f] {contextual := tt})

@[to_additive]
lemma injective_iff_trivial_ker (f : G → H) [is_group_hom f] :
  function.injective f ↔ ker f = trivial G :=
⟨trivial_ker_of_injective f, injective_of_trivial_ker f⟩

@[to_additive]
lemma trivial_ker_iff_eq_one (f : G → H) [is_group_hom f] :
  ker f = trivial G ↔ ∀ x, f x = 1 → x = 1 :=
by rw set.ext_iff; simp [ker]; exact
⟨λ h x hx, (h x).1 hx, λ h x, ⟨h x, λ hx, by rw [hx, map_one f]⟩⟩

end is_group_hom

section
local attribute [instance] subtype.group

@[to_additive]
instance subtype_val.is_group_hom [group G] {s : set G} [is_subgroup s] :
  is_group_hom (subtype.val : s → G) := { ..subtype_val.is_monoid_hom }

@[to_additive]
instance coe.is_group_hom [group G] {s : set G} [is_subgroup s] :
  is_group_hom (coe : s → G) := { ..subtype_val.is_monoid_hom }

@[to_additive]
instance subtype_mk.is_group_hom [group G] [group H] {s : set G}
  [is_subgroup s] (f : H → G) [is_group_hom f] (h : ∀ x, f x ∈ s) :
  is_group_hom (λ x, (⟨f x, h x⟩ : s)) := { ..subtype_mk.is_monoid_hom f h }

@[to_additive]
instance set_inclusion.is_group_hom [group G] {s t : set G}
  [is_subgroup s] [is_subgroup t] (h : s ⊆ t) : is_group_hom (set.inclusion h) :=
subtype_mk.is_group_hom _ _

end

section
local attribute [instance] subtype.monoid

/-- `subtype.val : set.range f → H` as a monoid homomorphism, when `f` is a monoid homomorphism. -/
@[to_additive "`subtype.val : set.range f → H` as an additive monoid homomorphism, when `f` is
an additive monoid homomorphism."]
def monoid_hom.range_subtype_val [monoid G] [monoid H] (f : G →* H) : (set.range f) →* H :=
monoid_hom.of subtype.val

/-- `set.range_factorization f : G → set.range f` as a monoid homomorphism, when `f` is a monoid
homomorphism. -/
@[to_additive "`set.range_factorization f : G → set.range f` as an additive monoid homomorphism,
when `f` is an additive monoid homomorphism."]
def monoid_hom.range_factorization [monoid G] [monoid H] (f : G →* H) : G →* (set.range f) :=
{ to_fun := set.range_factorization f,
  map_one' := by { dsimp [set.range_factorization], simp, refl, },
  map_mul' := by { intros, dsimp [set.range_factorization], simp, refl, } }

end

namespace add_group

variables [add_group A]

inductive in_closure (s : set A) : A → Prop
| basic {a : A} : a ∈ s → in_closure a
| zero : in_closure 0
| neg {a : A} : in_closure a → in_closure (-a)
| add {a b : A} : in_closure a → in_closure b → in_closure (a + b)

end add_group

namespace group
open is_submonoid is_subgroup

variables [group G] {s : set G}

@[to_additive]
inductive in_closure (s : set G) : G → Prop
| basic {a : G} : a ∈ s → in_closure a
| one : in_closure 1
| inv {a : G} : in_closure a → in_closure a⁻¹
| mul {a b : G} : in_closure a → in_closure b → in_closure (a * b)

/-- `group.closure s` is the subgroup closed over `s`, i.e. the smallest subgroup containg s. -/
@[to_additive]
def closure (s : set G) : set G := {a | in_closure s a }

@[to_additive]
lemma mem_closure {a : G} : a ∈ s → a ∈ closure s := in_closure.basic

@[to_additive]
instance closure.is_subgroup (s : set G) : is_subgroup (closure s) :=
{ one_mem := in_closure.one,
  mul_mem := assume a b, in_closure.mul,
  inv_mem := assume a, in_closure.inv }

@[to_additive]
theorem subset_closure {s : set G} : s ⊆ closure s := λ a, mem_closure

@[to_additive]
theorem closure_subset {s t : set G} [is_subgroup t] (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, one_mem, mul_mem, inv_mem_iff]

@[to_additive]
lemma closure_subset_iff (s t : set G) [is_subgroup t] : closure s ⊆ t ↔ s ⊆ t :=
⟨assume h b ha, h (mem_closure ha), assume h b ha, closure_subset h ha⟩

@[to_additive]
theorem closure_mono {s t : set G} (h : s ⊆ t) : closure s ⊆ closure t :=
closure_subset $ set.subset.trans h subset_closure

@[simp, to_additive]
lemma closure_subgroup (s : set G) [is_subgroup s] : closure s = s :=
set.subset.antisymm (closure_subset $ set.subset.refl s) subset_closure

@[to_additive]

@[to_additive]
lemma image_closure [group H] (f : G → H) [is_group_hom f] (s : set G) :
  f '' closure s = closure (f '' s) :=
le_antisymm
  begin
    rintros _ ⟨x, hx, rfl⟩,
    apply in_closure.rec_on hx; intros,
    { solve_by_elim [subset_closure, set.mem_image_of_mem] },
    { rw [is_monoid_hom.map_one f], apply is_submonoid.one_mem },
    { rw [is_group_hom.map_inv f], apply is_subgroup.inv_mem, assumption },
    { rw [is_monoid_hom.map_mul f], solve_by_elim [is_submonoid.mul_mem] }
  end
  (closure_subset $ set.image_subset _ subset_closure)

@[to_additive]
theorem mclosure_subset {s : set G} : monoid.closure s ⊆ closure s :=
monoid.closure_subset $ subset_closure

@[to_additive]
theorem mclosure_inv_subset {s : set G} : monoid.closure (has_inv.inv ⁻¹' s) ⊆ closure s :=
monoid.closure_subset $ λ x hx, inv_inv x ▸ (is_subgroup.inv_mem $ subset_closure hx)

@[to_additive]
theorem closure_eq_mclosure {s : set G} : closure s = monoid.closure (s ∪ has_inv.inv ⁻¹' s) :=
set.subset.antisymm
  (@closure_subset _ _ _ (monoid.closure (s ∪ has_inv.inv ⁻¹' s))
    { inv_mem := λ x hx, monoid.in_closure.rec_on hx
      (λ x hx, or.cases_on hx (λ hx, monoid.subset_closure $ or.inr $
        show x⁻¹⁻¹ ∈ s, from (inv_inv x).symm ▸ hx)
        (λ hx, monoid.subset_closure $ or.inl hx))
      ((@one_inv G _).symm ▸ is_submonoid.one_mem)
      (λ x y hx hy ihx ihy, (mul_inv_rev x y).symm ▸ is_submonoid.mul_mem ihy ihx) }
    (set.subset.trans (set.subset_union_left _ _) monoid.subset_closure))
  (monoid.closure_subset $ set.union_subset subset_closure $
    λ x hx, inv_inv x ▸ (is_subgroup.inv_mem $ subset_closure hx))

@[to_additive]
theorem mem_closure_union_iff {G : Type*} [comm_group G] {s t : set G} {x : G} :
  x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
begin
  simp only [closure_eq_mclosure, monoid.mem_closure_union_iff, exists_prop, preimage_union], split,
  { rintro ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, rfl⟩,
    refine ⟨_, ⟨_, hys, _, hzs, rfl⟩, _, ⟨_, hyt, _, hzt, rfl⟩, _⟩,
    rw [mul_assoc, mul_assoc, mul_left_comm zs] },
  { rintro ⟨_, ⟨ys, hys, zs, hzs, rfl⟩, _, ⟨yt, hyt, zt, hzt, rfl⟩, rfl⟩,
    refine ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, _⟩,
    rw [mul_assoc, mul_assoc, mul_left_comm yt] }
end

@[to_additive gmultiples_eq_closure]
theorem gpowers_eq_closure {a : G} : gpowers a = closure {a} :=
subset.antisymm
  (gpowers_subset $ mem_closure $ by simp)
  (closure_subset $ by simp [mem_gpowers])

end group

namespace is_subgroup
variable [group G]

@[to_additive]
lemma trivial_eq_closure : trivial G = group.closure ∅ :=
subset.antisymm
  (by simp [set.subset_def, is_submonoid.one_mem])
  (group.closure_subset $ by simp)

end is_subgroup

/-The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/

namespace group
variables {s : set G} [group G]

lemma conjugates_of_subset {t : set G} [normal_subgroup t] {a : G} (h : a ∈ t) :
  conjugates_of a ⊆ t :=
λ x hc,
begin
  obtain ⟨c, w⟩ := is_conj_iff.1 hc,
  have H := normal_subgroup.normal a h c,
  rwa ←w,
end

theorem conjugates_of_set_subset' {s t : set G} [normal_subgroup t] (h : s ⊆ t) :
  conjugates_of_set s ⊆ t :=
set.bUnion_subset (λ x H, conjugates_of_subset (h H))

/-- The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/
def normal_closure (s : set G) : set G := closure (conjugates_of_set s)

theorem conjugates_of_set_subset_normal_closure : conjugates_of_set s ⊆ normal_closure s :=
subset_closure

theorem subset_normal_closure : s ⊆ normal_closure s :=
set.subset.trans subset_conjugates_of_set conjugates_of_set_subset_normal_closure

/-- The normal closure of a set is a subgroup. -/
instance normal_closure.is_subgroup (s : set G) : is_subgroup (normal_closure s) :=
closure.is_subgroup (conjugates_of_set s)

/-- The normal closure of s is a normal subgroup. -/
instance normal_closure.is_normal : normal_subgroup (normal_closure s) :=
⟨ λ n h g,
begin
  induction h with x hx x hx ihx x y hx hy ihx ihy,
  {exact (conjugates_of_set_subset_normal_closure (conj_mem_conjugates_of_set hx))},
  {simpa using (normal_closure.is_subgroup s).one_mem},
  {rw ←conj_inv,
   exact (is_subgroup.inv_mem ihx)},
  {rw ←conj_mul,
   exact (is_submonoid.mul_mem ihx ihy)},
end ⟩

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normal_closure_subset {s t : set G} [normal_subgroup t] (h : s ⊆ t) :
  normal_closure s ⊆ t :=
λ a w,
begin
  induction w with x hx x hx ihx x y hx hy ihx ihy,
  {exact (conjugates_of_set_subset' h $ hx)},
  {exact is_submonoid.one_mem},
  {exact is_subgroup.inv_mem ihx},
  {exact is_submonoid.mul_mem ihx ihy}
end

lemma normal_closure_subset_iff {s t : set G} [normal_subgroup t] : s ⊆ t ↔ normal_closure s ⊆ t :=
⟨normal_closure_subset, set.subset.trans (subset_normal_closure)⟩

theorem normal_closure_mono {s t : set G} : s ⊆ t → normal_closure s ⊆ normal_closure t :=
λ h, normal_closure_subset (set.subset.trans h (subset_normal_closure))

end group

/-- Create a bundled subgroup from a set `s` and `[is_subgroup s]`. -/
@[to_additive "Create a bundled additive subgroup from a set `s` and `[is_add_subgroup s]`."]
def subgroup.of [group G] (s : set G) [h : is_subgroup s] : subgroup G :=
{ carrier := s,
  one_mem' := h.1.1,
  mul_mem' := h.1.2,
  inv_mem' := h.2 }

@[to_additive]
instance subgroup.is_subgroup [group G] (K : subgroup G) : is_subgroup (K : set G) :=
{ one_mem := K.one_mem',
  mul_mem := K.mul_mem',
  inv_mem := K.inv_mem' }

@[to_additive]
instance subgroup.of_normal [group G] (s : set G) [h : is_subgroup s] [n : normal_subgroup s] :
  subgroup.normal (subgroup.of s) :=
{ conj_mem := n.normal, }


import Mathlib.Tactic.Basic
import Mathlib.Tactic.Cases
import Mathlib.Init.Data.Nat.Basic

/-!
## Lists

Lean provides a rich library of functions on finite lists. In this section, we will review some of
them, and we will define some of our own; these are good exercises to familiarize ourselves with
functional programming in Lean.

In the first example, we show how to exploit injectivity of constructors. The
`cases` tactic can be used to apply injectivity on equations in which both sides
have the same constructor applied. In the proof below, the equation on which
injectivity is applied is `x :: xs = y :: ys`:

-/
lemma injection_example {α : Type} (x y : α) (xs ys : List α)
    (h : List.cons x xs = List.cons y ys) :
  x = y ∧ xs = ys := by
  cases h
  simp
/-!
As a result of the case distinction, `y` is replaced by `x` and `ys` is replaced by `xs`
throughout the goal, yielding the subgoal
```
h : x :: xs = x :: xs ⊢ x = x ∧ xs = xs
```
The `cases` tactic is also useful when the constructors are different, to detect
the impossible case:
-/
lemma distinctness_example {α : Type} (y : α) (ys : List α)
  (h : [] = y :: ys) :
  false :=
  by cases h
/-!
The first operation we define is a `map` function: a function that applies its
argument f—which is itself a function—to all elements stored in a container.
-/
def map {α β : Type} (f : α → β) : List α → List β
| [] => []
| (x :: xs) => f x :: map f xs

#eval map Nat.succ [1, 2, 3]  -- [2, 3, 4]
/-!
This could also be written using match on multiple parameters as follows:
-/
def map₂ {α β : Type} : (α → β) → List α → List β
| _, [] => []
| f, (x :: xs) => f x :: map₂ f xs
/-!
A basic property of map functions is that they have no effect if their argument
is the identity function (`λ x => x`, or `id`):
-/
lemma map_ident {α : Type} (xs : List α) :
    map (λ x => x) xs = xs := by
  induction' xs
  case nil => rfl
  case cons x xs ih =>
    simp [map, ih]
/-!
Another basic property is that successive maps can be compressed into a single map, whose argument
is the composition of the functions involved:
-/
lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ) (xs : List α) :
    map g (map f xs) = map (λ x => g (f x)) xs := by
  induction' xs
  case nil => rfl
  case cons y ys ih =>
   simp [map, ih]
/-!
When introducing new operations, it is useful to show how these behave when
used in combination with other operations. Here is an example that proves
that `map` distributes over `append`:
-/
lemma map_append {α β : Type} (f : α → β) (xs ys : List α) :
    map f (xs ++ ys) = map f xs ++ map f ys := by
  induction' xs
  case nil => rfl
  case cons y ys ih =>
    simp [map, ih]
/-!
Remarkably, the last three proofs are textually identical. These are typical
`induction'–refl–simp` proofs.

The next list operation removes the first element of a list, returning the tail:
-/
def tail {α : Type} : List α → List α
| [] => []
| (_ :: xs) => xs

/-!
For an empty list `[]`, we simply return `[]` as its own tail.

The counterpart of tail is a function that extracts the first element of a list.
We already reviewed one solution in [Section 4.6](TypeClasses.lean.md).
Another possible definition uses an option wrapper:
-/
def head_opt {α : Type} : List α → Option α
| [] => Option.none
| (x :: _) => Option.some x

/-!
The type `Option α` is equipped with two constructors: `Option.none` and
`Option.some a`, where `a : α`. We use `Option.none` when we have no meaningful value
to return and `Option.some` otherwise. We can think of `Option.none` as the `null`
pointer of functional programming, but unlike `null` pointers (and `null` references),
the type system guards against unsafe dereferences. To obtain the value stored
in an option, we must use pattern matching. Schematically:
```lean
match head_opt xs with
| option.none => handle_the_error
| option.some x => do_something_with_value x
```
We cannot simply write `do_something_with_value (head_opt xs)`, because this would be
type-incorrect. The type system forces us to think about error handling. Using the power of
dependent types, another way to implement a partial function is to specify a precondition. The
callee must then pass a proof that the precondition is satisfied as argument:
-/
def head_le {α : Type} : ∀xs : List α, xs ≠ [] → α
| [], hxs => absurd rfl hxs
| (x :: _), _ => x

/-!
The `head_le` function takes two explicit arguments. The first argument, `xs`, is a
list. The second argument, `hxs`, is a proof of `xs ≠ []`. Since the type (`xs ≠ []`) of
the second argument depends on the first argument, we must use the dependent
type syntax `∀xs : list α`, rather than `List α` to name the first argument. The
result of the function is a value of type α; thanks to the precondition, there is no
need for an option wrapper.

The precondition `hxs` is used to rule out the case where `xs` is `[]`. In that case, `hxs` is a
proof of `[] ≠ []`, which is impossible. The absurd tactic derives the contradiction and exploits it
to derive an arbitrary α. From a contradiction, we can derive anything, even an inhabitant of α.

We can then invoke the function as follows using the `simp` tactic to prove that `[3, 1, 4] ≠ []`:
-/
#eval head_le [3, 1, 4] (by simp)   -- 3
/-!
Let us move on. Given two lists `[x₁, . . ., xₙ]` and `[y₁, . . ., yₙ]` of the same
length, the `zip` operation constructs a list of pairs `[(x₁, y₁), . . ., (xₙ, yₙ)]`:
-/
def zip {α β : Type} : List α → List β → List (α × β)
| (x :: xs), (y :: ys) => (x, y) :: zip xs ys
| [], _ => []
| (_ :: _), [] => []
/-!
Remember that `(α × β)` is the type of pairs of values of types `α` and `β` and `(a, b)`
is an instance of that pair where `a : α` and `b : β`.

The function is also defined if one list is shorter than the other. For example,
`zip [a, b, c] [x, y] = [(a, x), (b, y)]`. Notice that the recursion, with three cases,
deviates slightly from the structural recursion schema.

The length of a list is defined by recursion:
-/
def length {α : Type} : List α → ℕ
| [] => 0
| (_ :: xs) => (length xs) + 1
/-!
We can say something interesting about the length of `zip`’s result—namely, it is
the minimum of the lengths of the two input lists:
-/
attribute [simp] Nat.add_le_add_iff_le_right

theorem min_add_add (l m n : Nat) :
    min (m + l) (n + l) = min m n + l := by
  cases Classical.em (m ≤ n)
  case inl h =>
    simp [min, h]
  case inr h =>
    simp [min, h]

lemma length_zip {α β : Type} (xs : List α) (ys : List β) :
    length (zip xs ys) = min (length xs) (length ys) := by
  induction xs generalizing ys with
  | nil => simp [length, min]
  | cons x xs' ih  =>
    cases ys
    case nil => rfl
    case cons y ys' =>
      simp [zip, length, min_add_add, ih]

/-!
The proof above teaches us yet another trick.
The `induction xs generalizing ys` statement causes Lean to generalize
over `ys` which yields the induction hypothesis:
```lean
ih: ∀ (ys : List β), length (zip xs' ys) = min (length xs') (length ys)
```
If you remove `generalizing ys` then you get the following which is not as useful to us
and the proof will get stuck:
```lean
ih: length (zip xs' ys) = min (length xs') (length ys)
```

The syntax `∀ (ys : List β)` indicates that the type `β` is an implicit
argument of `ih`. In contrast, `ys` is explicit—and from it, `β` can be inferred.

The presence of ∀-quantifiers is explained as follows. The `induction’` tactic
automatically generalized the lemma statement so that the induction hypothesis
is not restricted to same fixed `β` and `ys` as the proof goal but can be used for
arbitrary values of `β` and `ys`. Such flexibility is rarely needed for types (e.g., `β`),
but here we need it for `ys`, because we want to instantiate the quantifier with `ys`’s
tail (called `ys'`) and not with `ys` itself.

The proof relies on a helper lemma `min_add_add` which shows the min function
distributes over addition.

Recall the definition `min a b = (if a ≤ b then a else b)`. To reason about `min`, we
often need to perform a `case` distinction on the condition `a ≤ b`. This is achieved
using `cases Classical.em (a ≤ b)`. This creates two sub-goals: one with `a ≤ b` as
a hypothesis and one with `¬ a ≤ b`.

Here are two different ways to perform a case distinction on a proposition in
a structured proof:

-/
lemma min_add_add2 (l m n : ℕ) :
    min (m + l) (n + l) = min m n + l :=
  match Classical.em (m ≤ n) with
  | Or.inl h => by simp [min, h]
  | Or.inr h => by simp [min, h]

lemma min_add_add3 (l m n : ℕ) :
    min (m + l) (n + l) = min m n + l :=
  if h : m ≤ n then
    by simp [min, h]
  else
    by simp [min, h]
/-!
We see again that the mechanisms that are available to write functional programs,
such as `match` and `if–then–else`, are also available for writing structured proofs
(which are, after all, terms). We can now add a few rows to the table presented at
the end of Section 3.7:

| Tactical proofs | Structured proofs | Raw proof terms |
|-----------------|-------------------|-----------------|
| cases t         | match t with _    |  match t with _ |
| cases Classical.em Q | if Q then _ else _ | if Q then _ else _ |

We conclude with a distributivity law about `map` and `zip`, expressed using the
`*.1` and `*.2` selectors on pairs:

-/

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys, map (λab : α × β => (f (ab.1), g (ab.2))) (zip xs ys) =
    zip (map f xs) (map g ys)
  | (x :: xs), (y :: ys) => by simp [zip, map, map_zip]
  | [], _ => by rfl
  | (_ :: _), [] => by rfl
/-!
The patterns on the left correspond exactly to the patterns used in the definition of
zip. This is simpler than performing the induction on `xs` and the case distinction
on `ys` separately, as we did when we proved `length_zip`. Good proofs often follow
the structure of the definitions they are based on.

In the definition of `zip` and in the proof of `map_zip`, we were careful to specify
three non-overlapping patterns. It is also possible to write equations with overlapping patterns, as in
```lean
def f {α : Type} : List α → · · ·
| [] => . . .
| xs => . . . xs . . .
```
Since the patterns are applied sequentially, the above command defines the same
function as
```lean
def f2 {α : Type} : List α → · · ·
| [] => . . .
| (x :: xs) => . . . (x :: xs) . . .
```
We generally recommend the latter, more explicit style, because it leads to fewer
surprises, especially in proofs.
-/