/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.vector
import Mathlib.data.list.nodup
import Mathlib.data.list.of_fn
import Mathlib.control.applicative
import Mathlib.PostPort

universes u_1 u_2 u u_3

namespace Mathlib

/-!
# Additional theorems about the `vector` type

This file introduces the infix notation `::ᵥ` for `vector.cons`.
-/

namespace vector

infixr:67 "::ᵥ" => Mathlib.vector.cons

protected instance inhabited {n : ℕ} {α : Type u_1} [Inhabited α] : Inhabited (vector α n) :=
  { default := of_fn fun (_x : fin n) => Inhabited.default }

theorem to_list_injective {n : ℕ} {α : Type u_1} : function.injective to_list :=
  subtype.val_injective

/-- Two `v w : vector α n` are equal iff they are equal at every single index. -/
theorem ext {n : ℕ} {α : Type u_1} {v : vector α n} {w : vector α n} (h : ∀ (m : fin n), nth v m = nth w m) : v = w := sorry

/-- The empty `vector` is a `subsingleton`. -/
protected instance zero_subsingleton {α : Type u_1} : subsingleton (vector α 0) :=
  subsingleton.intro fun (_x _x_1 : vector α 0) => ext fun (m : fin 0) => fin.elim0 m

@[simp] theorem cons_val {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : subtype.val (a::ᵥv) = a :: subtype.val v := sorry

@[simp] theorem cons_head {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : head (a::ᵥv) = a := sorry

@[simp] theorem cons_tail {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : tail (a::ᵥv) = v := sorry

@[simp] theorem to_list_of_fn {α : Type u_1} {n : ℕ} (f : fin n → α) : to_list (of_fn f) = list.of_fn f := sorry

@[simp] theorem mk_to_list {n : ℕ} {α : Type u_1} (v : vector α n) (h : list.length (to_list v) = n) : { val := to_list v, property := h } = v := sorry

@[simp] theorem to_list_map {n : ℕ} {α : Type u_1} {β : Type u_2} (v : vector α n) (f : α → β) : to_list (map f v) = list.map f (to_list v) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = n) =>
      Eq.refl (to_list (map f { val := v_val, property := v_property }))

theorem nth_eq_nth_le {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) : nth v i =
  list.nth_le (to_list v) (subtype.val i)
    (eq.mpr (id (Eq._oldrec (Eq.refl (subtype.val i < list.length (to_list v))) (to_list_length v)))
      (subtype.property i)) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = n) =>
      idRhs (nth { val := v_val, property := v_property } i = nth { val := v_val, property := v_property } i) rfl

@[simp] theorem nth_map {n : ℕ} {α : Type u_1} {β : Type u_2} (v : vector α n) (f : α → β) (i : fin n) : nth (map f v) i = f (nth v i) := sorry

@[simp] theorem nth_of_fn {α : Type u_1} {n : ℕ} (f : fin n → α) (i : fin n) : nth (of_fn f) i = f i := sorry

@[simp] theorem of_fn_nth {n : ℕ} {α : Type u_1} (v : vector α n) : of_fn (nth v) = v := sorry

@[simp] theorem nth_tail {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) (i : fin n) : nth (tail v) i = nth v (fin.succ i) := sorry

@[simp] theorem tail_val {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) : subtype.val (tail v) = list.tail (subtype.val v) := sorry

/-- The `tail` of a `nil` vector is `nil`. -/
@[simp] theorem tail_nil {α : Type u_1} : tail nil = nil :=
  rfl

/-- The `tail` of a vector made up of one element is `nil`. -/
@[simp] theorem singleton_tail {α : Type u_1} (v : vector α 1) : tail v = nil :=
  eq.mpr (id (propext (eq_iff_true_of_subsingleton (tail v) nil))) trivial

@[simp] theorem tail_of_fn {α : Type u_1} {n : ℕ} (f : fin (Nat.succ n) → α) : tail (of_fn f) = of_fn fun (i : fin (Nat.succ n - 1)) => f (fin.succ i) := sorry

/-- The list that makes up a `vector` made up of a single element,
retrieved via `to_list`, is equal to the list of that single element. -/
@[simp] theorem to_list_singleton {α : Type u_1} (v : vector α 1) : to_list v = [head v] := sorry

/-- Mapping under `id` does not change a vector. -/
@[simp] theorem map_id {α : Type u_1} {n : ℕ} (v : vector α n) : map id v = v := sorry

theorem mem_iff_nth {n : ℕ} {α : Type u_1} {a : α} {v : vector α n} : a ∈ to_list v ↔ ∃ (i : fin n), nth v i = a := sorry

theorem nodup_iff_nth_inj {n : ℕ} {α : Type u_1} {v : vector α n} : list.nodup (to_list v) ↔ function.injective (nth v) := sorry

@[simp] theorem nth_mem {n : ℕ} {α : Type u_1} (i : fin n) (v : vector α n) : nth v i ∈ to_list v := sorry

theorem head'_to_list {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) : list.head' (to_list v) = some (head v) := sorry

def reverse {n : ℕ} {α : Type u_1} (v : vector α n) : vector α n :=
  { val := list.reverse (to_list v), property := sorry }

/-- The `list` of a vector after a `reverse`, retrieved by `to_list` is equal
to the `list.reverse` after retrieving a vector's `to_list`. -/
theorem to_list_reverse {n : ℕ} {α : Type u_1} {v : vector α n} : to_list (reverse v) = list.reverse (to_list v) :=
  rfl

@[simp] theorem nth_zero {n : ℕ} {α : Type u_1} (v : vector α (Nat.succ n)) : nth v 0 = head v := sorry

@[simp] theorem head_of_fn {α : Type u_1} {n : ℕ} (f : fin (Nat.succ n) → α) : head (of_fn f) = f 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (head (of_fn f) = f 0)) (Eq.symm (nth_zero (of_fn f)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth (of_fn f) 0 = f 0)) (nth_of_fn f 0))) (Eq.refl (f 0)))

@[simp] theorem nth_cons_zero {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) : nth (a::ᵥv) 0 = a := sorry

/-- Accessing the `nth` element of a vector made up
of one element `x : α` is `x` itself. -/
@[simp] theorem nth_cons_nil {α : Type u_1} {ix : fin 1} (x : α) : nth (x::ᵥnil) ix = x := sorry

@[simp] theorem nth_cons_succ {n : ℕ} {α : Type u_1} (a : α) (v : vector α n) (i : fin n) : nth (a::ᵥv) (fin.succ i) = nth v i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nth (a::ᵥv) (fin.succ i) = nth v i)) (Eq.symm (nth_tail (a::ᵥv) i))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth (tail (a::ᵥv)) i = nth v i)) (tail_cons a v))) (Eq.refl (nth v i)))

/-- The last element of a `vector`, given that the vector is at least one element. -/
def last {n : ℕ} {α : Type u_1} (v : vector α (n + 1)) : α :=
  nth v (fin.last n)

/-- The last element of a `vector`, given that the vector is at least one element. -/
theorem last_def {n : ℕ} {α : Type u_1} {v : vector α (n + 1)} : last v = nth v (fin.last n) :=
  rfl

/-- The `last` element of a vector is the `head` of the `reverse` vector. -/
theorem reverse_nth_zero {n : ℕ} {α : Type u_1} {v : vector α (n + 1)} : head (reverse v) = last v := sorry

/--
Construct a `vector β (n + 1)` from a `vector α n` by scanning `f : β → α → β`
from the "left", that is, from 0 to `fin.last n`, using `b : β` as the starting value.
-/
def scanl {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) : vector β (n + 1) :=
  { val := list.scanl f b (to_list v), property := sorry }

/-- Providing an empty vector to `scanl` gives the starting value `b : β`. -/
@[simp] theorem scanl_nil {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) : scanl f b nil = b::ᵥnil :=
  rfl

/--
The recursive step of `scanl` splits a vector `x ::ᵥ v : vector α (n + 1)`
into the provided starting value `b : β` and the recursed `scanl`
`f b x : β` as the starting value.

This lemma is the `cons` version of `scanl_nth`.
-/
@[simp] theorem scanl_cons {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) (x : α) : scanl f b (x::ᵥv) = b::ᵥscanl f (f b x) v := sorry

/--
The underlying `list` of a `vector` after a `scanl` is the `list.scanl`
of the underlying `list` of the original `vector`.
-/
@[simp] theorem scanl_val {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) {v : vector α n} : subtype.val (scanl f b v) = list.scanl f b (subtype.val v) := sorry

/--
The `to_list` of a `vector` after a `scanl` is the `list.scanl`
of the `to_list` of the original `vector`.
-/
@[simp] theorem to_list_scanl {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) : to_list (scanl f b v) = list.scanl f b (to_list v) :=
  rfl

/--
The recursive step of `scanl` splits a vector made up of a single element
`x ::ᵥ nil : vector α 1` into a `vector` of the provided starting value `b : β`
and the mapped `f b x : β` as the last value.
-/
@[simp] theorem scanl_singleton {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α 1) : scanl f b v = b::ᵥf b (head v)::ᵥnil := sorry

/--
The first element of `scanl` of a vector `v : vector α n`,
retrieved via `head`, is the starting value `b : β`.
-/
@[simp] theorem scanl_head {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) : head (scanl f b v) = b := sorry

/--
For an index `i : fin n`, the `nth` element of `scanl` of a
vector `v : vector α n` at `i.succ`, is equal to the application
function `f : β → α → β` of the `i.cast_succ` element of
`scanl f b v` and `nth v i`.

This lemma is the `nth` version of `scanl_cons`.
-/
@[simp] theorem scanl_nth {n : ℕ} {α : Type u_1} {β : Type u_2} (f : β → α → β) (b : β) (v : vector α n) (i : fin n) : nth (scanl f b v) (fin.succ i) = f (nth (scanl f b v) (coe_fn fin.cast_succ i)) (nth v i) := sorry

def m_of_fn {m : Type u → Type u_1} [Monad m] {α : Type u} {n : ℕ} : (fin n → m α) → m (vector α n) :=
  sorry

theorem m_of_fn_pure {m : Type u_1 → Type u_2} [Monad m] [is_lawful_monad m] {α : Type u_1} {n : ℕ} (f : fin n → α) : (m_of_fn fun (i : fin n) => pure (f i)) = pure (of_fn f) := sorry

def mmap {m : Type u → Type u_1} [Monad m] {α : Type u_2} {β : Type u} (f : α → m β) {n : ℕ} : vector α n → m (vector β n) :=
  sorry

@[simp] theorem mmap_nil {m : Type u_1 → Type u_2} [Monad m] {α : Type u_3} {β : Type u_1} (f : α → m β) : mmap f nil = pure nil :=
  rfl

@[simp] theorem mmap_cons {m : Type u_1 → Type u_2} [Monad m] {α : Type u_3} {β : Type u_1} (f : α → m β) (a : α) {n : ℕ} (v : vector α n) : mmap f (a::ᵥv) =
  do
    let h' ← f a
    let t' ← mmap f v
    pure (h'::ᵥt') := sorry

/-- Define `C v` by induction on `v : vector α (n + 1)`, a vector of
at least one element.
This function has two arguments: `h0` handles the base case on `C nil`,
and `hs` defines the inductive step using `∀ x : α, C v → C (x ::ᵥ v)`. -/
def induction_on {α : Type u_1} {n : ℕ} {C : {n : ℕ} → vector α n → Sort u_2} (v : vector α (n + 1)) (h0 : C nil) (hs : {n : ℕ} → {x : α} → {w : vector α n} → C w → C (x::ᵥw)) : C v :=
  Nat.rec (fun (v : vector α (0 + 1)) => eq.mpr sorry (eq.mpr sorry (hs h0)))
    (fun (n : ℕ) (hn : (v : vector α (n + 1)) → C v) (v : vector α (Nat.succ n + 1)) => eq.mpr sorry (hs (hn (tail v)))) n
    v

def to_array {n : ℕ} {α : Type u_1} : vector α n → array n α :=
  sorry

def insert_nth {n : ℕ} {α : Type u_1} (a : α) (i : fin (n + 1)) (v : vector α n) : vector α (n + 1) :=
  { val := list.insert_nth (↑i) a (subtype.val v), property := sorry }

theorem insert_nth_val {n : ℕ} {α : Type u_1} {a : α} {i : fin (n + 1)} {v : vector α n} : subtype.val (insert_nth a i v) = list.insert_nth (subtype.val i) a (subtype.val v) :=
  rfl

@[simp] theorem remove_nth_val {n : ℕ} {α : Type u_1} {i : fin n} {v : vector α n} : subtype.val (remove_nth i v) = list.remove_nth (subtype.val v) ↑i := sorry

theorem remove_nth_insert_nth {n : ℕ} {α : Type u_1} {a : α} {v : vector α n} {i : fin (n + 1)} : remove_nth i (insert_nth a i v) = v :=
  subtype.eq (list.remove_nth_insert_nth (subtype.val i) (subtype.val v))

theorem remove_nth_insert_nth_ne {n : ℕ} {α : Type u_1} {a : α} {v : vector α (n + 1)} {i : fin (n + bit0 1)} {j : fin (n + bit0 1)} (h : i ≠ j) : remove_nth i (insert_nth a j v) = insert_nth a (fin.pred_above i j (ne.symm h)) (remove_nth (fin.pred_above j i h) v) := sorry

theorem insert_nth_comm {n : ℕ} {α : Type u_1} (a : α) (b : α) (i : fin (n + 1)) (j : fin (n + 1)) (h : i ≤ j) (v : vector α n) : insert_nth b (fin.succ j) (insert_nth a i v) = insert_nth a (coe_fn fin.cast_succ i) (insert_nth b j v) := sorry

/-- `update_nth v n a` replaces the `n`th element of `v` with `a` -/
def update_nth {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) (a : α) : vector α n :=
  { val := list.update_nth (subtype.val v) (subtype.val i) a, property := sorry }

@[simp] theorem nth_update_nth_same {n : ℕ} {α : Type u_1} (v : vector α n) (i : fin n) (a : α) : nth (update_nth v i a) i = a := sorry

theorem nth_update_nth_of_ne {n : ℕ} {α : Type u_1} {v : vector α n} {i : fin n} {j : fin n} (h : i ≠ j) (a : α) : nth (update_nth v i a) j = nth v j := sorry

theorem nth_update_nth_eq_if {n : ℕ} {α : Type u_1} {v : vector α n} {i : fin n} {j : fin n} (a : α) : nth (update_nth v i a) j = ite (i = j) a (nth v j) := sorry

end vector

namespace vector

protected def traverse {n : ℕ} {F : Type u → Type u} [Applicative F] {α : Type u} {β : Type u} (f : α → F β) : vector α n → F (vector β n) :=
  sorry

@[simp] protected theorem traverse_def {n : ℕ} {F : Type u → Type u} [Applicative F] [is_lawful_applicative F] {α : Type u} {β : Type u} (f : α → F β) (x : α) (xs : vector α n) : vector.traverse f (x::ᵥxs) = cons <$> f x <*> vector.traverse f xs :=
  subtype.cases_on xs
    fun (xs : List α) (xs_property : list.length xs = n) =>
      eq.drec (Eq.refl (vector.traverse f (x::ᵥ{ val := xs, property := Eq.refl (list.length xs) }))) xs_property

protected theorem id_traverse {n : ℕ} {α : Type u} (x : vector α n) : vector.traverse id.mk x = x := sorry

protected theorem comp_traverse {n : ℕ} {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [Applicative G] [is_lawful_applicative F] [is_lawful_applicative G] {α : Type u} {β : Type u} {γ : Type u} (f : β → F γ) (g : α → G β) (x : vector α n) : vector.traverse (functor.comp.mk ∘ Functor.map f ∘ g) x = functor.comp.mk (vector.traverse f <$> vector.traverse g x) := sorry

protected theorem traverse_eq_map_id {n : ℕ} {α : Type u_1} {β : Type u_1} (f : α → β) (x : vector α n) : vector.traverse (id.mk ∘ f) x = id.mk (map f x) := sorry

protected theorem naturality {n : ℕ} {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [Applicative G] [is_lawful_applicative F] [is_lawful_applicative G] (η : applicative_transformation F G) {α : Type u} {β : Type u} (f : α → F β) (x : vector α n) : coe_fn η (vector β n) (vector.traverse f x) = vector.traverse (coe_fn η β ∘ f) x := sorry

protected instance flip.traversable {n : ℕ} : traversable (flip vector n) :=
  traversable.mk vector.traverse

protected instance flip.is_lawful_traversable {n : ℕ} : is_lawful_traversable (flip vector n) :=
  is_lawful_traversable.mk vector.id_traverse vector.comp_traverse vector.traverse_eq_map_id vector.naturality


import .presheaf2
import .def_choice.choice

namespace o_minimal

variables {R : Type*} {S : struc R}

/- NB:
Some lemmas in this file have an unnecessarily strong [OQM R] hypothesis
where [DUNLO R] (or maybe even nothing) would be enough;
that's just because they are lemmas about things which were defined
under a standing hypothesis of [OQM R].
Since the proofs of these "lemmas" are all omitted, it's also possible
that some required hypotheses (like [is_definable_le S R]) may be missing.
-/

/- Remark:
In Type, `roption X` is the "partial map classifier X⁺": Σ (φ : Ω), X^φ.
(Here Ω = Prop is the subobject classifier.)
f : K → roption X cuts out a subset K' ⊆ K (where f is "defined"),
given by a pullback square

  K' → X
  ↓    ↓
  K  → X⁺

We want K' to be defined and the restriction f' : K' → X to be definable.
In this way, `roption X` models the "*definable* partial map classifier" for `X`.

We could also consider `option X = X ⊕ unit`, and under the "sheafy" semantics
of ⊕, we would end up with an equivalent definable_psh structure.
This is not because the topos of sheaves on Def is boolean (it isn't)
but because we choose to interpret `Prop` as the classifier for *definable* subobjects
and, in Sh(Def), definable subobjects are decidable (complementable).
(Contrast Sh(𝔻, closed topology) [𝔻 = definable sets + *continuous* definable maps]
where definable or even closed subobjects are not decidable--only clopen subobjects are.
If we force definable subobjects to be decidable, we turn Sh(𝔻) into Sh(Def).)
-/
instance roption.definable_psh {X : Type*} [definable_psh S X] : definable_psh S (roption X) :=
{ definable := λ K f, sorry,
  definable_precomp := sorry }

instance pfun.definable_psh {X Y : Type*} [definable_psh S X] [definable_psh S Y] :
  definable_psh S (X →. Y) :=
show definable_psh S (X → roption Y), by apply_instance

lemma definable_orelse_pure {X : Type*} [definable_psh S X] :
  definable S (λ (a : roption X) (b : X), a.orelse_pure b) :=
sorry

-- Ideally, we could also say the `pfun_of_rel` depends definably on `rel`.
-- However, we will only use a fixed list of `rel`s (`is_least`, `is_glb`, etc.)
-- so we don't actually need it.
lemma definable_pfun_of_rel [OQM R]
  (rel : set R → R → Prop) (uni) (hrel : definable S rel) :
  definable S (pfun_of_rel rel uni) :=
sorry

-- Presumably, this lemma has the same content as the earlier
-- lemma def_is_least : def_rel_set S (is_least : set R → R → Prop).
-- Also, this one should be generalizable to any
--   {X : Type*} [definable_psh S X] [partial_order X] [definable_le S X]
-- in place of R!
lemma definable_the_least [OQM R] [is_definable_le S R] :
  definable S (the_least : set R →. R) :=
sorry

lemma definable_roption_map {X Y : Type*} [definable_psh S X] [definable_psh S Y] :
  definable S (roption.map : (X → Y) → (roption X → roption Y)) :=
sorry

lemma definable_Ioo [DUNLO R] [is_definable_le S R] :
  definable S (set.Ioo : R → R → set R) :=
sorry

lemma definable_interval_above [DUNLO R] [is_definable_le S R] :
  definable S (λ (X : set R) a, {b | a < b ∧ set.Ioo a b ⊆ X}) :=
sorry

lemma definable_chosen_one [OQM R] : definable S (@chosen_one R _) :=
sorry -- test case once we have a working tactic mode

end o_minimal


/-
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.basic
import deprecated.submonoid

/-!
# Unbundled subgroups (deprecated)

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

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines unbundled multiplicative and additive subgroups. Instead of using this file,
please use `subgroup G` and `add_subgroup A`, defined in `group_theory.subgroup.basic`.

## Main definitions

`is_add_subgroup (S : set A)` : the predicate that `S` is the underlying subset of an additive
subgroup of `A`. The bundled variant `add_subgroup A` should be used in preference to this.

`is_subgroup (S : set G)` : the predicate that `S` is the underlying subset of a subgroup
of `G`. The bundled variant `subgroup G` should be used in preference to this.

## Tags

subgroup, subgroups, is_subgroup
-/
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. -/
structure 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]
structure 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} (hs : is_subgroup s) {x y : G} (hx : x ∈ s) (hy : y ∈ s) :
  x / y ∈ s :=
by simpa only [div_eq_mul_inv] using hs.mul_mem hx (hs.inv_mem hy)

lemma additive.is_add_subgroup
  {s : set G} (hs : is_subgroup s) : @is_add_subgroup (additive G) _ s :=
@is_add_subgroup.mk (additive G) _ _ (additive.is_add_submonoid hs.to_is_submonoid) $
  λ _, hs.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 h⟩

lemma multiplicative.is_subgroup
  {s : set A} (hs : is_add_subgroup s) : @is_subgroup (multiplicative A) _ s :=
@is_subgroup.mk (multiplicative A) _ _ (multiplicative.is_submonoid hs.to_is_add_submonoid) $
  λ _, hs.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 h⟩

@[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]
lemma is_subgroup.inter {s₁ s₂ : set G} (hs₁ : is_subgroup s₁) (hs₂ : is_subgroup s₂) :
  is_subgroup (s₁ ∩ s₂) :=
{ inv_mem := λ x hx, ⟨hs₁.inv_mem hx.1, hs₂.inv_mem hx.2⟩,
  ..is_submonoid.inter hs₁.to_is_submonoid hs₂.to_is_submonoid}

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

@[to_additive]
lemma is_subgroup_Union_of_directed {ι : Type*} [hι : nonempty ι]
  {s : ι → set G} (hs : ∀ 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, (hs i).inv_mem hi⟩,
  to_is_submonoid := is_submonoid_Union_of_directed (λ i, (hs i).to_is_submonoid) directed }

end group

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

include hs

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

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

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

end is_subgroup

/-- `is_normal_add_subgroup (s : set A)` expresses the fact that `s` is a normal additive subgroup
of the additive group `A`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : add_subgroup A` and `hs : S.normal`, and not via this structure. -/
structure is_normal_add_subgroup [add_group A] (s : set A) extends is_add_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : A, g + n + -g ∈ s)

/-- `is_normal_subgroup (s : set G)` expresses the fact that `s` is a normal subgroup
of the group `G`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : subgroup G` and not via this structure. -/
@[to_additive]
structure is_normal_subgroup [group G] (s : set G) extends is_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : G, g * n * g⁻¹ ∈ s)

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

lemma additive.is_normal_add_subgroup [group G]
  {s : set G} (hs : is_normal_subgroup s) : @is_normal_add_subgroup (additive G) _ s :=
@is_normal_add_subgroup.mk (additive G) _ _
  (additive.is_add_subgroup hs.to_is_subgroup)
  (is_normal_subgroup.normal hs)

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

lemma multiplicative.is_normal_subgroup [add_group A]
  {s : set A} (hs : is_normal_add_subgroup s) : @is_normal_subgroup (multiplicative A) _ s :=
@is_normal_subgroup.mk (multiplicative A) _ _
  (multiplicative.is_subgroup hs.to_is_add_subgroup)
  (is_normal_add_subgroup.normal hs)

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

namespace is_subgroup
variable [group G]

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

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

/-- The trivial subgroup -/
@[to_additive "the trivial additive subgroup"]
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]
lemma trivial_normal : is_normal_subgroup (trivial G) :=
by refine {..}; simp [trivial] {contextual := tt}

@[to_additive]
lemma eq_trivial_iff {s : set G} (hs : 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 ▸ hs.to_is_submonoid.one_mem⟩⟩

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

/-- The underlying set of the center of a group. -/
@[to_additive add_center "The underlying set of the center of an additive group."]
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]
lemma center_normal : is_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] }

/-- The underlying set of the normalizer of a subset `S : set G` of a group `G`. That is,
  the elements `g : G` such that `g * S * g⁻¹ = S`. -/
@[to_additive add_normalizer "The underlying set of the normalizer of a subset `S : set A` of an
  additive group `A`. That is, the elements `a : A` such that `a + S - a = S`."]
def normalizer (s : set G) : set G :=
{g : G | ∀ n, n ∈ s ↔ g * n * g⁻¹ ∈ s}

@[to_additive]
lemma 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} (hs : is_subgroup s) : s ⊆ normalizer s :=
λ g hg n, by rw [is_subgroup.mul_mem_cancel_right hs ((is_subgroup.inv_mem_iff hs).2 hg),
  is_subgroup.mul_mem_cancel_left hs hg]

end is_subgroup

-- Homomorphism subgroups
namespace is_group_hom
open is_submonoid is_subgroup

/-- `ker f : set G` is the underlying subset of the kernel of a map `G → H`. -/
@[to_additive "`ker f : set A` is the underlying subset of the kernel of a map `A → B`"]
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} (hf : is_group_hom f) {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
begin
  rw [hf.map_mul, hf.map_inv] at h,
  rw [←inv_inv (f b), eq_inv_of_mul_eq_one_left h]
end

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

@[to_additive]
lemma inv_ker_one {f : G → H} (hf : 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 [←hf.map_inv, ←hf.map_mul] at this

@[to_additive]
lemma inv_ker_one' {f : G → H} (hf : 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 [←hf.map_inv, ←hf.map_mul] at this

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

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

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

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

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

@[to_additive]
lemma range_subgroup {f : G → H} (hf : is_group_hom f) : is_subgroup (set.range f) :=
@set.image_univ _ _ f ▸ hf.image_subgroup univ_subgroup.to_is_subgroup

local attribute [simp] one_mem inv_mem mul_mem is_normal_subgroup.normal

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

@[to_additive]
lemma preimage_normal {f : G → H} (hf : is_group_hom f) {s : set H} (hs : is_normal_subgroup s) :
  is_normal_subgroup (f ⁻¹' s) :=
{ one_mem := by simp [hf.map_one, hs.to_is_subgroup.one_mem],
  mul_mem := by simp [hf.map_mul, hs.to_is_subgroup.mul_mem] {contextual := tt},
  inv_mem := by simp [hf.map_inv, hs.to_is_subgroup.inv_mem] {contextual := tt},
  normal := by simp [hs.normal, hf.map_mul, hf.map_inv] {contextual := tt}}

@[to_additive]
lemma is_normal_subgroup_ker {f : G → H} (hf : is_group_hom f) : is_normal_subgroup (ker f) :=
hf.preimage_normal (trivial_normal)

@[to_additive]
lemma injective_of_trivial_ker {f : G → H} (hf : 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 hf.inv_ker_one hfa,
  rw [eq_inv_of_mul_eq_one_left ha, inv_inv a₂]
end

@[to_additive]
lemma trivial_ker_of_injective {f : G → H} (hf : 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 [hf.map_one]; rwa [mem_ker] at hx)
  (by simp [mem_ker, hf.map_one] {contextual := tt})

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

@[to_additive]
lemma trivial_ker_iff_eq_one {f : G → H} (hf : 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, hf.map_one]⟩⟩

end is_group_hom

namespace add_group

variables [add_group A]

/-- If `A` is an additive group and `s : set A`, then `in_closure s : set A` is the underlying
subset of the subgroup generated by `s`. -/
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}

/-- If `G` is a group and `s : set G`, then `in_closure s : set G` is the underlying
subset of the subgroup generated by `s`. -/
@[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 generated by `s`, i.e. the smallest subgroup containg `s`. -/
@[to_additive "`add_group.closure s` is the additive subgroup generated by `s`, i.e., the
  smallest additive subgroup containing `s`."]
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]
lemma 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} (ht : is_subgroup t) (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, ht.one_mem, ht.mul_mem, is_subgroup.inv_mem_iff]

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

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

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

@[to_additive]

@[to_additive]
lemma image_closure [group H] {f : G → H} (hf : 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 [hf.to_is_monoid_hom.map_one],
      apply is_submonoid.one_mem (closure.is_subgroup _).to_is_submonoid, },
    { rw [hf.map_inv],
      apply is_subgroup.inv_mem (closure.is_subgroup _), assumption },
    { rw [hf.to_is_monoid_hom.map_mul],
      solve_by_elim [is_submonoid.mul_mem (closure.is_subgroup _).to_is_submonoid] }
  end
  (closure_subset (hf.image_subgroup $ closure.is_subgroup _) $ set.image_subset _ subset_closure)

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

@[to_additive]
theorem mclosure_inv_subset {s : set G} : monoid.closure (has_inv.inv ⁻¹' s) ⊆ closure s :=
monoid.closure_subset (closure.is_subgroup _).to_is_submonoid $ λ x hx,
  inv_inv x ▸ ((closure.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))
    { one_mem := (monoid.closure.is_submonoid _).one_mem,
      mul_mem := λ _ _, (monoid.closure.is_submonoid _).mul_mem,
      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))
      ((@inv_one G _).symm ▸ is_submonoid.one_mem (monoid.closure.is_submonoid _))
      (λ x y hx hy ihx ihy,
        (mul_inv_rev x y).symm ▸ is_submonoid.mul_mem (monoid.closure.is_submonoid _) ihy ihx) }
    (set.subset.trans (set.subset_union_left _ _) monoid.subset_closure))
  (monoid.closure_subset (closure.is_subgroup _).to_is_submonoid $ set.union_subset subset_closure $
    λ x hx, inv_inv x ▸ (is_subgroup.inv_mem (closure.is_subgroup _) $ 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

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, (group.closure.is_subgroup _).one_mem])
  (group.closure_subset (trivial_normal).to_is_subgroup $ 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} (ht : is_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 := is_normal_subgroup.normal ht a h c,
  rwa ←w,
end

theorem conjugates_of_set_subset' {s t : set G} (ht : is_normal_subgroup t) (h : s ⊆ t) :
  conjugates_of_set s ⊆ t :=
set.Union₂_subset (λ x H, conjugates_of_subset ht (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. -/
lemma 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. -/
lemma normal_closure.is_normal : is_normal_subgroup (normal_closure s) :=
{ normal := λ 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 ((normal_closure.is_subgroup _).inv_mem ihx)},
  {rw ←conj_mul,
   exact ((normal_closure.is_subgroup _).to_is_submonoid.mul_mem ihx ihy)},
end,
..normal_closure.is_subgroup _ }

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normal_closure_subset {s t : set G} (ht : is_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' ht h $ hx)},
  {exact ht.to_is_subgroup.to_is_submonoid.one_mem},
  {exact ht.to_is_subgroup.inv_mem ihx},
  {exact ht.to_is_subgroup.to_is_submonoid.mul_mem ihx ihy}
end

lemma normal_closure_subset_iff {s t : set G} (ht : is_normal_subgroup t) :
  s ⊆ t ↔ normal_closure s ⊆ t :=
⟨normal_closure_subset ht, 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 normal_closure.is_normal (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]
lemma 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' }

-- this will never fire if it's an instance
@[to_additive]
lemma subgroup.of_normal [group G] (s : set G) (h : is_subgroup s) (n : is_normal_subgroup s) :
  subgroup.normal (subgroup.of h) :=
{ conj_mem := n.normal, }


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
let S : set ℝ := {x : ℝ | ∃ i : ℤ, x = i * α} in
∀ y : ℝ, y ∈ S → ∀ ε > 0, ∃ x : ℝ, x ∈ S ∧ |x - y| < ε :=
begin
  assume S,
  assume hS : ∀ y : ℝ, y ∈ S → ∀ ε > 0, ∃ x : ℝ, x ∈ S ∧ |x - y| < ε,
  assume y,
  assume h1 : y ∈ S,
  assume ε,
  assume h2 : ε > 0,
  have h3 : ∃ i : ℤ, y = i * α, from sorry,
  cases h3 with i h4,
  have h5 : ∃ x : ℝ, x ∈ S ∧ |x - y| < ε, from sorry,
  cases h5 with x h6,
  use x,
  show x ∈ S ∧ |x - y| < ε, from sorry,
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
let S : set ℝ := {x : ℝ | ∃ i : ℤ, x = i * α} in
let S' : set ℝ := {x : ℝ | ∃ i : ℤ, x = i * α % 1} in
∀ y : ℝ, y ∈ set.Icc 0 1 → ∃ x : ℝ, x ∈ S' ∧ abs (x - y) < 1 :=
begin
  assume S S' (y : ℝ) (h1 : y ∈ set.Icc 0 1),
  have h2 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → (i * α) ≠ (j * α), from sorry,
  have h4 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α), from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → (i * α) ≠ (j * α % 1), from sorry,
  have h6 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h7 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h8 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h9 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h10 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h11 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h12 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h13 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h14 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h15 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h16 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h17 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h18 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h19 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h20 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h21 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h22 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h23 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h24 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h25 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h26 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h27 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h28 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h29 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h30 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h31 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h32 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h33 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h34 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h35 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h36 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h37 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h38 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h39 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h40 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h41 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h42 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h43 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h44 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h45 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h46 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h47 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h48 : ∀ i j : ℤ, i ≠ j → (i * α % 1) ≠ (j * α % 1), from sorry,
  have h49 : ∀ i j
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∃ N : ℤ, |y - (N : ℝ) * x| < 1 :=
begin
  assume y h1,
  let S := {x : ℝ | ∃ N : ℤ, x = (N : ℝ) * α},
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h4 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h6 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h7 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h8 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h9 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h10 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h11 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h12 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h13 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h14 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h15 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h16 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h17 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h18 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h19 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h20 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h21 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h22 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h23 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h24 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h25 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h26 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h27 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h28 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h29 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h30 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h31 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h32 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h33 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from sorry,

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,
  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := sorry,
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from sorry,

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from sorry,

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from sorry,
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.adjunction.basic
import category_theory.conj
import category_theory.yoneda

/-!
# Adjoints of fully faithful functors

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

A left adjoint is fully faithful, if and only if the unit is an isomorphism
(and similarly for right adjoints and the counit).

`adjunction.restrict_fully_faithful` shows that an adjunction can be restricted along fully faithful
inclusions.

## Future work

The statements from Riehl 4.5.13 for adjoints which are either full, or faithful.
-/

open category_theory

namespace category_theory
universes v₁ v₂ u₁ u₂

open category
open opposite

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D]
variables {L : C ⥤ D} {R : D ⥤ C} (h : L ⊣ R)

/--
If the left adjoint is fully faithful, then the unit is an isomorphism.

See
* Lemma 4.5.13 from [Riehl][riehl2017]
* https://math.stackexchange.com/a/2727177
* https://stacks.math.columbia.edu/tag/07RB (we only prove the forward direction!)
-/
instance unit_is_iso_of_L_fully_faithful [full L] [faithful L] : is_iso (adjunction.unit h) :=
@nat_iso.is_iso_of_is_iso_app _ _ _ _ _ _ (adjunction.unit h) $ λ X,
@yoneda.is_iso _ _ _ _ ((adjunction.unit h).app X)
⟨⟨{ app := λ Y f, L.preimage ((h.hom_equiv (unop Y) (L.obj X)).symm f) },
  ⟨begin
    ext x f, dsimp,
    apply L.map_injective,
    simp,
  end, begin
    ext x f, dsimp,
    simp only [adjunction.hom_equiv_counit, preimage_comp, preimage_map, category.assoc],
    rw ←h.unit_naturality,
    simp,
  end⟩⟩⟩

/--
If the right adjoint is fully faithful, then the counit is an isomorphism.

See <https://stacks.math.columbia.edu/tag/07RB> (we only prove the forward direction!)
-/
instance counit_is_iso_of_R_fully_faithful [full R] [faithful R] : is_iso (adjunction.counit h) :=
@nat_iso.is_iso_of_is_iso_app _ _ _ _ _ _ (adjunction.counit h) $ λ X,
@is_iso_of_op _ _ _ _ _ $
@coyoneda.is_iso _ _ _ _ ((adjunction.counit h).app X).op
⟨⟨{ app := λ Y f, R.preimage ((h.hom_equiv (R.obj X) Y) f) },
  ⟨begin
    ext x f, dsimp,
    apply R.map_injective,
    simp,
  end, begin
    ext x f, dsimp,
    simp only [adjunction.hom_equiv_unit, preimage_comp, preimage_map],
    rw ←h.counit_naturality,
    simp,
  end⟩⟩⟩

/-- If the unit of an adjunction is an isomorphism, then its inverse on the image of L is given
by L whiskered with the counit. -/
@[simp]
lemma inv_map_unit {X : C} [is_iso (h.unit.app X)] :
  inv (L.map (h.unit.app X)) = h.counit.app (L.obj X) :=
is_iso.inv_eq_of_hom_inv_id h.left_triangle_components

/-- If the unit is an isomorphism, bundle one has an isomorphism `L ⋙ R ⋙ L ≅ L`. -/
@[simps]
noncomputable def whisker_left_L_counit_iso_of_is_iso_unit [is_iso h.unit] :
  L ⋙ R ⋙ L ≅ L :=
(L.associator R L).symm ≪≫ iso_whisker_right (as_iso h.unit).symm L ≪≫ functor.left_unitor _

/-- If the counit of an adjunction is an isomorphism, then its inverse on the image of R is given
by R whiskered with the unit. -/
@[simp]
lemma inv_counit_map {X : D} [is_iso (h.counit.app X)] :
  inv (R.map (h.counit.app X)) = h.unit.app (R.obj X) :=
is_iso.inv_eq_of_inv_hom_id h.right_triangle_components

/-- If the counit of an is an isomorphism, one has an isomorphism `(R ⋙ L ⋙ R) ≅ R`. -/
@[simps]
noncomputable def whisker_left_R_unit_iso_of_is_iso_counit [is_iso h.counit] :
  (R ⋙ L ⋙ R) ≅ R :=
(R.associator L R).symm ≪≫ iso_whisker_right (as_iso h.counit) R ≪≫ functor.left_unitor _

/-- If the unit is an isomorphism, then the left adjoint is full-/
noncomputable
def L_full_of_unit_is_iso [is_iso h.unit] : full L :=
{ preimage := λ X Y f, (h.hom_equiv X (L.obj Y) f) ≫ inv (h.unit.app Y) }

/-- If the unit is an isomorphism, then the left adjoint is faithful-/
lemma L_faithful_of_unit_is_iso [is_iso h.unit] : faithful L :=
{ map_injective' := λ X Y f g H,
  begin
    rw ←(h.hom_equiv X (L.obj Y)).apply_eq_iff_eq at H,
    simpa using H =≫ inv (h.unit.app Y),
  end }

/-- If the counit is an isomorphism, then the right adjoint is full-/
noncomputable
def R_full_of_counit_is_iso [is_iso h.counit] : full R :=
{ preimage := λ X Y f, inv (h.counit.app X) ≫ (h.hom_equiv (R.obj X) Y).symm f }

/-- If the counit is an isomorphism, then the right adjoint is faithful-/
lemma R_faithful_of_counit_is_iso [is_iso h.counit] : faithful R :=
{ map_injective' := λ X Y f g H,
  begin
    rw ←(h.hom_equiv (R.obj X) Y).symm.apply_eq_iff_eq at H,
    simpa using inv (h.counit.app X) ≫= H,
  end }

instance whisker_left_counit_iso_of_L_fully_faithful
  [full L] [faithful L] : is_iso (whisker_left L h.counit) :=
begin
  have := h.left_triangle,
  rw ←is_iso.eq_inv_comp at this,
  rw this,
  apply_instance
end

instance whisker_right_counit_iso_of_L_fully_faithful
  [full L] [faithful L] : is_iso (whisker_right h.counit R) :=
begin
  have := h.right_triangle,
  rw ←is_iso.eq_inv_comp at this,
  rw this,
  apply_instance
end

instance whisker_left_unit_iso_of_R_fully_faithful
  [full R] [faithful R] : is_iso (whisker_left R h.unit) :=
begin
  have := h.right_triangle,
  rw ←is_iso.eq_comp_inv at this,
  rw this,
  apply_instance
end

instance whisker_right_unit_iso_of_R_fully_faithful
  [full R] [faithful R] : is_iso (whisker_right h.unit L) :=
begin
  have := h.left_triangle,
  rw ←is_iso.eq_comp_inv at this,
  rw this,
  apply_instance
end

-- TODO also do the statements from Riehl 4.5.13 for full and faithful separately?

universes v₃ v₄ u₃ u₄

variables {C' : Type u₃} [category.{v₃} C']
variables {D' : Type u₄} [category.{v₄} D']

-- TODO: This needs some lemmas describing the produced adjunction, probably in terms of `adj`,
-- `iC` and `iD`.
/--
If `C` is a full subcategory of `C'` and `D` is a full subcategory of `D'`, then we can restrict
an adjunction `L' ⊣ R'` where `L' : C' ⥤ D'` and `R' : D' ⥤ C'` to `C` and `D`.
The construction here is slightly more general, in that `C` is required only to have a full and
faithful "inclusion" functor `iC : C ⥤ C'` (and similarly `iD : D ⥤ D'`) which commute (up to
natural isomorphism) with the proposed restrictions.
-/
def adjunction.restrict_fully_faithful (iC : C ⥤ C') (iD : D ⥤ D') {L' : C' ⥤ D'} {R' : D' ⥤ C'}
  (adj : L' ⊣ R') {L : C ⥤ D} {R : D ⥤ C} (comm1 : iC ⋙ L' ≅ L ⋙ iD) (comm2 : iD ⋙ R' ≅ R ⋙ iC)
  [full iC] [faithful iC] [full iD] [faithful iD] :
  L ⊣ R :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  calc (L.obj X ⟶ Y) ≃ (iD.obj (L.obj X) ⟶ iD.obj Y) : equiv_of_fully_faithful iD
       ... ≃ (L'.obj (iC.obj X) ⟶ iD.obj Y) : iso.hom_congr (comm1.symm.app X) (iso.refl _)
       ... ≃ (iC.obj X ⟶ R'.obj (iD.obj Y)) : adj.hom_equiv _ _
       ... ≃ (iC.obj X ⟶ iC.obj (R.obj Y)) : iso.hom_congr (iso.refl _) (comm2.app Y)
       ... ≃ (X ⟶ R.obj Y) : (equiv_of_fully_faithful iC).symm,
  hom_equiv_naturality_left_symm' := λ X' X Y f g,
  begin
    apply iD.map_injective,
    simpa using (comm1.inv.naturality_assoc f _).symm,
  end,
  hom_equiv_naturality_right' := λ X Y' Y f g,
  begin
    apply iC.map_injective,
    suffices : R'.map (iD.map g) ≫ comm2.hom.app Y = comm2.hom.app Y' ≫ iC.map (R.map g),
      simp [this],
    apply comm2.hom.naturality g,
  end }

end category_theory


import condensed.is_proetale_sheaf
import condensed.top_comparison
import condensed.adjunctions

/-!
We show that passing from a profinite set to a condensed set
preserves (finite) coproducts.
-/

open_locale big_operators classical
open category_theory
open category_theory.limits
open opposite

universe u

namespace Profinite

@[simps]
def to_Condensed_equiv (X : Profinite.{u}) (Y : CondensedSet.{u}) :
  (X.to_Condensed ⟶ Y) ≃ Y.val.obj (op X) :=
{ to_fun := λ f, f.val.app _ $ ulift.up $ 𝟙 _,
  inv_fun := λ f, Sheaf.hom.mk $
  { app := λ T g, Y.val.map (quiver.hom.op (ulift.down g)) f,
    naturality' := begin
      intros A B ff, ext t,
      obtain ⟨t⟩ := t,
      dsimp [Profinite.to_Condensed, ulift_functor, yoneda] at ⊢ t,
      simp only [functor.map_comp], refl,
    end },
  left_inv := λ f, begin
    ext T ⟨t⟩,
    dsimp [yoneda] at ⊢ t,
    change (f.val.app _ ≫ Y.val.map _) _ = _,
    rw ← nat_trans.naturality,
    change f.val.app _ _ = _,
    congr' 1, ext, refl,
  end,
  right_inv := λ f, by { dsimp, simp } }

end Profinite

namespace CondensedSet

variables {α : Type u} [fintype α] (X : α → Profinite.{u})

@[simps]
def sigma_cone : cocone (discrete.functor X ⋙ Profinite_to_Condensed) :=
{ X := (Profinite.sigma X).to_Condensed,
  ι :=
  { app := λ i, Profinite_to_Condensed.map $ Profinite.sigma.ι X i.1,
    naturality' := begin
      rintros ⟨i⟩ ⟨j⟩ ⟨⟨⟨⟩⟩⟩, dsimp, simp, dsimp, simp, dsimp, simp,
    end } } .

noncomputable
def val_obj_sigma_equiv (Y : CondensedSet.{u}) :
  Y.val.obj (op $ Profinite.sigma X) ≃ (Π (a : α), Y.val.obj (op $ X a)) :=
equiv.of_bijective
(λ f a, Y.val.map (Profinite.sigma.ι X a).op f)
begin
  have := Y.2,
  rw is_sheaf_iff_is_sheaf_of_type at this,
  rw Y.val.is_proetale_sheaf_of_types_tfae.out 0 4 at this,
  have key := this.1,
  exact key ⟨α⟩ X,
end

noncomputable
def _root_.Condensed.val_obj_sigma_add_equiv
  (Y : Condensed.{u} Ab.{u+1}) :
  Y.val.obj (op $ Profinite.sigma X) ≃+
  (Π (a : α), Y.val.obj (op $ X a)) :=
add_equiv.of_bijective
(add_monoid_hom.mk' (λ f a, Y.val.map (Profinite.sigma.ι X a).op f) (by { intros, ext1, simp }))
((Condensed_Ab_to_CondensedSet.obj Y).val_obj_sigma_equiv X).bijective

@[simp]
lemma coe_val_obj_sigma_equiv (Y : Condensed.{u} Ab.{u+1}) :
  ⇑((Condensed_Ab_to_CondensedSet.obj Y).val_obj_sigma_equiv X) =
  (Y.val_obj_sigma_add_equiv X) := rfl

@[simp]
lemma coe_val_obj_sigma_equiv_symm (Y : Condensed.{u} Ab.{u+1}) :
  ⇑((Condensed_Ab_to_CondensedSet.obj Y).val_obj_sigma_equiv X).symm =
  (Y.val_obj_sigma_add_equiv X).symm := rfl

@[simp]
lemma _root_.Condensed.val_obj_sigma_add_equiv_apply_apply
  (Y : Condensed.{u} Ab.{u+1}) (t) (a) :
  Y.val_obj_sigma_add_equiv X t a = Y.val.map (Profinite.sigma.ι X a).op t := rfl

lemma val_obj_sigma_equiv_symm_apply'
  (Y : CondensedSet.{u})
  (e : Π (a : α), Y.val.obj (op $ X a)) (a₀ : α) :
  (Y.val.map (Profinite.sigma.ι X a₀).op)
  (((val_obj_sigma_equiv X Y).symm) e) = e a₀ :=
begin
  let e' := _, change (Y.val.map (Profinite.sigma.ι X a₀).op) e' = _,
  have : e a₀ = (val_obj_sigma_equiv X Y) e' a₀,
    { revert a₀, rw ← function.funext_iff, dsimp only [e'], simp },
  rw this, refl,
end

-- TODO reuse the nonadditive variant for this.
lemma _root_.Condensed.val_obj_sigma_add_equiv_symm_apply'
  (Y : Condensed.{u} Ab.{u+1})
  (e : Π (a : α), Y.val.obj (op $ X a)) (a₀ : α) :
  (Y.val.map (Profinite.sigma.ι X a₀).op)
  (((_root_.Condensed.val_obj_sigma_add_equiv X Y).symm) e) = e a₀ :=
begin
  let e' := _, change (Y.val.map (Profinite.sigma.ι X a₀).op) e' = _,
  have : e a₀ = (_root_.Condensed.val_obj_sigma_add_equiv X Y) e' a₀,
    { revert a₀, rw ← function.funext_iff, dsimp only [e'], simp },
  rw this, refl,
end

lemma val_obj_sigma_equiv_symm_apply
  (Y : CondensedSet.{u})
  (e : Π (a : α), Y.val.obj (op $ X a)) (a₀ : α) :
    (Profinite_to_Condensed.map (Profinite.sigma.ι X a₀)) ≫
    (Profinite.to_Condensed_equiv (Profinite.sigma X) Y).symm
    ((Y.val_obj_sigma_equiv X).symm e) =
    (Profinite.to_Condensed_equiv (X a₀) Y).symm (e a₀) :=
begin
  apply_fun ((X a₀).to_Condensed_equiv Y),
  simp only [equiv.apply_symm_apply],
  dsimp [Profinite.to_Condensed_equiv],
  simp only [category.comp_id],
  apply val_obj_sigma_equiv_symm_apply'
end

-- TODO reuse the nonadditive variant for this.
lemma _root_.Condensed.val_obj_sigma_add_equiv_symm_apply
  (Y : Condensed.{u} Ab.{u+1})
  (e : Π (a : α), Y.val.obj (op $ X a)) (a₀ : α) :
    (Profinite_to_Condensed.map (Profinite.sigma.ι X a₀)) ≫
    (Profinite.to_Condensed_equiv (Profinite.sigma X)
    (Condensed_Ab_to_CondensedSet.obj Y)).symm
    ((Y.val_obj_sigma_add_equiv X).symm e) =
    (Profinite.to_Condensed_equiv (X a₀)
    (Condensed_Ab_to_CondensedSet.obj Y)).symm (e a₀) :=
begin
  apply_fun ((X a₀).to_Condensed_equiv (Condensed_Ab_to_CondensedSet.obj Y)),
  simp only [equiv.apply_symm_apply],
  dsimp [Profinite.to_Condensed_equiv],
  simp only [category.comp_id],
  apply _root_.Condensed.val_obj_sigma_add_equiv_symm_apply'
end

noncomputable
def is_colimit_sigma_cone : is_colimit (sigma_cone X) :=
{ desc := λ S, (Profinite.to_Condensed_equiv _ _).symm $
    (S.X.val_obj_sigma_equiv X).symm $ λ a,
    (Profinite.to_Condensed_equiv _ _) $ S.ι.app ⟨_⟩,
  fac' := begin
    rintros Q ⟨T⟩,
    dsimp,
    rw val_obj_sigma_equiv_symm_apply,
    ext W ⟨(t : _ ⟶ _)⟩,
    dsimp [Profinite.to_Condensed_equiv],
    change ((Q.ι.app ⟨T⟩).val.app (op (X T)) ≫ Q.X.val.map t.op) _ = _,
    erw ← (Q.ι.app ⟨T⟩).val.naturality,
    change (Q.ι.app ⟨T⟩).val.app (op (unop W)) _ = _,
    congr' 1,
    dsimp [Profinite.to_Condensed], ext, refl,
  end,
  uniq' := begin
    intros S m hm,
    apply_fun ((Profinite.sigma X).to_Condensed_equiv S.X),
    apply_fun (val_obj_sigma_equiv X S.X),
    simp only [equiv.apply_symm_apply],
    ext a,
    specialize hm ⟨a⟩,
    dsimp [val_obj_sigma_equiv],
    change (m.val.app (op (Profinite.sigma X)) ≫
      S.X.val.map _) _ = _,
    rw ← m.val.naturality,
    apply_fun (λ e, e.val.app (op (X a)) ⟨𝟙 _⟩) at hm,
    exact hm,
  end }

end CondensedSet


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.discrete
import Mathlib.category_theory.monoidal.unitors
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.algebra.punit_instances
import Mathlib.PostPort

universes v₁ u₁ l u₂ v₂ u_1 u_2

namespace Mathlib

/-!
# The category of monoids in a monoidal category.
-/

/--
A monoid object internal to a monoidal category.

When the monoidal category is preadditive, this is also sometimes called an "algebra object".
-/
structure Mon_ (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C]
where
  X : C
  one : 𝟙_ ⟶ X
  mul : X ⊗ X ⟶ X
  one_mul' : autoParam ((one ⊗ 𝟙) ≫ mul = category_theory.iso.hom λ_)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_one' : autoParam ((𝟙 ⊗ one) ≫ mul = category_theory.iso.hom ρ_)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_assoc' : autoParam ((mul ⊗ 𝟙) ≫ mul = category_theory.iso.hom α_ ≫ (𝟙 ⊗ mul) ≫ mul)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- Obviously there is some flexibility stating this axiom.

-- This one has left- and right-hand sides matching the statement of `monoid.mul_assoc`,

-- and chooses to place the associator on the right-hand side.

-- The heuristic is that unitors and associators "don't have much weight".

theorem Mon_.one_mul {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (c : Mon_ C) : (Mon_.one c ⊗ 𝟙) ≫ Mon_.mul c = category_theory.iso.hom λ_ := sorry

theorem Mon_.mul_one {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (c : Mon_ C) : (𝟙 ⊗ Mon_.one c) ≫ Mon_.mul c = category_theory.iso.hom ρ_ := sorry

@[simp] theorem Mon_.mul_assoc {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (c : Mon_ C) : (Mon_.mul c ⊗ 𝟙) ≫ Mon_.mul c = category_theory.iso.hom α_ ≫ (𝟙 ⊗ Mon_.mul c) ≫ Mon_.mul c := sorry

theorem Mon_.one_mul_assoc {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (c : Mon_ C) {X' : C} (f' : Mon_.X c ⟶ X') : (Mon_.one c ⊗ 𝟙) ≫ Mon_.mul c ≫ f' = category_theory.iso.hom λ_ ≫ f' := sorry

@[simp] theorem Mon_.mul_assoc_assoc {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (c : Mon_ C) {X' : C} (f' : Mon_.X c ⟶ X') : (Mon_.mul c ⊗ 𝟙) ≫ Mon_.mul c ≫ f' = category_theory.iso.hom α_ ≫ (𝟙 ⊗ Mon_.mul c) ≫ Mon_.mul c ≫ f' := sorry

namespace Mon_

/--
The trivial monoid object. We later show this is initial in `Mon_ C`.
-/
@[simp] theorem trivial_one (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] : one (trivial C) = 𝟙 :=
  Eq.refl (one (trivial C))

protected instance inhabited (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] : Inhabited (Mon_ C) :=
  { default := trivial C }

@[simp] theorem one_mul_hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {Z : C} (f : Z ⟶ X M) : (one M ⊗ f) ≫ mul M = category_theory.iso.hom λ_ ≫ f := sorry

@[simp] theorem mul_one_hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {Z : C} (f : Z ⟶ X M) : (f ⊗ one M) ≫ mul M = category_theory.iso.hom ρ_ ≫ f := sorry

theorem assoc_flip {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} : (𝟙 ⊗ mul M) ≫ mul M = category_theory.iso.inv α_ ≫ (mul M ⊗ 𝟙) ≫ mul M := sorry

/-- A morphism of monoid objects. -/
structure hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (M : Mon_ C) (N : Mon_ C)
where
  hom : X M ⟶ X N
  one_hom' : autoParam (one M ≫ hom = one N)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  mul_hom' : autoParam (mul M ≫ hom = (hom ⊗ hom) ≫ mul N)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.one_hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) : one M ≫ hom.hom c = one N := sorry

@[simp] theorem hom.mul_hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) : mul M ≫ hom.hom c = (hom.hom c ⊗ hom.hom c) ≫ mul N := sorry

@[simp] theorem hom.mul_hom_assoc {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} (c : hom M N) {X' : C} (f' : X N ⟶ X') : mul M ≫ hom.hom c ≫ f' = (hom.hom c ⊗ hom.hom c) ≫ mul N ≫ f' := sorry

/-- The identity morphism on a monoid object. -/
def id {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (M : Mon_ C) : hom M M :=
  hom.mk 𝟙

protected instance hom_inhabited {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (M : Mon_ C) : Inhabited (hom M M) :=
  { default := id M }

/-- Composition of morphisms of monoid objects. -/
@[simp] theorem comp_hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} {O : Mon_ C} (f : hom M N) (g : hom N O) : hom.hom (comp f g) = hom.hom f ≫ hom.hom g :=
  Eq.refl (hom.hom (comp f g))

protected instance category_theory.category {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] : category_theory.category (Mon_ C) :=
  category_theory.category.mk

@[simp] theorem id_hom' {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (M : Mon_ C) : hom.hom 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_hom' {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {M : Mon_ C} {N : Mon_ C} {K : Mon_ C} (f : M ⟶ N) (g : N ⟶ K) : hom.hom (f ≫ g) = hom.hom f ≫ hom.hom g :=
  rfl

/-- The forgetful functor from monoid objects to the ambient category. -/
@[simp] theorem forget_map (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] (A : Mon_ C) (B : Mon_ C) (f : A ⟶ B) : category_theory.functor.map (forget C) f = hom.hom f :=
  Eq.refl (category_theory.functor.map (forget C) f)

protected instance forget_faithful {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] : category_theory.faithful (forget C) :=
  category_theory.faithful.mk

protected instance category_theory.has_hom.hom.hom.category_theory.is_iso {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {A : Mon_ C} {B : Mon_ C} (f : A ⟶ B) [e : category_theory.is_iso (category_theory.functor.map (forget C) f)] : category_theory.is_iso (hom.hom f) :=
  e

/-- The forgetful functor from monoid objects to the ambient category reflects isomorphisms. -/
protected instance forget.category_theory.reflects_isomorphisms {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] : category_theory.reflects_isomorphisms (forget C) :=
  category_theory.reflects_isomorphisms.mk
    fun (X Y : Mon_ C) (f : X ⟶ Y) (e : category_theory.is_iso (category_theory.functor.map (forget C) f)) =>
      category_theory.is_iso.mk (hom.mk (inv (hom.hom f)))

protected instance unique_hom_from_trivial {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] (A : Mon_ C) : unique (trivial C ⟶ A) :=
  unique.mk { default := hom.mk (one A) } sorry

protected instance category_theory.limits.has_initial {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] : category_theory.limits.has_initial (Mon_ C) :=
  category_theory.limits.has_initial_of_unique (trivial C)

end Mon_

namespace category_theory.lax_monoidal_functor

/--
A lax monoidal functor takes monoid objects to monoid objects.

That is, a lax monoidal functor `F : C ⥤ D` induces a functor `Mon_ C ⥤ Mon_ D`.
-/
-- TODO: map_Mod F A : Mod A ⥤ Mod (F.map_Mon A)

@[simp] theorem map_Mon_obj_X {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) (A : Mon_ C) : Mon_.X (functor.obj (map_Mon F) A) = functor.obj (to_functor F) (Mon_.X A) :=
  Eq.refl (Mon_.X (functor.obj (map_Mon F) A))

/-- `map_Mon` is functorial in the lax monoidal functor. -/
def map_Mon_functor (C : Type u₁) [category C] [monoidal_category C] (D : Type u₂) [category D] [monoidal_category D] : lax_monoidal_functor C D ⥤ Mon_ C ⥤ Mon_ D :=
  functor.mk map_Mon
    fun (F G : lax_monoidal_functor C D) (α : F ⟶ G) =>
      nat_trans.mk fun (A : Mon_ C) => Mon_.hom.mk (nat_trans.app (monoidal_nat_trans.to_nat_trans α) (Mon_.X A))

end category_theory.lax_monoidal_functor

namespace Mon_

namespace equiv_lax_monoidal_functor_punit

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
def lax_monoidal_to_Mon (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C ⥤ Mon_ C :=
  category_theory.functor.mk
    (fun (F : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C) =>
      category_theory.functor.obj (category_theory.lax_monoidal_functor.map_Mon F)
        (trivial (category_theory.discrete PUnit)))
    fun (F G : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C) (α : F ⟶ G) =>
      category_theory.nat_trans.app
        (category_theory.functor.map
          (category_theory.lax_monoidal_functor.map_Mon_functor (category_theory.discrete PUnit) C) α)
        (trivial (category_theory.discrete PUnit))

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
def Mon_to_lax_monoidal (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] : Mon_ C ⥤ category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C :=
  category_theory.functor.mk
    (fun (A : Mon_ C) =>
      category_theory.lax_monoidal_functor.mk
        (category_theory.functor.mk (fun (_x : category_theory.discrete PUnit) => X A)
          fun (_x _x_1 : category_theory.discrete PUnit) (_x : _x ⟶ _x_1) => 𝟙)
        (one A) fun (_x _x : category_theory.discrete PUnit) => mul A)
    fun (A B : Mon_ C) (f : A ⟶ B) =>
      category_theory.monoidal_nat_trans.mk
        (category_theory.nat_trans.mk fun (_x : category_theory.discrete PUnit) => hom.hom f)

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simp] theorem unit_iso_inv_app_to_nat_trans_app (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] (X : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C) : ∀ (X_1 : category_theory.discrete PUnit),
  category_theory.nat_trans.app
      (category_theory.monoidal_nat_trans.to_nat_trans
        (category_theory.nat_trans.app (category_theory.iso.inv (unit_iso C)) X))
      X_1 =
    inv
      (category_theory.eq_to_hom
        (congr_arg (category_theory.functor.obj (category_theory.lax_monoidal_functor.to_functor X))
          (unit_iso._proof_1 X_1))) := sorry

/-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/
@[simp] theorem counit_iso_inv_app_hom (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] (X : Mon_ C) : hom.hom (category_theory.nat_trans.app (category_theory.iso.inv (counit_iso C)) X) = 𝟙 :=
  Eq.refl 𝟙

end equiv_lax_monoidal_functor_punit

/--
Monoid objects in `C` are "just" lax monoidal functors from the trivial monoidal category to `C`.
-/
def equiv_lax_monoidal_functor_punit (C : Type u₁) [category_theory.category C] [category_theory.monoidal_category C] : category_theory.lax_monoidal_functor (category_theory.discrete PUnit) C ≌ Mon_ C :=
  category_theory.equivalence.mk' sorry sorry sorry sorry


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import tactic.ext
import tactic.lint

/-!
# Functors

This module provides additional lemmas, definitions, and instances for `functor`s.

## Main definitions

* `const α` is the functor that sends all types to `α`.
* `add_const α` is `const α` but for when `α` has an additive structure.
* `comp F G` for functors `F` and `G` is the functor composition of `F` and `G`.
* `liftp` and `liftr` respectively lift predicates and relations on a type `α`
  to `F α`.  Terms of `F α` are considered to, in some sense, contain values of type `α`.

## Tags

functor, applicative
-/

attribute [functor_norm] seq_assoc pure_seq_eq_map map_pure seq_map_assoc map_seq

universes u v w

section functor

variables {F : Type u → Type v}
variables {α β γ : Type u}
variables [functor F] [is_lawful_functor F]

lemma functor.map_id : (<$>) id = (id : F α → F α) :=
by apply funext; apply id_map

lemma functor.map_comp_map (f : α → β) (g : β → γ) :
  ((<$>) g ∘ (<$>) f : F α → F γ) = (<$>) (g ∘ f) :=
by apply funext; intro; rw comp_map

theorem functor.ext {F} : ∀ {F1 : functor F} {F2 : functor F}
  [@is_lawful_functor F F1] [@is_lawful_functor F F2]
  (H : ∀ α β (f : α → β) (x : F α),
    @functor.map _ F1 _ _ f x = @functor.map _ F2 _ _ f x),
  F1 = F2
| ⟨m, mc⟩ ⟨m', mc'⟩ H1 H2 H :=
begin
  cases show @m = @m', by funext α β f x; apply H,
  congr, funext α β,
  have E1 := @map_const_eq _ ⟨@m, @mc⟩ H1,
  have E2 := @map_const_eq _ ⟨@m, @mc'⟩ H2,
  exact E1.trans E2.symm
end

end functor

/-- Introduce the `id` functor. Incidentally, this is `pure` for
`id` as a `monad` and as an `applicative` functor. -/
def id.mk {α : Sort u} : α → id α := id

namespace functor

/-- `const α` is the constant functor, mapping every type to `α`. When
`α` has a monoid structure, `const α` has an `applicative` instance.
(If `α` has an additive monoid structure, see `functor.add_const`.) -/
@[nolint unused_arguments]
def const (α : Type*) (β : Type*) := α

/-- `const.mk` is the canonical map `α → const α β` (the identity), and
it can be used as a pattern to extract this value. -/
@[pattern] def const.mk {α β} (x : α) : const α β := x

/-- `const.mk'` is `const.mk` but specialized to map `α` to
`const α punit`, where `punit` is the terminal object in `Type*`. -/
def const.mk' {α} (x : α) : const α punit := x

/-- Extract the element of `α` from the `const` functor. -/
def const.run {α β} (x : const α β) : α := x

namespace const

protected lemma ext {α β} {x y : const α β} (h : x.run = y.run) : x = y := h

/-- The map operation of the `const γ` functor. -/
@[nolint unused_arguments]
protected def map {γ α β} (f : α → β) (x : const γ β) : const γ α := x

instance {γ} : functor (const γ) :=
{ map := @const.map γ }

instance {γ} : is_lawful_functor (const γ) :=
by constructor; intros; refl

instance {α β} [inhabited α] : inhabited (const α β) :=
⟨(default _ : α)⟩

end const

/-- `add_const α` is a synonym for constant functor `const α`, mapping
every type to `α`. When `α` has a additive monoid structure,
`add_const α` has an `applicative` instance. (If `α` has a
multiplicative monoid structure, see `functor.const`.) -/
def add_const (α : Type*) := const α

/-- `add_const.mk` is the canonical map `α → add_const α β`, which is the identity,
where `add_const α β = const α β`. It can be used as a pattern to extract this value. -/
@[pattern]
def add_const.mk {α β} (x : α) : add_const α β := x

/-- Extract the element of `α` from the constant functor. -/
def add_const.run {α β} : add_const α β → α := id

instance add_const.functor {γ} : functor (add_const γ) :=
@const.functor γ

instance add_const.is_lawful_functor {γ} : is_lawful_functor (add_const γ) :=
@const.is_lawful_functor γ

instance {α β} [inhabited α] : inhabited (add_const α β) :=
⟨(default _ : α)⟩

/-- `functor.comp` is a wrapper around `function.comp` for types.
    It prevents Lean's type class resolution mechanism from trying
    a `functor (comp F id)` when `functor F` would do. -/
def comp (F : Type u → Type w) (G : Type v → Type u) (α : Type v) : Type w :=
F $ G α

/-- Construct a term of `comp F G α` from a term of `F (G α)`, which is the same type.
Can be used as a pattern to extract a term of `F (G α)`. -/
@[pattern] def comp.mk {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : F (G α)) : comp F G α := x

/-- Extract a term of `F (G α)` from a term of `comp F G α`, which is the same type. -/
def comp.run {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : comp F G α) : F (G α) := x

namespace comp

variables {F : Type u → Type w} {G : Type v → Type u}

protected lemma ext
  {α} {x y : comp F G α} : x.run = y.run → x = y := id

instance {α} [inhabited (F (G α))] : inhabited (comp F G α) :=
⟨(default _ : F (G α))⟩

variables [functor F] [functor G]

/-- The map operation for the composition `comp F G` of functors `F` and `G`. -/
protected def map {α β : Type v} (h : α → β) : comp F G α → comp F G β
| (comp.mk x) := comp.mk ((<$>) h <$> x)

instance : functor (comp F G) := { map := @comp.map F G _ _ }

@[functor_norm] lemma map_mk {α β} (h : α → β) (x : F (G α)) :
  h <$> comp.mk x = comp.mk ((<$>) h <$> x) := rfl

@[simp] protected lemma run_map {α β} (h : α → β) (x : comp F G α) :
  (h <$> x).run = (<$>) h <$> x.run := rfl

variables [is_lawful_functor F] [is_lawful_functor G]
variables {α β γ : Type v}

protected lemma id_map : ∀ (x : comp F G α), comp.map id x = x
| (comp.mk x) := by simp [comp.map, functor.map_id]

protected lemma comp_map (g' : α → β) (h : β → γ) : ∀ (x : comp F G α),
           comp.map (h ∘ g') x = comp.map h (comp.map g' x)
| (comp.mk x) := by simp [comp.map, functor.map_comp_map g' h] with functor_norm

instance : is_lawful_functor (comp F G) :=
{ id_map := @comp.id_map F G _ _ _ _,
  comp_map := @comp.comp_map F G _ _ _ _ }

theorem functor_comp_id {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor F id _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor F id _ _ _ _) _ (λ α β f x, rfl)

theorem functor_id_comp {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor id F _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor id F _ _ _ _) _ (λ α β f x, rfl)

end comp

namespace comp

open function (hiding comp)
open functor

variables {F : Type u → Type w} {G : Type v → Type u}

variables [applicative F] [applicative G]

/-- The `<*>` operation for the composition of applicative functors. -/
protected def seq {α β : Type v} : comp F G (α → β) → comp F G α → comp F G β
| (comp.mk f) (comp.mk x) := comp.mk $ (<*>) <$> f <*> x

instance : has_pure (comp F G) :=
⟨λ _ x, comp.mk $ pure $ pure x⟩

instance : has_seq (comp F G) :=
⟨λ _ _ f x, comp.seq f x⟩

@[simp] protected lemma run_pure {α : Type v} :
  ∀ x : α, (pure x : comp F G α).run = pure (pure x)
| _ := rfl

@[simp] protected lemma run_seq {α β : Type v} (f : comp F G (α → β)) (x : comp F G α) :
  (f <*> x).run = (<*>) <$> f.run <*> x.run := rfl

instance : applicative (comp F G) :=
{ map := @comp.map F G _ _,
  seq := @comp.seq F G _ _,
  ..comp.has_pure }

end comp

variables {F : Type u → Type u} [functor F]

/-- If we consider `x : F α` to, in some sense, contain values of type `α`,
predicate `liftp p x` holds iff every value contained by `x` satisfies `p`. -/
def liftp {α : Type u} (p : α → Prop) (x : F α) : Prop :=
∃ u : F (subtype p), subtype.val <$> u = x

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`liftr r x y` relates `x` and `y` iff (1) `x` and `y` have the same shape and
(2) we can pair values `a` from `x` and `b` from `y` so that `r a b` holds. -/
def liftr {α : Type u} (r : α → α → Prop) (x y : F α) : Prop :=
∃ u : F {p : α × α // r p.fst p.snd},
  (λ t : {p : α × α // r p.fst p.snd}, t.val.fst) <$> u = x ∧
  (λ t : {p : α × α // r p.fst p.snd}, t.val.snd) <$> u = y

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`supp x` is the set of values of type `α` that `x` contains. -/
def supp {α : Type u} (x : F α) : set α := { y : α | ∀ ⦃p⦄, liftp p x → p y }

theorem of_mem_supp {α : Type u} {x : F α} {p : α → Prop} (h : liftp p x) :
  ∀ y ∈ supp x, p y :=
λ y hy, hy h

end functor


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

! This file was ported from Lean 3 source module data.dlist.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Leanbin.Data.Dlist

/-!
# Difference list

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

This file provides a few results about `dlist`, which is defined in core Lean.

A difference list is a function that, given a list, returns the original content of the
difference list prepended to the given list. It is useful to represent elements of a given type
as `a₁ + ... + aₙ` where `+ : α → α → α` is any operation, without actually computing.

This structure supports `O(1)` `append` and `concat` operations on lists, making it
useful for append-heavy uses such as logging and pretty printing.
-/

/- warning: dlist.join -> Std.DList.join is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, (List.{u1} (Dlist.{u1} α)) -> (Dlist.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, (List.{u1} (Std.DList.{u1} α)) -> (Std.DList.{u1} α)
Case conversion may be inaccurate. Consider using '#align dlist.join Std.DList.joinₓ'. -/
/-- Concatenates a list of difference lists to form a single difference list. Similar to
`list.join`. -/
def Std.DList.join {α : Type _} : List (Dlist α) → Dlist α
  | [] => Dlist.empty
  | x :: xs => x ++ Std.DList.join xs
#align dlist.join Std.DList.join

/- warning: dlist_singleton -> Std.DList_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {a : α}, Eq.{succ u1} (Dlist.{u1} α) (Dlist.singleton.{u1} α a) (Std.DList.lazy_ofList.{u1} α (fun (_ : Unit) => List.cons.{u1} α a (List.nil.{u1} α)))
but is expected to have type
  forall {α : Type.{u1}} {a : α}, Eq.{succ u1} (Std.DList.{u1} α) (Std.DList.singleton.{u1} α a) (Std.DList.lazy_ofList.{u1} α (Thunk.mk.{u1} (List.{u1} α) (fun (x._@.Init.Core._hyg.266 : Unit) => List.cons.{u1} α a (List.nil.{u1} α))))
Case conversion may be inaccurate. Consider using '#align dlist_singleton Std.DList_singletonₓ'. -/
@[simp]
theorem Std.DList_singleton {α : Type _} {a : α} : Dlist.singleton a = Std.DList.lazy_ofList [a] :=
  rfl
#align dlist_singleton Std.DList_singleton

/- warning: dlist_lazy -> Std.DList_lazy is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {l : List.{u1} α}, Eq.{succ u1} (Dlist.{u1} α) (Std.DList.lazy_ofList.{u1} α (fun (_ : Unit) => l)) (Dlist.ofList.{u1} α l)
but is expected to have type
  forall {α : Type.{u1}} {l : List.{u1} α}, Eq.{succ u1} (Std.DList.{u1} α) (Std.DList.lazy_ofList.{u1} α (Thunk.mk.{u1} (List.{u1} α) (fun (x._@.Init.Core._hyg.266 : Unit) => l))) (Std.DList.ofList.{u1} α l)
Case conversion may be inaccurate. Consider using '#align dlist_lazy Std.DList_lazyₓ'. -/
@[simp]
theorem Std.DList_lazy {α : Type _} {l : List α} : Std.DList.lazy_ofList l = Dlist.ofList l :=
  rfl
#align dlist_lazy Std.DList_lazy