import formal_ml.vcd

namespace list
variable {α:Type*}

lemma nth_lt_of_sorted_of_lt [L:linear_order α] {a b:ℕ} {l:list α} (ha:a < l.length)
(hb:b < l.length):list.sorted (<) l → (a < b) → (l.nth_le a ha) < (l.nth_le b hb) :=
begin
  intros A1 A2,
  simp [list.sorted] at A1,
  rw list.pairwise_iff_nth_le at A1,
  apply A1,
  apply A2,
end

end list

namespace finset
variable {α:Type*}

lemma card_three [L:linear_order α] {T:finset α}:T.card = 3 →
(∃ (a b c:α), a < b ∧ b < c ∧ T = {a,b,c}) :=
begin
  intros h,
  have A1:(T.sort L.le).length = 3,
  { rw finset.length_sort, apply h },
  rw ← finset.sort_to_finset L.le T,
  have A2:(T.sort L.le).sorted (<) := sort_sorted_lt T,
  cases (T.sort L.le) with a0 S,
  { apply absurd A1, dec_trivial, },
  cases S with a1 S,
  { apply absurd A1, dec_trivial, },
  cases S with a2 S,
  { apply absurd A1, dec_trivial, },
  cases S with a3 S,
  existsi [a0, a1, a2],
  split,
  apply @list.nth_lt_of_sorted_of_lt α L 0 1 [a0, a1, a2],
  dec_trivial,
  dec_trivial,
  apply A2,
  dec_trivial,
  split,
  apply @list.nth_lt_of_sorted_of_lt α L 1 2 [a0, a1, a2],
  dec_trivial,
  dec_trivial,
  apply A2,
  dec_trivial,
  simp,
  apply absurd A1,
  dec_trivial,
end

lemma powerset_two {a b:α} [decidable_eq α] {a≠ b}:({a,b}:finset α).powerset =
{∅, {a},{b},{a,b}} := begin
  rw finset.powerset_insert,
  rw finset.powerset_singleton,
  simp,
  ext x,
  split; intros A1;
  { simp at A1, simp [A1], cases A1,
    simp [A1], cases A1, simp [A1],
    cases A1, simp [A1], simp [A1],  },
end

lemma forall_subset_card_1 {a:α} {P:finset α → Prop}:
P ∅ → P {a} → (∀ S:finset α, S⊆ {a} → P S) :=
begin
  intros A1 A2,
  intros S,
  intros A3,
  cases (finset.eq_empty_or_nonempty S) with h_empty h_nonempty,
  subst S,
  apply A1,
  simp [finset.nonempty] at h_nonempty,
  cases h_nonempty with x x_in_S,
  have A4:S = {a},
  { apply finset.subset.antisymm,
    apply A3, rw finset.subset_iff,
    intros y A5, simp at A5, subst y,
    have A6 := A3 x_in_S,
    simp at A6, subst x,
    apply x_in_S,
     },
  subst S,
  apply A2,
end

lemma forall_subset_card_2 {a a':α} [decidable_eq α] {P:finset α → Prop}:
P ∅ → P {a} → P {a'} → P ({a,a'}:finset α) →  (∀ S:finset α, S⊆ {a,a'} → P S) :=
begin
  intros A1 A2 A3 A4,
  intros S A5,
  cases (decidable.em (a∈ S)) with B1 B1;
  cases (decidable.em (a'∈S)) with B2 B2,
  { have A6:S = {a,a'},
    { ext x, split;intros A6_1, apply A5, apply A6_1,
      simp at A6_1, cases A6_1, subst x, apply B1, subst x, apply B2 },
    subst S, apply A4 },
  { have A6:S = {a},
    { ext x, split;intros A6_1, have A6_2 := A5 A6_1, simp at A6_2,
      cases A6_2, { subst x, simp },
      subst x, apply absurd A6_1,
      apply B2, simp at A6_1, subst x, apply B1 },
    subst S, apply A2 },
  { have A6:S = {a'},
    { ext x, split;intros A6_1, have A6_2 := A5 A6_1, simp at A6_2,
      cases A6_2, { subst x, apply absurd A6_1, apply B1 },
      subst x, simp,
      simp at A6_1, subst x, apply B2 },
    subst S, apply A3 },
  { have A6:S = ∅,
    { ext x, split;intros A6_1, have A6_2 := A5 A6_1, simp at A6_2,
      cases A6_2, { subst x, apply absurd A6_1, apply B1 },
      { subst x, apply absurd A6_1, apply B2 },
      simp at A6_1,
      apply false.elim A6_1 },
    subst S, apply A1 },
end

end finset

namespace set
variable {α:Type*}
lemma inter_singleton_eq_singleton_iff {a:α} {c:set α}:c ∩ {a} = {a} ↔ a ∈ c :=
begin
   have A0:a ∈ {a},
   { apply set.mem_singleton, },
  split;intros A1,
  { have A2:c ∩ {a} ⊆ c,
    { apply  set.inter_subset_left },
    apply A2, rw A1, apply A0 },
  { ext x,
    split, intros A1,
    simp at A1, simp,
    apply A1.right,
    intros A2, simp at A2, subst x,
    simp [A1] },
end

lemma two_of_three {a b c:α} {h_a_ne_b:a ≠ b} {h_b_ne_c:b≠ c} {T:set α}:T ∩ {a,b,c} = {a,c} ↔ ((a ∈ T)
∧ (b∉ T) ∧ (c∈ T)):=
begin
  have B0:a∈ ({a,b,c}:set α),
  { simp },
  have B1:a∈ ({a,c}:set α),
  { simp },
  have B2:c ∈ ({a,c}:set α),
  { simp, },
  split; intros A1,
  split,
  { rw set.subset.antisymm_iff at A1,
    have C1 := A1.right B1,
    simp at C1,
    apply C1 },
  split,
  { intros contra,
    rw set.subset.antisymm_iff at A1,
    have C1:b∈ T ∩ {a,b,c},
    { simp, apply contra },
    have C2 := A1.left C1,
    simp at C2,
      cases C2,
      apply h_a_ne_b,
      rw C2,
      apply h_b_ne_c,
      rw C2 },
  { rw set.subset.antisymm_iff at A1,
    have C1 := A1.right B2,
    simp at C1,
    apply C1 },
  ext x;split;intros D1,
  { simp at D1, cases D1 with D1 D2,
    cases D2 with D2 D3,
    subst x, simp,
    cases D3,
    subst x,
    apply absurd D1,
    apply A1.right.left,
    subst x, simp, },
  { simp, simp at D1,
    cases D1; subst x; simp [A1],  },
end

end set

namespace VC_PAC_problem
variable {α:Type*}

/- The class of bounded intervals. -/
def intervals (α) [linear_order α]:set (set α) :=
  {C|∃ (a b:α), C = set.Ioo a b ∨ C = set.Ioc a b ∨ C = set.Ico a b ∨ C = set.Icc a b}

/- The class of thresholds. -/
def thresholds (α) [linear_order α]:set (set α) :=
  {C|∃ (a:α), C = set.Iio a ∨ C = set.Iic a ∨ C = set.Ioi a ∨ C = set.Ici a}

lemma non_singleton_two [L:linear_order α]: (∃ a b:α, a ≠ b) → (∃ c d:α, c < d) := begin
  intros h,
  cases h with a h,
  cases h with b h,
  cases (lt_trichotomy a b) with h_a_lt_b h_a_eq_b_or_b_lt_a,
  { existsi [a,b], apply h_a_lt_b },
  cases h_a_eq_b_or_b_lt_a with h_a_eq_b h_b_lt_a,
  { exfalso, apply h, apply h_a_eq_b },
  { existsi [b,a], apply h_b_lt_a, },
end

lemma one_le_VCD {a:α} {C:set (set α)}:(∃ c∈ C, a∈ c) → (∃ c∈ C, a∉ c) → 1 ≤ VCD C :=
begin
  intros h1 h2,
  let T:finset α := {a},
  begin
    have A1:(T.card:enat) = (1:enat),
    { simp,  },
    rw ← A1,
    apply shatters_card_le_VCD,
    rw shatters_iff,
    apply finset.forall_subset_card_1,
    { cases h2 with c h2,
      cases h2 with h2 h3,
      apply exists.intro c,
      apply exists.intro h2,
      simp [h3], },
    { cases h1 with c h1,
      cases h1 with h1 h3,
      apply exists.intro c,
      apply exists.intro h1,
      simp,
      rw set.inter_singleton_eq_singleton_iff,
      apply h3 },
  end
end

/- Though long and drawn out, this should be straightforward to
   automate, which will be useful for when there are 16 or more cases. -/
lemma two_le_VCD {a a':α} [decidable_eq α] {C:set (set α)}:
(∃ c∈ C, a∈ c ∧ a'∈ c) →
(∃ c∈ C, a∉ c∧ a' ∈ c) →
(∃ c∈ C, a∈ c∧ a' ∉ c) →
(∃ c∈ C, a∉ c∧ a' ∉ c) →
2 ≤ VCD C :=
begin
  intros h1 h2 h3 h4,
  have A1:a ≠ a',
  { cases h2 with c h2, cases h2 with h2 h3,
    intros contra,
    subst a',
    apply h3.left, apply h3.right },
  begin
    have A2:(({a,a'}:finset α).card:enat) = (2:enat),
    { simp [A1], refl },
    rw ← A2,
    apply shatters_card_le_VCD,
    rw shatters_iff,
    apply finset.forall_subset_card_2,
    { cases h4 with c h4,
      cases h4 with h4 h5,
      existsi [c, h4],
      simp,
      ext x,split;intros B1,
      simp at B1,
      cases B1 with B1 B2,
      cases B2; subst x; exfalso, apply h5.left, apply B1,
      apply h5.right, apply B1, simp at B1, apply false.elim B1 },
    { cases h3 with c h3, cases h3 with h3 h5,
      existsi [c, h3],
      simp,
      ext x,split;intros B1,
      simp at B1,
      cases B1 with B1 B2,
      cases B2; subst x, simp,
      exfalso, apply h5.right, apply B1,
      simp at B1, subst x, simp, apply h5.left },
    { cases h2 with c h2, cases h2 with h2 h5,
      existsi [c, h2],
      simp,
      ext x,split;intros B1,
      simp at B1,
      cases B1 with B1 B2,
      cases B2; subst x,exfalso, apply h5.left,
      apply B1, simp,
      simp at B1, subst x, simp, apply h5.right },
    { cases h1 with c h1, cases h1 with h1 h5,
      existsi [c, h1],
      simp,
      ext x,split;intros B1,
      simp at B1,
      cases B1 with B1 B2,
      cases B2; subst x; simp,
      simp at B1, cases B1; subst x; simp [h5], },
  end
end

@[simp]
lemma set_Icc_mem_intervals {a b:α}[L:linear_order α]:set.Icc a b ∈ intervals α :=
begin
  simp [intervals], existsi [a, b], simp,
end

@[simp]
lemma set_Ioc_mem_intervals {a b:α}[L:linear_order α]:set.Ioc a b ∈ intervals α :=
begin
  simp [intervals], existsi [a, b], simp,
end

@[simp]
lemma set_Ico_mem_intervals {a b:α}[L:linear_order α]:set.Ico a b ∈ intervals α :=
begin
  simp [intervals], existsi [a, b], simp,
end

@[simp]
lemma set_Ioo_mem_intervals {a b:α}[L:linear_order α]:set.Ioo a b ∈ intervals α :=
begin
  simp [intervals], existsi [a, b], simp,
end

@[simp]
lemma set_Iio_mem_thresholds {a:α}[L:linear_order α]:set.Iio a ∈ thresholds α :=
begin
  simp [thresholds], existsi a, simp,
end

@[simp]
lemma set_Iic_mem_thresholds {a:α}[L:linear_order α]:set.Iic a ∈ thresholds α :=
begin
  simp [thresholds], existsi [a], simp,
end

@[simp]
lemma set_Ioi_mem_thresholds {a:α}[L:linear_order α]:set.Ioi a ∈ thresholds α :=
begin
  simp [thresholds], existsi a, simp,
end

@[simp]
lemma set_Ici_mem_thresholds {a:α}[L:linear_order α]:set.Ici a ∈ thresholds α :=
begin
  simp [thresholds], existsi [a], simp,
end

lemma intervals_convex {a b c : α} [linear_order α] (T:set α): (T∈ intervals α) →
(a ≤ b) → (b ≤ c) → (a∈ T) → (c ∈ T) → (b∈ T) :=
begin
  intros A1 A2 A3 A4 A5,
  simp [intervals] at A1,
  cases A1 with d A1,
  cases A1 with e A1,
  cases A1,
  { subst T, simp at A4, simp at A5, simp, split,
    apply lt_of_lt_of_le A4.left A2,
    apply lt_of_le_of_lt A3 A5.right },
  cases A1,
  { subst T, simp at A4, simp at A5, simp, split,
    apply lt_of_lt_of_le A4.left A2,
    apply le_trans A3 A5.right },
  cases A1,
  { subst T, simp at A4, simp at A5, simp, split,
    apply le_trans A4.left A2,
    apply lt_of_le_of_lt A3 A5.right },
  { subst T, simp at A4, simp at A5, simp, split,
    apply le_trans A4.left A2,
    apply le_trans A3 A5.right },
end

lemma thresholds_convex {a b c : α} [linear_order α] (T:set α): (T∈ thresholds α) →
(a ≤ b) → (b ≤ c) → (a∈ T) → (c ∈ T) → (b∈ T) :=
begin
  intros A1 A2 A3 A4 A5,
  simp [thresholds] at A1,
  cases A1 with d A1,
  --cases A1 with e A1,
  cases A1,
  { subst T, simp at A4, simp at A5, simp,
    apply lt_of_le_of_lt A3 A5 },
  cases A1,
  { subst T, simp at A4, simp at A5, simp,
    apply le_trans A3 A5 },
  cases A1,
  { subst T, simp at A4, simp at A5, simp,
    apply lt_of_lt_of_le A4 A2 },
  { subst T, simp at A4, simp at A5, simp,
    apply le_trans A4 A2 },
end

lemma enat.coe_two:((2:nat):enat)=2 :=
begin
  have A1:(1:enat) + (1:enat) = (2:enat),
  { refl },
  have A2:(1:nat) + (1:nat) = (2:nat),
  { refl },
  rw ← A2,
  rw ← A1,
  rw enat.coe_add,
  rw enat.coe_one,
end

lemma convex_VCD_le_2 [L:linear_order α] (C:set (set α)):(∀ (a b c:α) (d∈ C), (a ≤ b) → (b ≤ c) → (a ∈ d) → (c∈ d) → (b ∈ d)) → VCD C ≤ 2 :=
begin
  intros h_convex,
  have A1:(2:enat) = (2:nat),
  { rw enat.coe_two, },
  rw A1,
  apply VCD_le',
  intros S,
  intros h_S,
  have h_shatters := finset.card_three h_S,
  clear h_S,
  cases h_shatters with a h_shatters,
  cases h_shatters with b h_shatters,
  cases h_shatters with c h_shatters,
  cases h_shatters with h_a_lt_b h_shatters,
  cases h_shatters with h_b_lt_c h_shatters,
  subst S,
  have h_a_ne_b:a ≠ b,
  { intros contra, subst b, apply lt_irrefl a h_a_lt_b },
  have h_b_ne_c:b ≠ c,
  { intros contra, subst b, apply lt_irrefl c h_b_lt_c },

  intros contra,
  rw shatters_iff at contra,

  --cases contra with S' h_subset,
  have contra2 := contra {a,c} _,
  cases contra2 with d contra2,
  cases contra2 with contra2 contra3,
  simp at contra3,
  rw set.two_of_three at contra3,
  apply contra3.right.left,
  apply h_convex a b c d contra2 (le_of_lt h_a_lt_b) (le_of_lt h_b_lt_c) contra3.left contra3.right.right,
  apply h_a_ne_b,
  apply h_b_ne_c,
  simp [finset.insert_subset],
end

lemma intervals_VCD_2 [L:linear_order α] [decidable_eq α]: (∃ a b:α, a ≠ b) → VCD (intervals α) = 2 := begin
  intros h,
  apply le_antisymm,
  { /- In one dimension, a hypothesis space with convex hypotheses
       has a VCD less than or equal to 2. -/
    apply convex_VCD_le_2,
    intros a b c d h_d_mem h_a_le_b h_b_le_c h_a_mem h_b_mem,
    apply intervals_convex _ h_d_mem h_a_le_b h_b_le_c,
    apply h_a_mem,
    apply h_b_mem,
    },
  { have h2 := non_singleton_two h,
    cases h2 with a h2,
    cases h2 with b h2,
    apply @two_le_VCD _ a b,
    { existsi [set.Icc a b], simp [le_of_lt h2] },
    { existsi [set.Ioc a b], simp [le_of_lt h2, h2] },
    { existsi [set.Ico a b], simp [le_of_lt h2, h2] },
    { existsi [set.Ioo a b], simp [le_of_lt h2, h2] } },
end

lemma thresholds_VCD_2 [L:linear_order α] [decidable_eq α]: (∃ a b:α, a ≠ b) → VCD (thresholds α) = 2 := begin
  intros h,
  apply le_antisymm,
  { /- In one dimension, a hypothesis space with convex hypotheses
       has a VCD less than or equal to 2. -/
    apply convex_VCD_le_2,
    intros a b c d h_d_mem h_a_le_b h_b_le_c h_a_mem h_b_mem,
    apply thresholds_convex _ h_d_mem h_a_le_b h_b_le_c,
    apply h_a_mem,
    apply h_b_mem,
    },
  { have h2 := non_singleton_two h,
    cases h2 with a h2,
    cases h2 with b h2,
    apply @two_le_VCD _ a b,
    { existsi [set.Iic b], simp [le_of_lt h2] },
    { existsi [set.Ioi a], simp [le_of_lt h2, h2] },
    { existsi [set.Iic a], simp [le_of_lt h2, h2], },
    { existsi [set.Iio a], simp [le_of_lt h2, h2] } },
end

def set_of_sets.prod {β:Type*} (Cα:set (set α)) (Cβ:set (set β)):set (set (α × β)) :=
{p|∃ (A:set α) (B:set β), (A∈ Cα)  ∧ (B∈ Cβ) ∧ p = A.prod B}

--noncomputable def get_max_of_three_real (a b c:real):real := get_max_of_three real a b c
--α
end VC_PAC_problem


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.pempty
import Mathlib.category_theory.limits.limits
import Mathlib.PostPort

universes u v u₂

namespace Mathlib

/-!
# Initial and terminal objects in a category.

## References
* [Stacks: Initial and final objects](https://stacks.math.columbia.edu/tag/002B)
-/

namespace category_theory.limits

/-- Construct a cone for the empty diagram given an object. -/
/-- Construct a cocone for the empty diagram given an object. -/
@[simp] theorem as_empty_cone_π_app {C : Type u} [category C] (X : C) : ∀ (X_1 : discrete pempty), nat_trans.app (cone.π (as_empty_cone X)) X_1 = as_empty_cone._aux_1 X X_1 :=
  fun (X_1 : discrete pempty) => Eq.refl (nat_trans.app (cone.π (as_empty_cone X)) X_1)

@[simp] theorem as_empty_cocone_ι_app {C : Type u} [category C] (X : C) : ∀ (X_1 : discrete pempty), nat_trans.app (cocone.ι (as_empty_cocone X)) X_1 = as_empty_cocone._aux_1 X X_1 :=
  fun (X_1 : discrete pempty) => Eq.refl (nat_trans.app (cocone.ι (as_empty_cocone X)) X_1)

/-- `X` is terminal if the cone it induces on the empty diagram is limiting. -/
/-- `X` is initial if the cocone it induces on the empty diagram is colimiting. -/
def is_terminal {C : Type u} [category C] (X : C) :=
  is_limit (as_empty_cone X)

def is_initial {C : Type u} [category C] (X : C) :=
  is_colimit (as_empty_cocone X)

/-- Give the morphism to a terminal object from any other. -/
def is_terminal.from {C : Type u} [category C] {X : C} (t : is_terminal X) (Y : C) : Y ⟶ X :=
  is_limit.lift t (as_empty_cone Y)

/-- Any two morphisms to a terminal object are equal. -/
theorem is_terminal.hom_ext {C : Type u} [category C] {X : C} {Y : C} (t : is_terminal X) (f : Y ⟶ X) (g : Y ⟶ X) : f = g := sorry

/-- Give the morphism from an initial object to any other. -/
def is_initial.to {C : Type u} [category C] {X : C} (t : is_initial X) (Y : C) : X ⟶ Y :=
  is_colimit.desc t (as_empty_cocone Y)

/-- Any two morphisms from an initial object are equal. -/
theorem is_initial.hom_ext {C : Type u} [category C] {X : C} {Y : C} (t : is_initial X) (f : X ⟶ Y) (g : X ⟶ Y) : f = g := sorry

/-- Any morphism from a terminal object is mono. -/
theorem is_terminal.mono_from {C : Type u} [category C] {X : C} {Y : C} (t : is_terminal X) (f : X ⟶ Y) : mono f :=
  mono.mk fun (Z : C) (g h : Z ⟶ X) (eq : g ≫ f = h ≫ f) => is_terminal.hom_ext t g h

/-- Any morphism to an initial object is epi. -/
theorem is_initial.epi_to {C : Type u} [category C] {X : C} {Y : C} (t : is_initial X) (f : Y ⟶ X) : epi f :=
  epi.mk fun (Z : C) (g h : X ⟶ Z) (eq : f ≫ g = f ≫ h) => is_initial.hom_ext t g h

/--
A category has a terminal object if it has a limit over the empty diagram.
Use `has_terminal_of_unique` to construct instances.
-/
/--
def has_terminal (C : Type u) [category C] :=
  has_limits_of_shape (discrete pempty) C

A category has an initial object if it has a colimit over the empty diagram.
Use `has_initial_of_unique` to construct instances.
-/
def has_initial (C : Type u) [category C] :=
  has_colimits_of_shape (discrete pempty) C

/--
An arbitrary choice of terminal object, if one exists.
You can use the notation `⊤_ C`.
This object is characterized by having a unique morphism from any object.
-/
/--
def terminal (C : Type u) [category C] [has_terminal C] : C :=
  limit (functor.empty C)

An arbitrary choice of initial object, if one exists.
You can use the notation `⊥_ C`.
This object is characterized by having a unique morphism to any object.
-/
def initial (C : Type u) [category C] [has_initial C] : C :=
  colimit (functor.empty C)

prefix:20 "⊤_" => Mathlib.category_theory.limits.terminal

prefix:20 "⊥_" => Mathlib.category_theory.limits.initial

/-- We can more explicitly show that a category has a terminal object by specifying the object,
and showing there is a unique morphism to it from any other object. -/
theorem has_terminal_of_unique {C : Type u} [category C] (X : C) [h : (Y : C) → unique (Y ⟶ X)] : has_terminal C := sorry

/-- We can more explicitly show that a category has an initial object by specifying the object,
and showing there is a unique morphism from it to any other object. -/
theorem has_initial_of_unique {C : Type u} [category C] (X : C) [h : (Y : C) → unique (X ⟶ Y)] : has_initial C := sorry

/-- The map from an object to the terminal object. -/
def terminal.from {C : Type u} [category C] [has_terminal C] (P : C) : P ⟶ ⊤_C :=
  limit.lift (functor.empty C) (as_empty_cone P)

/-- The map to an object from the initial object. -/
def initial.to {C : Type u} [category C] [has_initial C] (P : C) : ⊥_C ⟶ P :=
  colimit.desc (functor.empty C) (as_empty_cocone P)

protected instance unique_to_terminal {C : Type u} [category C] [has_terminal C] (P : C) : unique (P ⟶ ⊤_C) :=
  unique.mk { default := terminal.from P } sorry

protected instance unique_from_initial {C : Type u} [category C] [has_initial C] (P : C) : unique (⊥_C ⟶ P) :=
  unique.mk { default := initial.to P } sorry

/-- A terminal object is terminal. -/
def terminal_is_terminal {C : Type u} [category C] [has_terminal C] : is_terminal (⊤_C) :=
  is_limit.mk fun (s : cone (functor.empty C)) => terminal.from (cone.X s)

/-- An initial object is initial. -/
def initial_is_initial {C : Type u} [category C] [has_initial C] : is_initial (⊥_C) :=
  is_colimit.mk fun (s : cocone (functor.empty C)) => initial.to (cocone.X s)

/-- Any morphism from a terminal object is mono. -/
protected instance terminal.mono_from {C : Type u} [category C] {Y : C} [has_terminal C] (f : ⊤_C ⟶ Y) : mono f :=
  is_terminal.mono_from terminal_is_terminal f

/-- Any morphism to an initial object is epi. -/
protected instance initial.epi_to {C : Type u} [category C] {Y : C} [has_initial C] (f : Y ⟶ ⊥_C) : epi f :=
  is_initial.epi_to initial_is_initial f

/-- An initial object is terminal in the opposite category. -/
def terminal_op_of_initial {C : Type u} [category C] {X : C} (t : is_initial X) : is_terminal (opposite.op X) :=
  is_limit.mk fun (s : cone (functor.empty (Cᵒᵖ))) => has_hom.hom.op (is_initial.to t (opposite.unop (cone.X s)))

/-- An initial object in the opposite category is terminal in the original category. -/
def terminal_unop_of_initial {C : Type u} [category C] {X : Cᵒᵖ} (t : is_initial X) : is_terminal (opposite.unop X) :=
  is_limit.mk fun (s : cone (functor.empty C)) => has_hom.hom.unop (is_initial.to t (opposite.op (cone.X s)))

/-- A terminal object is initial in the opposite category. -/
def initial_op_of_terminal {C : Type u} [category C] {X : C} (t : is_terminal X) : is_initial (opposite.op X) :=
  is_colimit.mk fun (s : cocone (functor.empty (Cᵒᵖ))) => has_hom.hom.op (is_terminal.from t (opposite.unop (cocone.X s)))

/-- A terminal object in the opposite category is initial in the original category. -/
def initial_unop_of_terminal {C : Type u} [category C] {X : Cᵒᵖ} (t : is_terminal X) : is_initial (opposite.unop X) :=
  is_colimit.mk fun (s : cocone (functor.empty C)) => has_hom.hom.unop (is_terminal.from t (opposite.op (cocone.X s)))

/-- From a functor `F : J ⥤ C`, given an initial object of `J`, construct a cone for `J`.
In `limit_of_diagram_initial` we show it is a limit cone. -/
@[simp] theorem cone_of_diagram_initial_π_app {C : Type u} [category C] {J : Type v} [small_category J] {X : J} (tX : is_initial X) (F : J ⥤ C) (j : J) : nat_trans.app (cone.π (cone_of_diagram_initial tX F)) j = functor.map F (is_initial.to tX j) :=
  Eq.refl (nat_trans.app (cone.π (cone_of_diagram_initial tX F)) j)

/-- From a functor `F : J ⥤ C`, given an initial object of `J`, show the cone
`cone_of_diagram_initial` is a limit. -/
def limit_of_diagram_initial {C : Type u} [category C] {J : Type v} [small_category J] {X : J} (tX : is_initial X) (F : J ⥤ C) : is_limit (cone_of_diagram_initial tX F) :=
  is_limit.mk fun (s : cone F) => nat_trans.app (cone.π s) X

-- This is reducible to allow usage of lemmas about `cone_point_unique_up_to_iso`.

/-- For a functor `F : J ⥤ C`, if `J` has an initial object then the image of it is isomorphic
to the limit of `F`. -/
def limit_of_initial {C : Type u} [category C] {J : Type v} [small_category J] (F : J ⥤ C) [has_initial J] [has_limit F] : limit F ≅ functor.obj F (⊥_J) :=
  is_limit.cone_point_unique_up_to_iso (limit.is_limit F) (limit_of_diagram_initial initial_is_initial F)

/-- From a functor `F : J ⥤ C`, given a terminal object of `J`, construct a cocone for `J`.
In `colimit_of_diagram_terminal` we show it is a colimit cocone. -/
@[simp] theorem cocone_of_diagram_terminal_X {C : Type u} [category C] {J : Type v} [small_category J] {X : J} (tX : is_terminal X) (F : J ⥤ C) : cocone.X (cocone_of_diagram_terminal tX F) = functor.obj F X :=
  Eq.refl (cocone.X (cocone_of_diagram_terminal tX F))

/-- From a functor `F : J ⥤ C`, given a terminal object of `J`, show the cocone
`cocone_of_diagram_terminal` is a colimit. -/
def colimit_of_diagram_terminal {C : Type u} [category C] {J : Type v} [small_category J] {X : J} (tX : is_terminal X) (F : J ⥤ C) : is_colimit (cocone_of_diagram_terminal tX F) :=
  is_colimit.mk fun (s : cocone F) => nat_trans.app (cocone.ι s) X

-- This is reducible to allow usage of lemmas about `cocone_point_unique_up_to_iso`.

/-- For a functor `F : J ⥤ C`, if `J` has a terminal object then the image of it is isomorphic
to the colimit of `F`. -/
def colimit_of_terminal {C : Type u} [category C] {J : Type v} [small_category J] (F : J ⥤ C) [has_terminal J] [has_colimit F] : colimit F ≅ functor.obj F (⊤_J) :=
  is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F) (colimit_of_diagram_terminal terminal_is_terminal F)

/--
The comparison morphism from the image of a terminal object to the terminal object in the target
category.
-/
-- TODO: Show this is an isomorphism if and only if `G` preserves terminal objects.

def terminal_comparison {C : Type u} [category C] {D : Type u₂} [category D] (G : C ⥤ D) [has_terminal C] [has_terminal D] : functor.obj G (⊤_C) ⟶ ⊤_D :=
  terminal.from (functor.obj G (⊤_C))

/--
The comparison morphism from the initial object in the target category to the image of the initial
object.
-/
-- TODO: Show this is an isomorphism if and only if `G` preserves initial objects.

def initial_comparison {C : Type u} [category C] {D : Type u₂} [category D] (G : C ⥤ D) [has_initial C] [has_initial D] : ⊥_D ⟶ functor.obj G (⊥_C) :=
  initial.to (functor.obj G (⊥_C))


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons

namespace tup
variable {α : Type*}

@[reducible] definition del : Π {n : ℕ}, fin (n+1) → α ^ (n + 1) → α ^ n
| n ⟨0,_⟩ xs := tail xs
| 0 ⟨k+1,hk⟩ _ := absurd (nat.lt_of_succ_lt_succ hk) (nat.not_lt_zero k)
| (n+1) ⟨k+1,hk⟩ xs := xs.head :: del ⟨k, nat.lt_of_succ_lt_succ hk⟩ xs.tail

@[simp] lemma del_zero {n : ℕ} (xs : α ^ (n+1)) : del 0 xs = tail xs :=
by cases n; reflexivity

@[simp] lemma del_succ {n : ℕ} (xs : α ^ (n+2)) :
∀ k, del (fin.succ k) xs = xs.head :: del k xs.tail :=
by cases n; intros k; cases k; simp [del, fin.succ]

@[simp] lemma del_zero_cons {n : ℕ} (x : α) (xs : α ^ n) : del 0 (x :: xs) = xs := by simp

@[simp] lemma del_succ_cons {n : ℕ} (x : α) (xs : α ^ (n+1)) (k : fin (n+1)) :
del (fin.succ k) (x :: xs) = x :: (del k xs) := by simp

lemma ith_del_of_vlt :
∀ {n : ℕ} {k : fin (n+1)} {i : fin n},
i.val < k.val → ∀ (xs : α ^ (n+1)), (del k xs)[i] = xs[fin.lift i]
| 0 _ _ := by intros; apply fin.elim0; assumption
| (n+1) ⟨0,_⟩ _ := by intros; exfalso; apply nat.not_lt_zero; assumption
| (n+1) ⟨k+1,hk⟩ ⟨0,_⟩ := by intros; unfold del; reflexivity
| (n+1) ⟨k+1,hk⟩ ⟨i+1,hi⟩ :=
  begin
  intros h xs,
  unfold del,
  apply ith_del_of_vlt,
  exact nat.lt_of_succ_lt_succ h
  end

lemma ith_del_of_vge :
∀ {n : ℕ} {k : fin (n+1)} {i : fin n},
i.val ≥ k.val → ∀ (xs : α ^ (n+1)), (del k xs)[i] = xs[fin.succ i]
| 0 _ _ := by intros; apply fin.elim0; assumption
| (n+1) ⟨0,_⟩ _ := by intros; simp [del]
| (n+1) ⟨k+1,hk⟩ ⟨0,_⟩ := by intros; exfalso; apply nat.not_succ_le_zero; assumption
| (n+1) ⟨k+1,hk⟩ ⟨i+1,hi⟩ :=
  begin
  intros h xs,
  unfold del,
  apply ith_del_of_vge,
  exact nat.le_of_succ_le_succ h
  end

definition ins : Π {n : ℕ}, fin (n+1) → α → α ^ n → α ^ (n + 1)
| n ⟨0,_⟩ x xs := x :: xs
| 0 ⟨i+1,hi⟩ _ _ := absurd (nat.lt_of_succ_lt_succ hi) (nat.not_lt_zero i)
| (n+1) ⟨i+1,hi⟩ x xs := xs.head :: ins ⟨i,nat.lt_of_succ_lt_succ hi⟩ x xs.tail

@[simp] lemma ins_zero {n : ℕ} (x : α) (xs : α ^ n) : ins 0 x xs = x :: xs :=
by cases n; reflexivity

@[simp] lemma ins_succ {n : ℕ} (x : α) (xs : α ^ (n+1)) :
∀ k, ins (fin.succ k) x xs = xs.head :: ins k x xs.tail :=
by cases n; intros k; cases k; simp [ins, fin.succ]

@[simp] lemma ins_succ_cons {n : ℕ} (x₀ x : α) (xs : α ^ n) (k : fin (n+1)) :
ins (fin.succ k) x₀ (x :: xs) = x :: ins k x₀ xs := by simp

@[simp] lemma ith_ins : ∀ {n : ℕ} (k : fin (n+1)) (x : α) (xs : α ^ n), (ins k x xs)[k] = x
| n ⟨0,_⟩ _ _ := by cases n; reflexivity
| 0 ⟨k+1,hk⟩ _ _ := absurd (nat.lt_of_succ_lt_succ hk) (nat.not_lt_zero k)
| (n+1) ⟨k+1,hk⟩ x xs := by simp [ins]; apply ith_ins

lemma ith_ins_of_vlt :
∀ {n : ℕ} {k : fin (n+1)} {i : fin n},
i.val < k.val → ∀ (x : α) (xs : α ^ n), (ins k x xs)[fin.lift i] = xs[i]
| n ⟨0,_⟩ ⟨i,_⟩ := λ h, absurd h (nat.not_lt_zero i)
| 0 ⟨k+1,hk⟩ _ := absurd (nat.lt_of_succ_lt_succ hk) (nat.not_lt_zero k)
| (n+1) ⟨k+1,hk⟩ ⟨0,_⟩ := by intros; unfold ins; reflexivity
| (n+1) ⟨k+1,hk⟩ ⟨i+1,hi⟩ :=
  have fin.lift ⟨i, nat.lt_of_succ_lt_succ hi⟩ = ⟨i, nat.lt_of_succ_lt hi⟩, from rfl,
  begin
  intros h x xs,
  unfold ins,
  simp [fin.lift],
  rw [← this],
  apply ith_ins_of_vlt,
  exact nat.lt_of_succ_lt_succ h,
  end

lemma ith_ins_of_vge :
∀ {n : ℕ} {k : fin (n+1)} {i : fin n},
i.val ≥ k.val → ∀ (x : α) (xs : α ^ n), (ins k x xs)[fin.succ i] = xs[i]
| n ⟨0,_⟩ ⟨i,_⟩ := by intros; cases n; simp [ins]
| 0 ⟨k+1,hk⟩ _ := absurd (nat.lt_of_succ_lt_succ hk) (nat.not_lt_zero k)
| (n+1) ⟨k+1,hk⟩ ⟨0,_⟩ := λ h, absurd h (nat.not_succ_le_zero k)
| (n+1) ⟨k+1,hk⟩ ⟨i+1,hi⟩ :=
  have fin.succ ⟨i,nat.lt_of_succ_lt_succ hi⟩ = ⟨i+1,hi⟩, from rfl,
  begin
  intros h x xs,
  unfold ins,
  simp,
  rw [← this],
  apply ith_ins_of_vge,
  exact nat.le_of_succ_le_succ h,
  end

lemma del_ins {n : ℕ} (k : fin (n+1)) (x : α) (xs : α ^ n) :
del k (ins k x xs) = xs :=
ext $ λ i,
if h : i.val < k.val then
by rw [ith_del_of_vlt h, ith_ins_of_vlt h]
else
have h : i.val ≥ k.val, from le_of_not_gt h,
by rw [ith_del_of_vge h, ith_ins_of_vge h]

lemma ins_del {n : ℕ} (k : fin (n+1)) (xs : α ^ (n+1)) :
ins k xs[k] (del k xs) = xs :=
ext $ λ i,
if h : i.val = k.val then
have heq : i = k, from fin.eq_of_veq h,
by rw [heq, ith_ins]
else if h' : i.val ≤ k.val then
have h' : i.val < k.val, from lt_of_le_of_ne h' h,
have i.val < n, from lt_of_lt_of_le h' (nat.le_of_lt_succ k.is_lt),
let i' := fin.mk i.val this in
have hlt : i'.val < k.val, from h',
have i = fin.lift i', from fin.eq_of_veq rfl,
begin
rw [this, ith_ins_of_vlt hlt, ith_del_of_vlt hlt]
end
else
have h' : k.val < i.val, from lt_of_not_ge h',
have 1 ≤ i.val, from nat.succ_le_of_lt (lt_of_le_of_lt (nat.zero_le k.val) h'),
have hi : i.val-1+1 = i.val, from nat.sub_add_cancel this,
have i.val-1 < n, from nat.lt_of_succ_lt_succ (show i.val-1+1 < n+1, from eq.substr hi i.is_lt),
let i' := fin.mk (i.val-1) this in
have hge : i'.val ≥ k.val, from nat.le_of_lt_succ (show i'.val+1 > k.val, from eq.substr hi h'),
have i = fin.succ i', from fin.eq_of_veq $ eq.symm hi,
by rw [this, ith_ins_of_vge hge, ith_del_of_vge hge]

definition set : Π {n : ℕ}, fin n → α → α ^ n → α ^ n
| 0 k _ _ := fin.elim0 k
| (n+1) ⟨0,_⟩ x xs := x :: xs.tail
| (n+1) ⟨k+1,hk⟩ x xs := xs.head :: set ⟨k, nat.lt_of_succ_lt_succ hk⟩ x xs.tail

@[simp] lemma set_zero {n : ℕ} (x : α) (xs : α ^ (n+1)) : set 0 x xs = x :: xs.tail := rfl

@[simp] lemma set_succ {n : ℕ} (x : α) (xs : α ^ (n+1)) : ∀ i, set (fin.succ i) x xs = xs.head :: set i x xs.tail := λ ⟨_,_⟩, rfl

@[simp] lemma ith_set : ∀ {n : ℕ} (k : fin n) (x : α) (xs : α ^ n), (set k x xs)[k] = x
| 0 k _ _ := fin.elim0 k
| (n+1) ⟨0,_⟩ x xs := by simp [set]
| (n+1) ⟨k+1,hk⟩ x xs := by simp [set]; apply ith_set

lemma ith_set_of_ne : ∀ {n : ℕ} (k i : fin n), i ≠ k → ∀ (x : α) (xs : α ^ n), (set k x xs)[i] = xs[i]
| 0 k _ _ := fin.elim0 k
| (n+1) ⟨0,_⟩ ⟨0,_⟩ h := absurd rfl h
| (n+1) ⟨0,_⟩ ⟨i+1,hi⟩ _ := by intros; simp [set]; reflexivity
| (n+1) ⟨k+1,hk⟩ ⟨0,_⟩ _ := by intros; simp [set]; reflexivity
| (n+1) ⟨k+1,hk⟩ ⟨i+1,hi⟩ h :=
  begin
  intros,
  simp [set],
  apply ith_set_of_ne,
  intros f,
  apply h,
  congr,
  exact fin.veq_of_eq f
  end

end tup


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.normed_space.hahn_banach.extension
import analysis.normed_space.is_R_or_C
import analysis.locally_convex.polar

/-!
# The topological dual of a normed space

In this file we define the topological dual `normed_space.dual` of a normed space, and the
continuous linear map `normed_space.inclusion_in_double_dual` from a normed space into its double
dual.

For base field `𝕜 = ℝ` or `𝕜 = ℂ`, this map is actually an isometric embedding; we provide a
version `normed_space.inclusion_in_double_dual_li` of the map which is of type a bundled linear
isometric embedding, `E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E))`.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `semi_normed_group` and we specialize to `normed_group` when needed.

## Main definitions

* `inclusion_in_double_dual` and `inclusion_in_double_dual_li` are the inclusion of a normed space
  in its double dual, considered as a bounded linear map and as a linear isometry, respectively.
* `polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals `x'` for which
  `∥x' z∥ ≤ 1` for every `z ∈ s`.

## Tags

dual
-/

noncomputable theory
open_locale classical topological_space
universes u v

namespace normed_space

section general
variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
variables (E : Type*) [semi_normed_group E] [normed_space 𝕜 E]
variables (F : Type*) [normed_group F] [normed_space 𝕜 F]

/-- The topological dual of a seminormed space `E`. -/
@[derive [inhabited, semi_normed_group, normed_space 𝕜]] def dual := E →L[𝕜] 𝕜

instance : add_monoid_hom_class (dual 𝕜 E) E 𝕜 := continuous_linear_map.add_monoid_hom_class

instance : has_coe_to_fun (dual 𝕜 E) (λ _, E → 𝕜) := continuous_linear_map.to_fun

instance : normed_group (dual 𝕜 F) := continuous_linear_map.to_normed_group

instance [finite_dimensional 𝕜 E] : finite_dimensional 𝕜 (dual 𝕜 E) :=
continuous_linear_map.finite_dimensional

/-- The inclusion of a normed space in its double (topological) dual, considered
   as a bounded linear map. -/
def inclusion_in_double_dual : E →L[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
continuous_linear_map.apply 𝕜 𝕜

@[simp] lemma dual_def (x : E) (f : dual 𝕜 E) : inclusion_in_double_dual 𝕜 E x f = f x := rfl

lemma inclusion_in_double_dual_norm_eq :
  ∥inclusion_in_double_dual 𝕜 E∥ = ∥(continuous_linear_map.id 𝕜 (dual 𝕜 E))∥ :=
continuous_linear_map.op_norm_flip _

lemma inclusion_in_double_dual_norm_le : ∥inclusion_in_double_dual 𝕜 E∥ ≤ 1 :=
by { rw inclusion_in_double_dual_norm_eq, exact continuous_linear_map.norm_id_le }

lemma double_dual_bound (x : E) : ∥(inclusion_in_double_dual 𝕜 E) x∥ ≤ ∥x∥ :=
by simpa using continuous_linear_map.le_of_op_norm_le _ (inclusion_in_double_dual_norm_le 𝕜 E) x

/-- The dual pairing as a bilinear form. -/
def dual_pairing : (dual 𝕜 E) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 := continuous_linear_map.coe_lm 𝕜

@[simp] lemma dual_pairing_apply {v : dual 𝕜 E} {x : E} : dual_pairing 𝕜 E v x = v x := rfl

lemma dual_pairing_separating_left : (dual_pairing 𝕜 E).separating_left :=
begin
  rw [linear_map.separating_left_iff_ker_eq_bot, linear_map.ker_eq_bot],
  exact continuous_linear_map.coe_injective,
end

end general

section bidual_isometry

variables (𝕜 : Type v) [is_R_or_C 𝕜]
  {E : Type u} [normed_group E] [normed_space 𝕜 E]

/-- If one controls the norm of every `f x`, then one controls the norm of `x`.
    Compare `continuous_linear_map.op_norm_le_bound`. -/
lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ∥f x∥ ≤ M * ∥f∥) :
  ∥x∥ ≤ M :=
begin
  classical,
  by_cases h : x = 0,
  { simp only [h, hMp, norm_zero] },
  { obtain ⟨f, hf₁, hfx⟩ : ∃ f : E →L[𝕜] 𝕜, ∥f∥ = 1 ∧ f x = ∥x∥ := exists_dual_vector 𝕜 x h,
    calc ∥x∥ = ∥(∥x∥ : 𝕜)∥ : is_R_or_C.norm_coe_norm.symm
    ... = ∥f x∥ : by rw hfx
    ... ≤ M * ∥f∥ : hM f
    ... = M : by rw [hf₁, mul_one] }
end

lemma eq_zero_of_forall_dual_eq_zero {x : E} (h : ∀ f : dual 𝕜 E, f x = (0 : 𝕜)) : x = 0 :=
norm_le_zero_iff.mp (norm_le_dual_bound 𝕜 x le_rfl (λ f, by simp [h f]))

lemma eq_zero_iff_forall_dual_eq_zero (x : E) : x = 0 ↔ ∀ g : dual 𝕜 E, g x = 0 :=
⟨λ hx, by simp [hx], λ h, eq_zero_of_forall_dual_eq_zero 𝕜 h⟩

/-- See also `geometric_hahn_banach_point_point`. -/
lemma eq_iff_forall_dual_eq {x y : E} :
  x = y ↔ ∀ g : dual 𝕜 E, g x = g y :=
begin
  rw [← sub_eq_zero, eq_zero_iff_forall_dual_eq_zero 𝕜 (x - y)],
  simp [sub_eq_zero],
end

/-- The inclusion of a normed space in its double dual is an isometry onto its image.-/
def inclusion_in_double_dual_li : E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
{ norm_map' := begin
    intros x,
    apply le_antisymm,
    { exact double_dual_bound 𝕜 E x },
    rw continuous_linear_map.norm_def,
    refine le_cInf continuous_linear_map.bounds_nonempty _,
    rintros c ⟨hc1, hc2⟩,
    exact norm_le_dual_bound 𝕜 x hc1 hc2
  end,
  .. inclusion_in_double_dual 𝕜 E }

end bidual_isometry

section polar_sets

open metric set normed_space

/-- Given a subset `s` in a normed space `E` (over a field `𝕜`), the polar
`polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals which
evaluate to something of norm at most one at all points `z ∈ s`. -/
def polar (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
  {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] : set E → set (dual 𝕜 E) :=
(dual_pairing 𝕜 E).flip.polar

variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
variables {E : Type*} [semi_normed_group E] [normed_space 𝕜 E]

lemma mem_polar_iff {x' : dual 𝕜 E} (s : set E) : x' ∈ polar 𝕜 s ↔ ∀ z ∈ s, ∥x' z∥ ≤ 1 := iff.rfl

@[simp] lemma polar_univ : polar 𝕜 (univ : set E) = {(0 : dual 𝕜 E)} :=
(dual_pairing 𝕜 E).flip.polar_univ
  (linear_map.flip_separating_right.mpr (dual_pairing_separating_left 𝕜 E))

lemma is_closed_polar (s : set E) : is_closed (polar 𝕜 s) :=
begin
  dunfold normed_space.polar,
  simp only [linear_map.polar_eq_Inter, linear_map.flip_apply],
  refine is_closed_bInter (λ z hz, _),
  exact is_closed_Iic.preimage (continuous_linear_map.apply 𝕜 𝕜 z).continuous.norm
end

@[simp] lemma polar_closure (s : set E) : polar 𝕜 (closure s) = polar 𝕜 s :=
((dual_pairing 𝕜 E).flip.polar_antitone subset_closure).antisymm $
  (dual_pairing 𝕜 E).flip.polar_gc.l_le $
  closure_minimal ((dual_pairing 𝕜 E).flip.polar_gc.le_u_l s) $
  by simpa [linear_map.flip_flip]
    using (is_closed_polar _ _).preimage (inclusion_in_double_dual 𝕜 E).continuous

variables {𝕜}

/-- If `x'` is a dual element such that the norms `∥x' z∥` are bounded for `z ∈ s`, then a
small scalar multiple of `x'` is in `polar 𝕜 s`. -/
lemma smul_mem_polar {s : set E} {x' : dual 𝕜 E} {c : 𝕜}
  (hc : ∀ z, z ∈ s → ∥ x' z ∥ ≤ ∥c∥) : c⁻¹ • x' ∈ polar 𝕜 s :=
begin
  by_cases c_zero : c = 0, { simp only [c_zero, inv_zero, zero_smul],
    exact (dual_pairing 𝕜 E).flip.zero_mem_polar _ },
  have eq : ∀ z, ∥ c⁻¹ • (x' z) ∥ = ∥ c⁻¹ ∥ * ∥ x' z ∥ := λ z, norm_smul c⁻¹ _,
  have le : ∀ z, z ∈ s → ∥ c⁻¹ • (x' z) ∥ ≤ ∥ c⁻¹ ∥ * ∥ c ∥,
  { intros z hzs,
    rw eq z,
    apply mul_le_mul (le_of_eq rfl) (hc z hzs) (norm_nonneg _) (norm_nonneg _), },
  have cancel : ∥ c⁻¹ ∥ * ∥ c ∥ = 1,
  by simp only [c_zero, norm_eq_zero, ne.def, not_false_iff,
                inv_mul_cancel, norm_inv],
  rwa cancel at le,
end

lemma polar_ball_subset_closed_ball_div {c : 𝕜} (hc : 1 < ∥c∥) {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (ball (0 : E) r) ⊆ closed_ball (0 : dual 𝕜 E) (∥c∥ / r) :=
begin
  intros x' hx',
  rw mem_polar_iff at hx',
  simp only [polar, mem_set_of_eq, mem_closed_ball_zero_iff, mem_ball_zero_iff] at *,
  have hcr : 0 < ∥c∥ / r, from div_pos (zero_lt_one.trans hc) hr,
  refine continuous_linear_map.op_norm_le_of_shell hr hcr.le hc (λ x h₁ h₂, _),
  calc ∥x' x∥ ≤ 1 : hx' _ h₂
  ... ≤ (∥c∥ / r) * ∥x∥ : (inv_pos_le_iff_one_le_mul' hcr).1 (by rwa inv_div)
end

variables (𝕜)

lemma closed_ball_inv_subset_polar_closed_ball {r : ℝ} :
  closed_ball (0 : dual 𝕜 E) r⁻¹ ⊆ polar 𝕜 (closed_ball (0 : E) r) :=
λ x' hx' x hx,
calc ∥x' x∥ ≤ ∥x'∥ * ∥x∥ : x'.le_op_norm x
... ≤ r⁻¹ * r :
  mul_le_mul (mem_closed_ball_zero_iff.1 hx') (mem_closed_ball_zero_iff.1 hx)
    (norm_nonneg _) (dist_nonneg.trans hx')
... = r / r : inv_mul_eq_div _ _
... ≤ 1 : div_self_le_one r

/-- The `polar` of closed ball in a normed space `E` is the closed ball of the dual with
inverse radius. -/
lemma polar_closed_ball
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (closed_ball (0 : E) r) = closed_ball (0 : dual 𝕜 E) r⁻¹ :=
begin
  refine subset.antisymm _ (closed_ball_inv_subset_polar_closed_ball _),
  intros x' h,
  simp only [mem_closed_ball_zero_iff],
  refine continuous_linear_map.op_norm_le_of_ball hr (inv_nonneg.mpr hr.le) (λ z hz, _),
  simpa only [one_div] using linear_map.bound_of_ball_bound' hr 1 x'.to_linear_map h z
end

/-- Given a neighborhood `s` of the origin in a normed space `E`, the dual norms
of all elements of the polar `polar 𝕜 s` are bounded by a constant. -/
lemma bounded_polar_of_mem_nhds_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  bounded (polar 𝕜 s) :=
begin
  obtain ⟨a, ha⟩ : ∃ a : 𝕜, 1 < ∥a∥ := normed_field.exists_one_lt_norm 𝕜,
  obtain ⟨r, r_pos, r_ball⟩ : ∃ (r : ℝ) (hr : 0 < r), ball 0 r ⊆ s :=
    metric.mem_nhds_iff.1 s_nhd,
  exact bounded_closed_ball.mono (((dual_pairing 𝕜 E).flip.polar_antitone r_ball).trans $
    polar_ball_subset_closed_ball_div ha r_pos)
end

end polar_sets

end normed_space


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux

! This file was ported from Lean 3 source module algebra.star.star_alg_hom
! leanprover-community/mathlib commit 35882ddc66524b6980532a123a4ad4166db34c81
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.NonUnitalAlg
import Mathlib.Algebra.Star.Prod
import Mathlib.Algebra.Algebra.Prod

/-!
# Morphisms of star algebras

This file defines morphisms between `R`-algebras (unital or non-unital) `A` and `B` where both
`A` and `B` are equipped with a `star` operation. These morphisms, namely `StarAlgHom` and
`NonUnitalStarAlgHom` are direct extensions of their non-`star`red counterparts with a field
`map_star` which guarantees they preserve the star operation. We keep the type classes as generic
as possible, in keeping with the definition of `NonUnitalAlgHom` in the non-unital case. In this
file, we only assume `Star` unless we want to talk about the zero map as a
`NonUnitalStarAlgHom`, in which case we need `StarAddMonoid`. Note that the scalar ring `R`
is not required to have a star operation, nor do we need `StarRing` or `StarModule` structures on
`A` and `B`.

As with `NonUnitalAlgHom`, in the non-unital case the multiplications are not assumed to be
associative or unital, or even to be compatible with the scalar actions. In a typical application,
the operations will satisfy compatibility conditions making them into algebras (albeit possibly
non-associative and/or non-unital) but such conditions are not required here for the definitions.

The primary impetus for defining these types is that they constitute the morphisms in the categories
of unital C⋆-algebras (with `StarAlgHom`s) and of C⋆-algebras (with `NonUnitalStarAlgHom`s).

## Main definitions

  * `NonUnitalStarAlgHom`
  * `StarAlgHom`

## Tags

non-unital, algebra, morphism, star
-/

open EquivLike

/-! ### Non-unital star algebra homomorphisms -/

/-- A *non-unital ⋆-algebra homomorphism* is a non-unital algebra homomorphism between
non-unital `R`-algebras `A` and `B` equipped with a `star` operation, and this homomorphism is
also `star`-preserving. -/
structure NonUnitalStarAlgHom (R A B : Type _) [Monoid R] [NonUnitalNonAssocSemiring A]
  [DistribMulAction R A] [Star A] [NonUnitalNonAssocSemiring B] [DistribMulAction R B]
  [Star B] extends A →ₙₐ[R] B where
  /-- By definition, a non-unital ⋆-algebra homomorphism preserves the `star` operation. -/
  map_star' : ∀ a : A, toFun (star a) = star (toFun a)
#align non_unital_star_alg_hom NonUnitalStarAlgHom

@[inherit_doc NonUnitalStarAlgHom] infixr:25 " →⋆ₙₐ " => NonUnitalStarAlgHom _

@[inherit_doc] notation:25 A " →⋆ₙₐ[" R "] " B => NonUnitalStarAlgHom R A B

/-- Reinterpret a non-unital star algebra homomorphism as a non-unital algebra homomorphism
by forgetting the interaction with the star operation. -/
add_decl_doc NonUnitalStarAlgHom.toNonUnitalAlgHom

/-- `NonUnitalStarAlgHomClass F R A B` asserts `F` is a type of bundled non-unital ⋆-algebra
homomorphisms from `A` to `B`. -/
class NonUnitalStarAlgHomClass (F : Type _) (R : outParam (Type _)) (A : outParam (Type _))
  (B : outParam (Type _)) [Monoid R] [Star A] [Star B] [NonUnitalNonAssocSemiring A]
  [NonUnitalNonAssocSemiring B] [DistribMulAction R A] [DistribMulAction R B] extends
  NonUnitalAlgHomClass F R A B, StarHomClass F A B
#align non_unital_star_alg_hom_class NonUnitalStarAlgHomClass

-- Porting note: no longer needed
---- `R` becomes a metavariable but that's fine because it's an `outParam`
--attribute [nolint dangerousInstance] NonUnitalStarAlgHomClass.toStarHomClass

namespace NonUnitalStarAlgHomClass

variable {F R A B : Type _} [Monoid R]

variable [NonUnitalNonAssocSemiring A] [DistribMulAction R A] [Star A]

variable [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [Star B]

instance [NonUnitalStarAlgHomClass F R A B] : CoeTC F (A →⋆ₙₐ[R] B)
    where coe f :=
    { (f : A →ₙₐ[R] B) with
      toFun := f
      map_star' := map_star f }

end NonUnitalStarAlgHomClass

namespace NonUnitalStarAlgHom

section Basic

variable {R A B C D : Type _} [Monoid R]

variable [NonUnitalNonAssocSemiring A] [DistribMulAction R A] [Star A]

variable [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [Star B]

variable [NonUnitalNonAssocSemiring C] [DistribMulAction R C] [Star C]

variable [NonUnitalNonAssocSemiring D] [DistribMulAction R D] [Star D]

instance : NonUnitalStarAlgHomClass (A →⋆ₙₐ[R] B) R A B
    where
  coe f := f.toFun
  coe_injective' := by rintro ⟨⟨⟨⟨f, _⟩, _⟩, _⟩, _⟩ ⟨⟨⟨⟨g, _⟩, _⟩, _⟩, _⟩ h; congr
  map_smul f := f.map_smul'
  map_add f := f.map_add'
  map_zero f := f.map_zero'
  map_mul f := f.map_mul'
  map_star f := f.map_star'

-- Porting note: this is no longer useful
--/-- Helper instance for when there's too many metavariables to apply `FunLike.CoeFun`
--directly. -/
--instance : CoeFun (A →⋆ₙₐ[R] B) fun _ => A → B :=
--  FunLike.hasCoeToFun

-- Porting note: in mathlib3 we didn't need the `Simps.apply` hint.
/-- See Note [custom simps projection] -/
def Simps.apply (f : A →⋆ₙₐ[R] B) : A → B := f

initialize_simps_projections NonUnitalStarAlgHom
  (toFun → apply)

@[simp]
protected theorem coe_coe {F : Type _} [NonUnitalStarAlgHomClass F R A B] (f : F) :
  ⇑(f : A →⋆ₙₐ[R] B) = f := rfl
#align non_unital_star_alg_hom.coe_coe NonUnitalStarAlgHom.coe_coe

@[simp]
theorem coe_toNonUnitalAlgHom {f : A →⋆ₙₐ[R] B} : (f.toNonUnitalAlgHom : A → B) = f :=
  rfl
#align non_unital_star_alg_hom.coe_to_non_unital_alg_hom NonUnitalStarAlgHom.coe_toNonUnitalAlgHom

@[ext]
theorem ext {f g : A →⋆ₙₐ[R] B} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align non_unital_star_alg_hom.ext NonUnitalStarAlgHom.ext

/-- Copy of a `NonUnitalStarAlgHom` with a new `toFun` equal to the old one. Useful
to fix definitional equalities. -/
protected def copy (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : A →⋆ₙₐ[R] B
    where
  toFun := f'
  map_smul' := h.symm ▸ map_smul f
  map_zero' := h.symm ▸ map_zero f
  map_add' := h.symm ▸ map_add f
  map_mul' := h.symm ▸ map_mul f
  map_star' := h.symm ▸ map_star f
#align non_unital_star_alg_hom.copy NonUnitalStarAlgHom.copy

@[simp]
theorem coe_copy (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align non_unital_star_alg_hom.coe_copy NonUnitalStarAlgHom.coe_copy

theorem copy_eq (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align non_unital_star_alg_hom.copy_eq NonUnitalStarAlgHom.copy_eq

-- porting note: doesn't align with Mathlib 3 because `NonUnitalStarAlgHom.mk` has a new signature
@[simp]
theorem coe_mk (f : A → B) (h₁ h₂ h₃ h₄ h₅) :
    ((⟨⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩, h₅⟩ : A →⋆ₙₐ[R] B) : A → B) = f :=
  rfl
#align non_unital_star_alg_hom.coe_mk NonUnitalStarAlgHom.coe_mkₓ

-- porting note: doesn't align with Mathlib 3 because `NonUnitalStarAlgHom.mk` has a new signature
@[simp]
theorem mk_coe (f : A →⋆ₙₐ[R] B) (h₁ h₂ h₃ h₄ h₅) :
  (⟨⟨⟨⟨f, h₁⟩, h₂, h₃⟩, h₄⟩, h₅⟩ : A →⋆ₙₐ[R] B) = f := by
  ext
  rfl
#align non_unital_star_alg_hom.mk_coe NonUnitalStarAlgHom.mk_coeₓ

section

variable (R A)

/-- The identity as a non-unital ⋆-algebra homomorphism. -/
protected def id : A →⋆ₙₐ[R] A :=
  { (1 : A →ₙₐ[R] A) with map_star' := fun _ => rfl }
#align non_unital_star_alg_hom.id NonUnitalStarAlgHom.id

@[simp]
theorem coe_id : ⇑(NonUnitalStarAlgHom.id R A) = id :=
  rfl
#align non_unital_star_alg_hom.coe_id NonUnitalStarAlgHom.coe_id

end

/-- The composition of non-unital ⋆-algebra homomorphisms, as a non-unital ⋆-algebra
homomorphism. -/
def comp (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) : A →⋆ₙₐ[R] C :=
  { f.toNonUnitalAlgHom.comp g.toNonUnitalAlgHom with
    map_star' := by
      simp only [map_star, NonUnitalAlgHom.toFun_eq_coe, eq_self_iff_true, NonUnitalAlgHom.coe_comp,
        coe_toNonUnitalAlgHom, Function.comp_apply, forall_const] }
#align non_unital_star_alg_hom.comp NonUnitalStarAlgHom.comp

@[simp]
theorem coe_comp (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) : ⇑(comp f g) = f ∘ g :=
  rfl
#align non_unital_star_alg_hom.coe_comp NonUnitalStarAlgHom.coe_comp

@[simp]
theorem comp_apply (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) (a : A) : comp f g a = f (g a) :=
  rfl
#align non_unital_star_alg_hom.comp_apply NonUnitalStarAlgHom.comp_apply

@[simp]
theorem comp_assoc (f : C →⋆ₙₐ[R] D) (g : B →⋆ₙₐ[R] C) (h : A →⋆ₙₐ[R] B) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align non_unital_star_alg_hom.comp_assoc NonUnitalStarAlgHom.comp_assoc

@[simp]
theorem id_comp (f : A →⋆ₙₐ[R] B) : (NonUnitalStarAlgHom.id _ _).comp f = f :=
  ext fun _ => rfl
#align non_unital_star_alg_hom.id_comp NonUnitalStarAlgHom.id_comp

@[simp]
theorem comp_id (f : A →⋆ₙₐ[R] B) : f.comp (NonUnitalStarAlgHom.id _ _) = f :=
  ext fun _ => rfl
#align non_unital_star_alg_hom.comp_id NonUnitalStarAlgHom.comp_id

instance : Monoid (A →⋆ₙₐ[R] A) where
  mul := comp
  mul_assoc := comp_assoc
  one := NonUnitalStarAlgHom.id R A
  one_mul := id_comp
  mul_one := comp_id

@[simp]
theorem coe_one : ((1 : A →⋆ₙₐ[R] A) : A → A) = id :=
  rfl
#align non_unital_star_alg_hom.coe_one NonUnitalStarAlgHom.coe_one

theorem one_apply (a : A) : (1 : A →⋆ₙₐ[R] A) a = a :=
  rfl
#align non_unital_star_alg_hom.one_apply NonUnitalStarAlgHom.one_apply

end Basic

section Zero

-- the `zero` requires extra type class assumptions because we need `star_zero`
variable {R A B C D : Type _} [Monoid R]

variable [NonUnitalNonAssocSemiring A] [DistribMulAction R A] [StarAddMonoid A]

variable [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [StarAddMonoid B]

instance : Zero (A →⋆ₙₐ[R] B) :=
  ⟨{ (0 : NonUnitalAlgHom R A B) with map_star' := by simp }⟩

instance : Inhabited (A →⋆ₙₐ[R] B) :=
  ⟨0⟩

instance : MonoidWithZero (A →⋆ₙₐ[R] A) :=
  { inferInstanceAs (Monoid (A →⋆ₙₐ[R] A)),
    inferInstanceAs (Zero (A →⋆ₙₐ[R] A)) with
    zero_mul := fun _ => ext fun _ => rfl
    mul_zero := fun f => ext fun _ => map_zero f }

@[simp]
theorem coe_zero : ((0 : A →⋆ₙₐ[R] B) : A → B) = 0 :=
  rfl
#align non_unital_star_alg_hom.coe_zero NonUnitalStarAlgHom.coe_zero

theorem zero_apply (a : A) : (0 : A →⋆ₙₐ[R] B) a = 0 :=
  rfl
#align non_unital_star_alg_hom.zero_apply NonUnitalStarAlgHom.zero_apply

end Zero

end NonUnitalStarAlgHom

/-! ### Unital star algebra homomorphisms -/

section Unital

/-- A *⋆-algebra homomorphism* is an algebra homomorphism between `R`-algebras `A` and `B`
equipped with a `star` operation, and this homomorphism is also `star`-preserving. -/
structure StarAlgHom (R A B : Type _) [CommSemiring R] [Semiring A] [Algebra R A] [Star A]
  [Semiring B] [Algebra R B] [Star B] extends AlgHom R A B where
  /-- By definition, a ⋆-algebra homomorphism preserves the `star` operation. -/
  map_star' : ∀ x : A, toFun (star x) = star (toFun x)
#align star_alg_hom StarAlgHom

@[inherit_doc StarAlgHom] infixr:25 " →⋆ₐ " => StarAlgHom _

@[inherit_doc] notation:25 A " →⋆ₐ[" R "] " B => StarAlgHom R A B

/-- Reinterpret a unital star algebra homomorphism as a unital algebra homomorphism
by forgetting the interaction with the star operation. -/
add_decl_doc StarAlgHom.toAlgHom

/-- `StarAlgHomClass F R A B` states that `F` is a type of ⋆-algebra homomorphisms.

You should also extend this typeclass when you extend `StarAlgHom`. -/
class StarAlgHomClass (F : Type _) (R : outParam (Type _)) (A : outParam (Type _))
  (B : outParam (Type _)) [CommSemiring R] [Semiring A] [Algebra R A] [Star A] [Semiring B]
  [Algebra R B] [Star B] extends AlgHomClass F R A B, StarHomClass F A B
#align star_alg_hom_class StarAlgHomClass

-- Porting note: no longer needed
---- `R` becomes a metavariable but that's fine because it's an `outParam`
--attribute [nolint dangerousInstance] StarAlgHomClass.toStarHomClass

namespace StarAlgHomClass

variable (F R A B : Type _)

-- See note [lower instance priority]
instance (priority := 100) toNonUnitalStarAlgHomClass {_ : CommSemiring R} {_ : Semiring A}
  {_ : Algebra R A} {_ : Star A} {_ : Semiring B} {_ : Algebra R B} {_ : Star B}
  [StarAlgHomClass F R A B] :
  NonUnitalStarAlgHomClass F R A B :=
  { StarAlgHomClass.toAlgHomClass, StarAlgHomClass.toStarHomClass with
    map_smul := map_smul }
#align star_alg_hom_class.to_non_unital_star_alg_hom_class StarAlgHomClass.toNonUnitalStarAlgHomClass

variable [CommSemiring R] [Semiring A] [Algebra R A] [Star A]

variable [Semiring B] [Algebra R B] [Star B] [hF : StarAlgHomClass F R A B]

instance : CoeTC F (A →⋆ₐ[R] B)
    where coe f :=
    { (f : A →ₐ[R] B) with
      toFun := f
      map_star' := map_star f }

end StarAlgHomClass

namespace StarAlgHom

variable {F R A B C D : Type _} [CommSemiring R] [Semiring A] [Algebra R A] [Star A] [Semiring B]
  [Algebra R B] [Star B] [Semiring C] [Algebra R C] [Star C] [Semiring D] [Algebra R D] [Star D]

instance : StarAlgHomClass (A →⋆ₐ[R] B) R A B
    where
  coe f := f.toFun
  coe_injective' := by rintro ⟨⟨⟨⟨⟨f, _⟩, _⟩, _⟩, _⟩, _⟩ ⟨⟨⟨⟨⟨g, _⟩, _⟩, _⟩, _⟩, _⟩ h; congr
  map_mul f := f.map_mul'
  map_one f := f.map_one'
  map_add f := f.map_add'
  map_zero f := f.map_zero'
  commutes f := f.commutes'
  map_star f := f.map_star'

@[simp]
protected theorem coe_coe {F : Type _} [StarAlgHomClass F R A B] (f : F) : ⇑(f : A →⋆ₐ[R] B) = f :=
  rfl
#align star_alg_hom.coe_coe StarAlgHom.coe_coe

-- Porting note: in mathlib3 we didn't need the `Simps.apply` hint.
/-- See Note [custom simps projection] -/
def Simps.apply (f : A →⋆ₐ[R] B) : A → B := f

initialize_simps_projections StarAlgHom (toFun → apply)

@[simp]
theorem coe_toAlgHom {f : A →⋆ₐ[R] B} : (f.toAlgHom : A → B) = f :=
  rfl
#align star_alg_hom.coe_to_alg_hom StarAlgHom.coe_toAlgHom

@[ext]
theorem ext {f g : A →⋆ₐ[R] B} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align star_alg_hom.ext StarAlgHom.ext

/-- Copy of a `StarAlgHom` with a new `toFun` equal to the old one. Useful
to fix definitional equalities. -/
protected def copy (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : A →⋆ₐ[R] B
    where
  toFun := f'
  map_one' := h.symm ▸ map_one f
  map_mul' := h.symm ▸ map_mul f
  map_zero' := h.symm ▸ map_zero f
  map_add' := h.symm ▸ map_add f
  commutes' := h.symm ▸ AlgHomClass.commutes f
  map_star' := h.symm ▸ map_star f
#align star_alg_hom.copy StarAlgHom.copy

@[simp]
theorem coe_copy (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : ⇑(f.copy f' h) = f' :=
  rfl
#align star_alg_hom.coe_copy StarAlgHom.coe_copy

theorem copy_eq (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : f.copy f' h = f :=
  FunLike.ext' h
#align star_alg_hom.copy_eq StarAlgHom.copy_eq

-- porting note: doesn't align with Mathlib 3 because `StarAlgHom.mk` has a new signature
@[simp]
theorem coe_mk (f : A → B) (h₁ h₂ h₃ h₄ h₅ h₆) :
    ((⟨⟨⟨⟨⟨f, h₁⟩, h₂⟩, h₃, h₄⟩, h₅⟩, h₆⟩ : A →⋆ₐ[R] B) : A → B) = f :=
  rfl
#align star_alg_hom.coe_mk StarAlgHom.coe_mkₓ

-- porting note: doesn't align with Mathlib 3 because `StarAlgHom.mk` has a new signature
@[simp]
theorem mk_coe (f : A →⋆ₐ[R] B) (h₁ h₂ h₃ h₄ h₅ h₆) :
    (⟨⟨⟨⟨⟨f, h₁⟩, h₂⟩, h₃, h₄⟩, h₅⟩, h₆⟩ : A →⋆ₐ[R] B) = f := by
  ext
  rfl
#align star_alg_hom.mk_coe StarAlgHom.mk_coeₓ

section

variable (R A)

/-- The identity as a `StarAlgHom`. -/
protected def id : A →⋆ₐ[R] A :=
  { AlgHom.id _ _ with map_star' := fun _ => rfl }
#align star_alg_hom.id StarAlgHom.id

@[simp]
theorem coe_id : ⇑(StarAlgHom.id R A) = id :=
  rfl
#align star_alg_hom.coe_id StarAlgHom.coe_id

end

instance : Inhabited (A →⋆ₐ[R] A) :=
  ⟨StarAlgHom.id R A⟩

/-- The composition of ⋆-algebra homomorphisms, as a ⋆-algebra homomorphism. -/
def comp (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) : A →⋆ₐ[R] C :=
  { f.toAlgHom.comp g.toAlgHom with
    map_star' := by
      simp only [map_star, AlgHom.toFun_eq_coe, AlgHom.coe_comp, coe_toAlgHom,
        Function.comp_apply, eq_self_iff_true, forall_const] }
#align star_alg_hom.comp StarAlgHom.comp

@[simp]
theorem coe_comp (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) : ⇑(comp f g) = f ∘ g :=
  rfl
#align star_alg_hom.coe_comp StarAlgHom.coe_comp

@[simp]
theorem comp_apply (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) (a : A) : comp f g a = f (g a) :=
  rfl
#align star_alg_hom.comp_apply StarAlgHom.comp_apply

@[simp]
theorem comp_assoc (f : C →⋆ₐ[R] D) (g : B →⋆ₐ[R] C) (h : A →⋆ₐ[R] B) :
    (f.comp g).comp h = f.comp (g.comp h) :=
  rfl
#align star_alg_hom.comp_assoc StarAlgHom.comp_assoc

@[simp]
theorem id_comp (f : A →⋆ₐ[R] B) : (StarAlgHom.id _ _).comp f = f :=
  ext fun _ => rfl
#align star_alg_hom.id_comp StarAlgHom.id_comp

@[simp]
theorem comp_id (f : A →⋆ₐ[R] B) : f.comp (StarAlgHom.id _ _) = f :=
  ext fun _ => rfl
#align star_alg_hom.comp_id StarAlgHom.comp_id

instance : Monoid (A →⋆ₐ[R] A) where
  mul := comp
  mul_assoc := comp_assoc
  one := StarAlgHom.id R A
  one_mul := id_comp
  mul_one := comp_id

/-- A unital morphism of ⋆-algebras is a `NonUnitalStarAlgHom`. -/
def toNonUnitalStarAlgHom (f : A →⋆ₐ[R] B) : A →⋆ₙₐ[R] B :=
  { f with map_smul' := map_smul f }
#align star_alg_hom.to_non_unital_star_alg_hom StarAlgHom.toNonUnitalStarAlgHom

@[simp]
theorem coe_toNonUnitalStarAlgHom (f : A →⋆ₐ[R] B) : (f.toNonUnitalStarAlgHom : A → B) = f :=
  rfl
#align star_alg_hom.coe_to_non_unital_star_alg_hom StarAlgHom.coe_toNonUnitalStarAlgHom

end StarAlgHom

end Unital

/-! ### Operations on the product type

Note that this is copied from [`Algebra/Hom/NonUnitalAlg`](NonUnitalAlg). -/

namespace NonUnitalStarAlgHom

section Prod

variable (R A B C : Type _) [Monoid R] [NonUnitalNonAssocSemiring A] [DistribMulAction R A] [Star A]
  [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [Star B] [NonUnitalNonAssocSemiring C]
  [DistribMulAction R C] [Star C]

/-- The first projection of a product is a non-unital ⋆-algebra homomoprhism. -/
@[simps!]
def fst : A × B →⋆ₙₐ[R] A :=
  { NonUnitalAlgHom.fst R A B with map_star' := fun _ => rfl }
#align non_unital_star_alg_hom.fst NonUnitalStarAlgHom.fst

/-- The second projection of a product is a non-unital ⋆-algebra homomorphism. -/
@[simps!]
def snd : A × B →⋆ₙₐ[R] B :=
  { NonUnitalAlgHom.snd R A B with map_star' := fun _ => rfl }
#align non_unital_star_alg_hom.snd NonUnitalStarAlgHom.snd

variable {R A B C}

/-- The `Pi.prod` of two morphisms is a morphism. -/
@[simps!]
def prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : A →⋆ₙₐ[R] B × C :=
  { f.toNonUnitalAlgHom.prod g.toNonUnitalAlgHom with
    map_star' := fun x => by simp [map_star, Prod.star_def] }
#align non_unital_star_alg_hom.prod NonUnitalStarAlgHom.prod

theorem coe_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : ⇑(f.prod g) = Pi.prod f g :=
  rfl
#align non_unital_star_alg_hom.coe_prod NonUnitalStarAlgHom.coe_prod

@[simp]
theorem fst_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : (fst R B C).comp (prod f g) = f := by
  ext; rfl
#align non_unital_star_alg_hom.fst_prod NonUnitalStarAlgHom.fst_prod

@[simp]
theorem snd_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : (snd R B C).comp (prod f g) = g := by
  ext; rfl
#align non_unital_star_alg_hom.snd_prod NonUnitalStarAlgHom.snd_prod

@[simp]
theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
  FunLike.coe_injective Pi.prod_fst_snd
#align non_unital_star_alg_hom.prod_fst_snd NonUnitalStarAlgHom.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains. -/
@[simps]
def prodEquiv : (A →⋆ₙₐ[R] B) × (A →⋆ₙₐ[R] C) ≃ (A →⋆ₙₐ[R] B × C)
    where
  toFun f := f.1.prod f.2
  invFun f := ((fst _ _ _).comp f, (snd _ _ _).comp f)
  left_inv f := by ext <;> rfl
  right_inv f := by ext <;> rfl
#align non_unital_star_alg_hom.prod_equiv NonUnitalStarAlgHom.prodEquiv

end Prod

section InlInr

variable (R A B C : Type _) [Monoid R] [NonUnitalNonAssocSemiring A] [DistribMulAction R A]
  [StarAddMonoid A] [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [StarAddMonoid B]
  [NonUnitalNonAssocSemiring C] [DistribMulAction R C] [StarAddMonoid C]

/-- The left injection into a product is a non-unital algebra homomorphism. -/
def inl : A →⋆ₙₐ[R] A × B :=
  prod 1 0
#align non_unital_star_alg_hom.inl NonUnitalStarAlgHom.inl

/-- The right injection into a product is a non-unital algebra homomorphism. -/
def inr : B →⋆ₙₐ[R] A × B :=
  prod 0 1
#align non_unital_star_alg_hom.inr NonUnitalStarAlgHom.inr

variable {R A B}

@[simp]
theorem coe_inl : (inl R A B : A → A × B) = fun x => (x, 0) :=
  rfl
#align non_unital_star_alg_hom.coe_inl NonUnitalStarAlgHom.coe_inl

theorem inl_apply (x : A) : inl R A B x = (x, 0) :=
  rfl
#align non_unital_star_alg_hom.inl_apply NonUnitalStarAlgHom.inl_apply

@[simp]
theorem coe_inr : (inr R A B : B → A × B) = Prod.mk 0 :=
  rfl
#align non_unital_star_alg_hom.coe_inr NonUnitalStarAlgHom.coe_inr

theorem inr_apply (x : B) : inr R A B x = (0, x) :=
  rfl
#align non_unital_star_alg_hom.inr_apply NonUnitalStarAlgHom.inr_apply

end InlInr

end NonUnitalStarAlgHom

namespace StarAlgHom

variable (R A B C : Type _) [CommSemiring R] [Semiring A] [Algebra R A] [Star A] [Semiring B]
  [Algebra R B] [Star B] [Semiring C] [Algebra R C] [Star C]

/-- The first projection of a product is a ⋆-algebra homomoprhism. -/
@[simps!]
def fst : A × B →⋆ₐ[R] A :=
  { AlgHom.fst R A B with map_star' := fun _ => rfl }
#align star_alg_hom.fst StarAlgHom.fst

/-- The second projection of a product is a ⋆-algebra homomorphism. -/
@[simps!]
def snd : A × B →⋆ₐ[R] B :=
  { AlgHom.snd R A B with map_star' := fun _ => rfl }
#align star_alg_hom.snd StarAlgHom.snd

variable {R A B C}

/-- The `Pi.prod` of two morphisms is a morphism. -/
@[simps!]
def prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : A →⋆ₐ[R] B × C :=
  { f.toAlgHom.prod g.toAlgHom with map_star' := fun x => by simp [Prod.star_def, map_star] }
#align star_alg_hom.prod StarAlgHom.prod

theorem coe_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : ⇑(f.prod g) = Pi.prod f g :=
  rfl
#align star_alg_hom.coe_prod StarAlgHom.coe_prod

@[simp]
theorem fst_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : (fst R B C).comp (prod f g) = f := by
  ext; rfl
#align star_alg_hom.fst_prod StarAlgHom.fst_prod

@[simp]
theorem snd_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : (snd R B C).comp (prod f g) = g := by
  ext; rfl
#align star_alg_hom.snd_prod StarAlgHom.snd_prod

@[simp]
theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 :=
  FunLike.coe_injective Pi.prod_fst_snd
#align star_alg_hom.prod_fst_snd StarAlgHom.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains. -/
@[simps]
def prodEquiv : (A →⋆ₐ[R] B) × (A →⋆ₐ[R] C) ≃ (A →⋆ₐ[R] B × C)
    where
  toFun f := f.1.prod f.2
  invFun f := ((fst _ _ _).comp f, (snd _ _ _).comp f)
  left_inv f := by ext <;> rfl
  right_inv f := by ext <;> rfl
#align star_alg_hom.prod_equiv StarAlgHom.prodEquiv

end StarAlgHom

/-! ### Star algebra equivalences -/

-- Porting note: changed order of arguments to work around
-- [https://github.com/leanprover-community/mathlib4/issues/2505]
/-- A *⋆-algebra* equivalence is an equivalence preserving addition, multiplication, scalar
multiplication and the star operation, which allows for considering both unital and non-unital
equivalences with a single structure. Currently, `AlgEquiv` requires unital algebras, which is
why this structure does not extend it. -/
structure StarAlgEquiv (R A B : Type _) [Add A] [Add B] [Mul A] [Mul B] [SMul R A] [SMul R B]
  [Star A] [Star B] extends A ≃+* B where
  /-- By definition, a ⋆-algebra equivalence preserves the `star` operation. -/
  map_star' : ∀ a : A, toFun (star a) = star (toFun a)
  /-- By definition, a ⋆-algebra equivalence commutes with the action of scalars. -/
  map_smul' : ∀ (r : R) (a : A), toFun (r • a) = r • toFun a
#align star_alg_equiv StarAlgEquiv

@[inherit_doc StarAlgEquiv] infixr:25 " ≃⋆ₐ " => StarAlgEquiv _

@[inherit_doc] notation:25 A " ≃⋆ₐ[" R "] " B => StarAlgEquiv R A B

/-- Reinterpret a star algebra equivalence as a `RingEquiv` by forgetting the interaction with
the star operation and scalar multiplication. -/
add_decl_doc StarAlgEquiv.toRingEquiv

/-- `StarAlgEquivClass F R A B` asserts `F` is a type of bundled ⋆-algebra equivalences between
`A` and `B`.

You should also extend this typeclass when you extend `StarAlgEquiv`. -/
class StarAlgEquivClass (F : Type _) (R : outParam (Type _)) (A : outParam (Type _))
  (B : outParam (Type _)) [Add A] [Mul A] [SMul R A] [Star A] [Add B] [Mul B] [SMul R B]
  [Star B] extends RingEquivClass F A B where
  /-- By definition, a ⋆-algebra equivalence preserves the `star` operation. -/
  map_star : ∀ (f : F) (a : A), f (star a) = star (f a)
  /-- By definition, a ⋆-algebra equivalence commutes with the action of scalars. -/
  map_smul : ∀ (f : F) (r : R) (a : A), f (r • a) = r • f a
#align star_alg_equiv_class StarAlgEquivClass

-- Porting note: no longer needed
---- `R` becomes a metavariable but that's fine because it's an `outParam`
-- attribute [nolint dangerousInstance] StarAlgEquivClass.toRingEquivClass

namespace StarAlgEquivClass

-- Porting note: Made following instance non-dangerous through [...] -> {_ : ...} replacement
-- See note [lower instance priority]
instance (priority := 50) {F R A B : Type _} {_ : Add A} {_ : Mul A} {_ : SMul R A} {_ : Star A}
    {_ : Add B} {_ : Mul B} {_ : SMul R B} {_ : Star B} [hF : StarAlgEquivClass F R A B] :
    StarHomClass F A B :=
  { hF with
    coe := fun f => f
    coe_injective' := FunLike.coe_injective }

-- Porting note: no longer needed
---- `R` becomes a metavariable but that's fine because it's an `outParam`
-- attribute [nolint dangerousInstance] StarAlgEquivClass.instStarHomClass

-- See note [lower instance priority]
instance (priority := 50) {F R A B : Type _} {_ : Add A} {_ : Mul A} {_ : Star A} {_ : SMul R A}
    {_ : Add B} {_ : Mul B} {_ : SMul R B} {_ : Star B} [hF : StarAlgEquivClass F R A B] :
    SMulHomClass F R A B :=
  { hF with
    coe := fun f => f
    coe_injective' := FunLike.coe_injective }

-- Porting note: no longer needed
---- `R` becomes a metavariable but that's fine because it's an `outParam`
--attribute [nolint dangerous_instance] StarAlgEquivClass.smulHomClass

-- See note [lower instance priority]
instance (priority := 100) {F R A B : Type _} {_ : Monoid R} {_ : NonUnitalNonAssocSemiring A}
    {_ : DistribMulAction R A} {_ : Star A} {_ : NonUnitalNonAssocSemiring B}
    {_ : DistribMulAction R B} {_ : Star B} [hF : StarAlgEquivClass F R A B] :
    NonUnitalStarAlgHomClass F R A B :=
  { hF with
    coe := fun f => f
    coe_injective' := FunLike.coe_injective
    map_zero := map_zero }

-- See note [lower instance priority]
instance (priority := 100) (F R A B : Type _) {_ : CommSemiring R} {_ : Semiring A}
    {_ : Algebra R A} {_ : Star A} {_ : Semiring B} {_ : Algebra R B} {_ : Star B}
    [hF : StarAlgEquivClass F R A B] : StarAlgHomClass F R A B :=
  { hF with
    coe := fun f => f
    coe_injective' := FunLike.coe_injective
    map_one := map_one
    map_zero := map_zero
    commutes := fun f r => by simp only [Algebra.algebraMap_eq_smul_one, map_smul, map_one] }

end StarAlgEquivClass

namespace StarAlgEquiv

section Basic

variable {F R A B C : Type _} [Add A] [Add B] [Mul A] [Mul B] [SMul R A] [SMul R B] [Star A]
  [Star B] [Add C] [Mul C] [SMul R C] [Star C]

instance : StarAlgEquivClass (A ≃⋆ₐ[R] B) R A B
    where
  coe f := f.toFun
  inv f := f.invFun
  left_inv f := f.left_inv
  right_inv f := f.right_inv
  coe_injective' f g h₁ h₂ := by
    rcases f with ⟨⟨⟨_, _, _⟩, _⟩, _⟩
    rcases g with ⟨⟨⟨_, _, _⟩, _⟩, _⟩
    congr
  map_mul f := f.map_mul'
  map_add f := f.map_add'
  map_star := map_star'
  map_smul := map_smul'

@[simp]
theorem toRingEquiv_eq_coe (e : A ≃⋆ₐ[R] B) : e.toRingEquiv = e :=
  rfl

-- Porting note: this is no longer useful
--/-- Helper instance for when there's too many metavariables to apply
--`FunLike.CoeFun` directly. -/
--instance : CoeFun (A ≃⋆ₐ[R] B) fun _ => A → B :=
--  ⟨StarAlgEquiv.toFun⟩

@[ext]
theorem ext {f g : A ≃⋆ₐ[R] B} (h : ∀ a, f a = g a) : f = g :=
  FunLike.ext f g h
#align star_alg_equiv.ext StarAlgEquiv.ext

theorem ext_iff {f g : A ≃⋆ₐ[R] B} : f = g ↔ ∀ a, f a = g a :=
  FunLike.ext_iff
#align star_alg_equiv.ext_iff StarAlgEquiv.ext_iff

/-- Star algebra equivalences are reflexive. -/
@[refl]
def refl : A ≃⋆ₐ[R] A :=
  { RingEquiv.refl A with
    map_smul' := fun _ _ => rfl
    map_star' := fun _ => rfl }
#align star_alg_equiv.refl StarAlgEquiv.refl

instance : Inhabited (A ≃⋆ₐ[R] A) :=
  ⟨refl⟩

@[simp]
theorem coe_refl : ⇑(refl : A ≃⋆ₐ[R] A) = id :=
  rfl
#align star_alg_equiv.coe_refl StarAlgEquiv.coe_refl

-- Porting note: changed proof a bit by using `EquivLike` to avoid lots of coercions
/-- Star algebra equivalences are symmetric. -/
@[symm]
nonrec def symm (e : A ≃⋆ₐ[R] B) : B ≃⋆ₐ[R] A :=
  { e.symm with
    map_star' := fun b => by
      simpa only [apply_inv_apply, inv_apply_apply] using
        congr_arg (inv e) (map_star e (inv e b)).symm
    map_smul' := fun r b => by
      simpa only [apply_inv_apply, inv_apply_apply] using
        congr_arg (inv e) (map_smul e r (inv e b)).symm }
#align star_alg_equiv.symm StarAlgEquiv.symm

-- Porting note: in mathlib3 we didn't need the `Simps.apply` hint.
/-- See Note [custom simps projection] -/
def Simps.apply (e : A ≃⋆ₐ[R] B) : A → B := e

/-- See Note [custom simps projection] -/
def Simps.symm_apply (e : A ≃⋆ₐ[R] B) : B → A :=
  e.symm
#align star_alg_equiv.simps.symm_apply StarAlgEquiv.Simps.symm_apply

initialize_simps_projections StarAlgEquiv (toFun → apply, invFun → symm_apply)

-- Porting note: use `EquivLike.inv` instead of `invFun`
@[simp]
theorem invFun_eq_symm {e : A ≃⋆ₐ[R] B} : EquivLike.inv e = e.symm :=
  rfl
#align star_alg_equiv.inv_fun_eq_symm StarAlgEquiv.invFun_eq_symm

@[simp]
theorem symm_symm (e : A ≃⋆ₐ[R] B) : e.symm.symm = e := by
  ext
  rfl
#align star_alg_equiv.symm_symm StarAlgEquiv.symm_symm

theorem symm_bijective : Function.Bijective (symm : (A ≃⋆ₐ[R] B) → B ≃⋆ₐ[R] A) :=
  Equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩
#align star_alg_equiv.symm_bijective StarAlgEquiv.symm_bijective

-- porting note: doesn't align with Mathlib 3 because `StarAlgEquiv.mk` has a new signature
@[simp]
theorem mk_coe' (e : A ≃⋆ₐ[R] B) (f h₁ h₂ h₃ h₄ h₅ h₆) :
    (⟨⟨⟨f, e, h₁, h₂⟩, h₃, h₄⟩, h₅, h₆⟩ : B ≃⋆ₐ[R] A) = e.symm :=
  symm_bijective.injective <| ext fun _ => rfl
#align star_alg_equiv.mk_coe' StarAlgEquiv.mk_coe'ₓ

-- porting note: doesn't align with Mathlib 3 because `StarAlgEquiv.mk` has a new signature
@[simp]
theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅ h₆) :
    (⟨⟨⟨f, f', h₁, h₂⟩, h₃, h₄⟩, h₅, h₆⟩ : A ≃⋆ₐ[R] B).symm =
      { (⟨⟨⟨f, f', h₁, h₂⟩, h₃, h₄⟩, h₅, h₆⟩ : A ≃⋆ₐ[R] B).symm with
        toFun := f'
        invFun := f } :=
  rfl
#align star_alg_equiv.symm_mk StarAlgEquiv.symm_mkₓ

@[simp]
theorem refl_symm : (StarAlgEquiv.refl : A ≃⋆ₐ[R] A).symm = StarAlgEquiv.refl :=
  rfl
#align star_alg_equiv.refl_symm StarAlgEquiv.refl_symm

-- should be a `simp` lemma, but causes a linter timeout
theorem to_ringEquiv_symm (f : A ≃⋆ₐ[R] B) : (f : A ≃+* B).symm = f.symm :=
  rfl
#align star_alg_equiv.to_ring_equiv_symm StarAlgEquiv.to_ringEquiv_symm

@[simp]
theorem symm_to_ringEquiv (e : A ≃⋆ₐ[R] B) : (e.symm : B ≃+* A) = (e : A ≃+* B).symm :=
  rfl
#align star_alg_equiv.symm_to_ring_equiv StarAlgEquiv.symm_to_ringEquiv

/-- Star algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) : A ≃⋆ₐ[R] C :=
  { e₁.toRingEquiv.trans
      e₂.toRingEquiv with
    map_smul' := fun r a =>
      show e₂.toFun (e₁.toFun (r • a)) = r • e₂.toFun (e₁.toFun a) by
        rw [e₁.map_smul', e₂.map_smul']
    map_star' := fun a =>
      show e₂.toFun (e₁.toFun (star a)) = star (e₂.toFun (e₁.toFun a)) by
        rw [e₁.map_star', e₂.map_star'] }
#align star_alg_equiv.trans StarAlgEquiv.trans

@[simp]
theorem apply_symm_apply (e : A ≃⋆ₐ[R] B) : ∀ x, e (e.symm x) = x :=
  e.toRingEquiv.apply_symm_apply
#align star_alg_equiv.apply_symm_apply StarAlgEquiv.apply_symm_apply

@[simp]
theorem symm_apply_apply (e : A ≃⋆ₐ[R] B) : ∀ x, e.symm (e x) = x :=
  e.toRingEquiv.symm_apply_apply
#align star_alg_equiv.symm_apply_apply StarAlgEquiv.symm_apply_apply

@[simp]
theorem symm_trans_apply (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) (x : C) :
    (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) :=
  rfl
#align star_alg_equiv.symm_trans_apply StarAlgEquiv.symm_trans_apply

@[simp]
theorem coe_trans (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ :=
  rfl
#align star_alg_equiv.coe_trans StarAlgEquiv.coe_trans

@[simp]
theorem trans_apply (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) (x : A) : (e₁.trans e₂) x = e₂ (e₁ x) :=
  rfl
#align star_alg_equiv.trans_apply StarAlgEquiv.trans_apply

theorem leftInverse_symm (e : A ≃⋆ₐ[R] B) : Function.LeftInverse e.symm e :=
  e.left_inv
#align star_alg_equiv.left_inverse_symm StarAlgEquiv.leftInverse_symm

theorem rightInverse_symm (e : A ≃⋆ₐ[R] B) : Function.RightInverse e.symm e :=
  e.right_inv
#align star_alg_equiv.right_inverse_symm StarAlgEquiv.rightInverse_symm

end Basic

section Bijective

variable {F G R A B : Type _} [Monoid R]

variable [NonUnitalNonAssocSemiring A] [DistribMulAction R A] [Star A]

variable [NonUnitalNonAssocSemiring B] [DistribMulAction R B] [Star B]

variable [hF : NonUnitalStarAlgHomClass F R A B] [NonUnitalStarAlgHomClass G R B A]

/-- If a (unital or non-unital) star algebra morphism has an inverse, it is an isomorphism of
star algebras. -/
@[simps]
def ofStarAlgHom (f : F) (g : G) (h₁ : ∀ x, g (f x) = x) (h₂ : ∀ x, f (g x) = x) : A ≃⋆ₐ[R] B
    where
  toFun := f
  invFun := g
  left_inv := h₁
  right_inv := h₂
  map_add' := map_add f
  map_mul' := map_mul f
  map_smul' := map_smul f
  map_star' := map_star f
#align star_alg_equiv.of_star_alg_hom StarAlgEquiv.ofStarAlgHom

/-- Promote a bijective star algebra homomorphism to a star algebra equivalence. -/
noncomputable def ofBijective (f : F) (hf : Function.Bijective f) : A ≃⋆ₐ[R] B :=
  {
    RingEquiv.ofBijective f
      (hf : Function.Bijective (f : A → B)) with
    toFun := f
    map_star' := map_star f
    map_smul' := map_smul f }
#align star_alg_equiv.of_bijective StarAlgEquiv.ofBijective

@[simp]
theorem coe_ofBijective {f : F} (hf : Function.Bijective f) :
    (StarAlgEquiv.ofBijective f hf : A → B) = f :=
  rfl
#align star_alg_equiv.coe_of_bijective StarAlgEquiv.coe_ofBijective

theorem ofBijective_apply {f : F} (hf : Function.Bijective f) (a : A) :
    (StarAlgEquiv.ofBijective f hf) a = f a :=
  rfl
#align star_alg_equiv.of_bijective_apply StarAlgEquiv.ofBijective_apply

end Bijective

end StarAlgEquiv


import IMO2017.A8.A8_general

/-! # IMO 2017 A8, Original Version -/

namespace IMOSL
namespace IMO2017A8

/-- Final solution, original version with rings -/
theorem final_solution_original {R : Type*} [linear_ordered_ring R] [densely_ordered R]
  (f : R → R) (h : ∀ x y : R, 0 < (f x + y) * (f y + x) → f x + y = f y + x) :
    ∀ x y : R, x ≤ y → f y + x ≤ f x + y :=
begin
  obtain ⟨g, rfl⟩ : ∃ g : R → R, (λ x, x - g x) = f :=
    ⟨id - f, funext (λ x, sub_sub_self x (f x))⟩,
  intros x y,
  rw [← add_sub_right_comm, ← add_sub_right_comm, add_comm y x, sub_le_sub_iff_left],
  revert x y; refine final_solution_part1 _ (λ x y h0, _),
  replace h := h x y; contrapose h,
  rw [← add_sub_right_comm, ← add_sub_right_comm, add_comm, sub_right_inj, add_comm, not_imp],
  refine ⟨_, ne_of_lt h0⟩,
  rw [not_and_distrib, not_le, not_le, ← sub_neg, or_comm, ← sub_pos] at h,
  cases h with h h,
  exacts [mul_pos (lt_trans h (sub_lt_sub_left h0 (x + y))) h,
    mul_pos_of_neg_of_neg h (lt_trans (sub_lt_sub_left h0 (x + y)) h)]
end

end IMO2017A8
end IMOSL


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module topology.algebra.mul_action
! leanprover-community/mathlib commit ac34df03f74e6f797efd6991df2e3b7f7d8d33e0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.AddTorsor
import Mathbin.Topology.Algebra.Constructions
import Mathbin.GroupTheory.GroupAction.Prod
import Mathbin.Topology.Algebra.ConstMulAction

/-!
# Continuous monoid action

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

In this file we define class `has_continuous_smul`. We say `has_continuous_smul M X` if `M` acts on
`X` and the map `(c, x) ↦ c • x` is continuous on `M × X`. We reuse this class for topological
(semi)modules, vector spaces and algebras.

## Main definitions

* `has_continuous_smul M X` : typeclass saying that the map `(c, x) ↦ c • x` is continuous
  on `M × X`;
* `homeomorph.smul_of_ne_zero`: if a group with zero `G₀` (e.g., a field) acts on `X` and `c : G₀`
  is a nonzero element of `G₀`, then scalar multiplication by `c` is a homeomorphism of `X`;
* `homeomorph.smul`: scalar multiplication by an element of a group `G` acting on `X`
  is a homeomorphism of `X`.
* `units.has_continuous_smul`: scalar multiplication by `Mˣ` is continuous when scalar
  multiplication by `M` is continuous. This allows `homeomorph.smul` to be used with on monoids
  with `G = Mˣ`.

## Main results

Besides homeomorphisms mentioned above, in this file we provide lemmas like `continuous.smul`
or `filter.tendsto.smul` that provide dot-syntax access to `continuous_smul`.
-/

open Topology Pointwise

open Filter

#print ContinuousSMul /-
/-- Class `has_continuous_smul M X` says that the scalar multiplication `(•) : M → X → X`
is continuous in both arguments. We use the same class for all kinds of multiplicative actions,
including (semi)modules and algebras. -/
class ContinuousSMul (M X : Type _) [SMul M X] [TopologicalSpace M] [TopologicalSpace X] :
  Prop where
  continuous_smul : Continuous fun p : M × X => p.1 • p.2
#align has_continuous_smul ContinuousSMul
-/

export ContinuousSMul (continuous_smul)

#print ContinuousVAdd /-
/-- Class `has_continuous_vadd M X` says that the additive action `(+ᵥ) : M → X → X`
is continuous in both arguments. We use the same class for all kinds of additive actions,
including (semi)modules and algebras. -/
class ContinuousVAdd (M X : Type _) [VAdd M X] [TopologicalSpace M] [TopologicalSpace X] :
  Prop where
  continuous_vadd : Continuous fun p : M × X => p.1 +ᵥ p.2
#align has_continuous_vadd ContinuousVAdd
-/

export ContinuousVAdd (continuous_vadd)

attribute [to_additive] ContinuousSMul

section Main

variable {M X Y α : Type _} [TopologicalSpace M] [TopologicalSpace X] [TopologicalSpace Y]

section SMul

variable [SMul M X] [ContinuousSMul M X]

#print ContinuousSMul.continuousConstSMul /-
@[to_additive]
instance (priority := 100) ContinuousSMul.continuousConstSMul : ContinuousConstSMul M X
    where continuous_const_smul _ := continuous_smul.comp (continuous_const.prod_mk continuous_id)
#align has_continuous_smul.has_continuous_const_smul ContinuousSMul.continuousConstSMul
#align has_continuous_vadd.has_continuous_const_vadd ContinuousVAdd.continuousConstVAdd
-/

/- warning: filter.tendsto.smul -> Filter.Tendsto.smul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {α : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : α -> M} {g : α -> X} {l : Filter.{u3} α} {c : M} {a : X}, (Filter.Tendsto.{u3, u1} α M f l (nhds.{u1} M _inst_1 c)) -> (Filter.Tendsto.{u3, u2} α X g l (nhds.{u2} X _inst_2 a)) -> (Filter.Tendsto.{u3, u2} α X (fun (x : α) => SMul.smul.{u1, u2} M X _inst_4 (f x) (g x)) l (nhds.{u2} X _inst_2 (SMul.smul.{u1, u2} M X _inst_4 c a)))
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {α : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : α -> M} {g : α -> X} {l : Filter.{u3} α} {c : M} {a : X}, (Filter.Tendsto.{u3, u2} α M f l (nhds.{u2} M _inst_1 c)) -> (Filter.Tendsto.{u3, u1} α X g l (nhds.{u1} X _inst_2 a)) -> (Filter.Tendsto.{u3, u1} α X (fun (x : α) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) (g x)) l (nhds.{u1} X _inst_2 (HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) c a)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.smul Filter.Tendsto.smulₓ'. -/
@[to_additive]
theorem Filter.Tendsto.smul {f : α → M} {g : α → X} {l : Filter α} {c : M} {a : X}
    (hf : Tendsto f l (𝓝 c)) (hg : Tendsto g l (𝓝 a)) :
    Tendsto (fun x => f x • g x) l (𝓝 <| c • a) :=
  (continuous_smul.Tendsto _).comp (hf.prod_mk_nhds hg)
#align filter.tendsto.smul Filter.Tendsto.smul
#align filter.tendsto.vadd Filter.Tendsto.vadd

/- warning: filter.tendsto.smul_const -> Filter.Tendsto.smul_const is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {α : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : α -> M} {l : Filter.{u3} α} {c : M}, (Filter.Tendsto.{u3, u1} α M f l (nhds.{u1} M _inst_1 c)) -> (forall (a : X), Filter.Tendsto.{u3, u2} α X (fun (x : α) => SMul.smul.{u1, u2} M X _inst_4 (f x) a) l (nhds.{u2} X _inst_2 (SMul.smul.{u1, u2} M X _inst_4 c a)))
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {α : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : α -> M} {l : Filter.{u3} α} {c : M}, (Filter.Tendsto.{u3, u2} α M f l (nhds.{u2} M _inst_1 c)) -> (forall (a : X), Filter.Tendsto.{u3, u1} α X (fun (x : α) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) a) l (nhds.{u1} X _inst_2 (HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) c a)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.smul_const Filter.Tendsto.smul_constₓ'. -/
@[to_additive]
theorem Filter.Tendsto.smul_const {f : α → M} {l : Filter α} {c : M} (hf : Tendsto f l (𝓝 c))
    (a : X) : Tendsto (fun x => f x • a) l (𝓝 (c • a)) :=
  hf.smul tendsto_const_nhds
#align filter.tendsto.smul_const Filter.Tendsto.smul_const
#align filter.tendsto.vadd_const Filter.Tendsto.vadd_const

variable {f : Y → M} {g : Y → X} {b : Y} {s : Set Y}

/- warning: continuous_within_at.smul -> ContinuousWithinAt.smul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {b : Y} {s : Set.{u3} Y}, (ContinuousWithinAt.{u3, u1} Y M _inst_3 _inst_1 f s b) -> (ContinuousWithinAt.{u3, u2} Y X _inst_3 _inst_2 g s b) -> (ContinuousWithinAt.{u3, u2} Y X _inst_3 _inst_2 (fun (x : Y) => SMul.smul.{u1, u2} M X _inst_4 (f x) (g x)) s b)
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {b : Y} {s : Set.{u3} Y}, (ContinuousWithinAt.{u3, u2} Y M _inst_3 _inst_1 f s b) -> (ContinuousWithinAt.{u3, u1} Y X _inst_3 _inst_2 g s b) -> (ContinuousWithinAt.{u3, u1} Y X _inst_3 _inst_2 (fun (x : Y) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) (g x)) s b)
Case conversion may be inaccurate. Consider using '#align continuous_within_at.smul ContinuousWithinAt.smulₓ'. -/
@[to_additive]
theorem ContinuousWithinAt.smul (hf : ContinuousWithinAt f s b) (hg : ContinuousWithinAt g s b) :
    ContinuousWithinAt (fun x => f x • g x) s b :=
  hf.smul hg
#align continuous_within_at.smul ContinuousWithinAt.smul
#align continuous_within_at.vadd ContinuousWithinAt.vadd

/- warning: continuous_at.smul -> ContinuousAt.smul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {b : Y}, (ContinuousAt.{u3, u1} Y M _inst_3 _inst_1 f b) -> (ContinuousAt.{u3, u2} Y X _inst_3 _inst_2 g b) -> (ContinuousAt.{u3, u2} Y X _inst_3 _inst_2 (fun (x : Y) => SMul.smul.{u1, u2} M X _inst_4 (f x) (g x)) b)
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {b : Y}, (ContinuousAt.{u3, u2} Y M _inst_3 _inst_1 f b) -> (ContinuousAt.{u3, u1} Y X _inst_3 _inst_2 g b) -> (ContinuousAt.{u3, u1} Y X _inst_3 _inst_2 (fun (x : Y) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) (g x)) b)
Case conversion may be inaccurate. Consider using '#align continuous_at.smul ContinuousAt.smulₓ'. -/
@[to_additive]
theorem ContinuousAt.smul (hf : ContinuousAt f b) (hg : ContinuousAt g b) :
    ContinuousAt (fun x => f x • g x) b :=
  hf.smul hg
#align continuous_at.smul ContinuousAt.smul
#align continuous_at.vadd ContinuousAt.vadd

/- warning: continuous_on.smul -> ContinuousOn.smul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {s : Set.{u3} Y}, (ContinuousOn.{u3, u1} Y M _inst_3 _inst_1 f s) -> (ContinuousOn.{u3, u2} Y X _inst_3 _inst_2 g s) -> (ContinuousOn.{u3, u2} Y X _inst_3 _inst_2 (fun (x : Y) => SMul.smul.{u1, u2} M X _inst_4 (f x) (g x)) s)
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X} {s : Set.{u3} Y}, (ContinuousOn.{u3, u2} Y M _inst_3 _inst_1 f s) -> (ContinuousOn.{u3, u1} Y X _inst_3 _inst_2 g s) -> (ContinuousOn.{u3, u1} Y X _inst_3 _inst_2 (fun (x : Y) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) (g x)) s)
Case conversion may be inaccurate. Consider using '#align continuous_on.smul ContinuousOn.smulₓ'. -/
@[to_additive]
theorem ContinuousOn.smul (hf : ContinuousOn f s) (hg : ContinuousOn g s) :
    ContinuousOn (fun x => f x • g x) s := fun x hx => (hf x hx).smul (hg x hx)
#align continuous_on.smul ContinuousOn.smul
#align continuous_on.vadd ContinuousOn.vadd

/- warning: continuous.smul -> Continuous.smul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u1, u2} M X] [_inst_5 : ContinuousSMul.{u1, u2} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X}, (Continuous.{u3, u1} Y M _inst_3 _inst_1 f) -> (Continuous.{u3, u2} Y X _inst_3 _inst_2 g) -> (Continuous.{u3, u2} Y X _inst_3 _inst_2 (fun (x : Y) => SMul.smul.{u1, u2} M X _inst_4 (f x) (g x)))
but is expected to have type
  forall {M : Type.{u2}} {X : Type.{u1}} {Y : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : TopologicalSpace.{u1} X] [_inst_3 : TopologicalSpace.{u3} Y] [_inst_4 : SMul.{u2, u1} M X] [_inst_5 : ContinuousSMul.{u2, u1} M X _inst_4 _inst_1 _inst_2] {f : Y -> M} {g : Y -> X}, (Continuous.{u3, u2} Y M _inst_3 _inst_1 f) -> (Continuous.{u3, u1} Y X _inst_3 _inst_2 g) -> (Continuous.{u3, u1} Y X _inst_3 _inst_2 (fun (x : Y) => HSMul.hSMul.{u2, u1, u1} M X X (instHSMul.{u2, u1} M X _inst_4) (f x) (g x)))
Case conversion may be inaccurate. Consider using '#align continuous.smul Continuous.smulₓ'. -/
@[continuity, to_additive]
theorem Continuous.smul (hf : Continuous f) (hg : Continuous g) : Continuous fun x => f x • g x :=
  continuous_smul.comp (hf.prod_mk hg)
#align continuous.smul Continuous.smul
#align continuous.vadd Continuous.vadd

#print ContinuousSMul.op /-
/-- If a scalar action is central, then its right action is continuous when its left action is. -/
@[to_additive
      "If an additive action is central, then its right action is continuous when its left\naction is."]
instance ContinuousSMul.op [SMul Mᵐᵒᵖ X] [IsCentralScalar M X] : ContinuousSMul Mᵐᵒᵖ X :=
  ⟨by
    suffices Continuous fun p : M × X => MulOpposite.op p.fst • p.snd from
      this.comp (MulOpposite.continuous_unop.Prod_map continuous_id)
    simpa only [op_smul_eq_smul] using (continuous_smul : Continuous fun p : M × X => _)⟩
#align has_continuous_smul.op ContinuousSMul.op
#align has_continuous_vadd.op ContinuousVAdd.op
-/

#print MulOpposite.continuousSMul /-
@[to_additive]
instance MulOpposite.continuousSMul : ContinuousSMul M Xᵐᵒᵖ :=
  ⟨MulOpposite.continuous_op.comp <|
      continuous_smul.comp <| continuous_id.Prod_map MulOpposite.continuous_unop⟩
#align mul_opposite.has_continuous_smul MulOpposite.continuousSMul
#align add_opposite.has_continuous_vadd AddOpposite.continuousVAdd
-/

end SMul

section Monoid

variable [Monoid M] [MulAction M X] [ContinuousSMul M X]

/- warning: units.has_continuous_smul -> Units.continuousSMul is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_4 : Monoid.{u1} M] [_inst_5 : MulAction.{u1, u2} M X _inst_4] [_inst_6 : ContinuousSMul.{u1, u2} M X (MulAction.toHasSmul.{u1, u2} M X _inst_4 _inst_5) _inst_1 _inst_2], ContinuousSMul.{u1, u2} (Units.{u1} M _inst_4) X (Units.hasSmul.{u1, u2} M X _inst_4 (MulAction.toHasSmul.{u1, u2} M X _inst_4 _inst_5)) (Units.topologicalSpace.{u1} M _inst_1 _inst_4) _inst_2
but is expected to have type
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : TopologicalSpace.{u2} X] [_inst_4 : Monoid.{u1} M] [_inst_5 : MulAction.{u1, u2} M X _inst_4] [_inst_6 : ContinuousSMul.{u1, u2} M X (MulAction.toSMul.{u1, u2} M X _inst_4 _inst_5) _inst_1 _inst_2], ContinuousSMul.{u1, u2} (Units.{u1} M _inst_4) X (Units.instSMulUnits.{u1, u2} M X _inst_4 (MulAction.toSMul.{u1, u2} M X _inst_4 _inst_5)) (Units.instTopologicalSpaceUnits.{u1} M _inst_1 _inst_4) _inst_2
Case conversion may be inaccurate. Consider using '#align units.has_continuous_smul Units.continuousSMulₓ'. -/
@[to_additive]
instance Units.continuousSMul : ContinuousSMul Mˣ X
    where continuous_smul :=
    show Continuous ((fun p : M × X => p.fst • p.snd) ∘ fun p : Mˣ × X => (p.1, p.2)) from
      continuous_smul.comp ((Units.continuous_val.comp continuous_fst).prod_mk continuous_snd)
#align units.has_continuous_smul Units.continuousSMul
#align add_units.has_continuous_vadd AddUnits.continuousVAdd

end Monoid

@[to_additive]
instance [SMul M X] [SMul M Y] [ContinuousSMul M X] [ContinuousSMul M Y] :
    ContinuousSMul M (X × Y) :=
  ⟨(continuous_fst.smul (continuous_fst.comp continuous_snd)).prod_mk
      (continuous_fst.smul (continuous_snd.comp continuous_snd))⟩

@[to_additive]
instance {ι : Type _} {γ : ι → Type _} [∀ i, TopologicalSpace (γ i)] [∀ i, SMul M (γ i)]
    [∀ i, ContinuousSMul M (γ i)] : ContinuousSMul M (∀ i, γ i) :=
  ⟨continuous_pi fun i =>
      (continuous_fst.smul continuous_snd).comp <|
        continuous_fst.prod_mk ((continuous_apply i).comp continuous_snd)⟩

end Main

section LatticeOps

variable {ι : Sort _} {M X : Type _} [TopologicalSpace M] [SMul M X]

/- warning: has_continuous_smul_Inf -> continuousSMul_infₛ is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : SMul.{u1, u2} M X] {ts : Set.{u2} (TopologicalSpace.{u2} X)}, (forall (t : TopologicalSpace.{u2} X), (Membership.Mem.{u2, u2} (TopologicalSpace.{u2} X) (Set.{u2} (TopologicalSpace.{u2} X)) (Set.hasMem.{u2} (TopologicalSpace.{u2} X)) t ts) -> (ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t)) -> (ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 (InfSet.infₛ.{u2} (TopologicalSpace.{u2} X) (ConditionallyCompleteLattice.toHasInf.{u2} (TopologicalSpace.{u2} X) (CompleteLattice.toConditionallyCompleteLattice.{u2} (TopologicalSpace.{u2} X) (TopologicalSpace.completeLattice.{u2} X))) ts))
but is expected to have type
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : SMul.{u1, u2} M X] {ts : Set.{u2} (TopologicalSpace.{u2} X)}, (forall (t : TopologicalSpace.{u2} X), (Membership.mem.{u2, u2} (TopologicalSpace.{u2} X) (Set.{u2} (TopologicalSpace.{u2} X)) (Set.instMembershipSet.{u2} (TopologicalSpace.{u2} X)) t ts) -> (ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t)) -> (ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 (InfSet.infₛ.{u2} (TopologicalSpace.{u2} X) (ConditionallyCompleteLattice.toInfSet.{u2} (TopologicalSpace.{u2} X) (CompleteLattice.toConditionallyCompleteLattice.{u2} (TopologicalSpace.{u2} X) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u2} X))) ts))
Case conversion may be inaccurate. Consider using '#align has_continuous_smul_Inf continuousSMul_infₛₓ'. -/
@[to_additive]
theorem continuousSMul_infₛ {ts : Set (TopologicalSpace X)}
    (h : ∀ t ∈ ts, @ContinuousSMul M X _ _ t) : @ContinuousSMul M X _ _ (infₛ ts) :=
  {
    continuous_smul := by
      rw [← @infₛ_singleton _ _ ‹TopologicalSpace M›]
      exact
        continuous_infₛ_rng.2 fun t ht =>
          continuous_infₛ_dom₂ (Eq.refl _) ht (@ContinuousSMul.continuous_smul _ _ _ _ t (h t ht)) }
#align has_continuous_smul_Inf continuousSMul_infₛ
#align has_continuous_vadd_Inf continuousVAdd_infₛ

/- warning: has_continuous_smul_infi -> continuousSMul_infᵢ is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {M : Type.{u2}} {X : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : SMul.{u2, u3} M X] {ts' : ι -> (TopologicalSpace.{u3} X)}, (forall (i : ι), ContinuousSMul.{u2, u3} M X _inst_2 _inst_1 (ts' i)) -> (ContinuousSMul.{u2, u3} M X _inst_2 _inst_1 (infᵢ.{u3, u1} (TopologicalSpace.{u3} X) (ConditionallyCompleteLattice.toHasInf.{u3} (TopologicalSpace.{u3} X) (CompleteLattice.toConditionallyCompleteLattice.{u3} (TopologicalSpace.{u3} X) (TopologicalSpace.completeLattice.{u3} X))) ι (fun (i : ι) => ts' i)))
but is expected to have type
  forall {ι : Sort.{u1}} {M : Type.{u2}} {X : Type.{u3}} [_inst_1 : TopologicalSpace.{u2} M] [_inst_2 : SMul.{u2, u3} M X] {ts' : ι -> (TopologicalSpace.{u3} X)}, (forall (i : ι), ContinuousSMul.{u2, u3} M X _inst_2 _inst_1 (ts' i)) -> (ContinuousSMul.{u2, u3} M X _inst_2 _inst_1 (infᵢ.{u3, u1} (TopologicalSpace.{u3} X) (ConditionallyCompleteLattice.toInfSet.{u3} (TopologicalSpace.{u3} X) (CompleteLattice.toConditionallyCompleteLattice.{u3} (TopologicalSpace.{u3} X) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u3} X))) ι (fun (i : ι) => ts' i)))
Case conversion may be inaccurate. Consider using '#align has_continuous_smul_infi continuousSMul_infᵢₓ'. -/
@[to_additive]
theorem continuousSMul_infᵢ {ts' : ι → TopologicalSpace X}
    (h : ∀ i, @ContinuousSMul M X _ _ (ts' i)) : @ContinuousSMul M X _ _ (⨅ i, ts' i) :=
  continuousSMul_infₛ <| Set.forall_range_iff.mpr h
#align has_continuous_smul_infi continuousSMul_infᵢ
#align has_continuous_vadd_infi continuousVAdd_infᵢ

/- warning: has_continuous_smul_inf -> continuousSMul_inf is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : SMul.{u1, u2} M X] {t₁ : TopologicalSpace.{u2} X} {t₂ : TopologicalSpace.{u2} X} [_inst_3 : ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t₁] [_inst_4 : ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t₂], ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 (Inf.inf.{u2} (TopologicalSpace.{u2} X) (SemilatticeInf.toHasInf.{u2} (TopologicalSpace.{u2} X) (Lattice.toSemilatticeInf.{u2} (TopologicalSpace.{u2} X) (ConditionallyCompleteLattice.toLattice.{u2} (TopologicalSpace.{u2} X) (CompleteLattice.toConditionallyCompleteLattice.{u2} (TopologicalSpace.{u2} X) (TopologicalSpace.completeLattice.{u2} X))))) t₁ t₂)
but is expected to have type
  forall {M : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} M] [_inst_2 : SMul.{u1, u2} M X] {t₁ : TopologicalSpace.{u2} X} {t₂ : TopologicalSpace.{u2} X} [_inst_3 : ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t₁] [_inst_4 : ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 t₂], ContinuousSMul.{u1, u2} M X _inst_2 _inst_1 (Inf.inf.{u2} (TopologicalSpace.{u2} X) (Lattice.toInf.{u2} (TopologicalSpace.{u2} X) (ConditionallyCompleteLattice.toLattice.{u2} (TopologicalSpace.{u2} X) (CompleteLattice.toConditionallyCompleteLattice.{u2} (TopologicalSpace.{u2} X) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u2} X)))) t₁ t₂)
Case conversion may be inaccurate. Consider using '#align has_continuous_smul_inf continuousSMul_infₓ'. -/
@[to_additive]
theorem continuousSMul_inf {t₁ t₂ : TopologicalSpace X} [@ContinuousSMul M X _ _ t₁]
    [@ContinuousSMul M X _ _ t₂] : @ContinuousSMul M X _ _ (t₁ ⊓ t₂) :=
  by
  rw [inf_eq_infᵢ]
  refine' continuousSMul_infᵢ fun b => _
  cases b <;> assumption
#align has_continuous_smul_inf continuousSMul_inf
#align has_continuous_vadd_inf continuousVAdd_inf

end LatticeOps

section AddTorsor

variable (G : Type _) (P : Type _) [AddGroup G] [AddTorsor G P] [TopologicalSpace G]

variable [PreconnectedSpace G] [TopologicalSpace P] [ContinuousVAdd G P]

include G

/- warning: add_torsor.connected_space -> AddTorsor.connectedSpace is a dubious translation:
lean 3 declaration is
  forall (G : Type.{u1}) (P : Type.{u2}) [_inst_1 : AddGroup.{u1} G] [_inst_2 : AddTorsor.{u1, u2} G P _inst_1] [_inst_3 : TopologicalSpace.{u1} G] [_inst_4 : PreconnectedSpace.{u1} G _inst_3] [_inst_5 : TopologicalSpace.{u2} P] [_inst_6 : ContinuousVAdd.{u1, u2} G P (AddAction.toHasVadd.{u1, u2} G P (SubNegMonoid.toAddMonoid.{u1} G (AddGroup.toSubNegMonoid.{u1} G _inst_1)) (AddTorsor.toAddAction.{u1, u2} G P _inst_1 _inst_2)) _inst_3 _inst_5], ConnectedSpace.{u2} P _inst_5
but is expected to have type
  forall (G : Type.{u2}) (P : Type.{u1}) [_inst_1 : AddGroup.{u2} G] [_inst_2 : AddTorsor.{u2, u1} G P _inst_1] [_inst_3 : TopologicalSpace.{u2} G] [_inst_4 : PreconnectedSpace.{u2} G _inst_3] [_inst_5 : TopologicalSpace.{u1} P] [_inst_6 : ContinuousVAdd.{u2, u1} G P (AddAction.toVAdd.{u2, u1} G P (SubNegMonoid.toAddMonoid.{u2} G (AddGroup.toSubNegMonoid.{u2} G _inst_1)) (AddTorsor.toAddAction.{u2, u1} G P _inst_1 _inst_2)) _inst_3 _inst_5], ConnectedSpace.{u1} P _inst_5
Case conversion may be inaccurate. Consider using '#align add_torsor.connected_space AddTorsor.connectedSpaceₓ'. -/
/-- An `add_torsor` for a connected space is a connected space. This is not an instance because
it loops for a group as a torsor over itself. -/
protected theorem AddTorsor.connectedSpace : ConnectedSpace P :=
  { isPreconnected_univ :=
      by
      convert is_preconnected_univ.image (Equiv.vaddConst (Classical.arbitrary P) : G → P)
          (continuous_id.vadd continuous_const).ContinuousOn
      rw [Set.image_univ, Equiv.range_eq_univ]
    to_nonempty := inferInstance }
#align add_torsor.connected_space AddTorsor.connectedSpace

end AddTorsor