/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Andrew Yang
-/
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.pullbacks
import category_theory.limits.preserves.shapes.pullbacks
import category_theory.limits.preserves.shapes.binary_products

/-!
# Constructing equalizers from pullbacks and binary products.

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

If a category has pullbacks and binary products, then it has equalizers.

TODO: generalize universe
-/

noncomputable theory

universes v v' u u'

open category_theory category_theory.category

namespace category_theory.limits

variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v'} D] (G : C ⥤ D)

-- We hide the "implementation details" inside a namespace
namespace has_equalizers_of_has_pullbacks_and_binary_products

variables [has_binary_products C] [has_pullbacks C]

/-- Define the equalizing object -/
@[reducible]
def construct_equalizer (F : walking_parallel_pair ⥤ C) : C :=
pullback (prod.lift (𝟙 _) (F.map walking_parallel_pair_hom.left))
         (prod.lift (𝟙 _) (F.map walking_parallel_pair_hom.right))

/-- Define the equalizing morphism -/
abbreviation pullback_fst (F : walking_parallel_pair ⥤ C) :
  construct_equalizer F ⟶ F.obj walking_parallel_pair.zero :=
pullback.fst

lemma pullback_fst_eq_pullback_snd (F : walking_parallel_pair ⥤ C) :
  pullback_fst F = pullback.snd :=
by convert pullback.condition =≫ limits.prod.fst; simp

/-- Define the equalizing cone -/
@[reducible]
def equalizer_cone (F : walking_parallel_pair ⥤ C) : cone F :=
cone.of_fork
  (fork.of_ι (pullback_fst F)
    (begin
      conv_rhs { rw pullback_fst_eq_pullback_snd, },
      convert pullback.condition =≫ limits.prod.snd using 1; simp
     end))

/-- Show the equalizing cone is a limit -/
def equalizer_cone_is_limit (F : walking_parallel_pair ⥤ C) : is_limit (equalizer_cone F) :=
{ lift :=
  begin
    intro c, apply pullback.lift (c.π.app _) (c.π.app _),
    apply limit.hom_ext,
    rintro (_ | _); simp
  end,
  fac' := by rintros c (_ | _); simp,
  uniq' :=
  begin
    intros c _ J,
    have J0 := J walking_parallel_pair.zero, simp at J0,
    apply pullback.hom_ext,
    { rwa limit.lift_π },
    { erw [limit.lift_π, ← J0, pullback_fst_eq_pullback_snd] }
  end }

end has_equalizers_of_has_pullbacks_and_binary_products

open has_equalizers_of_has_pullbacks_and_binary_products
/-- Any category with pullbacks and binary products, has equalizers. -/
-- This is not an instance, as it is not always how one wants to construct equalizers!
lemma has_equalizers_of_has_pullbacks_and_binary_products
  [has_binary_products C] [has_pullbacks C] :
  has_equalizers C :=
{ has_limit := λ F, has_limit.mk
  { cone := equalizer_cone F,
    is_limit := equalizer_cone_is_limit F } }

local attribute[instance] has_pullback_of_preserves_pullback

/-- A functor that preserves pullbacks and binary products also presrves equalizers. -/
def preserves_equalizers_of_preserves_pullbacks_and_binary_products
    [has_binary_products C] [has_pullbacks C]
    [preserves_limits_of_shape (discrete walking_pair) G]
    [preserves_limits_of_shape walking_cospan G] :
  preserves_limits_of_shape walking_parallel_pair G :=
⟨λ K, preserves_limit_of_preserves_limit_cone (equalizer_cone_is_limit K) $
{ lift := λ c, begin
    refine pullback.lift _ _ _ ≫ (@@preserves_pullback.iso _ _ _ _ _ _ _ _).inv,
    { exact c.π.app walking_parallel_pair.zero },
    { exact c.π.app walking_parallel_pair.zero },
    apply (map_is_limit_of_preserves_of_is_limit G _ _ (prod_is_prod _ _)).hom_ext,
    swap, apply_instance,
    rintro (_|_),
    { simp only [category.assoc, ← G.map_comp, prod.lift_fst,
        binary_fan.π_app_left, binary_fan.mk_fst], },
    { simp only [binary_fan.π_app_right, binary_fan.mk_snd,
        category.assoc, ← G.map_comp, prod.lift_snd],
      exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans
        (c.π.naturality (walking_parallel_pair_hom.right)) },
  end,
  fac' := λ c j, begin
    rcases j with (_|_);
      simp only [category.comp_id, preserves_pullback.iso_inv_fst, cone.of_fork_π, G.map_comp,
        preserves_pullback.iso_inv_fst_assoc, functor.map_cone_π_app, eq_to_hom_refl,
        category.assoc, fork.of_ι_π_app, pullback.lift_fst, pullback.lift_fst_assoc],
      exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans (category.id_comp _)
  end,
  uniq' := λ s m h, begin
    rw iso.eq_comp_inv,
    have := h walking_parallel_pair.zero,
    dsimp [equalizer_cone] at this,
    ext; simp only [preserves_pullback.iso_hom_snd,
      category.assoc, preserves_pullback.iso_hom_fst, pullback.lift_fst, pullback.lift_snd,
      category.comp_id, ← pullback_fst_eq_pullback_snd, ← this],
  end }⟩

-- We hide the "implementation details" inside a namespace
namespace has_coequalizers_of_has_pushouts_and_binary_coproducts

variables [has_binary_coproducts C] [has_pushouts C]

/-- Define the equalizing object -/
@[reducible]
def construct_coequalizer (F : walking_parallel_pair ⥤ C) : C :=
pushout (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.left))
        (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.right))

/-- Define the equalizing morphism -/
abbreviation pushout_inl (F : walking_parallel_pair ⥤ C) :
  F.obj walking_parallel_pair.one ⟶ construct_coequalizer F :=
pushout.inl

lemma pushout_inl_eq_pushout_inr (F : walking_parallel_pair ⥤ C) :
  pushout_inl F = pushout.inr :=
by convert limits.coprod.inl ≫= pushout.condition; simp

/-- Define the equalizing cocone -/
@[reducible]
def coequalizer_cocone (F : walking_parallel_pair ⥤ C) : cocone F :=
cocone.of_cofork
  (cofork.of_π (pushout_inl F)
    (begin
      conv_rhs { rw pushout_inl_eq_pushout_inr, },
      convert limits.coprod.inr ≫= pushout.condition using 1; simp
     end))

/-- Show the equalizing cocone is a colimit -/
def coequalizer_cocone_is_colimit (F : walking_parallel_pair ⥤ C) :
  is_colimit (coequalizer_cocone F) :=
{ desc :=
  begin
    intro c, apply pushout.desc (c.ι.app _) (c.ι.app _),
    apply colimit.hom_ext,
    rintro (_ | _); simp
  end,
  fac' := by rintros c (_ | _); simp,
  uniq' :=
  begin
    intros c _ J,
    have J1 : pushout_inl F ≫ m = c.ι.app walking_parallel_pair.one :=
      by simpa using J walking_parallel_pair.one,
    apply pushout.hom_ext,
    { rw colimit.ι_desc, exact J1 },
    { rw [colimit.ι_desc, ← pushout_inl_eq_pushout_inr], exact J1 }
  end }

end has_coequalizers_of_has_pushouts_and_binary_coproducts

open has_coequalizers_of_has_pushouts_and_binary_coproducts
/-- Any category with pullbacks and binary products, has equalizers. -/
-- This is not an instance, as it is not always how one wants to construct equalizers!
lemma has_coequalizers_of_has_pushouts_and_binary_coproducts
  [has_binary_coproducts C] [has_pushouts C] : has_coequalizers C :=
{ has_colimit := λ F, has_colimit.mk
  { cocone := coequalizer_cocone F,
    is_colimit := coequalizer_cocone_is_colimit F } }

local attribute[instance] has_pushout_of_preserves_pushout

/-- A functor that preserves pushouts and binary coproducts also presrves coequalizers. -/
def preserves_coequalizers_of_preserves_pushouts_and_binary_coproducts
    [has_binary_coproducts C] [has_pushouts C]
    [preserves_colimits_of_shape (discrete walking_pair) G]
    [preserves_colimits_of_shape walking_span G] :
  preserves_colimits_of_shape walking_parallel_pair G :=
⟨λ K, preserves_colimit_of_preserves_colimit_cocone (coequalizer_cocone_is_colimit K) $
{ desc := λ c, begin
    refine (@@preserves_pushout.iso _ _ _ _ _ _ _ _).inv ≫ pushout.desc _ _ _,
    { exact c.ι.app walking_parallel_pair.one },
    { exact c.ι.app walking_parallel_pair.one },
    apply (map_is_colimit_of_preserves_of_is_colimit G _ _ (coprod_is_coprod _ _)).hom_ext,
    swap, apply_instance,
    rintro (_|_),
    { simp only [binary_cofan.ι_app_left, binary_cofan.mk_inl, category.assoc, ← G.map_comp_assoc,
        coprod.inl_desc] },
    { simp only [binary_cofan.ι_app_right, binary_cofan.mk_inr, category.assoc, ← G.map_comp_assoc,
        coprod.inr_desc],
      exact (c.ι.naturality walking_parallel_pair_hom.left).trans
        (c.ι.naturality walking_parallel_pair_hom.right).symm, },
  end,
  fac' := λ c j, begin
    rcases j with (_|_); simp only [functor.map_cocone_ι_app, cocone.of_cofork_ι, category.id_comp,
      eq_to_hom_refl, category.assoc, functor.map_comp, cofork.of_π_ι_app, pushout.inl_desc,
      preserves_pushout.inl_iso_inv_assoc],
      exact (c.ι.naturality (walking_parallel_pair_hom.left)).trans (category.comp_id _)
  end,
  uniq' := λ s m h, begin
    rw iso.eq_inv_comp,
    have := h walking_parallel_pair.one,
    dsimp [coequalizer_cocone] at this,
    ext; simp only [preserves_pushout.inl_iso_hom_assoc, category.id_comp, pushout.inl_desc,
      pushout.inr_desc, preserves_pushout.inr_iso_hom_assoc,
      ← pushout_inl_eq_pushout_inr, ← this],
  end }⟩

end category_theory.limits


/-
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

! This file was ported from Lean 3 source module deprecated.subgroup
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.Deprecated.Submonoid

/-!
# Unbundled subgroups (deprecated)

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 `AddSubgroup A`, defined in `GroupTheory.Subgroup.Basic`.

## Main definitions

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

`IsSubgroup (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, IsSubgroup
-/

open Set Function

variable {G : Type _} {H : Type _} {A : Type _} {a a₁ a₂ b c : G}

section Group

variable [Group G] [AddGroup A]

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
structure IsAddSubgroup (s : Set A) extends IsAddSubmonoid s : Prop where
  /-- The proposition that `s` is closed under negation. -/
  neg_mem {a} : a ∈ s → -a ∈ s
#align is_add_subgroup IsAddSubgroup

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
@[to_additive]
structure IsSubgroup (s : Set G) extends IsSubmonoid s : Prop where
  /-- The proposition that `s` is closed under inverse. -/
  inv_mem {a} : a ∈ s → a⁻¹ ∈ s
#align is_subgroup IsSubgroup

@[to_additive]
theorem IsSubgroup.div_mem {s : Set G} (hs : IsSubgroup 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)
#align is_subgroup.div_mem IsSubgroup.div_mem
#align is_add_subgroup.sub_mem IsAddSubgroup.sub_mem

theorem Additive.isAddSubgroup {s : Set G} (hs : IsSubgroup s) : @IsAddSubgroup (Additive G) _ s :=
  @IsAddSubgroup.mk (Additive G) _ _ (Additive.isAddSubmonoid hs.toIsSubmonoid) hs.inv_mem
#align additive.is_add_subgroup Additive.isAddSubgroup

theorem Additive.isAddSubgroup_iff {s : Set G} : @IsAddSubgroup (Additive G) _ s ↔ IsSubgroup s :=
  ⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @IsSubgroup.mk G _ _ ⟨h₁, @h₂⟩ @h₃, fun h =>
    Additive.isAddSubgroup h⟩
#align additive.is_add_subgroup_iff Additive.isAddSubgroup_iff

theorem Multiplicative.isSubgroup {s : Set A} (hs : IsAddSubgroup s) :
    @IsSubgroup (Multiplicative A) _ s :=
  @IsSubgroup.mk (Multiplicative A) _ _ (Multiplicative.isSubmonoid hs.toIsAddSubmonoid) hs.neg_mem
#align multiplicative.is_subgroup Multiplicative.isSubgroup

theorem Multiplicative.isSubgroup_iff {s : Set A} :
    @IsSubgroup (Multiplicative A) _ s ↔ IsAddSubgroup s :=
  ⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @IsAddSubgroup.mk A _ _ ⟨h₁, @h₂⟩ @h₃, fun h =>
    Multiplicative.isSubgroup h⟩
#align multiplicative.is_subgroup_iff Multiplicative.isSubgroup_iff

@[to_additive of_add_neg]
theorem IsSubgroup.of_div (s : Set G) (one_mem : (1 : G) ∈ s)
    (div_mem : ∀ {a b : G}, a ∈ s → b ∈ s → a * b⁻¹ ∈ s) : IsSubgroup s :=
  have inv_mem : ∀ a, a ∈ s → a⁻¹ ∈ s := fun a ha => by
    have : 1 * a⁻¹ ∈ s := div_mem one_mem ha
    convert this using 1
    rw [one_mul]
  { inv_mem := inv_mem _
    mul_mem := fun {a b} ha hb => by
      have : a * b⁻¹⁻¹ ∈ s := div_mem ha (inv_mem b hb)
      convert this
      rw [inv_inv]
    one_mem }
#align is_subgroup.of_div IsSubgroup.of_div
#align is_add_subgroup.of_add_neg IsAddSubgroup.of_add_neg

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

@[to_additive]
theorem IsSubgroup.inter {s₁ s₂ : Set G} (hs₁ : IsSubgroup s₁) (hs₂ : IsSubgroup s₂) :
    IsSubgroup (s₁ ∩ s₂) :=
  { IsSubmonoid.inter hs₁.toIsSubmonoid hs₂.toIsSubmonoid with
    inv_mem := fun hx => ⟨hs₁.inv_mem hx.1, hs₂.inv_mem hx.2⟩ }
#align is_subgroup.inter IsSubgroup.inter
#align is_add_subgroup.inter IsAddSubgroup.inter

@[to_additive]
theorem IsSubgroup.interᵢ {ι : Sort _} {s : ι → Set G} (hs : ∀ y : ι, IsSubgroup (s y)) :
    IsSubgroup (Set.interᵢ s) :=
  { IsSubmonoid.interᵢ fun y => (hs y).toIsSubmonoid with
    inv_mem := fun h =>
      Set.mem_interᵢ.2 fun y => IsSubgroup.inv_mem (hs _) (Set.mem_interᵢ.1 h y) }
#align is_subgroup.Inter IsSubgroup.interᵢ
#align is_add_subgroup.Inter IsAddSubgroup.interᵢ

@[to_additive]
theorem isSubgroup_unionᵢ_of_directed {ι : Type _} [Nonempty ι] {s : ι → Set G}
    (hs : ∀ i, IsSubgroup (s i)) (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
    IsSubgroup (⋃ i, s i) :=
  { inv_mem := fun ha =>
      let ⟨i, hi⟩ := Set.mem_unionᵢ.1 ha
      Set.mem_unionᵢ.2 ⟨i, (hs i).inv_mem hi⟩
    toIsSubmonoid := isSubmonoid_unionᵢ_of_directed (fun i => (hs i).toIsSubmonoid) directed }
#align is_subgroup_Union_of_directed isSubgroup_unionᵢ_of_directed
#align is_add_subgroup_Union_of_directed isAddSubgroup_unionᵢ_of_directed

end Group

namespace IsSubgroup

open IsSubmonoid

variable [Group G] {s : Set G} (hs : IsSubgroup s)

@[to_additive]
theorem inv_mem_iff : a⁻¹ ∈ s ↔ a ∈ s :=
  ⟨fun h => by simpa using hs.inv_mem h, inv_mem hs⟩
#align is_subgroup.inv_mem_iff IsSubgroup.inv_mem_iff
#align is_add_subgroup.neg_mem_iff IsAddSubgroup.neg_mem_iff

@[to_additive]
theorem mul_mem_cancel_right (h : a ∈ s) : b * a ∈ s ↔ b ∈ s :=
  ⟨fun hba => by simpa using hs.mul_mem hba (hs.inv_mem h), fun hb => hs.mul_mem hb h⟩
#align is_subgroup.mul_mem_cancel_right IsSubgroup.mul_mem_cancel_right
#align is_add_subgroup.add_mem_cancel_right IsAddSubgroup.add_mem_cancel_right

@[to_additive]
theorem mul_mem_cancel_left (h : a ∈ s) : a * b ∈ s ↔ b ∈ s :=
  ⟨fun hab => by simpa using hs.mul_mem (hs.inv_mem h) hab, hs.mul_mem h⟩
#align is_subgroup.mul_mem_cancel_left IsSubgroup.mul_mem_cancel_left
#align is_add_subgroup.add_mem_cancel_left IsAddSubgroup.add_mem_cancel_left

end IsSubgroup

/-- `IsNormalAddSubgroup (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 : AddSubgroup A` and `hs : S.normal`, and not via this structure. -/
structure IsNormalAddSubgroup [AddGroup A] (s : Set A) extends IsAddSubgroup s : Prop where
  /-- The proposition that `s` is closed under (additive) conjugation. -/
  normal : ∀ n ∈ s, ∀ g : A, g + n + -g ∈ s
#align is_normal_add_subgroup IsNormalAddSubgroup

/-- `IsNormalSubgroup (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 IsNormalSubgroup [Group G] (s : Set G) extends IsSubgroup s : Prop where
  /-- The proposition that `s` is closed under conjugation. -/
  normal : ∀ n ∈ s, ∀ g : G, g * n * g⁻¹ ∈ s
#align is_normal_subgroup IsNormalSubgroup

@[to_additive]
theorem isNormalSubgroup_of_commGroup [CommGroup G] {s : Set G} (hs : IsSubgroup s) :
    IsNormalSubgroup s :=
  { hs with normal := fun n hn g => by rwa [mul_right_comm, mul_right_inv, one_mul] }
#align is_normal_subgroup_of_comm_group isNormalSubgroup_of_commGroup
#align is_normal_add_subgroup_of_add_comm_group isNormalAddSubgroup_of_addCommGroup

theorem Additive.isNormalAddSubgroup [Group G] {s : Set G} (hs : IsNormalSubgroup s) :
    @IsNormalAddSubgroup (Additive G) _ s :=
  @IsNormalAddSubgroup.mk (Additive G) _ _ (Additive.isAddSubgroup hs.toIsSubgroup)
    (@IsNormalSubgroup.normal _ ‹Group (Additive G)› _ hs)
    -- porting note: Lean needs help synthesising
#align additive.is_normal_add_subgroup Additive.isNormalAddSubgroup

theorem Additive.isNormalAddSubgroup_iff [Group G] {s : Set G} :
    @IsNormalAddSubgroup (Additive G) _ s ↔ IsNormalSubgroup s :=
  ⟨by rintro ⟨h₁, h₂⟩; exact @IsNormalSubgroup.mk G _ _ (Additive.isAddSubgroup_iff.1 h₁) @h₂,
    fun h => Additive.isNormalAddSubgroup h⟩
#align additive.is_normal_add_subgroup_iff Additive.isNormalAddSubgroup_iff

theorem Multiplicative.isNormalSubgroup [AddGroup A] {s : Set A} (hs : IsNormalAddSubgroup s) :
    @IsNormalSubgroup (Multiplicative A) _ s :=
  @IsNormalSubgroup.mk (Multiplicative A) _ _ (Multiplicative.isSubgroup hs.toIsAddSubgroup)
    (@IsNormalAddSubgroup.normal _ ‹AddGroup (Multiplicative A)› _ hs)
#align multiplicative.is_normal_subgroup Multiplicative.isNormalSubgroup

theorem Multiplicative.isNormalSubgroup_iff [AddGroup A] {s : Set A} :
    @IsNormalSubgroup (Multiplicative A) _ s ↔ IsNormalAddSubgroup s :=
  ⟨by
    rintro ⟨h₁, h₂⟩;
      exact @IsNormalAddSubgroup.mk A _ _ (Multiplicative.isSubgroup_iff.1 h₁) @h₂,
    fun h => Multiplicative.isNormalSubgroup h⟩
#align multiplicative.is_normal_subgroup_iff Multiplicative.isNormalSubgroup_iff

namespace IsSubgroup

variable [Group G]

-- Normal subgroup properties
@[to_additive]
theorem mem_norm_comm {s : Set G} (hs : IsNormalSubgroup s) {a b : G} (hab : a * b ∈ s) :
    b * a ∈ s := by
  have h : a⁻¹ * (a * b) * a⁻¹⁻¹ ∈ s := hs.normal (a * b) hab a⁻¹
  simp at h; exact h
#align is_subgroup.mem_norm_comm IsSubgroup.mem_norm_comm
#align is_add_subgroup.mem_norm_comm IsAddSubgroup.mem_norm_comm

@[to_additive]
theorem mem_norm_comm_iff {s : Set G} (hs : IsNormalSubgroup s) {a b : G} : a * b ∈ s ↔ b * a ∈ s :=
  ⟨mem_norm_comm hs, mem_norm_comm hs⟩
#align is_subgroup.mem_norm_comm_iff IsSubgroup.mem_norm_comm_iff
#align is_add_subgroup.mem_norm_comm_iff IsAddSubgroup.mem_norm_comm_iff

/-- The trivial subgroup -/
@[to_additive "the trivial additive subgroup"]
def trivial (G : Type _) [Group G] : Set G :=
  {1}
#align is_subgroup.trivial IsSubgroup.trivial
#align is_add_subgroup.trivial IsAddSubgroup.trivial

@[to_additive (attr := simp)]
theorem mem_trivial {g : G} : g ∈ trivial G ↔ g = 1 :=
  mem_singleton_iff
#align is_subgroup.mem_trivial IsSubgroup.mem_trivial
#align is_add_subgroup.mem_trivial IsAddSubgroup.mem_trivial

@[to_additive]
theorem trivial_normal : IsNormalSubgroup (trivial G) := by
  refine' { .. } <;> simp (config := { contextual := true }) [trivial]
#align is_subgroup.trivial_normal IsSubgroup.trivial_normal
#align is_add_subgroup.trivial_normal IsAddSubgroup.trivial_normal

@[to_additive]
theorem eq_trivial_iff {s : Set G} (hs : IsSubgroup s) : s = trivial G ↔ ∀ x ∈ s, x = (1 : G) := by
  simp only [Set.ext_iff, IsSubgroup.mem_trivial];
    exact ⟨fun h x => (h x).1, fun h x => ⟨h x, fun hx => hx.symm ▸ hs.toIsSubmonoid.one_mem⟩⟩
#align is_subgroup.eq_trivial_iff IsSubgroup.eq_trivial_iff
#align is_add_subgroup.eq_trivial_iff IsAddSubgroup.eq_trivial_iff

@[to_additive]
theorem univ_subgroup : IsNormalSubgroup (@univ G) := by refine' { .. } <;> simp
#align is_subgroup.univ_subgroup IsSubgroup.univ_subgroup
#align is_add_subgroup.univ_add_subgroup IsAddSubgroup.univ_addSubgroup

/-- The underlying set of the center of a group. -/
@[to_additive addCenter "The underlying set of the center of an additive group."]
def center (G : Type _) [Group G] : Set G :=
  { z | ∀ g, g * z = z * g }
#align is_subgroup.center IsSubgroup.center
#align is_add_subgroup.add_center IsAddSubgroup.addCenter

@[to_additive mem_add_center]
theorem mem_center {a : G} : a ∈ center G ↔ ∀ g, g * a = a * g :=
  Iff.rfl
#align is_subgroup.mem_center IsSubgroup.mem_center
#align is_add_subgroup.mem_add_center IsAddSubgroup.mem_add_center

@[to_additive add_center_normal]
theorem center_normal : IsNormalSubgroup (center G) :=
  { one_mem := by simp [center]
    mul_mem := fun ha hb g => by
      rw [← mul_assoc, mem_center.2 ha g, mul_assoc, mem_center.2 hb g, ← mul_assoc]
    inv_mem := fun {a} ha g =>
      calc
        g * a⁻¹ = a⁻¹ * (g * a) * a⁻¹ := by simp [ha g]
        _ = a⁻¹ * g := by rw [← mul_assoc, mul_assoc]; simp
    normal := fun 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]
         }
#align is_subgroup.center_normal IsSubgroup.center_normal
#align is_add_subgroup.add_center_normal IsAddSubgroup.add_center_normal

/-- 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 addNormalizer
      "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 }
#align is_subgroup.normalizer IsSubgroup.normalizer
#align is_add_subgroup.add_normalizer IsAddSubgroup.addNormalizer

@[to_additive]
theorem normalizer_isSubgroup (s : Set G) : IsSubgroup (normalizer s) :=
  { one_mem := by simp [normalizer]
    mul_mem := fun {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 := fun {a} (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s) n => by
      rw [ha (a⁻¹ * n * a⁻¹⁻¹)]; simp [mul_assoc] }
#align is_subgroup.normalizer_is_subgroup IsSubgroup.normalizer_isSubgroup
#align is_add_subgroup.normalizer_is_add_subgroup IsAddSubgroup.normalizer_isAddSubgroup

@[to_additive subset_add_normalizer]
theorem subset_normalizer {s : Set G} (hs : IsSubgroup s) : s ⊆ normalizer s := fun g hg n => by
  rw [IsSubgroup.mul_mem_cancel_right hs ((IsSubgroup.inv_mem_iff hs).2 hg),
    IsSubgroup.mul_mem_cancel_left hs hg]
#align is_subgroup.subset_normalizer IsSubgroup.subset_normalizer
#align is_add_subgroup.subset_add_normalizer IsAddSubgroup.subset_add_normalizer

end IsSubgroup

-- Homomorphism subgroups
namespace IsGroupHom

open IsSubmonoid IsSubgroup

/-- `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)
#align is_group_hom.ker IsGroupHom.ker
#align is_add_group_hom.ker IsAddGroupHom.ker

@[to_additive]
theorem mem_ker [Group H] (f : G → H) {x : G} : x ∈ ker f ↔ f x = 1 :=
  mem_trivial
#align is_group_hom.mem_ker IsGroupHom.mem_ker
#align is_add_group_hom.mem_ker IsAddGroupHom.mem_ker

variable [Group G] [Group H]

@[to_additive]
theorem one_ker_inv {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
  by
  rw [hf.map_mul, hf.map_inv] at h
  rw [← inv_inv (f b), eq_inv_of_mul_eq_one_left h]
#align is_group_hom.one_ker_inv IsGroupHom.one_ker_inv
#align is_add_group_hom.zero_ker_neg IsAddGroupHom.zero_ker_neg

@[to_additive]
theorem one_ker_inv' {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f (a⁻¹ * b) = 1) : f a = f b :=
  by
  rw [hf.map_mul, hf.map_inv] at h
  apply inv_injective
  rw [eq_inv_of_mul_eq_one_left h]
#align is_group_hom.one_ker_inv' IsGroupHom.one_ker_inv'
#align is_add_group_hom.zero_ker_neg' IsAddGroupHom.zero_ker_neg'

@[to_additive]
theorem inv_ker_one {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f a = f b) : f (a * b⁻¹) = 1 :=
  by
  have : f a * (f b)⁻¹ = 1 := by rw [h, mul_right_inv]
  rwa [← hf.map_inv, ← hf.map_mul] at this
#align is_group_hom.inv_ker_one IsGroupHom.inv_ker_one
#align is_add_group_hom.neg_ker_zero IsAddGroupHom.neg_ker_zero

@[to_additive]
theorem inv_ker_one' {f : G → H} (hf : IsGroupHom f) {a b : G} (h : f a = f b) : f (a⁻¹ * b) = 1 :=
  by
  have : (f a)⁻¹ * f b = 1 := by rw [h, mul_left_inv]
  rwa [← hf.map_inv, ← hf.map_mul] at this
#align is_group_hom.inv_ker_one' IsGroupHom.inv_ker_one'
#align is_add_group_hom.neg_ker_zero' IsAddGroupHom.neg_ker_zero'

@[to_additive]
theorem one_iff_ker_inv {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ f (a * b⁻¹) = 1 :=
  ⟨hf.inv_ker_one, hf.one_ker_inv⟩
#align is_group_hom.one_iff_ker_inv IsGroupHom.one_iff_ker_inv
#align is_add_group_hom.zero_iff_ker_neg IsAddGroupHom.zero_iff_ker_neg

@[to_additive]
theorem one_iff_ker_inv' {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ f (a⁻¹ * b) = 1 :=
  ⟨hf.inv_ker_one', hf.one_ker_inv'⟩
#align is_group_hom.one_iff_ker_inv' IsGroupHom.one_iff_ker_inv'
#align is_add_group_hom.zero_iff_ker_neg' IsAddGroupHom.zero_iff_ker_neg'

@[to_additive]
theorem inv_iff_ker {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ a * b⁻¹ ∈ ker f := by
  rw [mem_ker]; exact one_iff_ker_inv hf _ _
#align is_group_hom.inv_iff_ker IsGroupHom.inv_iff_ker
#align is_add_group_hom.neg_iff_ker IsAddGroupHom.neg_iff_ker

@[to_additive]
theorem inv_iff_ker' {f : G → H} (hf : IsGroupHom f) (a b : G) : f a = f b ↔ a⁻¹ * b ∈ ker f := by
  rw [mem_ker]; exact one_iff_ker_inv' hf _ _
#align is_group_hom.inv_iff_ker' IsGroupHom.inv_iff_ker'
#align is_add_group_hom.neg_iff_ker' IsAddGroupHom.neg_iff_ker'

@[to_additive]
theorem image_subgroup {f : G → H} (hf : IsGroupHom f) {s : Set G} (hs : IsSubgroup s) :
    IsSubgroup (f '' s) :=
  { mul_mem := fun {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.toIsSubmonoid.one_mem, hf.map_one⟩
    inv_mem := fun {a} ⟨b, hb, Eq⟩ =>
      ⟨b⁻¹, hs.inv_mem hb, by
        rw [hf.map_inv]
        simp [*]⟩ }
#align is_group_hom.image_subgroup IsGroupHom.image_subgroup
#align is_add_group_hom.image_add_subgroup IsAddGroupHom.image_addSubgroup

@[to_additive]
theorem range_subgroup {f : G → H} (hf : IsGroupHom f) : IsSubgroup (Set.range f) :=
  @Set.image_univ _ _ f ▸ hf.image_subgroup univ_subgroup.toIsSubgroup
#align is_group_hom.range_subgroup IsGroupHom.range_subgroup
#align is_add_group_hom.range_add_subgroup IsAddGroupHom.range_addSubgroup

attribute [local simp] IsSubmonoid.one_mem IsSubgroup.inv_mem
  IsSubmonoid.mul_mem IsNormalSubgroup.normal

@[to_additive]
theorem preimage {f : G → H} (hf : IsGroupHom f) {s : Set H} (hs : IsSubgroup s) :
    IsSubgroup (f ⁻¹' s) := by
  refine' { .. } <;>
    simp (config := { contextual := true }) [hs.one_mem, hs.mul_mem, hs.inv_mem, hf.map_mul,
      hf.map_one, hf.map_inv, InvMemClass.inv_mem]
#align is_group_hom.preimage IsGroupHom.preimage
#align is_add_group_hom.preimage IsAddGroupHom.preimage

@[to_additive]
theorem preimage_normal {f : G → H} (hf : IsGroupHom f) {s : Set H} (hs : IsNormalSubgroup s) :
    IsNormalSubgroup (f ⁻¹' s) :=
  { one_mem := by simp [hf.map_one, hs.toIsSubgroup.one_mem]
    mul_mem := by simp (config := { contextual := true }) [hf.map_mul, hs.toIsSubgroup.mul_mem]
    inv_mem := by simp (config := { contextual := true }) [hf.map_inv, hs.toIsSubgroup.inv_mem]
    normal := by simp (config := { contextual := true }) [hs.normal, hf.map_mul, hf.map_inv] }
#align is_group_hom.preimage_normal IsGroupHom.preimage_normal
#align is_add_group_hom.preimage_normal IsAddGroupHom.preimage_normal

@[to_additive]
theorem isNormalSubgroup_ker {f : G → H} (hf : IsGroupHom f) : IsNormalSubgroup (ker f) :=
  hf.preimage_normal trivial_normal
#align is_group_hom.is_normal_subgroup_ker IsGroupHom.isNormalSubgroup_ker
#align is_add_group_hom.is_normal_add_subgroup_ker IsAddGroupHom.isNormalAddSubgroup_ker

@[to_additive]
theorem injective_of_trivial_ker {f : G → H} (hf : IsGroupHom f) (h : ker f = trivial G) :
    Function.Injective f := by
  intro a₁ a₂ hfa
  simp [ext_iff, ker, IsSubgroup.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₂]
#align is_group_hom.injective_of_trivial_ker IsGroupHom.injective_of_trivial_ker
#align is_add_group_hom.injective_of_trivial_ker IsAddGroupHom.injective_of_trivial_ker

@[to_additive]
theorem trivial_ker_of_injective {f : G → H} (hf : IsGroupHom f) (h : Function.Injective f) :
    ker f = trivial G :=
  Set.ext fun x =>
    Iff.intro
      (fun hx => by
        suffices f x = f 1 by simpa using h this
        simp [hf.map_one]; rwa [mem_ker] at hx)
      (by simp (config := { contextual := true }) [mem_ker, hf.map_one])
#align is_group_hom.trivial_ker_of_injective IsGroupHom.trivial_ker_of_injective
#align is_add_group_hom.trivial_ker_of_injective IsAddGroupHom.trivial_ker_of_injective

@[to_additive]
theorem injective_iff_trivial_ker {f : G → H} (hf : IsGroupHom f) :
    Function.Injective f ↔ ker f = trivial G :=
  ⟨hf.trivial_ker_of_injective, hf.injective_of_trivial_ker⟩
#align is_group_hom.injective_iff_trivial_ker IsGroupHom.injective_iff_trivial_ker
#align is_add_group_hom.injective_iff_trivial_ker IsAddGroupHom.injective_iff_trivial_ker

@[to_additive]
theorem trivial_ker_iff_eq_one {f : G → H} (hf : IsGroupHom f) :
    ker f = trivial G ↔ ∀ x, f x = 1 → x = 1 := by
  rw [Set.ext_iff]; simp [ker];
    exact ⟨fun h x hx => (h x).1 hx, fun h x => ⟨h x, fun hx => by rw [hx, hf.map_one]⟩⟩
#align is_group_hom.trivial_ker_iff_eq_one IsGroupHom.trivial_ker_iff_eq_one
#align is_add_group_hom.trivial_ker_iff_eq_zero IsAddGroupHom.trivial_ker_iff_eq_zero

end IsGroupHom

namespace AddGroup

variable [AddGroup A]

/-- If `A` is an additive group and `s : Set A`, then `InClosure s : Set A` is the underlying
subset of the subgroup generated by `s`. -/
inductive InClosure (s : Set A) : A → Prop
  | basic {a : A} : a ∈ s → InClosure s a
  | zero : InClosure s 0
  | neg {a : A} : InClosure s a → InClosure s (-a)
  | add {a b : A} : InClosure s a → InClosure s b → InClosure s (a + b)
#align add_group.in_closure AddGroup.InClosure

end AddGroup

namespace Group

open IsSubmonoid IsSubgroup

variable [Group G] {s : Set G}

/-- If `G` is a group and `s : Set G`, then `InClosure s : Set G` is the underlying
subset of the subgroup generated by `s`. -/
@[to_additive]
inductive InClosure (s : Set G) : G → Prop
  | basic {a : G} : a ∈ s → InClosure s a
  | one : InClosure s 1
  | inv {a : G} : InClosure s a → InClosure s a⁻¹
  | mul {a b : G} : InClosure s a → InClosure s b → InClosure s (a * b)
#align group.in_closure Group.InClosure

/-- `Group.closure s` is the subgroup generated by `s`, i.e. the smallest subgroup containg `s`. -/
@[to_additive
  "`AddGroup.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 | InClosure s a }
#align group.closure Group.closure
#align add_group.closure AddGroup.closure

@[to_additive]
theorem mem_closure {a : G} : a ∈ s → a ∈ closure s :=
  InClosure.basic
#align group.mem_closure Group.mem_closure
#align add_group.mem_closure AddGroup.mem_closure

@[to_additive]
theorem closure.isSubgroup (s : Set G) : IsSubgroup (closure s) :=
  { one_mem := InClosure.one
    mul_mem := InClosure.mul
    inv_mem := InClosure.inv }
#align group.closure.is_subgroup Group.closure.isSubgroup
#align add_group.closure.is_add_subgroup AddGroup.closure.isAddSubgroup

@[to_additive]
theorem subset_closure {s : Set G} : s ⊆ closure s := fun _ => mem_closure
#align group.subset_closure Group.subset_closure
#align add_group.subset_closure AddGroup.subset_closure

@[to_additive]
theorem closure_subset {s t : Set G} (ht : IsSubgroup t) (h : s ⊆ t) : closure s ⊆ t := fun a ha =>
  by induction ha <;> simp [h _, *, ht.one_mem, ht.mul_mem, IsSubgroup.inv_mem_iff]
#align group.closure_subset Group.closure_subset
#align add_group.closure_subset AddGroup.closure_subset

@[to_additive]
theorem closure_subset_iff {s t : Set G} (ht : IsSubgroup t) : closure s ⊆ t ↔ s ⊆ t :=
  ⟨fun h _ ha => h (mem_closure ha), fun h _ ha => closure_subset ht h ha⟩
#align group.closure_subset_iff Group.closure_subset_iff
#align add_group.closure_subset_iff AddGroup.closure_subset_iff

@[to_additive]
theorem closure_mono {s t : Set G} (h : s ⊆ t) : closure s ⊆ closure t :=
  closure_subset (closure.isSubgroup _) <| Set.Subset.trans h subset_closure
#align group.closure_mono Group.closure_mono
#align add_group.closure_mono AddGroup.closure_mono

@[to_additive (attr := simp)]
theorem closure_subgroup {s : Set G} (hs : IsSubgroup s) : closure s = s :=
  Set.Subset.antisymm (closure_subset hs <| Set.Subset.refl s) subset_closure
#align group.closure_subgroup Group.closure_subgroup
#align add_group.closure_add_subgroup AddGroup.closure_addSubgroup

@[to_additive]
theorem exists_list_of_mem_closure {s : Set G} {a : G} (h : a ∈ closure s) :
    ∃ l : List G, (∀ x ∈ l, x ∈ s ∨ x⁻¹ ∈ s) ∧ l.prod = a :=
  InClosure.recOn h (fun {x} hxs => ⟨[x], List.forall_mem_singleton.2 <| Or.inl hxs, one_mul _⟩)
    ⟨[], List.forall_mem_nil _, rfl⟩
    (fun {x} _ ⟨L, HL1, HL2⟩ =>
      ⟨L.reverse.map Inv.inv, fun x hx =>
        let ⟨y, hy1, hy2⟩ := List.exists_of_mem_map hx
        hy2 ▸ Or.imp id (by rw [inv_inv]; exact id) (HL1 _ <| List.mem_reverse'.1 hy1).symm,
        HL2 ▸
          List.recOn L inv_one.symm fun hd tl ih => by
            rw [List.reverse_cons, List.map_append, List.prod_append, ih, List.map_singleton,
              List.prod_cons, List.prod_nil, mul_one, List.prod_cons, mul_inv_rev]⟩)
    fun {x y} _ _ ⟨L1, HL1, HL2⟩ ⟨L2, HL3, HL4⟩ =>
    ⟨L1 ++ L2, List.forall_mem_append.2 ⟨HL1, HL3⟩, by rw [List.prod_append, HL2, HL4]⟩
#align group.exists_list_of_mem_closure Group.exists_list_of_mem_closure
#align add_group.exists_list_of_mem_closure AddGroup.exists_list_of_mem_closure

@[to_additive]
theorem image_closure [Group H] {f : G → H} (hf : IsGroupHom f) (s : Set G) :
    f '' closure s = closure (f '' s) :=
  le_antisymm
    (by
      rintro _ ⟨x, hx, rfl⟩
      exact InClosure.recOn hx
        (by intros _ ha; exact subset_closure (mem_image_of_mem f ha))
        (by
          rw [hf.map_one]
          apply IsSubmonoid.one_mem (closure.isSubgroup _).toIsSubmonoid)
        (by
          intros _ _
          rw [hf.map_inv]
          apply IsSubgroup.inv_mem (closure.isSubgroup _))
        (by
          intros _ _ _ _ ha hb
          rw [hf.map_mul]
          exact (closure.isSubgroup (f '' s)).toIsSubmonoid.mul_mem ha hb))
    (closure_subset (hf.image_subgroup <| closure.isSubgroup _) <|
      Set.image_subset _ subset_closure)
#align group.image_closure Group.image_closure
#align add_group.image_closure AddGroup.image_closure

@[to_additive]
theorem mclosure_subset {s : Set G} : Monoid.Closure s ⊆ closure s :=
  Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid <| subset_closure
#align group.mclosure_subset Group.mclosure_subset
#align add_group.mclosure_subset AddGroup.mclosure_subset

@[to_additive]
theorem mclosure_inv_subset {s : Set G} : Monoid.Closure (Inv.inv ⁻¹' s) ⊆ closure s :=
  Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid fun x hx =>
    inv_inv x ▸ ((closure.isSubgroup _).inv_mem <| subset_closure hx)
#align group.mclosure_inv_subset Group.mclosure_inv_subset
#align add_group.mclosure_neg_subset AddGroup.mclosure_neg_subset

@[to_additive]
theorem closure_eq_mclosure {s : Set G} : closure s = Monoid.Closure (s ∪ Inv.inv ⁻¹' s) :=
  Set.Subset.antisymm
    (@closure_subset _ _ _ (Monoid.Closure (s ∪ Inv.inv ⁻¹' s))
      { one_mem := (Monoid.closure.isSubmonoid _).one_mem
        mul_mem := (Monoid.closure.isSubmonoid _).mul_mem
        inv_mem := fun hx =>
          Monoid.InClosure.recOn hx
            (fun {x} hx =>
              Or.casesOn hx
                (fun hx =>
                  Monoid.subset_closure <| Or.inr <| show x⁻¹⁻¹ ∈ s from (inv_inv x).symm ▸ hx)
                fun hx => Monoid.subset_closure <| Or.inl hx)
            ((@inv_one G _).symm ▸ IsSubmonoid.one_mem (Monoid.closure.isSubmonoid _))
            fun {x y} _ _ ihx ihy =>
            (mul_inv_rev x y).symm ▸ IsSubmonoid.mul_mem (Monoid.closure.isSubmonoid _) ihy ihx }
      (Set.Subset.trans (Set.subset_union_left _ _) Monoid.subset_closure))
    (Monoid.closure_subset (closure.isSubgroup _).toIsSubmonoid <|
      Set.union_subset subset_closure fun x hx =>
        inv_inv x ▸ (IsSubgroup.inv_mem (closure.isSubgroup _) <| subset_closure hx))
#align group.closure_eq_mclosure Group.closure_eq_mclosure
#align add_group.closure_eq_mclosure AddGroup.closure_eq_mclosure

@[to_additive]
theorem mem_closure_union_iff {G : Type _} [CommGroup G] {s t : Set G} {x : G} :
    x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
  by
  simp only [closure_eq_mclosure, Monoid.mem_closure_union_iff, exists_prop, preimage_union];
  constructor
  · 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]
#align group.mem_closure_union_iff Group.mem_closure_union_iff
#align add_group.mem_closure_union_iff AddGroup.mem_closure_union_iff

end Group

namespace IsSubgroup

variable [Group G]

@[to_additive]
theorem trivial_eq_closure : trivial G = Group.closure ∅ :=
  Subset.antisymm (by simp [Set.subset_def, (Group.closure.isSubgroup _).one_mem])
    (Group.closure_subset trivial_normal.toIsSubgroup <| by simp)
#align is_subgroup.trivial_eq_closure IsSubgroup.trivial_eq_closure
#align is_add_subgroup.trivial_eq_closure IsAddSubgroup.trivial_eq_closure

end IsSubgroup

/-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

variable {s : Set G} [Group G]

theorem conjugatesOf_subset {t : Set G} (ht : IsNormalSubgroup t) {a : G} (h : a ∈ t) :
    conjugatesOf a ⊆ t := fun x hc =>
  by
  obtain ⟨c, w⟩ := isConj_iff.1 hc
  have H := IsNormalSubgroup.normal ht a h c
  rwa [← w]
#align group.conjugates_of_subset Group.conjugatesOf_subset

theorem conjugatesOfSet_subset' {s t : Set G} (ht : IsNormalSubgroup t) (h : s ⊆ t) :
    conjugatesOfSet s ⊆ t :=
  Set.unionᵢ₂_subset fun _ H => conjugatesOf_subset ht (h H)
#align group.conjugates_of_set_subset' Group.conjugatesOfSet_subset'

/-- 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 normalClosure (s : Set G) : Set G :=
  closure (conjugatesOfSet s)
#align group.normal_closure Group.normalClosure

theorem conjugatesOfSet_subset_normalClosure : conjugatesOfSet s ⊆ normalClosure s :=
  subset_closure
#align group.conjugates_of_set_subset_normal_closure Group.conjugatesOfSet_subset_normalClosure

theorem subset_normalClosure : s ⊆ normalClosure s :=
  Set.Subset.trans subset_conjugatesOfSet conjugatesOfSet_subset_normalClosure
#align group.subset_normal_closure Group.subset_normalClosure

/-- The normal closure of a set is a subgroup. -/
theorem normalClosure.isSubgroup (s : Set G) : IsSubgroup (normalClosure s) :=
  closure.isSubgroup (conjugatesOfSet s)
#align group.normal_closure.is_subgroup Group.normalClosure.isSubgroup

/-- The normal closure of s is a normal subgroup. -/
theorem normalClosure.is_normal : IsNormalSubgroup (normalClosure s) :=
  { normalClosure.isSubgroup _ with
    normal := fun n h g => by
      induction' h with x hx x hx ihx x y hx hy ihx ihy
      · exact conjugatesOfSet_subset_normalClosure (conj_mem_conjugatesOfSet hx)
      · simpa using (normalClosure.isSubgroup s).one_mem
      · rw [← conj_inv]
        exact (normalClosure.isSubgroup _).inv_mem ihx
      · rw [← conj_mul]
        exact (normalClosure.isSubgroup _).toIsSubmonoid.mul_mem ihx ihy }
#align group.normal_closure.is_normal Group.normalClosure.is_normal

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normalClosure_subset {s t : Set G} (ht : IsNormalSubgroup t) (h : s ⊆ t) :
    normalClosure s ⊆ t := fun a w =>
  by
  induction' w with x hx x _ ihx x y _ _ ihx ihy
  · exact conjugatesOfSet_subset' ht h <| hx
  · exact ht.toIsSubgroup.toIsSubmonoid.one_mem
  · exact ht.toIsSubgroup.inv_mem ihx
  · exact ht.toIsSubgroup.toIsSubmonoid.mul_mem ihx ihy
#align group.normal_closure_subset Group.normalClosure_subset

theorem normalClosure_subset_iff {s t : Set G} (ht : IsNormalSubgroup t) :
    s ⊆ t ↔ normalClosure s ⊆ t :=
  ⟨normalClosure_subset ht, Set.Subset.trans subset_normalClosure⟩
#align group.normal_closure_subset_iff Group.normalClosure_subset_iff

theorem normalClosure_mono {s t : Set G} : s ⊆ t → normalClosure s ⊆ normalClosure t := fun h =>
  normalClosure_subset normalClosure.is_normal (Set.Subset.trans h subset_normalClosure)
#align group.normal_closure_mono Group.normalClosure_mono

end Group

/-- Create a bundled subgroup from a set `s` and `[IsSubgroup 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 : IsSubgroup s) : Subgroup G
    where
  carrier := s
  one_mem' := h.1.1
  mul_mem' := h.1.2
  inv_mem' := h.2
#align subgroup.of Subgroup.of
#align add_subgroup.of AddSubgroup.of

@[to_additive]
theorem Subgroup.isSubgroup [Group G] (K : Subgroup G) : IsSubgroup (K : Set G) :=
  { one_mem := K.one_mem'
    mul_mem := K.mul_mem'
    inv_mem := K.inv_mem' }
#align subgroup.is_subgroup Subgroup.isSubgroup
#align add_subgroup.is_add_subgroup AddSubgroup.isAddSubgroup

-- this will never fire if it's an instance
@[to_additive]
theorem Subgroup.of_normal [Group G] (s : Set G) (h : IsSubgroup s) (n : IsNormalSubgroup s) :
    Subgroup.Normal (Subgroup.of h) :=
  { conj_mem := n.normal }
#align subgroup.of_normal Subgroup.of_normal
#align add_subgroup.of_normal AddSubgroup.of_normal


import algebraic_topology.cech_nerve

universe u

noncomputable theory

open_locale simplicial

namespace category_theory

open category_theory.limits

variables {C : Type*} [category C]

namespace simplicial_object

variables [∀ (n : ℕ) (f : arrow C),
  has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)]

section
open simplex_category opposite limits.wide_pullback

lemma hom_ext (X : simplicial_object.augmented C) (F : arrow C)
  (f g : X ⟶ F.augmented_cech_nerve) (hl : f.left.app (op [0]) = g.left.app (op [0]))
  (hr : f.right = g.right) :
  f = g :=
begin
  apply (cech_nerve_equiv X F).symm.injective,
  dsimp only [cech_nerve_equiv_symm_apply],
  ext1,
  { simp only [equivalence_right_to_left_left],
    rw hl },
  { exact hr }
end

-- move this
@[simps]
def augmented_cech_nerve.left_obj_zero_iso (F : arrow C) :
  F.augmented_cech_nerve.left.obj (op [0]) ≅ F.left :=
{ hom := π _ ⟨0⟩,
  inv := lift F.hom (λ _, 𝟙 _) (λ _, category.id_comp _),
  hom_inv_id' :=
  begin
    ext,
    { rw [category.assoc, lift_π, category.id_comp, category.comp_id],
      cases j, congr' 2, dsimp at j ⊢, exact subsingleton.elim _ _ },
    { simp only [π_arrow, category.id_comp, limits.wide_pullback.lift_base, category.assoc], }
  end,
  inv_hom_id' := lift_π _ _ _ _ _ }
.

-- move this
lemma augmented_cech_nerve.left_map_comp_obj_zero_iso
  (F : arrow C) (n : simplex_category) (i : ulift (fin (n.len+1))) :
  F.augmented_cech_nerve.left.map (n.const i.down).op ≫ (augmented_cech_nerve.left_obj_zero_iso F).hom =
  wide_pullback.π _ i :=
begin
  rw [← iso.eq_comp_inv],
  dsimp only [arrow.augmented_cech_nerve_left, arrow.cech_nerve_map,
    augmented_cech_nerve.left_obj_zero_iso_inv],
  ext1 ⟨j⟩,
  { rw [limits.wide_pullback.lift_π, category.assoc, limits.wide_pullback.lift_π, category.comp_id],
    cases i, refl },
  { rw [limits.wide_pullback.lift_base, category.assoc, limits.wide_pullback.lift_base,
      limits.wide_pullback.π_arrow], }
end
.

@[simp]
lemma equivalence_left_to_right_left_app_zero_comp_π
  (X : simplicial_object.augmented C) (F : arrow C) (G : augmented.to_arrow.obj X ⟶ F) (i) :
  (equivalence_left_to_right X F G).left.app (op [0]) ≫ limits.wide_pullback.π _ i =
  G.left :=
begin
  dsimp only [equivalence_left_to_right_left_app, unop_op],
  rw [limits.wide_pullback.lift_π, simplex_category.hom_zero_zero ([0].const i.down),
    op_id, X.left.map_id, category.id_comp],
end
.

end

end simplicial_object

end category_theory


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/
import meta.rb_map
import tactic.core

/-!
# Tactics About Dependencies

This module provides tactics to compute dependencies and reverse dependencies of
hypotheses. An expression `e` depends on a hypothesis `h` if `e` would not be
valid if `h` were removed from the context. For example, the expression
`e := x > 0` depends on `x`. We say that `x` is a dependency of `e` and that `e`
is a reverse dependency of `x`.

It is sometimes useful to consider *inclusive* dependency: `e` inclusively
depends on `h` iff `e` depends on `h` or `e = h` (so inclusive dependency is the
reflexive closure of regular dependency).

Note that the standard library does not use quite the same terminology:

* `kdependencies`/`kdeps` from the standard library compute reverse
  dependencies, not dependencies.
* `kdepends_on` and functions derived from it ignore local definitions and
  therefore compute a weaker dependency relation (see next section).

## Local Definitions

Determining dependencies of hypotheses is usually straightforward: a hypothesis
`r : R` depends on another hypothesis `d : D` if `d` occurs in `R`. The
implementation is more involved, however, in the presence of local definitions.
Consider this context:

```lean
n m : ℕ
k : ℕ := m
o : ℕ := k
h : o > 0
```

`h` depends on `o`, `k` and `m`, but only the dependency on `o` is syntactically
obvious. `kdepends_on` ignores this complication and claims that `h` does not
depend on `k` or `m`. We do not follow this example but process local
definitions properly. This means that if the context contains a local
definition, we need to compute the syntactic dependencies of `h`, then their
dependencies, and so on.

## Direct Dependencies

If you want to ignore local definitions while computing dependencies, this
module also provides tactics to find the *direct* dependencies of a hypothesis.
These are the hypotheses that syntactically appear in the hypothesis's type (or
value, if the hypothesis is a local definition).
-/

open native
open expr_set (local_set_to_name_set)
open name_set (local_list_to_name_set)

namespace tactic

/-! ### Direct Dependencies -/

/-! #### Checking whether hypotheses directly depend on each other -/

/--
`type_has_local_in_name_set h ns` returns true iff the type of `h` contains a
local constant whose unique name appears in `ns`.
-/
meta def type_has_local_in_name_set (h : expr) (ns : name_set) : tactic bool := do
  h_type ← infer_type h,
  pure $ h_type.has_local_in ns

/--
`type_has_local_in_set h hs` returns true iff the type of `h` contains any of
the local constants `hs`.
-/
meta def type_has_local_in_set (h : expr) (hs : expr_set) : tactic bool :=
type_has_local_in_name_set h $ local_set_to_name_set hs

/--
`type_has_local_in h hs` returns true iff the type of `h` contains any of the
local constants `hs`.
-/
meta def type_has_local_in (h : expr) (hs : list expr) : tactic bool :=
type_has_local_in_name_set h $ local_list_to_name_set hs

/--
`local_def_value_has_local_in_name_set h ns` returns true iff `h` is a local
definition whose value contains a local constant whose unique name appears in
`ns`.
-/
meta def local_def_value_has_local_in_name_set (h : expr) (ns : name_set) :
  tactic bool := do
  (some h_val) ← try_core $ local_def_value h | pure ff,
  pure $ h_val.has_local_in ns

/--
`local_def_value_has_local_in_set h hs` returns true iff `h` is a local
definition whose value contains any of the local constants `hs`.
-/
meta def local_def_value_has_local_in_set (h : expr) (hs : expr_set) :
  tactic bool :=
local_def_value_has_local_in_name_set h $ local_set_to_name_set hs

/--
`local_def_value_has_local_in h hs` returns true iff `h` is a local definition
whose value contains any of the local constants `hs`.
-/
meta def local_def_value_has_local_in (h : expr) (hs : list expr) :
  tactic bool :=
local_def_value_has_local_in_name_set h $ local_list_to_name_set hs

/--
`hyp_directly_depends_on_local_name_set h ns` is true iff the hypothesis `h`
directly depends on a hypothesis whose unique name appears in `ns`.
-/
meta def hyp_directly_depends_on_local_name_set (h : expr) (ns : name_set) :
  tactic bool :=
list.mbor
  [ type_has_local_in_name_set h ns,
    local_def_value_has_local_in_name_set h ns ]

/--
`hyp_directly_depends_on_local_set h hs` is true iff the hypothesis `h` directly
depends on any of the hypotheses `hs`.
-/
meta def hyp_directly_depends_on_local_set (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_directly_depends_on_local_name_set h $ local_set_to_name_set hs

/--
`hyp_directly_depends_on_locals h hs` is true iff the hypothesis `h` directly
depends on any of the hypotheses `hs`.
-/
meta def hyp_directly_depends_on_locals (h : expr) (hs : list expr) :
  tactic bool :=
hyp_directly_depends_on_local_name_set h $ local_list_to_name_set hs

/--
`hyp_directly_depends_on_local_name_set_inclusive h ns` is true iff the
hypothesis `h` directly depends on a hypothesis whose unique name appears in
`ns` or `h`'s name appears in `ns`.
-/
meta def hyp_directly_depends_on_local_name_set_inclusive (h : expr)
  (ns : name_set) : tactic bool :=
list.mbor
  [ pure $ ns.contains h.local_uniq_name
  , hyp_directly_depends_on_local_name_set h ns ]

/--
`hyp_directly_depends_on_local_set_inclusive h ns` is true iff the hypothesis `h`
directly depends on any of the hypotheses `hs` or `h` appears in `hs`.
-/
meta def hyp_directly_depends_on_local_set_inclusive (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_directly_depends_on_local_name_set_inclusive h $ local_set_to_name_set hs

/--
`hyp_directly_depends_on_locals_inclusive h ns` is true iff the hypothesis `h`
directly depends on any of the hypotheses `hs` or `h` appears in `hs`.
-/
meta def hyp_directly_depends_on_locals_inclusive (h : expr) (hs : list expr) :
  tactic bool :=
hyp_directly_depends_on_local_name_set_inclusive h $ local_list_to_name_set hs

/-! #### Computing the direct dependencies of a hypothesis -/

/--
`direct_dependency_set_of_hyp h` is the set of hypotheses that the hypothesis
`h` directly depends on. These are the hypotheses that appear in `h`'s type or
value (if `h` is a local definition).
-/
meta def direct_dependency_set_of_hyp (h : expr) : tactic expr_set := do
  t ← infer_type h,
  let deps := t.list_local_consts',
  (some val) ← try_core $ local_def_value h | pure deps,
  let deps := deps.union val.list_local_consts',
  pure deps

/--
`direct_dependency_name_set_of_hyp h` is the set of unique names of hypotheses
that the hypothesis `h` directly depends on. These are the hypotheses that
appear in `h`'s type or value (if `h` is a local definition).
-/
meta def direct_dependency_name_set_of_hyp (h : expr) : tactic name_set :=
local_set_to_name_set <$> direct_dependency_set_of_hyp h

/--
`direct_dependencies_of_hyp h` is the list of hypotheses that the hypothesis `h`
directly depends on. These are the hypotheses that appear in `h`'s type or value
(if `h` is a local definition). The dependencies are returned in no particular
order.
-/
meta def direct_dependencies_of_hyp (h : expr) : tactic (list expr) :=
rb_set.to_list <$> direct_dependency_set_of_hyp h

/--
`direct_dependency_set_of_hyp_inclusive h` is the set of hypotheses that the
hypothesis `h` directly depends on, plus `h` itself.
-/
meta def direct_dependency_set_of_hyp_inclusive (h : expr) : tactic expr_set := do
  deps ← direct_dependency_set_of_hyp h,
  pure $ deps.insert h

/--
`direct_dependency_name_set_of_hyp_inclusive h` is the set of unique names of
hypotheses that the hypothesis `h` directly depends on, plus `h` itself.
-/
meta def direct_dependency_name_set_of_hyp_inclusive (h : expr) :
  tactic name_set :=
local_set_to_name_set <$> direct_dependency_set_of_hyp_inclusive h

/--
`direct_dependencies_of_hyp_inclusive h` is the list of hypotheses that the
hypothesis `h` directly depends on, plus `h` itself. The dependencies are
returned in no particular order.
-/
meta def direct_dependencies_of_hyp_inclusive (h : expr) : tactic (list expr) :=
rb_set.to_list <$> direct_dependency_set_of_hyp_inclusive h

/-! ### Indirect/Transitive Dependencies -/

/-! #### Checking whether hypotheses depend on each other -/

/--
`hyp_depends_on_local_name_set' cache h ns` is true iff `h` depends on any of
the hypotheses whose unique names appear in `ns`. `cache` must be a set of
hypotheses known *not* to depend (even indirectly) on any of the `ns`. This is
a performance optimisation, so you can give an empty cache. The tactic also
returns an expanded cache with hypotheses which the tactic has encountered.

You probably want to use `tactic.hyp_depends_on_local_name_set` or
`tactic.hyps_depend_on_local_name_set` instead of this tactic.
-/
meta def hyp_depends_on_local_name_set' : expr_set → expr → name_set →
  tactic (bool × expr_set) := λ cache h ns, do
  ff ← pure $ cache.contains h | pure (ff, cache),
  direct_deps ← direct_dependency_set_of_hyp h,
  let has_dep := direct_deps.fold ff (λ d b, b || ns.contains d.local_uniq_name),
  ff ← pure has_dep | pure (tt, cache),
  (has_dep, cache) ← direct_deps.mfold (ff, cache) $ λ d ⟨b, cache⟩,
    if b
      then pure (tt, cache)
      else hyp_depends_on_local_name_set' cache d ns,
  if has_dep
    then pure (tt, cache)
    else pure (ff, cache.insert h)

/--
`hyp_depends_on_local_name_set h ns` is true iff the hypothesis `h` depends on
any of the hypotheses whose unique names appear in `ns`. If you need to check
dependencies of multiple hypotheses, use `tactic.hyps_depend_on_local_name_set`.
-/
meta def hyp_depends_on_local_name_set (h : expr) (ns : name_set) : tactic bool := do
  ctx_has_local_def ← context_upto_hyp_has_local_def h,
  if ctx_has_local_def
    then prod.fst <$> hyp_depends_on_local_name_set' mk_expr_set h ns
    else hyp_directly_depends_on_local_name_set h ns

/--
`hyp_depends_on_local_set h hs` is true iff the hypothesis `h` depends on
any of the hypotheses `hs`. If you need to check dependencies of multiple
hypotheses, use `tactic.hyps_depend_on_local_set`.
-/
meta def hyp_depends_on_local_set (h : expr) (hs : expr_set) : tactic bool :=
hyp_depends_on_local_name_set h $ local_set_to_name_set hs

/--
`hyp_depends_on_locals h hs` is true iff the hypothesis `h` depends on any of
the hypotheses `hs`. If you need to check dependencies of multiple hypotheses,
use `tactic.hyps_depend_on_locals`.
-/
meta def hyp_depends_on_locals (h : expr) (hs : list expr) : tactic bool :=
hyp_depends_on_local_name_set h $ local_list_to_name_set hs

/--
`hyps_depend_on_local_name_set hs ns` returns, for each `h ∈ hs`, whether `h`
depends on a hypothesis whose unique name appears in `ns`. This is the same as
(but more efficient than) calling `tactic.hyp_depends_on_local_name_set` for
every `h ∈ hs`.
-/
meta def hyps_depend_on_local_name_set (hs : list expr) (ns : name_set) :
  tactic (list bool) := do
  ctx_has_local ← context_has_local_def,
  if ctx_has_local
    then
      let go : expr → list bool × expr_set → tactic (list bool × expr_set) :=
      λ h ⟨deps, cache⟩, do
      { (h_dep, cache) ← hyp_depends_on_local_name_set' cache h ns,
        pure (h_dep :: deps, cache) }
      in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else hs.mmap $ λ h, hyp_directly_depends_on_local_name_set h ns

/--
`hyps_depend_on_local_set hs is` returns, for each `h ∈ hs`, whether `h` depends
on any of the hypotheses `is`. This is the same as (but more efficient than)
calling `tactic.hyp_depends_on_local_set` for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_set (hs : list expr) (is : expr_set) :
  tactic (list bool) :=
hyps_depend_on_local_name_set hs $ local_set_to_name_set is

/--
`hyps_depend_on_locals hs is` returns, for each `h ∈ hs`, whether `h` depends
on any of the hypotheses `is`. This is the same as (but more efficient than)
calling `tactic.hyp_depends_on_locals` for every `h ∈ hs`.
-/
meta def hyps_depend_on_locals (hs is : list expr) : tactic (list bool) :=
hyps_depend_on_local_name_set hs $ local_list_to_name_set is

/--
`hyp_depends_on_local_name_set_inclusive' cache h ns` is true iff the hypothesis
`h` inclusively depends on a hypothesis whose unique name appears in `ns`.
`cache` must be a set of hypotheses known *not* to depend (even indirectly) on
any of the `ns`. This is a performance optimisation, so you can give an empty
cache. The tactic also returns an expanded cache with hypotheses which the
tactic has encountered. Note that the cache records exclusive, not inclusive
dependencies.

You probably want to use `tactic.hyp_depends_on_local_name_set_inclusive` or
`tactic.hyps_depend_on_local_name_set_inclusive` instead of this tactic.
-/
meta def hyp_depends_on_local_name_set_inclusive' (cache : expr_set) (h : expr)
  (ns : name_set) : tactic (bool × expr_set) :=
if ns.contains h.local_uniq_name
  then pure (tt, cache)
  else hyp_depends_on_local_name_set' cache h ns

/--
`hyp_depends_on_local_name_set_inclusive h ns` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses whose unique names appear in `ns`.
If you need to check the dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_local_name_set_inclusive`.
-/
meta def hyp_depends_on_local_name_set_inclusive (h : expr) (ns : name_set) :
  tactic bool :=
list.mbor
  [ pure $ ns.contains h.local_uniq_name,
    hyp_depends_on_local_name_set h ns ]

/--
`hyp_depends_on_local_set_inclusive h hs` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses `hs`. If you need to check
dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_local_set_inclusive`.
-/
meta def hyp_depends_on_local_set_inclusive (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_depends_on_local_name_set_inclusive h $ local_set_to_name_set hs

/--
`hyp_depends_on_locals_inclusive h hs` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses `hs`. If you need to check
dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_locals_inclusive`.
-/
meta def hyp_depends_on_locals_inclusive (h : expr) (hs : list expr) :
  tactic bool :=
hyp_depends_on_local_name_set_inclusive h $ local_list_to_name_set hs

/--
`hyps_depend_on_local_name_set_inclusive hs ns` returns, for each `h ∈ hs`,
whether `h` inclusively depends on a hypothesis whose unique name appears in
`ns`. This is the same as (but more efficient than) calling
`tactic.hyp_depends_on_local_name_set_inclusive` for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_name_set_inclusive (hs : list expr) (ns : name_set) :
  tactic (list bool) := do
  ctx_has_local ← context_has_local_def,
  if ctx_has_local
    then
      let go : expr → list bool × expr_set → tactic (list bool × expr_set) :=
      λ h ⟨deps, cache⟩, do
      { (h_dep, cache) ← hyp_depends_on_local_name_set_inclusive' cache h ns,
        pure (h_dep :: deps, cache) }
      in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap $ λ h, hyp_directly_depends_on_local_name_set_inclusive h ns

/--
`hyps_depend_on_local_set_inclusive hs is` returns, for each `h ∈ hs`, whether
`h` depends inclusively on any of the hypotheses `is`. This is the same as
(but more efficient than) calling `tactic.hyp_depends_on_local_set_inclusive`
for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_set_inclusive (hs : list expr) (is : expr_set) :
  tactic (list bool) :=
hyps_depend_on_local_name_set_inclusive hs $ local_set_to_name_set is

/--
`hyps_depend_on_locals_inclusive hs is` returns, for each `h ∈ hs`, whether `h`
depends inclusively on any of the hypotheses `is`. This is the same as (but more
efficient than) calling `tactic.hyp_depends_on_locals_inclusive` for every
`h ∈ hs`.
-/
meta def hyps_depend_on_locals_inclusive (hs is : list expr) : tactic (list bool) :=
hyps_depend_on_local_name_set_inclusive hs $ local_list_to_name_set is

/-! #### Computing the dependencies of a hypothesis -/

/--
`dependency_set_of_hyp' cache h` is the set of dependencies of the hypothesis
`h`. `cache` is a map from hypotheses to all their dependencies (including
indirect dependencies). This is a performance optimisation, so you can give an
empty cache. The tactic also returns an expanded cache with hypotheses which
the tactic has encountered.

You probably want to use `tactic.dependency_set_of_hyp` or
`tactic.dependency_sets_of_hyps` instead of this tactic.
-/
meta def dependency_set_of_hyp' : expr_map expr_set → expr →
  tactic (expr_set × expr_map expr_set) := λ cache h, do
  match cache.find h with
  | some deps := pure (deps, cache)
  | none := do
    direct_deps ← direct_dependency_set_of_hyp h,
    (deps, cache) ←
      direct_deps.mfold (direct_deps, cache) $ λ h' ⟨deps, cache⟩, do
      { (deps', cache) ← dependency_set_of_hyp' cache h',
        pure (deps.union deps', cache) },
    pure (deps, cache.insert h deps)
  end

/--
`dependency_set_of_hyp h` is the set of dependencies of the hypothesis `h`. If
you need the dependencies of multiple hypotheses, use
`tactic.dependency_sets_of_hyps`.
-/
meta def dependency_set_of_hyp (h : expr) : tactic expr_set := do
  ctx_has_local ← context_upto_hyp_has_local_def h,
  if ctx_has_local
    then prod.fst <$> dependency_set_of_hyp' mk_expr_map h
    else direct_dependency_set_of_hyp h

/--
`dependency_name_set_of_hyp h` is the set of unique names of the dependencies of
the hypothesis `h`. If you need the dependencies of multiple hypotheses, use
`tactic.dependency_name_sets_of_hyps`.
-/
meta def dependency_name_set_of_hyp (h : expr) : tactic name_set :=
local_set_to_name_set <$> dependency_set_of_hyp h

/--
`dependencies_of_hyp h` is the list of dependencies of the hypothesis `h`.
The dependencies are returned in no particular order. If you need the
dependencies of multiple hypotheses, use `tactic.dependencies_of_hyps`.
-/
meta def dependencies_of_hyp (h : expr) : tactic (list expr) :=
rb_set.to_list <$> dependency_set_of_hyp h

/--
`dependency_sets_of_hyps hs` returns, for each `h ∈ hs`, the set of dependencies
of `h`. This is the same as (but more performant than) using
`tactic.dependency_set_of_hyp` on every `h ∈ hs`.
-/
meta def dependency_sets_of_hyps (hs : list expr) : tactic (list expr_set) := do
  ctx_has_def ← context_has_local_def,
  if ctx_has_def
    then
      let go : expr → list expr_set × expr_map expr_set →
        tactic (list expr_set × expr_map expr_set) := do
      λ h ⟨deps, cache⟩, do
        { (h_deps, cache) ← dependency_set_of_hyp' cache h,
          pure (h_deps :: deps, cache) }
      in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap direct_dependency_set_of_hyp

/--
`dependency_name_sets_of_hyps hs` returns, for each `h ∈ hs`, the set of unique
names of the dependencies of `h`. This is the same as (but more performant than)
using `tactic.dependency_name_set_of_hyp` on every `h ∈ hs`.
-/
meta def dependency_name_sets_of_hyps (hs : list expr) : tactic (list name_set) :=
list.map local_set_to_name_set <$> dependency_sets_of_hyps hs

/--
`dependencies_of_hyps hs` returns, for each `h ∈ hs`, the dependencies of `h`.
The dependencies appear in no particular order in the returned lists. This is
the same as (but more performant than) using `tactic.dependencies_of_hyp` on
every `h ∈ hs`.
-/
meta def dependencies_of_hyps (hs : list expr) : tactic (list (list expr)) :=
list.map rb_set.to_list <$> dependency_sets_of_hyps hs

/--
`dependency_set_of_hyp_inclusive' cache h` is the set of dependencies of the
hypothesis `h`, plus `h` itself. `cache` is a map from hypotheses to all their
dependencies (including indirect dependencies). This is a performance
optimisation, so you can give an empty cache. The tactic also returns an
expanded cache with hypotheses which the tactic has encountered. Note that the
cache records exclusive, not inclusive dependencies.

You probably want to use `tactic.dependency_set_of_hyp_inclusive` or
`tactic.dependency_sets_of_hyps_inclusive` instead of this tactic.
-/
meta def dependency_set_of_hyp_inclusive' (cache : expr_map expr_set) (h : expr) :
  tactic (expr_set × expr_map expr_set) := do
  (deps, cache) ← dependency_set_of_hyp' cache h,
  pure (deps.insert h, cache)

/--
`dependency_set_of_hyp_inclusive h` is the set of dependencies of the hypothesis
`h`, plus `h` itself. If you need the dependencies of multiple hypotheses, use
`tactic.dependency_sets_of_hyps_inclusive`.
-/
meta def dependency_set_of_hyp_inclusive (h : expr) : tactic expr_set := do
  deps ← dependency_set_of_hyp h,
  pure $ deps.insert h

/--
`dependency_name_set_of_hyp_inclusive h` is the set of unique names of the
dependencies of the hypothesis `h`, plus the unique name of `h` itself. If you
need the dependencies of multiple hypotheses, use
`tactic.dependency_name_sets_of_hyps_inclusive`.
-/
meta def dependency_name_set_of_hyp_inclusive (h : expr) : tactic name_set :=
local_set_to_name_set <$> dependency_set_of_hyp_inclusive h

/--
`dependencies_of_hyp_inclusive h` is the list of dependencies of the hypothesis
`h`, plus `h` itself. The dependencies are returned in no particular order. If
you need the dependencies of multiple hypotheses, use
`tactic.dependencies_of_hyps_inclusive`.
-/
meta def dependencies_of_hyp_inclusive (h : expr) : tactic (list expr) :=
rb_set.to_list <$> dependency_set_of_hyp_inclusive h

/--
`dependency_sets_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the
dependencies of `h`, plus `h` itself. This is the same as (but more performant
than) using `tactic.dependency_set_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependency_sets_of_hyps_inclusive (hs : list expr) :
  tactic (list expr_set) := do
  ctx_has_def ← context_has_local_def,
  if ctx_has_def
    then
      let go : expr → list expr_set × expr_map expr_set →
        tactic (list expr_set × expr_map expr_set) :=
      λ h ⟨deps, cache⟩, do
      { (h_deps, cache) ← dependency_set_of_hyp_inclusive' cache h,
        pure (h_deps :: deps, cache) }
      in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap direct_dependency_set_of_hyp_inclusive

/--
`dependency_name_sets_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the
unique names of the dependencies of `h`, plus the unique name of `h` itself.
This is the same as (but more performant than) using
`tactic.dependency_name_set_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependency_name_sets_of_hyps_inclusive (hs : list expr) :
  tactic (list name_set) :=
list.map local_set_to_name_set <$> dependency_sets_of_hyps_inclusive hs

/--
`dependencies_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the dependencies
of `h`, plus `h` itself. The dependencies appear in no particular order in the
returned lists. This is the same as (but more performant than) using
`tactic.dependencies_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependencies_of_hyps_inclusive (hs : list expr) :
  tactic (list (list expr)) :=
list.map rb_set.to_list <$> dependency_sets_of_hyps_inclusive hs

/-! #### Computing the reverse dependencies of a hypothesis -/

private meta def reverse_dependencies_of_hyp_name_set_aux (hs : name_set) :
  list expr → list expr → name_set → tactic (list expr)
| [] revdeps _ := pure revdeps.reverse
| (H :: Hs) revdeps ns := do
  let H_uname := H.local_uniq_name,
  H_is_revdep ← list.mband
    [ pure $ ¬ hs.contains H_uname,
      hyp_directly_depends_on_local_name_set H ns ],
  if H_is_revdep
    then
      reverse_dependencies_of_hyp_name_set_aux Hs (H :: revdeps)
        (ns.insert H_uname)
    else
      reverse_dependencies_of_hyp_name_set_aux Hs revdeps ns

/--
`reverse_dependencies_of_hyp_name_set hs` is the list of reverse dependencies of
the hypotheses whose unique names appear in `hs`, excluding the `hs` themselves.
The reverse dependencies are returned in the order in which they appear in the
context.
-/
meta def reverse_dependencies_of_hyp_name_set (hs : name_set) :
  tactic (list expr) := do
  ctx ← local_context,
  let ctx := ctx.after (λ h, hs.contains h.local_uniq_name),
  reverse_dependencies_of_hyp_name_set_aux hs ctx [] hs

/--
`reverse_dependencies_of_hyp_set hs` is the list of reverse dependencies of the
hypotheses `hs`, excluding the `hs` themselves. The reverse dependencies are
returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyp_set (hs : expr_set) : tactic (list expr) :=
reverse_dependencies_of_hyp_name_set $ local_set_to_name_set hs

/--
`reverse_dependencies_of_hyps hs` is the list of reverse dependencies of the
hypotheses `hs`, excluding the `hs` themselves. The reverse dependencies are
returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyps (hs : list expr) : tactic (list expr) :=
reverse_dependencies_of_hyp_name_set $ local_list_to_name_set hs

private meta def reverse_dependencies_of_hyp_name_set_inclusive_aux :
  list expr → list expr → name_set → tactic (list expr)
| [] revdeps _ := pure revdeps.reverse
| (H :: Hs) revdeps ns := do
  let H_uname := H.local_uniq_name,
  H_is_revdep ← list.mbor
    [ pure $ ns.contains H.local_uniq_name,
      hyp_directly_depends_on_local_name_set H ns ],
  if H_is_revdep
    then
      reverse_dependencies_of_hyp_name_set_inclusive_aux Hs (H :: revdeps)
        (ns.insert H_uname)
    else
      reverse_dependencies_of_hyp_name_set_inclusive_aux Hs revdeps ns

/--
`reverse_dependencies_of_hyp_name_set_inclusive hs` is the list of reverse
dependencies of the hypotheses whose unique names appear in `hs`, including the
`hs` themselves. The reverse dependencies are returned in the order in which
they appear in the context.
-/
meta def reverse_dependencies_of_hyp_name_set_inclusive (hs : name_set) :
  tactic (list expr) := do
  ctx ← local_context,
  let ctx := ctx.drop_while (λ h, ¬ hs.contains h.local_uniq_name),
  reverse_dependencies_of_hyp_name_set_inclusive_aux ctx [] hs

/--
`reverse_dependencies_of_hyp_set_inclusive hs` is the list of reverse
dependencies of the hypotheses `hs`, including the `hs` themselves. The
inclusive reverse dependencies are returned in the order in which they appear in
the context.
-/
meta def reverse_dependencies_of_hyp_set_inclusive (hs : expr_set) :
  tactic (list expr) :=
reverse_dependencies_of_hyp_name_set_inclusive $ local_set_to_name_set hs

/--
`reverse_dependencies_of_hyps_inclusive hs` is the list of reverse dependencies
of the hypotheses `hs`, including the `hs` themselves. The reverse dependencies
are returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyps_inclusive (hs : list expr) :
  tactic (list expr) :=
reverse_dependencies_of_hyp_name_set_inclusive $ local_list_to_name_set hs

/-! ### Reverting a hypothesis and its reverse dependencies -/

/--
`revert_name_set hs` reverts the hypotheses whose unique names appear in `hs`,
as well as any hypotheses that depend on them. Returns the number of reverted
hypotheses and a list containing these hypotheses. The reverted hypotheses are
returned in the order in which they used to appear in the context and are
guaranteed to store the correct type (see `tactic.update_type`).
-/
meta def revert_name_set (hs : name_set) : tactic (ℕ × list expr) := do
  to_revert ← reverse_dependencies_of_hyp_name_set_inclusive hs,
  to_revert_with_types ← to_revert.mmap update_type,
  num_reverted ← revert_lst to_revert,
  pure (num_reverted, to_revert_with_types)

/--
`revert_set hs` reverts the hypotheses `hs`, as well as any hypotheses that
depend on them. Returns the number of reverted hypotheses and a list containing
these hypotheses. The reverted hypotheses are returned in the order in which
they used to appear in the context and are guaranteed to store the correct type
(see `tactic.update_type`).
-/
meta def revert_set (hs : expr_set) : tactic (ℕ × list expr) :=
revert_name_set $ local_set_to_name_set hs

/--
`revert_lst' hs` reverts the hypotheses `hs`, as well as any hypotheses that
depend on them. Returns the number of reverted hypotheses and a list containing
these hypotheses. The reverted hypotheses are returned in the order in which
they used to appear in the context and are guaranteed to store the correct type
(see `tactic.update_type`).

This is a more informative version of `tactic.revert_lst`.
-/
meta def revert_lst' (hs : list expr) : tactic (ℕ × list expr) :=
revert_name_set $ local_list_to_name_set hs

/--
`revert_reverse_dependencies_of_hyp h` reverts all the hypotheses that depend on
the hypothesis `h`, including the local definitions that have `h` in their
value. This fixes a bug in `tactic.revert_kdependencies` that does not revert
local definitions for which `h` only appears in the value. Returns the number
of reverted hypotheses.
-/
/- We cannot implement it as `revert e >> intro1` because that would change the
local constant in the context. -/
meta def revert_reverse_dependencies_of_hyp (h : expr) : tactic ℕ :=
reverse_dependencies_of_hyp_name_set (mk_name_set.insert h.local_uniq_name) >>=
  revert_lst

/--
`revert_reverse_dependencies_of_hyp_name_set hs` reverts all the hypotheses that
depend on a hypothesis whose unique name appears in `hs`. The `hs` themselves
are not reverted, unless they depend on each other. Returns the number of
reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyp_name_set (hs : name_set) : tactic ℕ :=
reverse_dependencies_of_hyp_name_set hs >>= revert_lst

/--
`revert_reverse_dependencies_of_hyp_set hs` reverts all the hypotheses that
depend on a hypothesis in `hs`. The `hs` themselves are not reverted, unless
they depend on each other. Returns the number of reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyp_set (hs : expr_set) : tactic ℕ :=
reverse_dependencies_of_hyp_set hs >>= revert_lst

/--
`revert_reverse_dependencies_of_hyp hs` reverts all the hypotheses that depend
on a hypothesis in `hs`. The `hs` themselves are not reverted, unless they
depend on each other. Returns the number of reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyps (hs : list expr) : tactic ℕ :=
reverse_dependencies_of_hyps hs >>= revert_lst

end tactic


import tactic
import ruby.rewrite1

open rel

variables {α β γ δ ε φ ψ : Type}

--set_option trace.app_builder true

example (r : rel (α × β) γ) (s : rel α δ) (t : rel γ ε)
  : (r† ;; [s, idd])† ;; t = (idd ;; [s†, idd] ;; r) ;; t := by ruby_nf


import spaces.bounded_cont_diff_map
import analysis.normed.group.basic
import measure_theory.function.lp_space

open topological_space function measure_theory set filter
open_locale bounded_cont_diff_map topological_space ennreal bounded_continuous_function nnreal

section prelim

-- Commutativity should not be needed, but it's sufficient for now
@[to_additive]
theorem continuous_iff_continuous_at_one {G H hom : Type*} [comm_group G] [comm_group H]
  [topological_space G] [topological_space H] [topological_group G] [topological_group H]
  [monoid_hom_class hom G H] {f : hom} :
  continuous f ↔ continuous_at f 1 :=
begin
  refine ⟨λ h, h.continuous_at, λ h, _⟩,
  letI : uniform_space G := topological_group.to_uniform_space G,
  letI : uniform_group G := topological_group_is_uniform,
  letI : uniform_space H := topological_group.to_uniform_space H,
  letI : uniform_group H := topological_group_is_uniform,
  exact uniform_continuous.continuous (uniform_continuous_of_continuous_at_one f h)
end

theorem continuous_multilinear_map.ext_iff {ι 𝕜 F : Type*} {E : ι → Type*} [decidable_eq ι] [nondiscrete_normed_field 𝕜]
  [Π i, normed_group (E i)] [normed_group F] [Π i, normed_space 𝕜 (E i)] [normed_space 𝕜 F]
  {f g : continuous_multilinear_map 𝕜 E F} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, continuous_multilinear_map.ext⟩

lemma has_fderiv_at.tsupport_subset {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {f : E → F} {f' : E → E →L[𝕜] F} (hf : ∀ x, has_fderiv_at f (f' x) x) :
  tsupport f' ⊆ tsupport f :=
begin
  intros x,
  contrapose,
  rw [not_mem_closure_support_iff_eventually_eq, not_mem_closure_support_iff_eventually_eq],
  intros h,
  filter_upwards [h.eventually_eq_nhds],
  intros y hy,
  exact has_fderiv_at.unique (hf y) ((has_fderiv_at_const 0 y).congr_of_eventually_eq hy)
end

lemma fderiv_tsupport_subset {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {f : E → F} (hf : differentiable 𝕜 f) :
  tsupport (fderiv 𝕜 f) ⊆ tsupport f :=
has_fderiv_at.tsupport_subset (λ x, (hf x).has_fderiv_at)

lemma iterated_fderiv_tsupport_subset {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {nf : with_top ℕ} {i : ℕ} {f : E → F} (hf : cont_diff 𝕜 nf f)
  (hif : (i : with_top ℕ) ≤ nf) :
  tsupport (iterated_fderiv 𝕜 i f) ⊆ tsupport f :=
begin
  induction i with i hi,
  { refine subset_of_eq (congr_arg closure _),
    ext x,
    refine not_iff_not_of_iff _,
    simp only [continuous_multilinear_map.ext_iff, iterated_fderiv_zero_apply,
                continuous_multilinear_map.zero_apply, forall_const], },
  { have hif' : (i : with_top ℕ) < nf :=
      lt_of_lt_of_le (with_top.coe_lt_coe.mpr $ i.lt_succ_self) hif,
    have hdf : differentiable 𝕜 (iterated_fderiv 𝕜 i f) :=
      (cont_diff_iff_continuous_differentiable.mp hf).2 i hif',
    calc tsupport (iterated_fderiv 𝕜 (i+1) f)
        = tsupport (fderiv 𝕜 $ iterated_fderiv 𝕜 i f) : by
          { refine congr_arg closure _,
            ext x,
            refine not_iff_not_of_iff _,
            rw [iterated_fderiv_succ_eq_comp_left, comp_apply,
                (continuous_multilinear_curry_left_equiv _ _ _).map_eq_zero_iff] }
    ... ⊆ tsupport (iterated_fderiv 𝕜 i f) : fderiv_tsupport_subset hdf
    ... ⊆ tsupport f : hi hif'.le }
end

lemma has_compact_support_iterated_fderiv {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F]
  {nf : with_top ℕ} {i : ℕ} {f : E → F} (hf : cont_diff 𝕜 nf f) (hsupp : has_compact_support f)
  (hif : (i : with_top ℕ) ≤ nf) : has_compact_support (iterated_fderiv 𝕜 i f) :=
compact_of_is_closed_subset hsupp (is_closed_tsupport _) (iterated_fderiv_tsupport_subset hf hif)

lemma continuous.mem_ℒp_of_has_compact_support {α E : Type*} [hα : nonempty α]
  [topological_space α] {m : measurable_space α} [t2_space α] [opens_measurable_space α]
  [normed_group E] [measurable_space E] [borel_space E]
  [second_countable_topology_either α E]  -- TODO : this should be removable because we are integrating
                                          -- on a compact subset
  {f : α → E} (hf : continuous f) (hsupp : has_compact_support f)
  (p : ℝ≥0∞) (μ : measure α) [is_finite_measure_on_compacts μ]:
  mem_ℒp f p μ :=
begin
  have : bdd_above (range $ norm ∘ f),
    from hf.norm.bdd_above_range_of_has_compact_support hsupp.norm,
  refine mem_ℒp.of_le
    (mem_ℒp_indicator_const p hsupp.measurable_set (⨆ x, ∥f x∥) (or.inr hsupp.measure_lt_top.ne))
    hf.ae_strongly_measurable (ae_of_all _ $ λ x, _),
  rw norm_indicator_eq_indicator_norm,
  refine set.le_indicator (λ a _, _) (λ a, _) x,
  { rw real.norm_of_nonneg (le_csupr_of_le this hα.some (norm_nonneg _)),
    exact le_csupr this a },
  { intros ha,
    simpa using not_mem_of_not_mem_closure ha }
end

end prelim

private def cont_diff_map_supported_in_submodule (𝕜 E F : Type*) [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F] (K : set E)
  (n : with_top ℕ) : submodule 𝕜 (E → F) :=
{ carrier := {f | cont_diff 𝕜 n f ∧ ∀ x ∉ K, f x = 0},
  zero_mem' := ⟨cont_diff_zero_fun, λ x hx, rfl⟩,
  add_mem' := λ f g hf hg, ⟨hf.1.add hg.1, λ x hx,
    by rw [pi.add_apply, hf.2 x hx, hg.2 x hx, add_zero]⟩,
  smul_mem' := λ c f hf, ⟨cont_diff_const.smul hf.1, λ x hx,
    by rw [pi.smul_apply, hf.2 x hx, smul_zero]⟩ }

def cont_diff_map_supported_in (𝕜 E F : Type*) [nondiscrete_normed_field 𝕜]
  [normed_group E] [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F] (K : set E)
  (n : with_top ℕ) := ↥(cont_diff_map_supported_in_submodule 𝕜 E F K n)

namespace cont_diff_map_supported_in

section any_set

variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_group F]
  [normed_space 𝕜 E] [normed_space 𝕜 F] {K : set E} {n : with_top ℕ}
  {f g : cont_diff_map_supported_in 𝕜 E F K n} {x : E}

instance : add_comm_group (cont_diff_map_supported_in 𝕜 E F K n) := submodule.add_comm_group _
instance : module 𝕜 (cont_diff_map_supported_in 𝕜 E F K n) := submodule.module _
instance : has_coe_to_fun (cont_diff_map_supported_in 𝕜 E F K n) (λ _, E → F) := ⟨λ f, f.1⟩

@[ext] lemma ext (H : ∀x, f x = g x) : f = g :=
by {ext, exact H x}

protected lemma cont_diff (f : cont_diff_map_supported_in 𝕜 E F K n) :
  cont_diff 𝕜 n f :=
f.2.1

protected lemma continuous (f : cont_diff_map_supported_in 𝕜 E F K n) :
  continuous f :=
f.cont_diff.continuous

lemma supported_in (f : cont_diff_map_supported_in 𝕜 E F K n) :
  ∀ x ∉ K, f x = 0 :=
f.2.2

lemma support_subset (f : cont_diff_map_supported_in 𝕜 E F K n) :
  support f ⊆ K :=
support_subset_iff'.mpr f.2.2

end any_set

section compact

variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_group F]
  [normed_space 𝕜 E] [normed_space 𝕜 F] {K : compacts E} {n : with_top ℕ}
  {f g : cont_diff_map_supported_in 𝕜 E F K n} {x : E}

lemma has_compact_support (f : cont_diff_map_supported_in 𝕜 E F K n) :
  has_compact_support f :=
has_compact_support.intro K.2 f.supported_in

lemma tsupport_subset (f : cont_diff_map_supported_in 𝕜 E F K n) :
  tsupport f ⊆ K :=
closure_minimal f.support_subset K.2.is_closed

def of_support_subset {f : E → F} (hf : cont_diff 𝕜 n f) (hsupp : support f ⊆ K) :
  cont_diff_map_supported_in 𝕜 E F K n :=
⟨f, ⟨hf, λ x hx, by_contra $ λ hxn, hx (hsupp hxn)⟩⟩

protected lemma bounded (f : cont_diff_map_supported_in 𝕜 E F K n) {i : ℕ} (hi : ↑i ≤ n) :
  ∃ C, ∀ x, ∥iterated_fderiv 𝕜 i f x∥ ≤ C :=
continuous.bounded_above_of_compact_support
  ((cont_diff_iff_continuous_differentiable.mp f.cont_diff).1 i hi)
  (has_compact_support_iterated_fderiv f.cont_diff f.has_compact_support hi)

def to_bounded_cont_diff_map (f : cont_diff_map_supported_in 𝕜 E F K n) :
  B^n⟮E,F;𝕜⟯ :=
⟨f, f.cont_diff, λ i hi, f.bounded hi⟩

lemma coe_to_bounded_cont_diff_map (f : cont_diff_map_supported_in 𝕜 E F K n) :
  (f.to_bounded_cont_diff_map : E → F) = f := rfl

lemma to_bounded_cont_diff_map_injective :
  injective (to_bounded_cont_diff_map : cont_diff_map_supported_in 𝕜 E F K n → B^n⟮E,F;𝕜⟯) :=
begin
  intros f g hfg,
  ext x,
  change to_bounded_cont_diff_map f x = _,
  rw hfg,
  refl
end

def to_bounded_cont_diff_mapₗ :
  cont_diff_map_supported_in 𝕜 E F K n →ₗ[𝕜] (B^n⟮E,F;𝕜⟯) :=
{ to_fun := to_bounded_cont_diff_map,
  map_add' := λ f g, rfl,
  map_smul' := λ a f, rfl }

noncomputable instance : topological_space (cont_diff_map_supported_in 𝕜 E F K n) :=
topological_space.induced to_bounded_cont_diff_mapₗ infer_instance

noncomputable instance : uniform_space (cont_diff_map_supported_in 𝕜 E F K n) :=
uniform_space.comap to_bounded_cont_diff_mapₗ infer_instance

instance : topological_add_group (cont_diff_map_supported_in 𝕜 E F K n) :=
topological_add_group_induced _

instance : has_continuous_smul 𝕜 (cont_diff_map_supported_in 𝕜 E F K n) :=
has_continuous_smul_induced _

variables (𝕜 E F K n)

noncomputable def snorms :
  seminorm_family 𝕜 (cont_diff_map_supported_in 𝕜 E F K n)
  (bounded_cont_diff_map.snorms_ind n) :=
(bounded_cont_diff_map.snorms 𝕜 E F n).comp to_bounded_cont_diff_mapₗ

variables {𝕜 E F K n}

lemma snorms_monotone :
  monotone (snorms 𝕜 E F K n) :=
λ i j hij, seminorm.comp_mono _ (bounded_cont_diff_map.snorms_monotone hij)

--lemma finset.sup_eq_csupr {α β : Type*} [nonempty α] [conditionally_complete_linear_order_bot β] (s : finset α)
--  (f : α → β) : s.sup f = (⨆a∈s, f a) :=
--le_antisymm
--  (finset.sup_le $ assume a ha, le_csupr_of_le sorry a $ le_csupr finite_range_const.bdd_above ha)
--  (csupr_le' $ assume a, csupr_le' $ assume ha, finset.le_sup ha)

lemma snorms_apply (i : ℕ) (hi : ↑i ≤ n) :
  snorms 𝕜 E F K n ⟨i, hi⟩ f = ↑(⨆ (j ≤ i) (x ∈ K), ∥iterated_fderiv 𝕜 j f x∥₊) :=
begin
  rw [snorms, bounded_cont_diff_map.snorms, seminorm_family.comp_apply, seminorm.comp_apply,
      subtype.coe_mk, seminorm.finset_sup_apply, nnreal.coe_injective.eq_iff],
  -- finset.sup'_eq_csupr, sup_ima],
  sorry
end

lemma snorms_directed :
  directed (≤) (snorms 𝕜 E F K n) :=
monotone.directed_le snorms_monotone

instance with_seminorms : with_seminorms (cont_diff_map_supported_in.snorms 𝕜 E F K n) :=
to_bounded_cont_diff_mapₗ.with_seminorms_induced

noncomputable! def to_bounded_cont_diff_mapL :
  cont_diff_map_supported_in 𝕜 E F K n →L[𝕜] (B^n⟮E,F;𝕜⟯) :=
{ to_linear_map := to_bounded_cont_diff_mapₗ,
  cont := continuous_induced_dom }

lemma continuous_iff {X : Type*} [topological_space X]
  (φ : X → cont_diff_map_supported_in 𝕜 E F K n) :
  continuous φ ↔ continuous
    (cont_diff_map_supported_in.to_bounded_cont_diff_map ∘ φ) :=
⟨λ hφ, to_bounded_cont_diff_mapL.continuous.comp hφ, continuous_induced_rng⟩

lemma continuous_of_commutes {𝕜' E' F' : Type*} [normed_group E'] [normed_group F']
  [nondiscrete_normed_field 𝕜'] [normed_space 𝕜' E'] [normed_space 𝕜' F'] {K' : compacts E'}
  (φ : cont_diff_map_supported_in 𝕜 E F K n → cont_diff_map_supported_in 𝕜' E' F' K' n)
  (ψ : B^n⟮E,F;𝕜⟯ → B^n⟮E',F';𝕜'⟯) (hcont : continuous ψ)
  (hcomm : to_bounded_cont_diff_map ∘ φ = ψ ∘ to_bounded_cont_diff_map) :
  continuous φ :=
begin
  rw [continuous_iff, hcomm],
  exact hcont.comp to_bounded_cont_diff_mapL.continuous
end

protected def of_le {k : with_top ℕ} (hkn : k ≤ n) (f : cont_diff_map_supported_in 𝕜 E F K n) :
  cont_diff_map_supported_in 𝕜 E F K k :=
⟨f, f.cont_diff.of_le hkn, f.supported_in⟩

protected def of_leₗ {k : with_top ℕ} (hkn : k ≤ n) :
  cont_diff_map_supported_in 𝕜 E F K n →ₗ[𝕜] cont_diff_map_supported_in 𝕜 E F K k :=
{ to_fun := cont_diff_map_supported_in.of_le hkn,
  map_add' := λ f g, by ext; refl,
  map_smul' := λ c f, by ext; refl }

protected noncomputable! def of_leL {k : with_top ℕ} (hkn : k ≤ n) :
  (cont_diff_map_supported_in 𝕜 E F K n) →L[𝕜] (cont_diff_map_supported_in 𝕜 E F K k) :=
{ to_linear_map := cont_diff_map_supported_in.of_leₗ hkn,
  cont := continuous_induced_rng
    ((bounded_cont_diff_map.of_leL 𝕜 E F hkn).comp (to_bounded_cont_diff_mapL)).continuous }

protected noncomputable def iterated_fderivL (i : ℕ) :
  (cont_diff_map_supported_in 𝕜 E F K n) →L[𝕜] (E →ᵇ (E [×i]→L[𝕜] F)) :=
bounded_cont_diff_map.iterated_fderivL i ∘L to_bounded_cont_diff_mapL

protected lemma has_basis_zero :
  (𝓝 0 : filter $ cont_diff_map_supported_in 𝕜 E F K n).has_basis
  (λ Nε : ℕ × ℝ, 0 < Nε.2) (λ Nε, ⋂ (i : ℕ) (hiN : i ≤ Nε.1) (hi : ↑i ≤ n),
    cont_diff_map_supported_in.iterated_fderivL i ⁻¹' metric.ball 0 Nε.2) :=
begin
  rw [nhds_induced],
  convert bounded_cont_diff_map.has_basis_zero.comap to_bounded_cont_diff_mapₗ,
  ext,
  simp only [mem_Inter, mem_preimage, mem_ball_zero_iff],
  refl
end

section zero

noncomputable instance : metric_space (cont_diff_map_supported_in 𝕜 E F K 0) :=
metric_space.induced (to_bounded_cont_diff_mapL : cont_diff_map_supported_in 𝕜 E F K 0 →L[𝕜] _)
  to_bounded_cont_diff_map_injective infer_instance

noncomputable instance : normed_group (cont_diff_map_supported_in 𝕜 E F K 0) :=
{ to_metric_space := infer_instance,
  ..normed_group.induced
    (to_bounded_cont_diff_mapL : cont_diff_map_supported_in 𝕜 E F K 0 →L[𝕜] _)
      .to_linear_map.to_add_monoid_hom to_bounded_cont_diff_map_injective }

lemma norm_def {f : cont_diff_map_supported_in 𝕜 E F K 0} : ∥f∥ = ∥to_bounded_cont_diff_mapL f∥ := rfl

-- TODO : add `cont_diff_map_supported_in.to_bounded_continuous_function`
lemma le_norm {f : cont_diff_map_supported_in 𝕜 E F K 0} (x : E) : ∥f x∥ ≤ ∥f∥ :=
bounded_continuous_function.norm_coe_le_norm
  (bounded_cont_diff_map.to_bounded_continuous_function 𝕜 E F 0 (to_bounded_cont_diff_mapL f)) x

noncomputable! instance : normed_space 𝕜 (cont_diff_map_supported_in 𝕜 E F K 0) :=
{ norm_smul_le := λ c f,
  begin
    rw [norm_def, norm_def, continuous_linear_map.map_smul],
    exact normed_space.norm_smul_le _ _
  end }

end zero

section infinity

lemma differentiable (f : cont_diff_map_supported_in 𝕜 E F K ⊤) : differentiable 𝕜 f :=
f.cont_diff.differentiable le_top

noncomputable def fderiv (f : cont_diff_map_supported_in 𝕜 E F K ⊤) :
  cont_diff_map_supported_in 𝕜 E (E →L[𝕜] F) K ⊤ :=
of_support_subset (cont_diff_top_iff_fderiv.mp f.cont_diff).2
  (subset_closure.trans $ (fderiv_tsupport_subset f.differentiable).trans f.tsupport_subset)

noncomputable def fderivₗ : cont_diff_map_supported_in 𝕜 E F K ⊤
  →ₗ[𝕜] cont_diff_map_supported_in 𝕜 E (E →L[𝕜] F) K ⊤ :=
{ to_fun := cont_diff_map_supported_in.fderiv,
  map_add' := λ f g,
  begin
    ext x : 1,
    exact fderiv_add f.differentiable.differentiable_at
      g.differentiable.differentiable_at,
  end,
  map_smul' := λ a f,
  begin
    ext x : 1,
    exact fderiv_const_smul f.differentiable.differentiable_at _
  end }

noncomputable def fderivL : cont_diff_map_supported_in 𝕜 E F K ⊤
  →L[𝕜] cont_diff_map_supported_in 𝕜 E (E →L[𝕜] F) K ⊤ :=
{ to_linear_map := fderivₗ,
  cont := continuous_induced_rng
    (bounded_cont_diff_map.fderivL ∘L to_bounded_cont_diff_mapL).continuous }

end infinity

lemma mem_ℒp (f : cont_diff_map_supported_in 𝕜 E F K n)
  [measurable_space 𝕜] [opens_measurable_space 𝕜]
  {m : measurable_space E} [opens_measurable_space E] [measurable_space F]
  [second_countable_topology F] [borel_space F] (p : ℝ≥0∞) (μ : measure E) [fact (1 ≤ p)]
  [is_finite_measure_on_compacts μ] : mem_ℒp f p μ :=
f.continuous.mem_ℒp_of_has_compact_support f.has_compact_support p μ

variables (n)

def to_Lpₗ [measurable_space 𝕜] [opens_measurable_space 𝕜]
  {m : measurable_space E} [opens_measurable_space E] [measurable_space F]
  [second_countable_topology F] [borel_space F] (p : ℝ≥0∞) (μ : measure E) [fact (1 ≤ p)]
  [is_finite_measure_on_compacts μ] :
  (cont_diff_map_supported_in 𝕜 E F K n) →ₗ[𝕜] (Lp F p μ) :=
{ to_fun := λ f, (f.mem_ℒp p μ).to_Lp f,
  map_add' := λ f g, (f.mem_ℒp p μ).to_Lp_add (g.mem_ℒp p μ),
  map_smul' := λ c f, (f.mem_ℒp p μ).to_Lp_const_smul c }

lemma coe_fn_to_Lpₗ [measurable_space 𝕜] [opens_measurable_space 𝕜]
  {m : measurable_space E} [opens_measurable_space E] [measurable_space F]
  [second_countable_topology F] [borel_space F] (p : ℝ≥0∞) (μ : measure E) [fact (1 ≤ p)]
  [is_finite_measure_on_compacts μ] (f : cont_diff_map_supported_in 𝕜 E F K n) :
  to_Lpₗ n p μ f =ᵐ[μ] f :=
(f.mem_ℒp p μ).coe_fn_to_Lp

noncomputable! def to_Lp_zero [measurable_space 𝕜] [opens_measurable_space 𝕜]
  {m : measurable_space E} [opens_measurable_space E] [measurable_space F]
  [second_countable_topology F] [borel_space F] (p : ℝ≥0∞) (μ : measure E) [fact (1 ≤ p)]
  [is_finite_measure_on_compacts μ] :
  (cont_diff_map_supported_in 𝕜 E F K 0) →L[𝕜] (Lp F p μ) :=
{ to_linear_map := to_Lpₗ 0 p μ,
  cont :=
  begin
    -- TODO : unify with `continuous.mem_ℒp_of_has_compact_support`
    have hK₁ : measurable_set ↑K := K.compact.measurable_set,
    have hK₂ : μ ↑K ≠ ∞ := K.compact.measure_lt_top.ne,
    change continuous (to_Lpₗ 0 p μ),
    refine linear_map.continuous_of_bound (to_Lpₗ 0 p μ)
      (∥indicator_const_Lp p hK₁ hK₂ (1 : ℝ)∥) (λ f, _),
    rw [mul_comm],
    refine Lp.norm_le_mul_norm_of_ae_le_mul _,
    filter_upwards [f.coe_fn_to_Lpₗ 0 p μ,
      (indicator_const_Lp_coe_fn : indicator_const_Lp p hK₁ hK₂ (1 : ℝ) =ᵐ[μ] _)],
    intros x hx₁ hx₂,
    rw [hx₁, hx₂, ← norm_norm f, ← norm_smul, ← indicator_const_smul_apply, norm_indicator_eq_indicator_norm],
    refine set.le_indicator (λ a _, _) (λ a ha, _) x,
    { rw [smul_eq_mul, mul_one, norm_norm],
      exact le_norm _ },
    { rw [f.supported_in _ ha, norm_zero] }
  end }

noncomputable! def to_Lp [measurable_space 𝕜] [opens_measurable_space 𝕜]
  {m : measurable_space E} [opens_measurable_space E] [measurable_space F]
  [second_countable_topology F] [borel_space F] (p : ℝ≥0∞) (μ : measure E) [fact (1 ≤ p)]
  [is_finite_measure_on_compacts μ] :
  (cont_diff_map_supported_in 𝕜 E F K n) →L[𝕜] (Lp F p μ) :=
{ to_fun := λ f, (f.mem_ℒp p μ).to_Lp f,
  map_add' := λ f g, (f.mem_ℒp p μ).to_Lp_add (g.mem_ℒp p μ),
  map_smul' := λ c f, (f.mem_ℒp p μ).to_Lp_const_smul c,
  cont := ((to_Lp_zero p μ).comp (cont_diff_map_supported_in.of_leL (zero_le _))).continuous }

end compact

section real

variables {E F G : Type*} [normed_group E] [normed_group F] [normed_group G]
  [normed_space ℝ E] [normed_space ℝ F] [normed_space ℝ G] {K : compacts E}
  {n : with_top ℕ} {f g : cont_diff_map_supported_in ℝ E F K n} {x : E}

lemma continuous_iff_of_linear (T : cont_diff_map_supported_in ℝ E F K n →ₗ[ℝ] G) :
  continuous T ↔ ∃ (p : ℕ), ∃ C > 0, ∀ f : cont_diff_map_supported_in ℝ E F K n,
    ∥T f∥ ≤ C * (⨆ (i ≤ p) (hin : ↑i ≤ n) (x : E), ∥iterated_fderiv ℝ i f x∥) :=
begin
  rw [continuous_iff_continuous_at_zero, continuous_at, map_zero],
  rw cont_diff_map_supported_in.has_basis_zero.tendsto_iff metric.nhds_basis_ball,
  split,
  { intros H,
    rcases H 1 one_pos with ⟨⟨p, ε⟩, hε, H⟩,
    have hε' : 0 < ε⁻¹ := inv_pos.mpr hε,
    refine ⟨p, ε⁻¹, hε', λ f, _⟩,
    rw [← div_eq_inv_mul, le_div_iff hε, mul_comm, ← real.norm_of_nonneg hε.le,
        ← norm_smul ε (T f), ← T.map_smul _],
    let N : ℝ := ⨆ (i ≤ p) (hin : ↑i ≤ n) (x : E), ∥iterated_fderiv ℝ i f x∥,
    sorry },
  sorry
end

lemma continuous_iff_of_linear' (T : cont_diff_map_supported_in ℝ E F K n →ₗ[ℝ] G) :
  continuous T ↔ ∃ (p : ℕ) (C > 0), ∀ f : cont_diff_map_supported_in ℝ E F K n,
    ∥T f∥ ≤ C * (⨆ (i ≤ p) (hin : ↑i ≤ n) (x : E), ∥iterated_fderiv ℝ i f x∥) :=
begin
  letI : uniform_add_group (cont_diff_map_supported_in ℝ E F K n) := sorry,
  split,
  { sorry },
  { intro h,
    refine seminorm.continuous_from_bounded (snorms ℝ E F K n) (λ _ : fin 1, norm_seminorm ℝ G) _ _,
    rw seminorm.is_bounded_iff_of_directed_dom,
    { intro,
      rcases h with ⟨p, C, hC, hbound⟩,
      refine ⟨⟨p, sorry⟩, C.to_nnreal, sorry, _⟩,
      intros f,
      convert hbound f,
      rw [snorms, seminorm.coe_smul, pi.smul_apply, seminorm_family.comp_apply, seminorm.comp_apply,
          bounded_cont_diff_map.snorms],
      sorry },
    sorry }
end

end real

end cont_diff_map_supported_in


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.doc_commands

open lean.parser tactic interactive

/--
`restate_axiom` takes a structure field, and makes a new, definitionally simplified copy of it.
If the existing field name ends with a `'`, the new field just has the prime removed. Otherwise,
we append `_lemma`.
The main application is to provide clean versions of structure fields that have been tagged with
an auto_param.
-/
meta def restate_axiom (d : declaration) (new_name : name) : tactic unit :=
do (levels, type, value, reducibility, trusted) ← pure (match d.to_definition with
  | declaration.defn name levels type value reducibility trusted :=
    (levels, type, value, reducibility, trusted)
  | _ := undefined
  end),
  (s, u) ← mk_simp_set ff [] [],
  new_type ← (s.dsimplify [] type) <|> pure (type),
  prop ← is_prop new_type,
  let new_decl := if prop then
      declaration.thm new_name levels new_type (task.pure value)
    else
      declaration.defn new_name levels new_type value reducibility trusted,
  updateex_env $ λ env, env.add new_decl

private meta def name_lemma (old : name) (new : option name := none) : tactic name :=
match new with
| none :=
  match old.components.reverse with
  | last :: most := (do let last := last.to_string,
                       let last := if last.to_list.ilast = ''' then
                                     (last.to_list.reverse.drop 1).reverse.as_string
                                   else last ++ "_lemma",
                       return (mk_str_name old.get_prefix last)) <|> failed
  | nil          := undefined
  end
| (some new) := return (mk_str_name old.get_prefix new.to_string)
end

/--
`restate_axiom` makes a new copy of a structure field, first definitionally simplifying the type.
This is useful to remove `auto_param` or `opt_param` from the statement.

As an example, we have:
```lean
structure A :=
(x : ℕ)
(a' : x = 1 . skip)

example (z : A) : z.x = 1 := by rw A.a' -- rewrite tactic failed, lemma is not an equality nor a iff

restate_axiom A.a'
example (z : A) : z.x = 1 := by rw A.a
```

By default, `restate_axiom` names the new lemma by removing a trailing `'`, or otherwise appending
`_lemma` if there is no trailing `'`. You can also give `restate_axiom` a second argument to
specify the new name, as in
```lean
restate_axiom A.a f
example (z : A) : z.x = 1 := by rw A.f
```
-/
@[user_command] meta def restate_axiom_cmd (_ : parse $ tk "restate_axiom") : lean.parser unit :=
do from_lemma ← ident,
   new_name ← optional ident,
   from_lemma_fully_qualified ← resolve_constant from_lemma,
  d ← get_decl from_lemma_fully_qualified <|>
    fail ("declaration " ++ to_string from_lemma ++ " not found"),
  do
  { new_name ← name_lemma from_lemma_fully_qualified new_name,
    restate_axiom d new_name }

add_tactic_doc
{ name                     := "restate_axiom",
  category                 := doc_category.cmd,
  decl_names               := [`restate_axiom_cmd],
  tags                     := ["renaming", "environment"] }