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

/-!
# Split coequalizers

We define what it means for a triple of morphisms `f g : X ⟶ Y`, `π : Y ⟶ Z` to be a split
coequalizer: there is a section `s` of `π` and a section `t` of `g`, which additionally satisfy
`t ≫ f = π ≫ s`.

In addition, we show that every split coequalizer is a coequalizer
(`category_theory.is_split_coequalizer.is_coequalizer`) and absolute
(`category_theory.is_split_coequalizer.map`)

A pair `f g : X ⟶ Y` has a split coequalizer if there is a `Z` and `π : Y ⟶ Z` making `f,g,π` a
split coequalizer.
A pair `f g : X ⟶ Y` has a `G`-split coequalizer if `G f, G g` has a split coequalizer.

These definitions and constructions are useful in particular for the monadicity theorems.

## TODO

Dualise to split equalizers.
-/

namespace category_theory

universes v v₂ u u₂

variables {C : Type u} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)
variables {X Y : C} (f g : X ⟶ Y)

/--
A split coequalizer diagram consists of morphisms

      f   π
    X ⇉ Y → Z
      g

satisfying `f ≫ π = g ≫ π` together with morphisms

      t   s
    X ← Y ← Z

satisfying `s ≫ π = 𝟙 Z`, `t ≫ g = 𝟙 Y` and `t ≫ f = π ≫ s`.

The name "coequalizer" is appropriate, since any split coequalizer is a coequalizer, see
`category_theory.is_split_coequalizer.is_coequalizer`.
Split coequalizers are also absolute, since a functor preserves all the structure above.
-/
structure is_split_coequalizer {Z : C} (π : Y ⟶ Z) :=
(right_section : Z ⟶ Y)
(left_section : Y ⟶ X)
(condition : f ≫ π = g ≫ π)
(right_section_π : right_section ≫ π = 𝟙 Z)
(left_section_bottom : left_section ≫ g = 𝟙 Y)
(left_section_top : left_section ≫ f = π ≫ right_section)

instance {X : C} : inhabited (is_split_coequalizer (𝟙 X) (𝟙 X) (𝟙 X)) :=
⟨⟨𝟙 _, 𝟙 _, rfl, category.id_comp _, category.id_comp _, rfl⟩⟩

open is_split_coequalizer
attribute [reassoc] condition
attribute [simp, reassoc] right_section_π left_section_bottom left_section_top

variables {f g}

/-- Split coequalizers are absolute: they are preserved by any functor. -/
@[simps]
def is_split_coequalizer.map {Z : C} {π : Y ⟶ Z} (q : is_split_coequalizer f g π) (F : C ⥤ D) :
  is_split_coequalizer (F.map f) (F.map g) (F.map π) :=
{ right_section := F.map q.right_section,
  left_section := F.map q.left_section,
  condition := by rw [←F.map_comp, q.condition, F.map_comp],
  right_section_π := by rw [←F.map_comp, q.right_section_π, F.map_id],
  left_section_bottom := by rw [←F.map_comp, q.left_section_bottom, F.map_id],
  left_section_top := by rw [←F.map_comp, q.left_section_top, F.map_comp] }

section

open limits

/-- A split coequalizer clearly induces a cofork. -/
@[simps X]
def is_split_coequalizer.as_cofork {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
  cofork f g :=
cofork.of_π h t.condition

@[simp] lemma is_split_coequalizer.as_cofork_π  {Z : C} {h : Y ⟶ Z}
  (t : is_split_coequalizer f g h) : t.as_cofork.π = h := rfl

/--
The cofork induced by a split coequalizer is a coequalizer, justifying the name. In some cases it
is more convenient to show a given cofork is a coequalizer by showing it is split.
-/
def is_split_coequalizer.is_coequalizer
  {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
  is_colimit t.as_cofork :=
cofork.is_colimit.mk' _ $ λ s,
⟨t.right_section ≫ s.π,
 by { dsimp, rw [← t.left_section_top_assoc, s.condition, t.left_section_bottom_assoc] },
 λ m hm, by { simp [←hm] }⟩

end

variables (f g)
/--
The pair `f,g` is a split pair if there is a `h : Y ⟶ Z` so that `f, g, h` forms a split coequalizer
in `C`.
-/
class has_split_coequalizer : Prop :=
(splittable [] : ∃ {Z : C} (h : Y ⟶ Z), nonempty (is_split_coequalizer f g h))

/--
The pair `f,g` is a `G`-split pair if there is a `h : G Y ⟶ Z` so that `G f, G g, h` forms a split
coequalizer in `D`.
-/
abbreviation functor.is_split_pair : Prop := has_split_coequalizer (G.map f) (G.map g)

/-- Get the coequalizer object from the typeclass `is_split_pair`. -/
noncomputable def has_split_coequalizer.coequalizer_of_split [has_split_coequalizer f g] : C :=
(has_split_coequalizer.splittable f g).some

/-- Get the coequalizer morphism from the typeclass `is_split_pair`. -/
noncomputable def has_split_coequalizer.coequalizer_π [has_split_coequalizer f g] :
  Y ⟶ has_split_coequalizer.coequalizer_of_split f g :=
(has_split_coequalizer.splittable f g).some_spec.some

/-- The coequalizer morphism `coequalizer_ι` gives a split coequalizer on `f,g`. -/
noncomputable def has_split_coequalizer.is_split_coequalizer [has_split_coequalizer f g] :
  is_split_coequalizer f g (has_split_coequalizer.coequalizer_π f g) :=
classical.choice (has_split_coequalizer.splittable f g).some_spec.some_spec

/-- If `f, g` is split, then `G f, G g` is split. -/
instance map_is_split_pair [has_split_coequalizer f g] :
  has_split_coequalizer (G.map f) (G.map g) :=
{ splittable :=
  ⟨_, _, ⟨is_split_coequalizer.map (has_split_coequalizer.is_split_coequalizer f g) _⟩⟩ }

namespace limits

/-- If a pair has a split coequalizer, it has a coequalizer. -/
@[priority 1]
instance has_coequalizer_of_has_split_coequalizer [has_split_coequalizer f g] :
  has_coequalizer f g :=
has_colimit.mk ⟨_, (has_split_coequalizer.is_split_coequalizer f g).is_coequalizer⟩

end limits

end category_theory


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Yury Kudryashov
-/
import topology.algebra.order.intermediate_value

/-!
# Compactness of a closed interval

In this file we prove that a closed interval in a conditionally complete linear ordered type with
order topology (or a product of such types) is compact. We also prove the extreme value theorem
(`is_compact.exists_forall_le`, `is_compact.exists_forall_ge`): a continuous function on a compact
set takes its minimum and maximum values.

We also prove that the image of a closed interval under a continuous map is a closed interval, see
`continuous_on.image_Icc`.

## Tags

compact, extreme value theorem
-/

open classical filter order_dual topological_space function set

/-!
### Compactness of a closed interval

In this section we define a typeclass `compact_Icc_space α` saying that all closed intervals in `α`
are compact. Then we provide an instance for a `conditionally_complete_linear_order` and prove that
the product (both `α × β` and an indexed product) of spaces with this property inherits the
property.

We also prove some simple lemmas about spaces with this property.
-/

/-- This typeclass says that all closed intervals in `α` are compact. This is true for all
conditionally complete linear orders with order topology and products (finite or infinite)
of such spaces. -/
class compact_Icc_space (α : Type*) [topological_space α] [preorder α] : Prop :=
(is_compact_Icc : ∀ {a b : α}, is_compact (Icc a b))

export compact_Icc_space (is_compact_Icc)

/-- A closed interval in a conditionally complete linear order is compact. -/
@[priority 100]
instance conditionally_complete_linear_order.to_compact_Icc_space
  (α : Type*) [conditionally_complete_linear_order α] [topological_space α] [order_topology α] :
  compact_Icc_space α :=
begin
  refine ⟨λ a b, _⟩,
  cases le_or_lt a b with hab hab, swap, { simp [hab] },
  refine is_compact_iff_ultrafilter_le_nhds.2 (λ f hf, _),
  contrapose! hf,
  rw [le_principal_iff],
  have hpt : ∀ x ∈ Icc a b, {x} ∉ f,
    from λ x hx hxf, hf x hx ((le_pure_iff.2 hxf).trans (pure_le_nhds x)),
  set s := {x ∈ Icc a b | Icc a x ∉ f},
  have hsb : b ∈ upper_bounds s, from λ x hx, hx.1.2,
  have sbd : bdd_above s, from ⟨b, hsb⟩,
  have ha : a ∈ s, by simp [hpt, hab],
  rcases hab.eq_or_lt with rfl|hlt, { exact ha.2 },
  set c := Sup s,
  have hsc : is_lub s c, from is_lub_cSup ⟨a, ha⟩ sbd,
  have hc : c ∈ Icc a b, from ⟨hsc.1 ha, hsc.2 hsb⟩,
  specialize hf c hc,
  have hcs : c ∈ s,
  { cases hc.1.eq_or_lt with heq hlt, { rwa ← heq },
    refine ⟨hc, λ hcf, hf (λ U hU, _)⟩,
    rcases (mem_nhds_within_Iic_iff_exists_Ioc_subset' hlt).1 (mem_nhds_within_of_mem_nhds hU)
      with ⟨x, hxc, hxU⟩,
    rcases ((hsc.frequently_mem ⟨a, ha⟩).and_eventually
      (Ioc_mem_nhds_within_Iic ⟨hxc, le_rfl⟩)).exists
      with ⟨y, ⟨hyab, hyf⟩, hy⟩,
    refine mem_of_superset(f.diff_mem_iff.2 ⟨hcf, hyf⟩) (subset.trans _ hxU),
    rw diff_subset_iff,
    exact subset.trans Icc_subset_Icc_union_Ioc
      (union_subset_union subset.rfl $ Ioc_subset_Ioc_left hy.1.le) },
  cases hc.2.eq_or_lt with heq hlt, { rw ← heq, exact hcs.2 },
  contrapose! hf,
  intros U hU,
  rcases (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hlt).1 (mem_nhds_within_of_mem_nhds hU)
    with ⟨y, hxy, hyU⟩,
  refine mem_of_superset _ hyU, clear_dependent U,
  have hy : y ∈ Icc a b, from ⟨hc.1.trans hxy.1.le, hxy.2⟩,
  by_cases hay : Icc a y ∈ f,
  { refine mem_of_superset (f.diff_mem_iff.2 ⟨f.diff_mem_iff.2 ⟨hay, hcs.2⟩, hpt y hy⟩) _,
    rw [diff_subset_iff, union_comm, Ico_union_right hxy.1.le, diff_subset_iff],
    exact Icc_subset_Icc_union_Icc },
  { exact ((hsc.1 ⟨hy, hay⟩).not_lt hxy.1).elim },
end

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, compact_Icc_space (α i)] : compact_Icc_space (Π i, α i) :=
⟨λ a b, pi_univ_Icc a b ▸ is_compact_univ_pi $ λ i, is_compact_Icc⟩

instance pi.compact_Icc_space' {α β : Type*} [preorder β] [topological_space β]
  [compact_Icc_space β] : compact_Icc_space (α → β) :=
pi.compact_Icc_space

instance {α β : Type*} [preorder α] [topological_space α] [compact_Icc_space α]
  [preorder β] [topological_space β] [compact_Icc_space β] :
  compact_Icc_space (α × β) :=
⟨λ a b, (Icc_prod_eq a b).symm ▸ is_compact_Icc.prod is_compact_Icc⟩

/-- An unordered closed interval is compact. -/
lemma is_compact_interval {α : Type*} [linear_order α] [topological_space α] [compact_Icc_space α]
  {a b : α} : is_compact (interval a b) :=
is_compact_Icc

/-- A complete linear order is a compact space.

We do not register an instance for a `[compact_Icc_space α]` because this would only add instances
for products (indexed or not) of complete linear orders, and we have instances with higher priority
that cover these cases. -/
@[priority 100] -- See note [lower instance priority]
instance compact_space_of_complete_linear_order {α : Type*} [complete_linear_order α]
  [topological_space α] [order_topology α] :
  compact_space α :=
⟨by simp only [← Icc_bot_top, is_compact_Icc]⟩

section

variables {α : Type*} [preorder α] [topological_space α] [compact_Icc_space α]

instance compact_space_Icc (a b : α) : compact_space (Icc a b) :=
is_compact_iff_compact_space.mp is_compact_Icc

end

/-!
### Min and max elements of a compact set
-/

variables {α β : Type*} [conditionally_complete_linear_order α] [topological_space α]
  [order_topology α] [topological_space β]

lemma is_compact.Inf_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  Inf s ∈ s :=
hs.is_closed.cInf_mem ne_s hs.bdd_below

lemma is_compact.Sup_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  Sup s ∈ s :=
@is_compact.Inf_mem (order_dual α) _ _ _ _ hs ne_s

lemma is_compact.is_glb_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_glb s (Inf s) :=
is_glb_cInf ne_s hs.bdd_below

lemma is_compact.is_lub_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_lub s (Sup s) :=
@is_compact.is_glb_Inf (order_dual α) _ _ _ _ hs ne_s

lemma is_compact.is_least_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_least s (Inf s) :=
⟨hs.Inf_mem ne_s, (hs.is_glb_Inf ne_s).1⟩

lemma is_compact.is_greatest_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  is_greatest s (Sup s) :=
@is_compact.is_least_Inf (order_dual α) _ _ _ _ hs ne_s

lemma is_compact.exists_is_least {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x, is_least s x :=
⟨_, hs.is_least_Inf ne_s⟩

lemma is_compact.exists_is_greatest {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x, is_greatest s x :=
⟨_, hs.is_greatest_Sup ne_s⟩

lemma is_compact.exists_is_glb {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x ∈ s, is_glb s x :=
⟨_, hs.Inf_mem ne_s, hs.is_glb_Inf ne_s⟩

lemma is_compact.exists_is_lub {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
  ∃ x ∈ s, is_lub s x :=
⟨_, hs.Sup_mem ne_s, hs.is_lub_Sup ne_s⟩

lemma is_compact.exists_Inf_image_eq {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃ x ∈ s,  Inf (f '' s) = f x :=
let ⟨x, hxs, hx⟩ := (hs.image_of_continuous_on hf).Inf_mem (ne_s.image f)
in ⟨x, hxs, hx.symm⟩

lemma is_compact.exists_Sup_image_eq :
  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
  ∃ x ∈ s,  Sup (f '' s) = f x :=
@is_compact.exists_Inf_image_eq (order_dual α) _ _ _ _ _

lemma eq_Icc_of_connected_compact {s : set α} (h₁ : is_connected s) (h₂ : is_compact s) :
  s = Icc (Inf s) (Sup s) :=
eq_Icc_cInf_cSup_of_connected_bdd_closed h₁ h₂.bdd_below h₂.bdd_above h₂.is_closed

/-!
### Extreme value theorem
-/

/-- The **extreme value theorem**: a continuous function realizes its minimum on a compact set. -/
lemma is_compact.exists_forall_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
  {f : β → α} (hf : continuous_on f s) :
  ∃x∈s, ∀y∈s, f x ≤ f y :=
begin
  rcases (hs.image_of_continuous_on hf).exists_is_least (ne_s.image f)
    with ⟨_, ⟨x, hxs, rfl⟩, hx⟩,
  exact ⟨x, hxs, ball_image_iff.1 hx⟩
end

/-- The **extreme value theorem**: a continuous function realizes its maximum on a compact set. -/
lemma is_compact.exists_forall_ge :
  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
  ∃x∈s, ∀y∈s, f y ≤ f x :=
@is_compact.exists_forall_le (order_dual α) _ _ _ _ _

/-- The **extreme value theorem**: if a continuous function `f` is larger than a value in its range
away from compact sets, then it has a global minimum. -/
lemma _root_.continuous.exists_forall_le' {f : β → α} (hf : continuous f) (x₀ : β)
  (h : ∀ᶠ x in cocompact β, f x₀ ≤ f x) : ∃ (x : β), ∀ (y : β), f x ≤ f y :=
begin
  obtain ⟨K : set β, hK : is_compact K, hKf : ∀ x ∉ K, f x₀ ≤ f x⟩ :=
  (has_basis_cocompact.eventually_iff).mp h,
  obtain ⟨x, -, hx⟩ : ∃ x ∈ insert x₀ K, ∀ y ∈ insert x₀ K, f x ≤ f y :=
  (hK.insert x₀).exists_forall_le (nonempty_insert _ _) hf.continuous_on,
  refine ⟨x, λ y, _⟩,
  by_cases hy : y ∈ K,
  exacts [hx y (or.inr hy), (hx _ (or.inl rfl)).trans (hKf y hy)]
end

/-- The **extreme value theorem**: if a continuous function `f` is smaller than a value in its range
away from compact sets, then it has a global maximum. -/
lemma _root_.continuous.exists_forall_ge' {f : β → α} (hf : continuous f) (x₀ : β)
  (h : ∀ᶠ x in cocompact β, f x ≤ f x₀) : ∃ (x : β), ∀ (y : β), f y ≤ f x :=
@continuous.exists_forall_le' (order_dual α) _ _ _ _ _ _ hf x₀ h

/-- The **extreme value theorem**: if a continuous function `f` tends to infinity away from compact
sets, then it has a global minimum. -/
lemma _root_.continuous.exists_forall_le [nonempty β] {f : β → α}
  (hf : continuous f) (hlim : tendsto f (cocompact β) at_top) :
  ∃ x, ∀ y, f x ≤ f y :=
by { inhabit β, exact hf.exists_forall_le' default (hlim.eventually $ eventually_ge_at_top _) }

/-- The **extreme value theorem**: if a continuous function `f` tends to negative infinity away from
compact sets, then it has a global maximum. -/
lemma continuous.exists_forall_ge [nonempty β] {f : β → α}
  (hf : continuous f) (hlim : tendsto f (cocompact β) at_bot) :
  ∃ x, ∀ y, f y ≤ f x :=
@continuous.exists_forall_le (order_dual α) _ _ _ _ _ _ _ hf hlim

/-- A continuous function with compact support has a global minimum. -/
@[to_additive]
lemma _root_.continuous.exists_forall_le_of_has_compact_mul_support [nonempty β] [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  ∃ (x : β), ∀ (y : β), f x ≤ f y :=
begin
  -- Proof sketch: we use `continuous.exists_forall_le'` with as `x₀` any element outside the
  -- support of `f`, if such an element exists (and otherwise an arbitrary element).
  refine hf.exists_forall_le' (classical.epsilon $ λ x, f x = 1)
    (eventually_of_mem h.compl_mem_cocompact $ λ x hx, _),
  have : f x = 1 := nmem_mul_support.mp (mt (λ h2x, subset_closure h2x) hx),
  exact ((classical.epsilon_spec ⟨x, this⟩).trans this.symm).le
end

/-- A continuous function with compact support has a global maximum. -/
@[to_additive]
lemma continuous.exists_forall_ge_of_has_compact_mul_support [nonempty β] [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  ∃ (x : β), ∀ (y : β), f y ≤ f x :=
@continuous.exists_forall_le_of_has_compact_mul_support (order_dual α) _ _ _ _ _ _ _ _ hf h

/-- A continuous function with compact support is bounded below. -/
@[to_additive]
lemma continuous.bdd_below_range_of_has_compact_mul_support [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  bdd_below (range f) :=
begin
  casesI is_empty_or_nonempty β with hβ hβ,
  { rw range_eq_empty_iff.mpr, exact bdd_below_empty, exact hβ },
  obtain ⟨x, hx⟩ := hf.exists_forall_le_of_has_compact_mul_support h,
  refine ⟨f x, _⟩, rintro _ ⟨x', rfl⟩, exact hx x'
end

/-- A continuous function with compact support is bounded above. -/
@[to_additive]
lemma continuous.bdd_above_range_of_has_compact_mul_support [has_one α]
  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
  bdd_above (range f) :=
@continuous.bdd_below_range_of_has_compact_mul_support (order_dual α) _ _ _ _ _ _ _ hf h

/-- A continuous function is bounded below on a compact set. -/
lemma is_compact.bdd_below_image {f : β → α} {K : set β}
  (hK : is_compact K) (hf : continuous_on f K) : bdd_below (f '' K) :=
begin
  rcases eq_empty_or_nonempty K with rfl|h, { rw [image_empty], exact bdd_below_empty },
  obtain ⟨c, -, hc⟩ := hK.exists_forall_le h hf,
  refine ⟨f c, _⟩, rintro _ ⟨x, hx, rfl⟩, exact hc x hx
end

/-- A continuous function is bounded above on a compact set. -/
lemma is_compact.bdd_above_image {f : β → α} {K : set β}
  (hK : is_compact K) (hf : continuous_on f K) : bdd_above (f '' K) :=
@is_compact.bdd_below_image (order_dual α) _ _ _ _ _ _ _ hK hf

namespace continuous_on
/-!
### Image of a closed interval
-/

variables [densely_ordered α] [conditionally_complete_linear_order β] [order_topology β]
  {f : α → β} {a b c : α}

open_locale interval

lemma image_Icc (hab : a ≤ b) (h : continuous_on f $ Icc a b) :
  f '' Icc a b = Icc (Inf $ f '' Icc a b) (Sup $ f '' Icc a b) :=
eq_Icc_of_connected_compact ⟨(nonempty_Icc.2 hab).image f, is_preconnected_Icc.image f h⟩
  (is_compact_Icc.image_of_continuous_on h)

lemma image_interval_eq_Icc (h : continuous_on f $ [a, b]) :
  f '' [a, b] = Icc (Inf (f '' [a, b])) (Sup (f '' [a, b])) :=
begin
  cases le_total a b with h2 h2,
  { simp_rw [interval_of_le h2] at h ⊢, exact h.image_Icc h2 },
  { simp_rw [interval_of_ge h2] at h ⊢, exact h.image_Icc h2 },
end

lemma image_interval (h : continuous_on f $ [a, b]) :
  f '' [a, b] = [Inf (f '' [a, b]), Sup (f '' [a, b])] :=
begin
  refine h.image_interval_eq_Icc.trans (interval_of_le _).symm,
  refine cInf_le_cSup _ _ (nonempty_interval.image _); rw h.image_interval_eq_Icc,
  exacts [bdd_below_Icc, bdd_above_Icc]
end

lemma Inf_image_Icc_le (h : continuous_on f $ Icc a b) (hc : c ∈ Icc a b) :
  Inf (f '' (Icc a b)) ≤ f c :=
begin
  rw h.image_Icc (nonempty_Icc.mp (set.nonempty_of_mem hc)),
  exact cInf_le bdd_below_Icc (mem_Icc.mpr ⟨cInf_le (is_compact_Icc.bdd_below_image h) ⟨c, hc, rfl⟩,
     le_cSup (is_compact_Icc.bdd_above_image h) ⟨c, hc, rfl⟩⟩),
end

lemma le_Sup_image_Icc (h : continuous_on f $ Icc a b) (hc : c ∈ Icc a b) :
  f c ≤ Sup (f '' (Icc a b)) :=
begin
  rw h.image_Icc (nonempty_Icc.mp (set.nonempty_of_mem hc)),
  exact le_cSup bdd_above_Icc (mem_Icc.mpr ⟨cInf_le (is_compact_Icc.bdd_below_image h) ⟨c, hc, rfl⟩,
     le_cSup (is_compact_Icc.bdd_above_image h) ⟨c, hc, rfl⟩⟩),
end

end continuous_on


import data.real.basic
import lib.attempt

theorem challenge3 :
(2 : ℝ) + 2 ≠ 5 :=
attempt begin
  have h : (2 : ℝ) + 2 = 4 := rfl,
  rw h,
  unfold has_one.one,
  sorry
end $
attempt begin
  apply (λ x, x),
  norm_num,
end $
attempt begin
  linarith
end $
attempt begin
  -- library_search,
  sorry
end $
attempt begin
  have h: (2 + 2 : ℕ) ≠ (5 : ℕ),
  -- library_search,
  exact nat.bit0_ne_bit1 2 2,
  sorry
end $
attempt begin
  exact λ h, zero_ne_one $
    eq.trans (eq.symm
        (sub_eq_zero_of_eq h.symm))
      (add_sub_cancel' _ _),
end $
attempt begin
  intro h,
  apply zero_ne_one _,
  { exact ℝ }, { apply_instance },
  apply eq.trans,
  apply eq.symm,
  apply sub_eq_zero_of_eq,
  apply h.symm,
  apply add_sub_cancel' (4 : ℝ) (1 : ℝ),
end $
begin
  exact bit0_ne_bit1,
end

#print challenge3

example : Π x : ℕ, 4 ≠ (5 : ℝ) + ↑x :=
begin
  linarith, l
end


import Mathlib.Topology.Basic

variable [TopologicalSpace X] [TopologicalSpace Y]

example : Continuous (id : X → X) := by continuity

example {f : X → Y} {g : Y → X} (hf : Continuous f) (hg : Continuous g) :
  Continuous (fun x => f (g x)) := by continuity

example {f : X → Y} {g : Y → X} (hf : Continuous f) (hg : Continuous g) :
  Continuous (f ∘ g ∘ f) := by continuity

example {f : X → Y} {g : Y → X} (hf : Continuous f) (hg : Continuous g) :
  Continuous (f ∘ g) := by continuity

example (y : Y) : Continuous (fun (_ : X) ↦ y) := by continuity

example {f : Y → Y} (y : Y) : Continuous (f ∘ (fun (_ : X) => y)) := by continuity

example {g : X → X} (y : Y) : Continuous ((fun _ ↦ y) ∘ g) := by continuity

example {f : X → Y} (x : X) : Continuous (fun (_ : X) ↦ f x) := by continuity

-- Todo: more interesting examples when more algebra is ported

-- Porting note: port the tests from mathlib3 once we have the necessary theory files

/- Todo: restore this test
example [TopologicalSpace X] [TopologicalSpace Y]
  (f₁ f₂ : X → Y) (hf₁ : Continuous f₁) (hf₂ : Continuous f₂)
  (g : Y → ℝ) (hg : Continuous g) : Continuous (fun x => (max (g (f₁ x)) (g (f₂ x))) + 1) :=
  by continuity -/


import ground_zero.types.equiv

namespace ground_zero.types

universe u

lemma uninhabited_type {α : Sort u} (f : α → empty) : α ≃ empty :=
begin
  have g : empty → α := begin intro e, induction e end,
  existsi f, split; existsi g,
  { intro x, have e := f x, induction e },
  { intro x, induction x }
end

inductive lost (α : Sort u)
| cons {} : α → lost → lost

def code {α : Sort u} : lost α → empty
| (lost.cons head tail) := code tail

theorem is_zero {α : Sort u} : lost α ≃ empty :=
uninhabited_type code

namespace lost
end lost

end ground_zero.types


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Frédéric Dupuis, Heather Macbeth
-/
import analysis.normed.group.basic
import topology.algebra.module

/-!
# (Semi-)linear isometries

In this file we define `linear_isometry σ₁₂ E E₂` (notation: `E →ₛₗᵢ[σ₁₂] E₂`) to be a semilinear
isometric embedding of `E` into `E₂` and `linear_isometry_equiv` (notation: `E ≃ₛₗᵢ[σ₁₂] E₂`) to be
a semilinear isometric equivalence between `E` and `E₂`.  The notation for the associated purely
linear concepts is `E →ₗᵢ[R] E₂`, `E ≃ₗᵢ[R] E₂`, and `E →ₗᵢ⋆[R] E₂`, `E ≃ₗᵢ⋆[R] E₂` for
the star-linear versions.

We also prove some trivial lemmas and provide convenience constructors.

Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the
theory for `semi_normed_space` and we specialize to `normed_space` when needed.
-/
open function set

variables {R R₂ R₃ R₄ E E₂ E₃ E₄ F : Type*} [semiring R] [semiring R₂] [semiring R₃] [semiring R₄]
  {σ₁₂ : R →+* R₂} {σ₂₁ : R₂ →+* R} {σ₁₃ : R →+* R₃} {σ₃₁ : R₃ →+* R} {σ₁₄ : R →+* R₄}
  {σ₄₁ : R₄ →+* R} {σ₂₃ : R₂ →+* R₃} {σ₃₂ : R₃ →+* R₂} {σ₂₄ : R₂ →+* R₄} {σ₄₂ : R₄ →+* R₂}
  {σ₃₄ : R₃ →+* R₄} {σ₄₃ : R₄ →+* R₃}
  [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂]
  [ring_hom_inv_pair σ₁₃ σ₃₁] [ring_hom_inv_pair σ₃₁ σ₁₃]
  [ring_hom_inv_pair σ₂₃ σ₃₂] [ring_hom_inv_pair σ₃₂ σ₂₃]
  [ring_hom_inv_pair σ₁₄ σ₄₁] [ring_hom_inv_pair σ₄₁ σ₁₄]
  [ring_hom_inv_pair σ₂₄ σ₄₂] [ring_hom_inv_pair σ₄₂ σ₂₄]
  [ring_hom_inv_pair σ₃₄ σ₄₃] [ring_hom_inv_pair σ₄₃ σ₃₄]
  [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [ring_hom_comp_triple σ₁₂ σ₂₄ σ₁₄]
  [ring_hom_comp_triple σ₂₃ σ₃₄ σ₂₄] [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄]
  [ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁] [ring_hom_comp_triple σ₄₂ σ₂₁ σ₄₁]
  [ring_hom_comp_triple σ₄₃ σ₃₂ σ₄₂] [ring_hom_comp_triple σ₄₃ σ₃₁ σ₄₁]
  [semi_normed_group E] [semi_normed_group E₂] [semi_normed_group E₃] [semi_normed_group E₄]
  [module R E] [module R₂ E₂] [module R₃ E₃] [module R₄ E₄]
  [normed_group F] [module R F]

/-- A `σ₁₂`-semilinear isometric embedding of a normed `R`-module into an `R₂`-module. -/
structure linear_isometry (σ₁₂ : R →+* R₂) (E E₂ : Type*) [semi_normed_group E]
  [semi_normed_group E₂] [module R E] [module R₂ E₂] extends E →ₛₗ[σ₁₂] E₂ :=
(norm_map' : ∀ x, ∥to_linear_map x∥ = ∥x∥)

notation E ` →ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry σ₁₂ E E₂
notation E ` →ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry (ring_hom.id R) E E₂
notation E ` →ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 := linear_isometry (@star_ring_aut R _ _ : R →+* R) E E₂

namespace linear_isometry

/-- We use `f₁` when we need the domain to be a `normed_space`. -/
variables (f : E →ₛₗᵢ[σ₁₂] E₂) (f₁ : F →ₛₗᵢ[σ₁₂] E₂)

instance : has_coe_to_fun (E →ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := ⟨λ f, f.to_fun⟩

@[simp] lemma coe_to_linear_map : ⇑f.to_linear_map = f := rfl

lemma to_linear_map_injective : injective (to_linear_map : (E →ₛₗᵢ[σ₁₂] E₂) → (E →ₛₗ[σ₁₂] E₂))
| ⟨f, _⟩ ⟨g, _⟩ rfl := rfl

lemma coe_fn_injective : injective (λ (f : E →ₛₗᵢ[σ₁₂] E₂) (x : E), f x) :=
linear_map.coe_injective.comp to_linear_map_injective

@[ext] lemma ext {f g : E →ₛₗᵢ[σ₁₂] E₂} (h : ∀ x, f x = g x) : f = g :=
coe_fn_injective $ funext h

@[simp] lemma map_zero : f 0 = 0 := f.to_linear_map.map_zero

@[simp] lemma map_add (x y : E) : f (x + y) = f x + f y := f.to_linear_map.map_add x y

@[simp] lemma map_sub (x y : E) : f (x - y) = f x - f y := f.to_linear_map.map_sub x y

@[simp] lemma map_smulₛₗ (c : R) (x : E) : f (c • x) = σ₁₂ c • f x := f.to_linear_map.map_smulₛₗ c x

@[simp] lemma map_smul [module R E₂] (f : E →ₗᵢ[R] E₂) (c : R) (x : E) : f (c • x) = c • f x :=
f.to_linear_map.map_smul c x

@[simp] lemma norm_map (x : E) : ∥f x∥ = ∥x∥ := f.norm_map' x

@[simp] lemma nnnorm_map (x : E) : nnnorm (f x) = nnnorm x := nnreal.eq $ f.norm_map x

protected lemma isometry : isometry f :=
f.to_linear_map.to_add_monoid_hom.isometry_of_norm f.norm_map

@[simp] lemma is_complete_image_iff {s : set E} : is_complete (f '' s) ↔ is_complete s :=
is_complete_image_iff f.isometry.uniform_inducing

lemma is_complete_map_iff [ring_hom_surjective σ₁₂] {p : submodule R E} :
  is_complete (p.map f.to_linear_map : set E₂) ↔ is_complete (p : set E) :=
f.is_complete_image_iff

instance complete_space_map [ring_hom_surjective σ₁₂] (p : submodule R E) [complete_space p] :
  complete_space (p.map f.to_linear_map) :=
(f.is_complete_map_iff.2 $ complete_space_coe_iff_is_complete.1 ‹_›).complete_space_coe

@[simp] lemma dist_map (x y : E) : dist (f x) (f y) = dist x y := f.isometry.dist_eq x y
@[simp] lemma edist_map (x y : E) : edist (f x) (f y) = edist x y := f.isometry.edist_eq x y

protected lemma injective : injective f₁ := f₁.isometry.injective

@[simp] lemma map_eq_iff {x y : F} : f₁ x = f₁ y ↔ x = y := f₁.injective.eq_iff

lemma map_ne {x y : F} (h : x ≠ y) : f₁ x ≠ f₁ y := f₁.injective.ne h

protected lemma lipschitz : lipschitz_with 1 f := f.isometry.lipschitz

protected lemma antilipschitz : antilipschitz_with 1 f := f.isometry.antilipschitz

@[continuity] protected lemma continuous : continuous f := f.isometry.continuous

lemma ediam_image (s : set E) : emetric.diam (f '' s) = emetric.diam s :=
f.isometry.ediam_image s

lemma ediam_range : emetric.diam (range f) = emetric.diam (univ : set E) :=
f.isometry.ediam_range

lemma diam_image (s : set E) : metric.diam (f '' s) = metric.diam s :=
f.isometry.diam_image s

lemma diam_range : metric.diam (range f) = metric.diam (univ : set E) :=
f.isometry.diam_range

/-- Interpret a linear isometry as a continuous linear map. -/
def to_continuous_linear_map : E →SL[σ₁₂] E₂ := ⟨f.to_linear_map, f.continuous⟩

@[simp] lemma coe_to_continuous_linear_map : ⇑f.to_continuous_linear_map = f := rfl

@[simp] lemma comp_continuous_iff {α : Type*} [topological_space α] {g : α → E} :
  continuous (f ∘ g) ↔ continuous g :=
f.isometry.comp_continuous_iff

/-- The identity linear isometry. -/
def id : E →ₗᵢ[R] E := ⟨linear_map.id, λ x, rfl⟩

@[simp] lemma coe_id : ((id : E →ₗᵢ[R] E) : E → E) = _root_.id := rfl

@[simp] lemma id_apply (x : E) : (id : E →ₗᵢ[R] E) x = x := rfl

@[simp] lemma id_to_linear_map : (id.to_linear_map : E →ₗ[R] E) = linear_map.id := rfl

instance : inhabited (E →ₗᵢ[R] E) := ⟨id⟩

/-- Composition of linear isometries. -/
def comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) : E →ₛₗᵢ[σ₁₃] E₃ :=
⟨g.to_linear_map.comp f.to_linear_map, λ x, (g.norm_map _).trans (f.norm_map _)⟩

include σ₁₃
@[simp] lemma coe_comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) :
  ⇑(g.comp f) = g ∘ f :=
rfl
omit σ₁₃

@[simp] lemma id_comp : (id : E₂ →ₗᵢ[R₂] E₂).comp f = f := ext $ λ x, rfl

@[simp] lemma comp_id : f.comp id = f := ext $ λ x, rfl

include σ₁₃ σ₂₄ σ₁₄
lemma comp_assoc (f : E₃ →ₛₗᵢ[σ₃₄] E₄) (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (h : E →ₛₗᵢ[σ₁₂] E₂) :
  (f.comp g).comp h = f.comp (g.comp h) :=
rfl
omit σ₁₃ σ₂₄ σ₁₄

instance : monoid (E →ₗᵢ[R] E) :=
{ one := id,
  mul := comp,
  mul_assoc := comp_assoc,
  one_mul := id_comp,
  mul_one := comp_id }

@[simp] lemma coe_one : ((1 : E →ₗᵢ[R] E) : E → E) = _root_.id := rfl
@[simp] lemma coe_mul (f g : E →ₗᵢ[R] E) : ⇑(f * g) = f ∘ g := rfl

end linear_isometry

/-- Construct a `linear_isometry` from a `linear_map` satisfying `isometry`. -/
def linear_map.to_linear_isometry (f : E →ₛₗ[σ₁₂] E₂) (hf : isometry f) : E →ₛₗᵢ[σ₁₂] E₂ :=
{ norm_map' := by { simp_rw [←dist_zero_right, ←f.map_zero], exact λ x, hf.dist_eq x _ },
  .. f }

namespace submodule

variables {R' : Type*} [ring R'] [module R' E] (p : submodule R' E)

/-- `submodule.subtype` as a `linear_isometry`. -/
def subtypeₗᵢ : p →ₗᵢ[R'] E := ⟨p.subtype, λ x, rfl⟩

@[simp] lemma coe_subtypeₗᵢ : ⇑p.subtypeₗᵢ = p.subtype := rfl

@[simp] lemma subtypeₗᵢ_to_linear_map : p.subtypeₗᵢ.to_linear_map = p.subtype := rfl

/-- `submodule.subtype` as a `continuous_linear_map`. -/
def subtypeL : p →L[R'] E := p.subtypeₗᵢ.to_continuous_linear_map

@[simp] lemma coe_subtypeL : (p.subtypeL : p →ₗ[R'] E) = p.subtype := rfl

@[simp] lemma coe_subtypeL' : ⇑p.subtypeL = p.subtype := rfl

@[simp] lemma range_subtypeL : p.subtypeL.range = p :=
range_subtype _

@[simp] lemma ker_subtypeL : p.subtypeL.ker = ⊥ :=
ker_subtype _

end submodule

/-- A semilinear isometric equivalence between two normed vector spaces. -/
structure linear_isometry_equiv (σ₁₂ : R →+* R₂) {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁]
  [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [semi_normed_group E] [semi_normed_group E₂]
  [module R E] [module R₂ E₂] extends E ≃ₛₗ[σ₁₂] E₂ :=
(norm_map' : ∀ x, ∥to_linear_equiv x∥ = ∥x∥)

notation E ` ≃ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry_equiv σ₁₂ E E₂
notation E ` ≃ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry_equiv (ring_hom.id R) E E₂
notation E ` ≃ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 :=
  linear_isometry_equiv (@star_ring_aut R _ _ : R →+* R) E E₂

namespace linear_isometry_equiv

variables (e : E ≃ₛₗᵢ[σ₁₂] E₂)

include σ₂₁
instance : has_coe_to_fun (E ≃ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := ⟨λ f, f.to_fun⟩

@[simp] lemma coe_mk (e : E ≃ₛₗ[σ₁₂] E₂) (he : ∀ x, ∥e x∥ = ∥x∥) :
  ⇑(mk e he) = e :=
rfl

@[simp] lemma coe_to_linear_equiv (e : E ≃ₛₗᵢ[σ₁₂] E₂) : ⇑e.to_linear_equiv = e := rfl

lemma to_linear_equiv_injective : injective (to_linear_equiv : (E ≃ₛₗᵢ[σ₁₂] E₂) → (E ≃ₛₗ[σ₁₂] E₂))
| ⟨e, _⟩ ⟨_, _⟩ rfl := rfl

@[ext] lemma ext {e e' : E ≃ₛₗᵢ[σ₁₂] E₂} (h : ∀ x, e x = e' x) : e = e' :=
to_linear_equiv_injective $ linear_equiv.ext h

/-- Construct a `linear_isometry_equiv` from a `linear_equiv` and two inequalities:
`∀ x, ∥e x∥ ≤ ∥x∥` and `∀ y, ∥e.symm y∥ ≤ ∥y∥`. -/
def of_bounds (e : E ≃ₛₗ[σ₁₂] E₂) (h₁ : ∀ x, ∥e x∥ ≤ ∥x∥) (h₂ : ∀ y, ∥e.symm y∥ ≤ ∥y∥) :
  E ≃ₛₗᵢ[σ₁₂] E₂ :=
⟨e, λ x, le_antisymm (h₁ x) $ by simpa only [e.symm_apply_apply] using h₂ (e x)⟩

@[simp] lemma norm_map (x : E) : ∥e x∥ = ∥x∥ := e.norm_map' x

/-- Reinterpret a `linear_isometry_equiv` as a `linear_isometry`. -/
def to_linear_isometry : E →ₛₗᵢ[σ₁₂] E₂ := ⟨e.1, e.2⟩

@[simp] lemma coe_to_linear_isometry : ⇑e.to_linear_isometry = e := rfl

protected lemma isometry : isometry e := e.to_linear_isometry.isometry

/-- Reinterpret a `linear_isometry_equiv` as an `isometric`. -/
def to_isometric : E ≃ᵢ E₂ := ⟨e.to_linear_equiv.to_equiv, e.isometry⟩

@[simp] lemma coe_to_isometric : ⇑e.to_isometric = e := rfl

lemma range_eq_univ (e : E ≃ₛₗᵢ[σ₁₂] E₂) : set.range e = set.univ :=
by { rw ← coe_to_isometric, exact isometric.range_eq_univ _, }

/-- Reinterpret a `linear_isometry_equiv` as an `homeomorph`. -/
def to_homeomorph : E ≃ₜ E₂ := e.to_isometric.to_homeomorph

@[simp] lemma coe_to_homeomorph : ⇑e.to_homeomorph = e := rfl

protected lemma continuous : continuous e := e.isometry.continuous
protected lemma continuous_at {x} : continuous_at e x := e.continuous.continuous_at
protected lemma continuous_on {s} : continuous_on e s := e.continuous.continuous_on

protected lemma continuous_within_at {s x} : continuous_within_at e s x :=
e.continuous.continuous_within_at

/-- Interpret a `linear_isometry_equiv` as a continuous linear equiv. -/
def to_continuous_linear_equiv : E ≃SL[σ₁₂] E₂ :=
{ .. e.to_linear_isometry.to_continuous_linear_map,
  .. e.to_homeomorph }

@[simp] lemma coe_to_continuous_linear_equiv : ⇑e.to_continuous_linear_equiv = e := rfl

omit σ₂₁

variables (R E)

/-- Identity map as a `linear_isometry_equiv`. -/
def refl : E ≃ₗᵢ[R] E := ⟨linear_equiv.refl R E, λ x, rfl⟩

variables {R E}

instance : inhabited (E ≃ₗᵢ[R] E) := ⟨refl R E⟩

@[simp] lemma coe_refl : ⇑(refl R E) = id := rfl

/-- The inverse `linear_isometry_equiv`. -/
def symm : E₂ ≃ₛₗᵢ[σ₂₁] E :=
⟨e.to_linear_equiv.symm,
  λ x, (e.norm_map _).symm.trans $ congr_arg norm $ e.to_linear_equiv.apply_symm_apply x⟩

@[simp] lemma apply_symm_apply (x : E₂) : e (e.symm x) = x := e.to_linear_equiv.apply_symm_apply x
@[simp] lemma symm_apply_apply (x : E) : e.symm (e x) = x := e.to_linear_equiv.symm_apply_apply x
@[simp] lemma map_eq_zero_iff {x : E} : e x = 0 ↔ x = 0 := e.to_linear_equiv.map_eq_zero_iff
@[simp] lemma symm_symm : e.symm.symm = e := ext $ λ x, rfl

@[simp] lemma to_linear_equiv_symm : e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl
@[simp] lemma to_isometric_symm : e.to_isometric.symm = e.symm.to_isometric := rfl
@[simp] lemma to_homeomorph_symm : e.to_homeomorph.symm = e.symm.to_homeomorph := rfl

include σ₃₁ σ₃₂
/-- Composition of `linear_isometry_equiv`s as a `linear_isometry_equiv`. -/
def trans (e' : E₂ ≃ₛₗᵢ[σ₂₃] E₃) : E ≃ₛₗᵢ[σ₁₃] E₃ :=
⟨e.to_linear_equiv.trans e'.to_linear_equiv, λ x, (e'.norm_map _).trans (e.norm_map _)⟩

include σ₁₃ σ₂₁
@[simp] lemma coe_trans (e₁ : E ≃ₛₗᵢ[σ₁₂] E₂) (e₂ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ :=
rfl
omit σ₁₃ σ₂₁ σ₃₁ σ₃₂

@[simp] lemma trans_refl : e.trans (refl R₂ E₂) = e := ext $ λ x, rfl
@[simp] lemma refl_trans : (refl R E).trans e = e := ext $ λ x, rfl
@[simp] lemma self_trans_symm : e.trans e.symm = refl R E := ext e.symm_apply_apply
@[simp] lemma symm_trans_self : e.symm.trans e = refl R₂ E₂ := ext e.apply_symm_apply
@[simp] lemma symm_comp_self : e.symm ∘ e = id := funext e.symm_apply_apply
@[simp] lemma self_comp_symm : e ∘ e.symm = id := e.symm.symm_comp_self

include σ₁₃ σ₂₁ σ₃₂ σ₃₁
@[simp] lemma coe_symm_trans (e₁ : E ≃ₛₗᵢ[σ₁₂] E₂) (e₂ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) :
  ⇑(e₁.trans e₂).symm = e₁.symm ∘ e₂.symm :=
rfl

include σ₁₄ σ₄₁ σ₄₂ σ₄₃ σ₂₄
lemma trans_assoc (eEE₂ : E ≃ₛₗᵢ[σ₁₂] E₂) (eE₂E₃ : E₂ ≃ₛₗᵢ[σ₂₃] E₃) (eE₃E₄ : E₃ ≃ₛₗᵢ[σ₃₄] E₄) :
  eEE₂.trans (eE₂E₃.trans eE₃E₄) = (eEE₂.trans eE₂E₃).trans eE₃E₄ :=
rfl
omit σ₂₁ σ₃₁ σ₄₁ σ₃₂ σ₄₂ σ₄₃ σ₁₃ σ₂₄ σ₁₄

instance : group (E ≃ₗᵢ[R] E) :=
{ mul := λ e₁ e₂, e₂.trans e₁,
  one := refl _ _,
  inv := symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_assoc := λ _ _ _, trans_assoc _ _ _,
  mul_left_inv := self_trans_symm }

@[simp] lemma coe_one : ⇑(1 : E ≃ₗᵢ[R] E) = id := rfl
@[simp] lemma coe_mul (e e' : E ≃ₗᵢ[R] E) : ⇑(e * e') = e ∘ e' := rfl
@[simp] lemma coe_inv (e : E ≃ₗᵢ[R] E) : ⇑(e⁻¹) = e.symm := rfl

include σ₂₁

/-- Reinterpret a `linear_isometry_equiv` as a `continuous_linear_equiv`. -/
instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E ≃SL[σ₁₂] E₂) :=
⟨λ e, ⟨e.to_linear_equiv, e.continuous, e.to_isometric.symm.continuous⟩⟩

instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E →SL[σ₁₂] E₂) := ⟨λ e, ↑(e : E ≃SL[σ₁₂] E₂)⟩

@[simp] lemma coe_coe : ⇑(e : E ≃SL[σ₁₂] E₂) = e := rfl

@[simp] lemma coe_coe' : ((e : E ≃SL[σ₁₂] E₂) : E →SL[σ₁₂] E₂) = e := rfl

@[simp] lemma coe_coe'' : ⇑(e : E →SL[σ₁₂] E₂) = e := rfl

omit σ₂₁

@[simp] lemma map_zero : e 0 = 0 := e.1.map_zero

@[simp] lemma map_add (x y : E) : e (x + y) = e x + e y := e.1.map_add x y

@[simp] lemma map_sub (x y : E) : e (x - y) = e x - e y := e.1.map_sub x y

@[simp] lemma map_smulₛₗ (c : R) (x : E) : e (c • x) = σ₁₂ c • e x := e.1.map_smulₛₗ c x

@[simp] lemma map_smul [module R E₂] {e : E ≃ₗᵢ[R] E₂} (c : R) (x : E) : e (c • x) = c • e x :=
e.1.map_smul c x

@[simp] lemma nnnorm_map (x : E) : nnnorm (e x) = nnnorm x := e.to_linear_isometry.nnnorm_map x

@[simp] lemma dist_map (x y : E) : dist (e x) (e y) = dist x y :=
e.to_linear_isometry.dist_map x y

@[simp] lemma edist_map (x y : E) : edist (e x) (e y) = edist x y :=
e.to_linear_isometry.edist_map x y

protected lemma bijective : bijective e := e.1.bijective
protected lemma injective : injective e := e.1.injective
protected lemma surjective : surjective e := e.1.surjective

@[simp] lemma map_eq_iff {x y : E} : e x = e y ↔ x = y := e.injective.eq_iff

lemma map_ne {x y : E} (h : x ≠ y) : e x ≠ e y := e.injective.ne h

protected lemma lipschitz : lipschitz_with 1 e := e.isometry.lipschitz

protected lemma antilipschitz : antilipschitz_with 1 e := e.isometry.antilipschitz

@[simp] lemma ediam_image (s : set E) : emetric.diam (e '' s) = emetric.diam s :=
e.isometry.ediam_image s

@[simp] lemma diam_image (s : set E) : metric.diam (e '' s) = metric.diam s :=
e.isometry.diam_image s

variables {α : Type*} [topological_space α]

@[simp] lemma comp_continuous_on_iff {f : α → E} {s : set α} :
  continuous_on (e ∘ f) s ↔ continuous_on f s :=
e.isometry.comp_continuous_on_iff

@[simp] lemma comp_continuous_iff {f : α → E} :
  continuous (e ∘ f) ↔ continuous f :=
e.isometry.comp_continuous_iff

instance complete_space_map (p : submodule R E) [complete_space p] :
  complete_space (p.map (e.to_linear_equiv : E →ₛₗ[σ₁₂] E₂)) :=
e.to_linear_isometry.complete_space_map p

include σ₂₁
/-- Construct a linear isometry equiv from a surjective linear isometry. -/
noncomputable def of_surjective (f : F →ₛₗᵢ[σ₁₂] E₂)
  (hfr : function.surjective f) :
  F ≃ₛₗᵢ[σ₁₂] E₂ :=
{ norm_map' := f.norm_map,
  .. linear_equiv.of_bijective f.to_linear_map f.injective hfr }
omit σ₂₁

variables (R)
/-- The negation operation on a normed space `E`, considered as a linear isometry equivalence. -/
def neg : E ≃ₗᵢ[R] E :=
{ norm_map' := norm_neg,
  .. linear_equiv.neg R }

variables {R}
@[simp] lemma coe_neg : (neg R : E → E) = λ x, -x := rfl

@[simp] lemma symm_neg : (neg R : E ≃ₗᵢ[R] E).symm = neg R := rfl

variables (R E E₂ E₃)

/-- The natural equivalence `(E × E₂) × E₃ ≃ E × (E₂ × E₃)` is a linear isometry. -/
noncomputable def prod_assoc [module R E₂] [module R E₃] : (E × E₂) × E₃ ≃ₗᵢ[R] E × E₂ × E₃ :=
{ to_fun    := equiv.prod_assoc E E₂ E₃,
  inv_fun   := (equiv.prod_assoc E E₂ E₃).symm,
  map_add'  := by simp,
  map_smul' := by simp,
  norm_map' :=
    begin
      rintros ⟨⟨e, f⟩, g⟩,
      simp only [linear_equiv.coe_mk, equiv.prod_assoc_apply, prod.semi_norm_def, max_assoc],
    end,
  .. equiv.prod_assoc E E₂ E₃, }

@[simp] lemma coe_prod_assoc [module R E₂] [module R E₃] :
  (prod_assoc R E E₂ E₃ : (E × E₂) × E₃ → E × E₂ × E₃) = equiv.prod_assoc E E₂ E₃ :=
rfl

@[simp] lemma coe_prod_assoc_symm [module R E₂] [module R E₃] :
  ((prod_assoc R E E₂ E₃).symm : E × E₂ × E₃ → (E × E₂) × E₃) = (equiv.prod_assoc E E₂ E₃).symm :=
rfl

end linear_isometry_equiv


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.invertible
import Mathlib.data.indicator_function
import Mathlib.linear_algebra.affine_space.affine_map
import Mathlib.linear_algebra.affine_space.affine_subspace
import Mathlib.linear_algebra.finsupp
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Affine combinations of points

This file defines affine combinations of points.

## Main definitions

* `weighted_vsub_of_point` is a general weighted combination of
  subtractions with an explicit base point, yielding a vector.

* `weighted_vsub` uses an arbitrary choice of base point and is intended
  to be used when the sum of weights is 0, in which case the result is
  independent of the choice of base point.

* `affine_combination` adds the weighted combination to the arbitrary
  base point, yielding a point rather than a vector, and is intended
  to be used when the sum of weights is 1, in which case the result is
  independent of the choice of base point.

These definitions are for sums over a `finset`; versions for a
`fintype` may be obtained using `finset.univ`, while versions for a
`finsupp` may be obtained using `finsupp.support`.

## References

* https://en.wikipedia.org/wiki/Affine_space

-/

namespace finset

/-- A weighted sum of the results of subtracting a base point from the
given points, as a linear map on the weights.  The main cases of
interest are where the sum of the weights is 0, in which case the sum
is independent of the choice of base point, and where the sum of the
weights is 1, in which case the sum added to the base point is
independent of the choice of base point. -/
def weighted_vsub_of_point {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) (b : P) :
    linear_map k (ι → k) V :=
  finset.sum s fun (i : ι) => linear_map.smul_right (linear_map.proj i) (p i -ᵥ b)

@[simp] theorem weighted_vsub_of_point_apply {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k)
    (p : ι → P) (b : P) :
    coe_fn (weighted_vsub_of_point s p b) w = finset.sum s fun (i : ι) => w i • (p i -ᵥ b) :=
  sorry

/-- The weighted sum is independent of the base point when the sum of
the weights is 0. -/
theorem weighted_vsub_of_point_eq_of_sum_eq_zero {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι)
    (w : ι → k) (p : ι → P) (h : (finset.sum s fun (i : ι) => w i) = 0) (b₁ : P) (b₂ : P) :
    coe_fn (weighted_vsub_of_point s p b₁) w = coe_fn (weighted_vsub_of_point s p b₂) w :=
  sorry

/-- The weighted sum, added to the base point, is independent of the
base point when the sum of the weights is 1. -/
theorem weighted_vsub_of_point_vadd_eq_of_sum_eq_one {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι)
    (w : ι → k) (p : ι → P) (h : (finset.sum s fun (i : ι) => w i) = 1) (b₁ : P) (b₂ : P) :
    coe_fn (weighted_vsub_of_point s p b₁) w +ᵥ b₁ =
        coe_fn (weighted_vsub_of_point s p b₂) w +ᵥ b₂ :=
  sorry

/-- The weighted sum is unaffected by removing the base point, if
present, from the set of points. -/
@[simp] theorem weighted_vsub_of_point_erase {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k)
    (p : ι → P) (i : ι) :
    coe_fn (weighted_vsub_of_point (erase s i) p (p i)) w =
        coe_fn (weighted_vsub_of_point s p (p i)) w :=
  sorry

/-- The weighted sum is unaffected by adding the base point, whether
or not present, to the set of points. -/
@[simp] theorem weighted_vsub_of_point_insert {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k)
    (p : ι → P) (i : ι) :
    coe_fn (weighted_vsub_of_point (insert i s) p (p i)) w =
        coe_fn (weighted_vsub_of_point s p (p i)) w :=
  sorry

/-- The weighted sum is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
theorem weighted_vsub_of_point_indicator_subset {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (w : ι → k)
    (p : ι → P) (b : P) {s₁ : finset ι} {s₂ : finset ι} (h : s₁ ⊆ s₂) :
    coe_fn (weighted_vsub_of_point s₁ p b) w =
        coe_fn (weighted_vsub_of_point s₂ p b) (set.indicator (↑s₁) w) :=
  sorry

/-- A weighted sum, over the image of an embedding, equals a weighted
sum with the same points and weights over the original
`finset`. -/
theorem weighted_vsub_of_point_map {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} {ι₂ : Type u_5}
    (s₂ : finset ι₂) (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) (b : P) :
    coe_fn (weighted_vsub_of_point (map e s₂) p b) w =
        coe_fn (weighted_vsub_of_point s₂ (p ∘ ⇑e) b) (w ∘ ⇑e) :=
  sorry

/-- A weighted sum of the results of subtracting a default base point
from the given points, as a linear map on the weights.  This is
intended to be used when the sum of the weights is 0; that condition
is specified as a hypothesis on those lemmas that require it. -/
def weighted_vsub {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) :
    linear_map k (ι → k) V :=
  weighted_vsub_of_point s p (Classical.choice sorry)

/-- Applying `weighted_vsub` with given weights.  This is for the case
where a result involving a default base point is OK (for example, when
that base point will cancel out later); a more typical use case for
`weighted_vsub` would involve selecting a preferred base point with
`weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero` and then
using `weighted_vsub_of_point_apply`. -/
theorem weighted_vsub_apply {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k) (p : ι → P) :
    coe_fn (weighted_vsub s p) w =
        finset.sum s fun (i : ι) => w i • (p i -ᵥ Classical.choice add_torsor.nonempty) :=
  sorry

/-- `weighted_vsub` gives the sum of the results of subtracting any
base point, when the sum of the weights is 0. -/
theorem weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero {k : Type u_1} {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4}
    (s : finset ι) (w : ι → k) (p : ι → P) (h : (finset.sum s fun (i : ι) => w i) = 0) (b : P) :
    coe_fn (weighted_vsub s p) w = coe_fn (weighted_vsub_of_point s p b) w :=
  weighted_vsub_of_point_eq_of_sum_eq_zero s w p h (Classical.choice weighted_vsub._proof_1) b

/-- The `weighted_vsub` for an empty set is 0. -/
@[simp] theorem weighted_vsub_empty {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (w : ι → k) (p : ι → P) :
    coe_fn (weighted_vsub ∅ p) w = 0 :=
  sorry

/-- The weighted sum is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
theorem weighted_vsub_indicator_subset {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (w : ι → k) (p : ι → P)
    {s₁ : finset ι} {s₂ : finset ι} (h : s₁ ⊆ s₂) :
    coe_fn (weighted_vsub s₁ p) w = coe_fn (weighted_vsub s₂ p) (set.indicator (↑s₁) w) :=
  weighted_vsub_of_point_indicator_subset w p (Classical.choice weighted_vsub._proof_1) h

/-- A weighted subtraction, over the image of an embedding, equals a
weighted subtraction with the same points and weights over the
original `finset`. -/
theorem weighted_vsub_map {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [S : add_torsor V P] {ι : Type u_4} {ι₂ : Type u_5} (s₂ : finset ι₂) (e : ι₂ ↪ ι)
    (w : ι → k) (p : ι → P) :
    coe_fn (weighted_vsub (map e s₂) p) w = coe_fn (weighted_vsub s₂ (p ∘ ⇑e)) (w ∘ ⇑e) :=
  weighted_vsub_of_point_map s₂ e w p (Classical.choice weighted_vsub._proof_1)

/-- A weighted sum of the results of subtracting a default base point
from the given points, added to that base point, as an affine map on
the weights.  This is intended to be used when the sum of the weights
is 1, in which case it is an affine combination (barycenter) of the
points with the given weights; that condition is specified as a
hypothesis on those lemmas that require it. -/
def affine_combination {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V]
    [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) :
    affine_map k (ι → k) P :=
  affine_map.mk
    (fun (w : ι → k) =>
      coe_fn (weighted_vsub_of_point s p (Classical.choice sorry)) w +ᵥ Classical.choice sorry)
    (weighted_vsub s p) sorry

/-- The linear map corresponding to `affine_combination` is
`weighted_vsub`. -/
@[simp] theorem affine_combination_linear {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) :
    affine_map.linear (affine_combination s p) = weighted_vsub s p :=
  rfl

/-- Applying `affine_combination` with given weights.  This is for the
case where a result involving a default base point is OK (for example,
when that base point will cancel out later); a more typical use case
for `affine_combination` would involve selecting a preferred base
point with
`affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one` and
then using `weighted_vsub_of_point_apply`. -/
theorem affine_combination_apply {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k)
    (p : ι → P) :
    coe_fn (affine_combination s p) w =
        coe_fn (weighted_vsub_of_point s p (Classical.choice add_torsor.nonempty)) w +ᵥ
          Classical.choice add_torsor.nonempty :=
  rfl

/-- `affine_combination` gives the sum with any base point, when the
sum of the weights is 1. -/
theorem affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one {k : Type u_1}
    {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V] [S : add_torsor V P]
    {ι : Type u_4} (s : finset ι) (w : ι → k) (p : ι → P)
    (h : (finset.sum s fun (i : ι) => w i) = 1) (b : P) :
    coe_fn (affine_combination s p) w = coe_fn (weighted_vsub_of_point s p b) w +ᵥ b :=
  weighted_vsub_of_point_vadd_eq_of_sum_eq_one s w p h
    (Classical.choice affine_combination._proof_1) b

/-- Adding a `weighted_vsub` to an `affine_combination`. -/
theorem weighted_vsub_vadd_affine_combination {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w₁ : ι → k)
    (w₂ : ι → k) (p : ι → P) :
    coe_fn (weighted_vsub s p) w₁ +ᵥ coe_fn (affine_combination s p) w₂ =
        coe_fn (affine_combination s p) (w₁ + w₂) :=
  sorry

/-- Subtracting two `affine_combination`s. -/
theorem affine_combination_vsub {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι) (w₁ : ι → k)
    (w₂ : ι → k) (p : ι → P) :
    coe_fn (affine_combination s p) w₁ -ᵥ coe_fn (affine_combination s p) w₂ =
        coe_fn (weighted_vsub s p) (w₁ - w₂) :=
  sorry

/-- An `affine_combination` equals a point if that point is in the set
and has weight 1 and the other points in the set have weight 0. -/
@[simp] theorem affine_combination_of_eq_one_of_eq_zero {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (s : finset ι)
    (w : ι → k) (p : ι → P) {i : ι} (his : i ∈ s) (hwi : w i = 1)
    (hw0 : ∀ (i2 : ι), i2 ∈ s → i2 ≠ i → w i2 = 0) : coe_fn (affine_combination s p) w = p i :=
  sorry

/-- An affine combination is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
theorem affine_combination_indicator_subset {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} (w : ι → k) (p : ι → P)
    {s₁ : finset ι} {s₂ : finset ι} (h : s₁ ⊆ s₂) :
    coe_fn (affine_combination s₁ p) w = coe_fn (affine_combination s₂ p) (set.indicator (↑s₁) w) :=
  sorry

/-- An affine combination, over the image of an embedding, equals an
affine combination with the same points and weights over the original
`finset`. -/
theorem affine_combination_map {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4} {ι₂ : Type u_5}
    (s₂ : finset ι₂) (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) :
    coe_fn (affine_combination (map e s₂) p) w = coe_fn (affine_combination s₂ (p ∘ ⇑e)) (w ∘ ⇑e) :=
  sorry

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A vector can be expressed as
`weighted_vsub_of_point` using a `finset` lying within that subset and
with a given sum of weights if and only if it can be expressed as
`weighted_vsub_of_point` with that sum of weights for the
corresponding indexed family whose index type is the subtype
corresponding to that subset. -/
theorem eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype {k : Type u_1}
    {V : Type u_2} {P : Type u_3} [ring k] [add_comm_group V] [module k V] [S : add_torsor V P]
    {ι : Type u_4} {v : V} {x : k} {s : set ι} {p : ι → P} {b : P} :
    (∃ (fs : finset ι),
          ∃ (hfs : ↑fs ⊆ s),
            ∃ (w : ι → k),
              ∃ (hw : (finset.sum fs fun (i : ι) => w i) = x),
                v = coe_fn (weighted_vsub_of_point fs p b) w) ↔
        ∃ (fs : finset ↥s),
          ∃ (w : ↥s → k),
            ∃ (hw : (finset.sum fs fun (i : ↥s) => w i) = x),
              v = coe_fn (weighted_vsub_of_point fs (fun (i : ↥s) => p ↑i) b) w :=
  sorry

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A vector can be expressed as `weighted_vsub` using
a `finset` lying within that subset and with sum of weights 0 if and
only if it can be expressed as `weighted_vsub` with sum of weights 0
for the corresponding indexed family whose index type is the subtype
corresponding to that subset. -/
theorem eq_weighted_vsub_subset_iff_eq_weighted_vsub_subtype (k : Type u_1) {V : Type u_2}
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4}
    {v : V} {s : set ι} {p : ι → P} :
    (∃ (fs : finset ι),
          ∃ (hfs : ↑fs ⊆ s),
            ∃ (w : ι → k),
              ∃ (hw : (finset.sum fs fun (i : ι) => w i) = 0), v = coe_fn (weighted_vsub fs p) w) ↔
        ∃ (fs : finset ↥s),
          ∃ (w : ↥s → k),
            ∃ (hw : (finset.sum fs fun (i : ↥s) => w i) = 0),
              v = coe_fn (weighted_vsub fs fun (i : ↥s) => p ↑i) w :=
  eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A point can be expressed as an
`affine_combination` using a `finset` lying within that subset and
with sum of weights 1 if and only if it can be expressed an
`affine_combination` with sum of weights 1 for the corresponding
indexed family whose index type is the subtype corresponding to that
subset. -/
theorem eq_affine_combination_subset_iff_eq_affine_combination_subtype (k : Type u_1) (V : Type u_2)
    {P : Type u_3} [ring k] [add_comm_group V] [module k V] [S : add_torsor V P] {ι : Type u_4}
    {p0 : P} {s : set ι} {p : ι → P} :
    (∃ (fs : finset ι),
          ∃ (hfs : ↑fs ⊆ s),
            ∃ (w : ι → k),
              ∃ (hw : (finset.sum fs fun (i : ι) => w i) = 1),
                p0 = coe_fn (affine_combination fs p) w) ↔
        ∃ (fs : finset ↥s),
          ∃ (w : ↥s → k),
            ∃ (hw : (finset.sum fs fun (i : ↥s) => w i) = 1),
              p0 = coe_fn (affine_combination fs fun (i : ↥s) => p ↑i) w :=
  sorry

end finset

namespace finset

/-- The weights for the centroid of some points. -/
def centroid_weights (k : Type u_1) [division_ring k] {ι : Type u_4} (s : finset ι) : ι → k :=
  function.const ι (↑(card s)⁻¹)

/-- `centroid_weights` at any point. -/
@[simp] theorem centroid_weights_apply (k : Type u_1) [division_ring k] {ι : Type u_4}
    (s : finset ι) (i : ι) : centroid_weights k s i = (↑(card s)⁻¹) :=
  rfl

/-- `centroid_weights` equals a constant function. -/
theorem centroid_weights_eq_const (k : Type u_1) [division_ring k] {ι : Type u_4} (s : finset ι) :
    centroid_weights k s = function.const ι (↑(card s)⁻¹) :=
  rfl

/-- The weights in the centroid sum to 1, if the number of points,
converted to `k`, is not zero. -/
theorem sum_centroid_weights_eq_one_of_cast_card_ne_zero {k : Type u_1} [division_ring k]
    {ι : Type u_4} (s : finset ι) (h : ↑(card s) ≠ 0) :
    (finset.sum s fun (i : ι) => centroid_weights k s i) = 1 :=
  sorry

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the number of points is not zero. -/
theorem sum_centroid_weights_eq_one_of_card_ne_zero (k : Type u_1) [division_ring k] {ι : Type u_4}
    (s : finset ι) [char_zero k] (h : card s ≠ 0) :
    (finset.sum s fun (i : ι) => centroid_weights k s i) = 1 :=
  sorry

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the set is nonempty. -/
theorem sum_centroid_weights_eq_one_of_nonempty (k : Type u_1) [division_ring k] {ι : Type u_4}
    (s : finset ι) [char_zero k] (h : finset.nonempty s) :
    (finset.sum s fun (i : ι) => centroid_weights k s i) = 1 :=
  sum_centroid_weights_eq_one_of_card_ne_zero k s (ne_of_gt (iff.mpr card_pos h))

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the number of points is `n + 1`. -/
theorem sum_centroid_weights_eq_one_of_card_eq_add_one (k : Type u_1) [division_ring k]
    {ι : Type u_4} (s : finset ι) [char_zero k] {n : ℕ} (h : card s = n + 1) :
    (finset.sum s fun (i : ι) => centroid_weights k s i) = 1 :=
  sum_centroid_weights_eq_one_of_card_ne_zero k s (Eq.symm h ▸ nat.succ_ne_zero n)

/-- The centroid of some points.  Although defined for any `s`, this
is intended to be used in the case where the number of points,
converted to `k`, is not zero. -/
def centroid (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k] [add_comm_group V]
    [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) : P :=
  coe_fn (affine_combination s p) (centroid_weights k s)

/-- The definition of the centroid. -/
theorem centroid_def (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι) (p : ι → P) :
    centroid k s p = coe_fn (affine_combination s p) (centroid_weights k s) :=
  rfl

/-- The centroid of a single point. -/
@[simp] theorem centroid_singleton (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (p : ι → P) (i : ι) :
    centroid k (singleton i) p = p i :=
  sorry

/-- The centroid of two points, expressed directly as adding a vector
to a point. -/
theorem centroid_insert_singleton (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [invertible (bit0 1)]
    (p : ι → P) (i₁ : ι) (i₂ : ι) :
    centroid k (insert i₁ (singleton i₂)) p = bit0 1⁻¹ • (p i₂ -ᵥ p i₁) +ᵥ p i₁ :=
  sorry

/-- The centroid of two points indexed by `fin 2`, expressed directly
as adding a vector to the first point. -/
theorem centroid_insert_singleton_fin (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] [invertible (bit0 1)] (p : fin (bit0 1) → P) :
    centroid k univ p = bit0 1⁻¹ • (p 1 -ᵥ p 0) +ᵥ p 0 :=
  sorry

/-- A centroid, over the image of an embedding, equals a centroid with
the same points and weights over the original `finset`. -/
theorem centroid_map (k : Type u_1) {V : Type u_2} {P : Type u_3} [division_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {ι₂ : Type u_5} (s₂ : finset ι₂)
    (e : ι₂ ↪ ι) (p : ι → P) : centroid k (map e s₂) p = centroid k s₂ (p ∘ ⇑e) :=
  sorry

/-- `centroid_weights` gives the weights for the centroid as a
constant function, which is suitable when summing over the points
whose centroid is being taken.  This function gives the weights in a
form suitable for summing over a larger set of points, as an indicator
function that is zero outside the set whose centroid is being taken.
In the case of a `fintype`, the sum may be over `univ`. -/
def centroid_weights_indicator (k : Type u_1) [division_ring k] {ι : Type u_4} (s : finset ι) :
    ι → k :=
  set.indicator (↑s) (centroid_weights k s)

/-- The definition of `centroid_weights_indicator`. -/
theorem centroid_weights_indicator_def (k : Type u_1) [division_ring k] {ι : Type u_4}
    (s : finset ι) : centroid_weights_indicator k s = set.indicator (↑s) (centroid_weights k s) :=
  rfl

/-- The sum of the weights for the centroid indexed by a `fintype`. -/
theorem sum_centroid_weights_indicator (k : Type u_1) [division_ring k] {ι : Type u_4}
    (s : finset ι) [fintype ι] :
    (finset.sum univ fun (i : ι) => centroid_weights_indicator k s i) =
        finset.sum s fun (i : ι) => centroid_weights k s i :=
  Eq.symm (set.sum_indicator_subset (fun (i : ι) => centroid_weights k s i) (subset_univ s))

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the number of points is not
zero. -/
theorem sum_centroid_weights_indicator_eq_one_of_card_ne_zero (k : Type u_1) [division_ring k]
    {ι : Type u_4} (s : finset ι) [char_zero k] [fintype ι] (h : card s ≠ 0) :
    (finset.sum univ fun (i : ι) => centroid_weights_indicator k s i) = 1 :=
  sorry

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the set is nonempty. -/
theorem sum_centroid_weights_indicator_eq_one_of_nonempty (k : Type u_1) [division_ring k]
    {ι : Type u_4} (s : finset ι) [char_zero k] [fintype ι] (h : finset.nonempty s) :
    (finset.sum univ fun (i : ι) => centroid_weights_indicator k s i) = 1 :=
  sorry

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the number of points is `n + 1`. -/
theorem sum_centroid_weights_indicator_eq_one_of_card_eq_add_one (k : Type u_1) [division_ring k]
    {ι : Type u_4} (s : finset ι) [char_zero k] [fintype ι] {n : ℕ} (h : card s = n + 1) :
    (finset.sum univ fun (i : ι) => centroid_weights_indicator k s i) = 1 :=
  sorry

/-- The centroid as an affine combination over a `fintype`. -/
theorem centroid_eq_affine_combination_fintype (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι)
    [fintype ι] (p : ι → P) :
    centroid k s p = coe_fn (affine_combination univ p) (centroid_weights_indicator k s) :=
  affine_combination_indicator_subset (centroid_weights k s) p (subset_univ s)

/-- An indexed family of points that is injective on the given
`finset` has the same centroid as the image of that `finset`.  This is
stated in terms of a set equal to the image to provide control of
definitional equality for the index type used for the centroid of the
image. -/
theorem centroid_eq_centroid_image_of_inj_on (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι)
    {p : ι → P} (hi : ∀ (i j : ι), i ∈ s → j ∈ s → p i = p j → i = j) {ps : set P} [fintype ↥ps]
    (hps : ps = p '' ↑s) : centroid k s p = centroid k univ fun (x : ↥ps) => ↑x :=
  sorry

/-- Two indexed families of points that are injective on the given
`finset`s and with the same points in the image of those `finset`s
have the same centroid. -/
theorem centroid_eq_of_inj_on_of_image_eq (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι)
    {ι₂ : Type u_5} (s₂ : finset ι₂) {p : ι → P}
    (hi : ∀ (i j : ι), i ∈ s → j ∈ s → p i = p j → i = j) {p₂ : ι₂ → P}
    (hi₂ : ∀ (i j : ι₂), i ∈ s₂ → j ∈ s₂ → p₂ i = p₂ j → i = j) (he : p '' ↑s = p₂ '' ↑s₂) :
    centroid k s p = centroid k s₂ p₂ :=
  sorry

end finset

/-- A `weighted_vsub` with sum of weights 0 is in the `vector_span` of
an indexed family. -/
theorem weighted_vsub_mem_vector_span {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {s : finset ι} {w : ι → k}
    (h : (finset.sum s fun (i : ι) => w i) = 0) (p : ι → P) :
    coe_fn (finset.weighted_vsub s p) w ∈ vector_span k (set.range p) :=
  sorry

/-- An `affine_combination` with sum of weights 1 is in the
`affine_span` of an indexed family, if the underlying ring is
nontrivial. -/
theorem affine_combination_mem_affine_span {k : Type u_1} {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [nontrivial k] {s : finset ι}
    {w : ι → k} (h : (finset.sum s fun (i : ι) => w i) = 1) (p : ι → P) :
    coe_fn (finset.affine_combination s p) w ∈ affine_span k (set.range p) :=
  sorry

/-- A vector is in the `vector_span` of an indexed family if and only
if it is a `weighted_vsub` with sum of weights 0. -/
theorem mem_vector_span_iff_eq_weighted_vsub (k : Type u_1) {V : Type u_2} {P : Type u_3} [ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {v : V} {p : ι → P} :
    v ∈ vector_span k (set.range p) ↔
        ∃ (s : finset ι),
          ∃ (w : ι → k),
            ∃ (h : (finset.sum s fun (i : ι) => w i) = 0),
              v = coe_fn (finset.weighted_vsub s p) w :=
  sorry

/-- A point in the `affine_span` of an indexed family is an
`affine_combination` with sum of weights 1. -/
theorem eq_affine_combination_of_mem_affine_span {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {p1 : P} {p : ι → P}
    (h : p1 ∈ affine_span k (set.range p)) :
    ∃ (s : finset ι),
        ∃ (w : ι → k),
          ∃ (hw : (finset.sum s fun (i : ι) => w i) = 1),
            p1 = coe_fn (finset.affine_combination s p) w :=
  sorry

/-- A point is in the `affine_span` of an indexed family if and only
if it is an `affine_combination` with sum of weights 1, provided the
underlying ring is nontrivial. -/
theorem mem_affine_span_iff_eq_affine_combination (k : Type u_1) (V : Type u_2) {P : Type u_3}
    [ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [nontrivial k] {p1 : P}
    {p : ι → P} :
    p1 ∈ affine_span k (set.range p) ↔
        ∃ (s : finset ι),
          ∃ (w : ι → k),
            ∃ (hw : (finset.sum s fun (i : ι) => w i) = 1),
              p1 = coe_fn (finset.affine_combination s p) w :=
  sorry

/-- The centroid lies in the affine span if the number of points,
converted to `k`, is not zero. -/
theorem centroid_mem_affine_span_of_cast_card_ne_zero {k : Type u_1} {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} {s : finset ι}
    (p : ι → P) (h : ↑(finset.card s) ≠ 0) : finset.centroid k s p ∈ affine_span k (set.range p) :=
  affine_combination_mem_affine_span (finset.sum_centroid_weights_eq_one_of_cast_card_ne_zero s h) p

/-- In the characteristic zero case, the centroid lies in the affine
span if the number of points is not zero. -/
theorem centroid_mem_affine_span_of_card_ne_zero (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [char_zero k]
    {s : finset ι} (p : ι → P) (h : finset.card s ≠ 0) :
    finset.centroid k s p ∈ affine_span k (set.range p) :=
  affine_combination_mem_affine_span (finset.sum_centroid_weights_eq_one_of_card_ne_zero k s h) p

/-- In the characteristic zero case, the centroid lies in the affine
span if the set is nonempty. -/
theorem centroid_mem_affine_span_of_nonempty (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [char_zero k]
    {s : finset ι} (p : ι → P) (h : finset.nonempty s) :
    finset.centroid k s p ∈ affine_span k (set.range p) :=
  affine_combination_mem_affine_span (finset.sum_centroid_weights_eq_one_of_nonempty k s h) p

/-- In the characteristic zero case, the centroid lies in the affine
span if the number of points is `n + 1`. -/
theorem centroid_mem_affine_span_of_card_eq_add_one (k : Type u_1) {V : Type u_2} {P : Type u_3}
    [division_ring k] [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} [char_zero k]
    {s : finset ι} (p : ι → P) {n : ℕ} (h : finset.card s = n + 1) :
    finset.centroid k s p ∈ affine_span k (set.range p) :=
  affine_combination_mem_affine_span (finset.sum_centroid_weights_eq_one_of_card_eq_add_one k s h) p

namespace affine_map

-- TODO: define `affine_map.proj`, `affine_map.fst`, `affine_map.snd`

/-- A weighted sum, as an affine map on the points involved. -/
def weighted_vsub_of_point {k : Type u_1} {V : Type u_2} (P : Type u_3) [comm_ring k]
    [add_comm_group V] [module k V] [add_torsor V P] {ι : Type u_4} (s : finset ι) (w : ι → k) :
    affine_map k ((ι → P) × P) V :=
  mk (fun (p : (ι → P) × P) => coe_fn (finset.weighted_vsub_of_point s (prod.fst p) (prod.snd p)) w)
    (finset.sum s
      fun (i : ι) =>
        w i •
          (linear_map.comp (linear_map.proj i) (linear_map.fst k (ι → V) V) -
            linear_map.snd k (ι → V) V))
    sorry

end Mathlib


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import category_theory.concrete_category.bundled_hom
import category_theory.elementwise
import topology.continuous_function.basic

/-!
# Category instance for topological spaces

We introduce the bundled category `Top` of topological spaces together with the functors `discrete`
and `trivial` from the category of types to `Top` which equip a type with the corresponding
discrete, resp. trivial, topology. For a proof that these functors are left, resp. right adjoint
to the forgetful functor, see `topology.category.Top.adjunctions`.
-/

open category_theory
open topological_space

universe u

/-- The category of topological spaces and continuous maps. -/
def Top : Type (u+1) := bundled topological_space

namespace Top

instance bundled_hom : bundled_hom @continuous_map :=
⟨@continuous_map.to_fun, @continuous_map.id, @continuous_map.comp, @continuous_map.coe_injective⟩

attribute [derive [large_category, concrete_category]] Top

instance : has_coe_to_sort Top Type* := bundled.has_coe_to_sort

instance topological_space_unbundled (x : Top) : topological_space x := x.str

@[simp] lemma id_app (X : Top.{u}) (x : X) :
  (𝟙 X : X → X) x = x := rfl

@[simp] lemma comp_app {X Y Z : Top.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g : X → Z) x = g (f x) := rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top := ⟨X⟩

instance (X : Top) : topological_space X := X.str

@[simp] lemma coe_of (X : Type u) [topological_space X] : (of X : Type u) = X := rfl

instance : inhabited Top := ⟨Top.of empty⟩

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊥⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_bot } }

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊤⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_top } }

/-- Any homeomorphisms induces an isomorphism in `Top`. -/
@[simps] def iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f⟩,
  inv := ⟨f.symm⟩ }

/-- Any isomorphism in `Top` induces a homeomorphism. -/
@[simps] def homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp,
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

@[simp] lemma of_iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : homeo_of_iso (iso_of_homeo f) = f :=
by { ext, refl }

@[simp] lemma of_homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : iso_of_homeo (homeo_of_iso f) = f :=
by { ext, refl }

@[simp]
lemma open_embedding_iff_comp_is_iso {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] :
  open_embedding (f ≫ g) ↔ open_embedding f :=
open_embedding_iff_open_embedding_compose f (Top.homeo_of_iso (as_iso g)).open_embedding

@[simp]
lemma open_embedding_iff_is_iso_comp {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] :
  open_embedding (f ≫ g) ↔ open_embedding g :=
begin
  split,
  { intro h,
    convert h.comp (Top.homeo_of_iso (as_iso f).symm).open_embedding,
    exact congr_arg _ (is_iso.inv_hom_id_assoc f g).symm },
  { exact λ h, h.comp (Top.homeo_of_iso (as_iso f)).open_embedding }
end

end Top


lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
intro h,
cases h with p q,
split,
exact q,
exact p,
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.of_associative
import algebra.lie.non_unital_non_assoc_algebra
import algebra.lie.universal_enveloping
import algebra.free_non_unital_non_assoc_algebra

/-!
# Free Lie algebras

Given a commutative ring `R` and a type `X` we construct the free Lie algebra on `X` with
coefficients in `R` together with its universal property.

## Main definitions

  * `free_lie_algebra`
  * `free_lie_algebra.lift`
  * `free_lie_algebra.of`
  * `free_lie_algebra.universal_enveloping_equiv_free_algebra`

## Implementation details

### Quotient of free non-unital, non-associative algebra

We follow [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975) and construct
the free Lie algebra as a quotient of the free non-unital, non-associative algebra. Since we do not
currently have definitions of ideals, lattices of ideals, and quotients for
`non_unital_non_assoc_semiring`, we construct our quotient using the low-level `quot` function on
an inductively-defined relation.

### Alternative construction (needs PBW)

An alternative construction of the free Lie algebra on `X` is to start with the free unital
associative algebra on `X`, regard it as a Lie algebra via the ring commutator, and take its
smallest Lie subalgebra containing `X`. I.e.:
`lie_subalgebra.lie_span R (free_algebra R X) (set.range (free_algebra.ι R))`.

However with this definition there does not seem to be an easy proof that the required universal
property holds, and I don't know of a proof that avoids invoking the Poincaré–Birkhoff–Witt theorem.
A related MathOverflow question is [this one](https://mathoverflow.net/questions/396680/).

## Tags

lie algebra, free algebra, non-unital, non-associative, universal property, forgetful functor,
adjoint functor
-/

universes u v w

noncomputable theory

variables (R : Type u) (X : Type v) [comm_ring R]

/- We save characters by using Bourbaki's name `lib` (as in «libre») for
`free_non_unital_non_assoc_algebra` in this file. -/
local notation `lib` := free_non_unital_non_assoc_algebra
local notation `lib.lift` := free_non_unital_non_assoc_algebra.lift
local notation `lib.of` := free_non_unital_non_assoc_algebra.of
local notation `lib.lift_of_apply` := free_non_unital_non_assoc_algebra.lift_of_apply
local notation `lib.lift_comp_of` := free_non_unital_non_assoc_algebra.lift_comp_of

namespace free_lie_algebra

/-- The quotient of `lib R X` by the equivalence relation generated by this relation will give us
the free Lie algebra. -/
inductive rel : lib R X → lib R X → Prop
| lie_self (a : lib R X) : rel (a * a) 0
| leibniz_lie (a b c : lib R X) : rel (a * (b * c)) (((a * b) * c) + (b * (a * c)))
| smul (t : R) {a b : lib R X} : rel a b → rel (t • a) (t • b)
| add_right {a b : lib R X} (c : lib R X) : rel a b → rel (a + c) (b + c)
| mul_left (a : lib R X) {b c : lib R X} : rel b c → rel (a * b) (a * c)
| mul_right {a b : lib R X} (c : lib R X) : rel a b → rel (a * c) (b * c)

variables {R X}

lemma rel.add_left (a : lib R X) {b c : lib R X} (h : rel R X b c) : rel R X (a + b) (a + c) :=
by { rw [add_comm _ b, add_comm _ c], exact h.add_right _, }

lemma rel.neg {a b : lib R X} (h : rel R X a b) : rel R X (-a) (-b) :=
by simpa only [neg_one_smul] using h.smul (-1)

lemma rel.sub_right {a b : lib R X} (c : lib R X) (h : rel R X a b) : rel R X (a - c) (b - c) :=
by simpa only [sub_eq_add_neg] using h.add_right (-c)

lemma rel.smul_of_tower {S : Type*} [monoid S] [distrib_mul_action S R] [is_scalar_tower S R R]
  (t : S) (a b : lib R X)
  (h : rel R X a b) : rel R X (t • a) (t • b) :=
begin
  rw [←smul_one_smul R t a, ←smul_one_smul R t b],
  exact h.smul _,
end

end free_lie_algebra

/-- The free Lie algebra on the type `X` with coefficients in the commutative ring `R`. -/
@[derive inhabited]
def free_lie_algebra := quot (free_lie_algebra.rel R X)

namespace free_lie_algebra

instance {S : Type*} [monoid S] [distrib_mul_action S R] [is_scalar_tower S R R] :
  has_smul S (free_lie_algebra R X) :=
{ smul := λ t, quot.map ((•) t) (rel.smul_of_tower t) }

instance {S : Type*} [monoid S] [distrib_mul_action S R] [distrib_mul_action Sᵐᵒᵖ R]
  [is_scalar_tower S R R] [is_central_scalar S R] :
  is_central_scalar S (free_lie_algebra R X) :=
{ op_smul_eq_smul := λ t, quot.ind $ by exact λ a, congr_arg (quot.mk _) (op_smul_eq_smul t a) }

instance : has_zero (free_lie_algebra R X) :=
{ zero := quot.mk _ 0 }

instance : has_add (free_lie_algebra R X) :=
{ add := quot.map₂ (+) (λ _ _ _, rel.add_left _) (λ _ _ _, rel.add_right _) }

instance : has_neg (free_lie_algebra R X) :=
{ neg := quot.map has_neg.neg (λ _ _, rel.neg) }

instance : has_sub (free_lie_algebra R X) :=
{ sub := quot.map₂ has_sub.sub (λ _ _ _, rel.sub_left _) (λ _ _ _, rel.sub_right _) }

instance : add_group (free_lie_algebra R X) :=
function.surjective.add_group (quot.mk _) (surjective_quot_mk _)
  rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

instance : add_comm_semigroup (free_lie_algebra R X) :=
function.surjective.add_comm_semigroup (quot.mk _) (surjective_quot_mk _) (λ _ _, rfl)

instance : add_comm_group (free_lie_algebra R X) :=
{ ..free_lie_algebra.add_group R X,
  ..free_lie_algebra.add_comm_semigroup R X }

instance {S : Type*} [semiring S] [module S R] [is_scalar_tower S R R] :
  module S (free_lie_algebra R X) :=
function.surjective.module S ⟨quot.mk _, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) (λ _ _, rfl)

/-- Note that here we turn the `has_mul` coming from the `non_unital_non_assoc_semiring` structure
on `lib R X` into a `has_bracket` on `free_lie_algebra`. -/
instance : lie_ring (free_lie_algebra R X) :=
{ bracket     := quot.map₂ (*) (λ _ _ _, rel.mul_left _) (λ _ _ _, rel.mul_right _),
  add_lie     := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, change quot.mk _ _ = quot.mk _ _, rw add_mul, },
  lie_add     := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, change quot.mk _ _ = quot.mk _ _, rw mul_add, },
  lie_self    := by { rintros ⟨a⟩, exact quot.sound (rel.lie_self a), },
  leibniz_lie := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, exact quot.sound (rel.leibniz_lie a b c), }, }

instance : lie_algebra R (free_lie_algebra R X) :=
{ lie_smul :=
  begin
    rintros t ⟨a⟩ ⟨c⟩,
    change quot.mk _ (a • (t • c)) = quot.mk _ (t • (a • c)),
    rw ← smul_comm,
  end, }

variables {X}

/-- The embedding of `X` into the free Lie algebra of `X` with coefficients in the commutative ring
`R`. -/
def of : X → free_lie_algebra R X := λ x, quot.mk _ (lib.of R x)

variables {L : Type w} [lie_ring L] [lie_algebra R L]

/-- An auxiliary definition used to construct the equivalence `lift` below. -/
def lift_aux (f : X → commutator_ring L) := lib.lift R f

lemma lift_aux_map_smul (f : X → L) (t : R) (a : lib R X) :
  lift_aux R f (t • a) = t • lift_aux R f a :=
non_unital_alg_hom.map_smul _ t a

lemma lift_aux_map_add (f : X → L) (a b : lib R X) :
  lift_aux R f (a + b) = (lift_aux R f a) + (lift_aux R f b) :=
non_unital_alg_hom.map_add _ a b

lemma lift_aux_map_mul (f : X → L) (a b : lib R X) :
  lift_aux R f (a * b) = ⁅lift_aux R f a, lift_aux R f b⁆ :=
non_unital_alg_hom.map_mul _ a b

lemma lift_aux_spec (f : X → L) (a b : lib R X) (h : free_lie_algebra.rel R X a b) :
  lift_aux R f a = lift_aux R f b :=
begin
  induction h,
  case rel.lie_self : a'
  { simp only [lift_aux_map_mul, non_unital_alg_hom.map_zero, lie_self], },
  case rel.leibniz_lie : a' b' c'
  { simp only [lift_aux_map_mul, lift_aux_map_add, sub_add_cancel, lie_lie], },
  case rel.smul : t a' b' h₁ h₂
  { simp only [lift_aux_map_smul, h₂], },
  case rel.add_right : a' b' c' h₁ h₂
  { simp only [lift_aux_map_add, h₂], },
  case rel.mul_left : a' b' c' h₁ h₂
  { simp only [lift_aux_map_mul, h₂], },
  case rel.mul_right : a' b' c' h₁ h₂
  { simp only [lift_aux_map_mul, h₂], },
end

/-- The quotient map as a `non_unital_alg_hom`. -/
def mk : lib R X →ₙₐ[R] commutator_ring (free_lie_algebra R X) :=
{ to_fun    := quot.mk (rel R X),
  map_smul' := λ t a, rfl,
  map_zero' := rfl,
  map_add'  := λ a b, rfl,
  map_mul'  := λ a b, rfl, }

/-- The functor `X ↦ free_lie_algebra R X` from the category of types to the category of Lie
algebras over `R` is adjoint to the forgetful functor in the other direction. -/
def lift : (X → L) ≃ (free_lie_algebra R X →ₗ⁅R⁆ L) :=
{ to_fun    := λ f,
    { to_fun    := λ c, quot.lift_on c (lift_aux R f) (lift_aux_spec R f),
      map_add'  := by { rintros ⟨a⟩ ⟨b⟩, rw ← lift_aux_map_add, refl, },
      map_smul' := by { rintros t ⟨a⟩, rw ← lift_aux_map_smul, refl, },
      map_lie'  := by { rintros ⟨a⟩ ⟨b⟩, rw ← lift_aux_map_mul, refl, }, },
  inv_fun   := λ F, F ∘ (of R),
  left_inv  := λ f, by { ext x, simp only [lift_aux, of, quot.lift_on_mk, lie_hom.coe_mk,
    function.comp_app, lib.lift_of_apply], },
  right_inv := λ F,
    begin
      ext ⟨a⟩,
      let F' := F.to_non_unital_alg_hom.comp (mk R),
      exact non_unital_alg_hom.congr_fun (lib.lift_comp_of R F') a,
    end, }

@[simp] lemma lift_symm_apply (F : free_lie_algebra R X →ₗ⁅R⁆ L) : (lift R).symm F = F ∘ (of R) :=
rfl

variables {R}

@[simp] lemma of_comp_lift (f : X → L) : (lift R f) ∘ (of R) = f :=
(lift R).left_inv f

@[simp] lemma lift_unique (f : X → L) (g : free_lie_algebra R X →ₗ⁅R⁆ L) :
  g ∘ (of R) = f ↔ g = lift R f :=
(lift R).symm_apply_eq

attribute [irreducible] of lift

@[simp] lemma lift_of_apply (f : X → L) (x) : lift R f (of R x) = f x :=
by rw [← function.comp_app (lift R f) (of R) x, of_comp_lift]

@[simp] lemma lift_comp_of (F : free_lie_algebra R X →ₗ⁅R⁆ L) : lift R (F ∘ (of R)) = F :=
by { rw ← lift_symm_apply, exact (lift R).apply_symm_apply F, }

@[ext] lemma hom_ext {F₁ F₂ : free_lie_algebra R X →ₗ⁅R⁆ L} (h : ∀ x, F₁ (of R x) = F₂ (of R x)) :
  F₁ = F₂ :=
have h' : (lift R).symm F₁ = (lift R).symm F₂, { ext, simp [h], },
(lift R).symm.injective h'

variables (R X)

/-- The universal enveloping algebra of the free Lie algebra is just the free unital associative
algebra. -/
@[simps] def universal_enveloping_equiv_free_algebra :
  universal_enveloping_algebra R (free_lie_algebra R X) ≃ₐ[R] free_algebra R X :=
alg_equiv.of_alg_hom
  (universal_enveloping_algebra.lift R $ free_lie_algebra.lift R $ free_algebra.ι R)
  (free_algebra.lift R $ (universal_enveloping_algebra.ι R) ∘ (free_lie_algebra.of R))
  (by { ext, simp, })
  (by { ext, simp, })

end free_lie_algebra


import tactic.show_term
namespace beta_reduce

variables α : Type
variable m : α
set_option pp.beta true
#check (λ x (y : α → α), y x) m (λ n, n) -- m : α

end beta_reduce

axiom some : 1 = 1

#print axioms
#print notation ▸
#print prefix nat.add
#print classes -- add_comm_group, add_monoid, ...
#print instances add_monoid
#print fields add_monoid
#print fields add_group

/- -- version 1 --
add_group.zero         : α
add_group.neg          : α → α
add_group.add          : α → α → α

add_group.zero_add     : ∀ a : α,  0 + a = a
add_group.add_zero     : ∀ a : α,  a + 0 = a
add_group.add_left_neg : ∀ a : α, -a + a = 0

add_group.add_assoc    : ∀ a b c : α, (a + b) + c = a + (b + c)
-/

/- -- version 2 --
add_group.zero         : α
add_group.add_zero     : ∀ a : α,  a + 0 = a
add_group.zero_add     : ∀ a : α,  0 + a = a

add_group.neg          : α → α
add_group.add_left_neg : ∀ a : α, -a + a = 0

add_group.add          : α → α → α
add_group.add_assoc    : ∀ a b c : α, (a + b) + c = a + (b + c)
-/
example (p q : Prop) : p ∧ q → q ∧ p := by {
  intro h,
  cases h, -- like destruct in coq
  split,
  repeat { assumption },
}

example (p q : Prop) : p ∧ q → q ∧ p :=
assume hpq : p ∧ q,
have hp : p, from and.left ‹p ∧ q›,
have hq : q, from and.right ‹p ∧ q›,
show q ∧ p, from and.intro ‹q› ‹p›
-- ‹ = \f, › = \frq
-- ‹p› means (by assumption : p)
-- ‹_› means (by assumption : _) means (by assumption)

lemma test1 (a b : nat) : a + b = b + a := by show_term { ac_refl }
lemma test2 (a b c : nat) : a + (b + c) = (a + b) + c := by show_term { ac_refl }
#print test1 -- λ (a b : ℕ), ((is_commutative.comm b a).trans (eq.refl (a + b)).symm).symm
#print test2 -- λ (a b c : ℕ), ((is_associative.assoc a b c).trans (eq.refl (a + (b + c))).symm).symm

inductive nat' : Type
| zero' : nat'
| succ' : nat' → nat'

open nat'

def nat'_zero := zero'

@[instance] def nat'.has_zero : has_zero nat' := { zero := zero' }
@[instance] def nat'.has_one : has_one nat' := ⟨succ' zero'⟩
@[instance] def nat'.has_add : has_add nat' := {
  add :=
  (λ x y,
    match x, y with
    | x, 0 := x
    | x, _ := 1
    end
  )
}

set_option pp.proofs true

lemma test_subst : 1 = 2 → 2 = 3 → 3 = 1 := λ h, eq.subst h eq.symm
lemma test_subst2 : 1 = 2 → 2 = 3 → 1 = 3 := λ h, h ▸ id
lemma test_trans : 1 = 2 → 2 = 3 → 1 = 3 := eq.trans --λ h₁ h₂, eq.trans h₁ h₂
lemma strange_proof (h₂ : 4 = 5 → 2 = 5) : 1 = 2 → 2 = 3 → 1 = 3 := λ h, h.symm ▸ h₂
lemma strange_proof2 (h₂ : 4 = 5 → 2 = 5) : 1 = 2 → 2 = 3 → 3 = 1 := λ h, h.symm ▸ (λ h₃, eq.symm (h₂ h₃))

#print test_subst

#check (0 + 1 : nat')

example : (0 : nat') = zero' := rfl

#check zero'

-- instance add_monoid : nat := {
--   add_monoid.zero
-- }

namespace red

constant g : nat → nat

noncomputable def f := g
example : f = g := rfl
-- attribute [irreducible] f
-- attribute [semireducible] f
attribute [reducible] f

example (a : nat) (H : a = g a) : f a = a :=
@@eq.subst
  (λ x, f a = x)
  (eq.symm H)
  (eq.refl (f a))

end red

namespace smart_unfolding

constant n : nat
#reduce n + (nat.succ n) -- (n.add n).succ
set_option type_context.smart_unfolding false
#reduce n + (nat.succ n)
-- ((nat.rec ⟨λ (a : ℕ), a, punit.star⟩
--     (λ (n : ℕ)
--      (ih : pprod (ℕ → ℕ) (nat.rec punit (λ (n : ℕ) (ih : Type), pprod (pprod (ℕ → ℕ) ih) punit) n)),
--        ⟨λ (a : ℕ), (ih.fst a).succ, ⟨ih, punit.star⟩⟩)
--     n).fst
--    n).succ

end smart_unfolding

namespace make_constructor_fresh_names
open tactic

inductive Foo
| mk₁ (a b c : nat) : Foo
| mk₂ (d e : bool) : Foo
| mk₃ (f g : Foo) : Foo

example (a b : nat) : a = a :=
by do
  ns ← mk_constructors_fresh_names `Foo,
  trace ns,
  constructor

end make_constructor_fresh_names