/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.tactic
import Mathlib.PostPort

universes u u_1 l v u_2 w u_3

namespace Mathlib

/-!
# Ordering on topologies and (co)induced topologies

Topologies on a fixed type `α` are ordered, by reverse inclusion.
That is, for topologies `t₁` and `t₂` on `α`, we write `t₁ ≤ t₂`
if every set open in `t₂` is also open in `t₁`.
(One also calls `t₁` finer than `t₂`, and `t₂` coarser than `t₁`.)

Any function `f : α → β` induces
       `induced f : topological_space β → topological_space α`
and  `coinduced f : topological_space α → topological_space β`.
Continuity, the ordering on topologies and (co)induced topologies are
related as follows:
* The identity map (α, t₁) → (α, t₂) is continuous iff t₁ ≤ t₂.
* A map f : (α, t) → (β, u) is continuous
    iff             t ≤ induced f u   (`continuous_iff_le_induced`)
    iff coinduced f t ≤ u             (`continuous_iff_coinduced_le`).

Topologies on α form a complete lattice, with ⊥ the discrete topology
and ⊤ the indiscrete topology.

For a function f : α → β, (coinduced f, induced f) is a Galois connection
between topologies on α and topologies on β.

## Implementation notes

There is a Galois insertion between topologies on α (with the inclusion ordering)
and all collections of sets in α. The complete lattice structure on topologies
on α is defined as the reverse of the one obtained via this Galois insertion.

## Tags

finer, coarser, induced topology, coinduced topology

-/

namespace topological_space

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generate_open {α : Type u} (g : set (set α)) : set α → Prop
where
| basic : ∀ (s : set α), s ∈ g → generate_open g s
| univ : generate_open g set.univ
| inter : ∀ (s t : set α), generate_open g s → generate_open g t → generate_open g (s ∩ t)
| sUnion : ∀ (k : set (set α)), (∀ (s : set α), s ∈ k → generate_open g s) → generate_open g (⋃₀k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from {α : Type u} (g : set (set α)) : topological_space α :=
  mk (generate_open g) generate_open.univ generate_open.inter generate_open.sUnion

theorem nhds_generate_from {α : Type u} {g : set (set α)} {a : α} : nhds a = infi fun (s : set α) => infi fun (H : s ∈ set_of fun (s : set α) => a ∈ s ∧ s ∈ g) => filter.principal s := sorry

theorem tendsto_nhds_generate_from {α : Type u} {β : Type u_1} {m : α → β} {f : filter α} {g : set (set β)} {b : β} (h : ∀ (s : set β), s ∈ g → b ∈ s → m ⁻¹' s ∈ f) : filter.tendsto m f (nhds b) := sorry

/-- Construct a topology on α given the filter of neighborhoods of each point of α. -/
protected def mk_of_nhds {α : Type u} (n : α → filter α) : topological_space α :=
  mk (fun (s : set α) => ∀ (a : α), a ∈ s → s ∈ n a) sorry sorry sorry

theorem nhds_mk_of_nhds {α : Type u} (n : α → filter α) (a : α) (h₀ : pure ≤ n) (h₁ : ∀ {a : α} {s : set α}, s ∈ n a → ∃ (t : set α), ∃ (H : t ∈ n a), t ⊆ s ∧ ∀ (a' : α), a' ∈ t → s ∈ n a') : nhds a = n a := sorry

end topological_space

/-- The inclusion ordering on topologies on α. We use it to get a complete
   lattice instance via the Galois insertion method, but the partial order
   that we will eventually impose on `topological_space α` is the reverse one. -/
def tmp_order {α : Type u} : partial_order (topological_space α) :=
  partial_order.mk (fun (t s : topological_space α) => topological_space.is_open t ≤ topological_space.is_open s)
    (preorder.lt._default fun (t s : topological_space α) => topological_space.is_open t ≤ topological_space.is_open s)
    sorry sorry sorry

/- We'll later restate this lemma in terms of the correct order on `topological_space α`. -/

/-- If `s` equals the collection of open sets in the topology it generates,
  then `s` defines a topology. -/
protected def mk_of_closure {α : Type u} (s : set (set α)) (hs : (set_of fun (u : set α) => topological_space.is_open (topological_space.generate_from s) u) = s) : topological_space α :=
  topological_space.mk (fun (u : set α) => u ∈ s) sorry sorry sorry

theorem mk_of_closure_sets {α : Type u} {s : set (set α)} {hs : (set_of fun (u : set α) => topological_space.is_open (topological_space.generate_from s) u) = s} : Mathlib.mk_of_closure s hs = topological_space.generate_from s :=
  topological_space_eq (Eq.symm hs)

/-- The Galois insertion between `set (set α)` and `topological_space α` whose lower part
  sends a collection of subsets of α to the topology they generate, and whose upper part
  sends a topology to its collection of open subsets. -/
def gi_generate_from (α : Type u_1) : galois_insertion topological_space.generate_from
  fun (t : topological_space α) => set_of fun (s : set α) => topological_space.is_open t s :=
  galois_insertion.mk
    (fun (g : set (set α))
      (hg : (set_of fun (s : set α) => topological_space.is_open (topological_space.generate_from g) s) ≤ g) =>
      Mathlib.mk_of_closure g sorry)
    sorry sorry sorry

theorem generate_from_mono {α : Type u_1} {g₁ : set (set α)} {g₂ : set (set α)} (h : g₁ ⊆ g₂) : topological_space.generate_from g₁ ≤ topological_space.generate_from g₂ :=
  galois_connection.monotone_l (galois_insertion.gc (gi_generate_from α)) h

/-- The complete lattice of topological spaces, but built on the inclusion ordering. -/
def tmp_complete_lattice {α : Type u} : complete_lattice (topological_space α) :=
  galois_insertion.lift_complete_lattice (gi_generate_from α)

/-- The ordering on topologies on the type `α`.
  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
protected instance topological_space.partial_order {α : Type u} : partial_order (topological_space α) :=
  partial_order.mk (fun (t s : topological_space α) => topological_space.is_open s ≤ topological_space.is_open t)
    (preorder.lt._default fun (t s : topological_space α) => topological_space.is_open s ≤ topological_space.is_open t)
    sorry sorry sorry

theorem le_generate_from_iff_subset_is_open {α : Type u} {g : set (set α)} {t : topological_space α} : t ≤ topological_space.generate_from g ↔ g ⊆ set_of fun (s : set α) => topological_space.is_open t s :=
  generate_from_le_iff_subset_is_open

/-- Topologies on `α` form a complete lattice, with `⊥` the discrete topology
  and `⊤` the indiscrete topology. The infimum of a collection of topologies
  is the topology generated by all their open sets, while the supremem is the
  topology whose open sets are those sets open in every member of the collection. -/
protected instance topological_space.complete_lattice {α : Type u} : complete_lattice (topological_space α) :=
  order_dual.complete_lattice (topological_space α)

/-- A topological space is discrete if every set is open, that is,
  its topology equals the discrete topology `⊥`. -/
class discrete_topology (α : Type u_1) [t : topological_space α]
where
  eq_bot : t = ⊥

@[simp] theorem is_open_discrete {α : Type u} [topological_space α] [discrete_topology α] (s : set α) : is_open s :=
  Eq.symm (discrete_topology.eq_bot α) ▸ trivial

@[simp] theorem is_closed_discrete {α : Type u} [topological_space α] [discrete_topology α] (s : set α) : is_closed s :=
  Eq.symm (discrete_topology.eq_bot α) ▸ trivial

theorem continuous_of_discrete_topology {α : Type u} {β : Type v} [topological_space α] [discrete_topology α] [topological_space β] {f : α → β} : continuous f :=
  iff.mpr continuous_def fun (s : set β) (hs : is_open s) => is_open_discrete (f ⁻¹' s)

theorem nhds_bot (α : Type u_1) : nhds = pure :=
  le_antisymm (id fun (a : α) => id fun (s : set α) (hs : s ∈ pure a) => mem_nhds_sets trivial hs) pure_le_nhds

theorem nhds_discrete (α : Type u_1) [topological_space α] [discrete_topology α] : nhds = pure :=
  Eq.symm (discrete_topology.eq_bot α) ▸ nhds_bot α

theorem le_of_nhds_le_nhds {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} (h : ∀ (x : α), nhds x ≤ nhds x) : t₁ ≤ t₂ := sorry

theorem eq_of_nhds_eq_nhds {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} (h : ∀ (x : α), nhds x = nhds x) : t₁ = t₂ :=
  le_antisymm (le_of_nhds_le_nhds fun (x : α) => le_of_eq (h x))
    (le_of_nhds_le_nhds fun (x : α) => le_of_eq (Eq.symm (h x)))

theorem eq_bot_of_singletons_open {α : Type u} {t : topological_space α} (h : ∀ (x : α), topological_space.is_open t (singleton x)) : t = ⊥ :=
  bot_unique
    fun (s : set α) (hs : topological_space.is_open ⊥ s) =>
      set.bUnion_of_singleton s ▸ is_open_bUnion fun (x : α) (_x : x ∈ s) => h x

theorem forall_open_iff_discrete {X : Type u_1} [topological_space X] : (∀ (s : set X), is_open s) ↔ discrete_topology X := sorry

theorem singletons_open_iff_discrete {X : Type u_1} [topological_space X] : (∀ (a : X), is_open (singleton a)) ↔ discrete_topology X :=
  { mp := fun (h : ∀ (a : X), is_open (singleton a)) => discrete_topology.mk (eq_bot_of_singletons_open h),
    mpr := fun (a : discrete_topology X) (_x : X) => is_open_discrete (singleton _x) }

/-- Given `f : α → β` and a topology on `β`, the induced topology on `α` is the collection of
  sets that are preimages of some open set in `β`. This is the coarsest topology that
  makes `f` continuous. -/
def topological_space.induced {α : Type u} {β : Type v} (f : α → β) (t : topological_space β) : topological_space α :=
  topological_space.mk (fun (s : set α) => ∃ (s' : set β), topological_space.is_open t s' ∧ f ⁻¹' s' = s) sorry sorry
    sorry

theorem is_open_induced_iff {α : Type u_1} {β : Type u_2} [t : topological_space β] {s : set α} {f : α → β} : is_open s ↔ ∃ (t_1 : set β), is_open t_1 ∧ f ⁻¹' t_1 = s :=
  iff.rfl

theorem is_closed_induced_iff {α : Type u_1} {β : Type u_2} [t : topological_space β] {s : set α} {f : α → β} : is_closed s ↔ ∃ (t_1 : set β), is_closed t_1 ∧ s = f ⁻¹' t_1 := sorry

/-- Given `f : α → β` and a topology on `α`, the coinduced topology on `β` is defined
  such that `s:set β` is open if the preimage of `s` is open. This is the finest topology that
  makes `f` continuous. -/
def topological_space.coinduced {α : Type u} {β : Type v} (f : α → β) (t : topological_space α) : topological_space β :=
  topological_space.mk (fun (s : set β) => topological_space.is_open t (f ⁻¹' s)) sorry sorry sorry

theorem is_open_coinduced {α : Type u_1} {β : Type u_2} {t : topological_space α} {s : set β} {f : α → β} : is_open s ↔ is_open (f ⁻¹' s) :=
  iff.rfl

theorem continuous.coinduced_le {α : Type u_1} {β : Type u_2} {t : topological_space α} {t' : topological_space β} {f : α → β} (h : continuous f) : topological_space.coinduced f t ≤ t' :=
  fun (s : set β) (hs : topological_space.is_open t' s) => iff.mp continuous_def h s hs

theorem coinduced_le_iff_le_induced {α : Type u_1} {β : Type u_2} {f : α → β} {tα : topological_space α} {tβ : topological_space β} : topological_space.coinduced f tα ≤ tβ ↔ tα ≤ topological_space.induced f tβ := sorry

theorem continuous.le_induced {α : Type u_1} {β : Type u_2} {t : topological_space α} {t' : topological_space β} {f : α → β} (h : continuous f) : t ≤ topological_space.induced f t' :=
  iff.mp coinduced_le_iff_le_induced (continuous.coinduced_le h)

theorem gc_coinduced_induced {α : Type u_1} {β : Type u_2} (f : α → β) : galois_connection (topological_space.coinduced f) (topological_space.induced f) :=
  fun (f_1 : topological_space α) (g : topological_space β) => coinduced_le_iff_le_induced

theorem induced_mono {α : Type u_1} {β : Type u_2} {t₁ : topological_space α} {t₂ : topological_space α} {g : β → α} (h : t₁ ≤ t₂) : topological_space.induced g t₁ ≤ topological_space.induced g t₂ :=
  galois_connection.monotone_u (gc_coinduced_induced g) h

theorem coinduced_mono {α : Type u_1} {β : Type u_2} {t₁ : topological_space α} {t₂ : topological_space α} {f : α → β} (h : t₁ ≤ t₂) : topological_space.coinduced f t₁ ≤ topological_space.coinduced f t₂ :=
  galois_connection.monotone_l (gc_coinduced_induced f) h

@[simp] theorem induced_top {α : Type u_1} {β : Type u_2} {g : β → α} : topological_space.induced g ⊤ = ⊤ :=
  galois_connection.u_top (gc_coinduced_induced g)

@[simp] theorem induced_inf {α : Type u_1} {β : Type u_2} {t₁ : topological_space α} {t₂ : topological_space α} {g : β → α} : topological_space.induced g (t₁ ⊓ t₂) = topological_space.induced g t₁ ⊓ topological_space.induced g t₂ :=
  galois_connection.u_inf (gc_coinduced_induced g)

@[simp] theorem induced_infi {α : Type u_1} {β : Type u_2} {g : β → α} {ι : Sort w} {t : ι → topological_space α} : topological_space.induced g (infi fun (i : ι) => t i) = infi fun (i : ι) => topological_space.induced g (t i) :=
  galois_connection.u_infi (gc_coinduced_induced g)

@[simp] theorem coinduced_bot {α : Type u_1} {β : Type u_2} {f : α → β} : topological_space.coinduced f ⊥ = ⊥ :=
  galois_connection.l_bot (gc_coinduced_induced f)

@[simp] theorem coinduced_sup {α : Type u_1} {β : Type u_2} {t₁ : topological_space α} {t₂ : topological_space α} {f : α → β} : topological_space.coinduced f (t₁ ⊔ t₂) = topological_space.coinduced f t₁ ⊔ topological_space.coinduced f t₂ :=
  galois_connection.l_sup (gc_coinduced_induced f)

@[simp] theorem coinduced_supr {α : Type u_1} {β : Type u_2} {f : α → β} {ι : Sort w} {t : ι → topological_space α} : topological_space.coinduced f (supr fun (i : ι) => t i) = supr fun (i : ι) => topological_space.coinduced f (t i) :=
  galois_connection.l_supr (gc_coinduced_induced f)

theorem induced_id {α : Type u_1} [t : topological_space α] : topological_space.induced id t = t := sorry

theorem induced_compose {α : Type u_1} {β : Type u_2} {γ : Type u_3} [tγ : topological_space γ] {f : α → β} {g : β → γ} : topological_space.induced f (topological_space.induced g tγ) = topological_space.induced (g ∘ f) tγ := sorry

theorem coinduced_id {α : Type u_1} [t : topological_space α] : topological_space.coinduced id t = t :=
  topological_space_eq rfl

theorem coinduced_compose {α : Type u_1} {β : Type u_2} {γ : Type u_3} [tα : topological_space α] {f : α → β} {g : β → γ} : topological_space.coinduced g (topological_space.coinduced f tα) = topological_space.coinduced (g ∘ f) tα :=
  topological_space_eq rfl

/- constructions using the complete lattice structure -/

protected instance inhabited_topological_space {α : Type u} : Inhabited (topological_space α) :=
  { default := ⊤ }

protected instance subsingleton.unique_topological_space {α : Type u} [subsingleton α] : unique (topological_space α) :=
  unique.mk { default := ⊥ } sorry

protected instance subsingleton.discrete_topology {α : Type u} [t : topological_space α] [subsingleton α] : discrete_topology α :=
  discrete_topology.mk (unique.eq_default t)

protected instance empty.topological_space : topological_space empty :=
  ⊥

protected instance empty.discrete_topology : discrete_topology empty :=
  discrete_topology.mk rfl

protected instance pempty.topological_space : topological_space pempty :=
  ⊥

protected instance pempty.discrete_topology : discrete_topology pempty :=
  discrete_topology.mk rfl

protected instance unit.topological_space : topological_space Unit :=
  ⊥

protected instance unit.discrete_topology : discrete_topology Unit :=
  discrete_topology.mk rfl

protected instance bool.topological_space : topological_space Bool :=
  ⊥

protected instance bool.discrete_topology : discrete_topology Bool :=
  discrete_topology.mk rfl

protected instance nat.topological_space : topological_space ℕ :=
  ⊥

protected instance nat.discrete_topology : discrete_topology ℕ :=
  discrete_topology.mk rfl

protected instance int.topological_space : topological_space ℤ :=
  ⊥

protected instance int.discrete_topology : discrete_topology ℤ :=
  discrete_topology.mk rfl

protected instance sierpinski_space : topological_space Prop :=
  topological_space.generate_from (singleton (singleton True))

theorem le_generate_from {α : Type u} {t : topological_space α} {g : set (set α)} (h : ∀ (s : set α), s ∈ g → is_open s) : t ≤ topological_space.generate_from g :=
  iff.mpr le_generate_from_iff_subset_is_open h

theorem induced_generate_from_eq {α : Type u_1} {β : Type u_2} {b : set (set β)} {f : α → β} : topological_space.induced f (topological_space.generate_from b) = topological_space.generate_from (set.preimage f '' b) := sorry

/-- This construction is left adjoint to the operation sending a topology on `α`
  to its neighborhood filter at a fixed point `a : α`. -/
protected def topological_space.nhds_adjoint {α : Type u} (a : α) (f : filter α) : topological_space α :=
  topological_space.mk (fun (s : set α) => a ∈ s → s ∈ f) sorry sorry sorry

theorem gc_nhds {α : Type u} (a : α) : galois_connection (topological_space.nhds_adjoint a) fun (t : topological_space α) => nhds a := sorry

theorem nhds_mono {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} {a : α} (h : t₁ ≤ t₂) : nhds a ≤ nhds a :=
  galois_connection.monotone_u (gc_nhds a) h

theorem nhds_infi {α : Type u} {ι : Sort u_1} {t : ι → topological_space α} {a : α} : nhds a = infi fun (i : ι) => nhds a :=
  galois_connection.u_infi (gc_nhds a)

theorem nhds_Inf {α : Type u} {s : set (topological_space α)} {a : α} : nhds a = infi fun (t : topological_space α) => infi fun (H : t ∈ s) => nhds a :=
  galois_connection.u_Inf (gc_nhds a)

theorem nhds_inf {α : Type u} {t₁ : topological_space α} {t₂ : topological_space α} {a : α} : nhds a = nhds a ⊓ nhds a :=
  galois_connection.u_inf (gc_nhds a)

theorem nhds_top {α : Type u} {a : α} : nhds a = ⊤ :=
  galois_connection.u_top (gc_nhds a)

theorem continuous_iff_coinduced_le {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space β} : continuous f ↔ topological_space.coinduced f t₁ ≤ t₂ :=
  iff.trans continuous_def iff.rfl

theorem continuous_iff_le_induced {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space β} : continuous f ↔ t₁ ≤ topological_space.induced f t₂ :=
  iff.trans continuous_iff_coinduced_le (gc_coinduced_induced f t₁ t₂)

theorem continuous_generated_from {α : Type u} {β : Type v} {f : α → β} {t : topological_space α} {b : set (set β)} (h : ∀ (s : set β), s ∈ b → is_open (f ⁻¹' s)) : continuous f :=
  iff.mpr continuous_iff_coinduced_le (le_generate_from h)

theorem continuous_induced_dom {α : Type u} {β : Type v} {f : α → β} {t : topological_space β} : continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) => Exists.intro s { left := h, right := rfl }

theorem continuous_induced_rng {α : Type u} {β : Type v} {γ : Type u_1} {f : α → β} {g : γ → α} {t₂ : topological_space β} {t₁ : topological_space γ} (h : continuous (f ∘ g)) : continuous g := sorry

theorem continuous_induced_rng' {α : Type u} {β : Type v} {γ : Type u_1} [topological_space α] [topological_space β] [topological_space γ] {g : γ → α} (f : α → β) (H : _inst_1 = topological_space.induced f _inst_2) (h : continuous (f ∘ g)) : continuous g :=
  Eq.symm H ▸ continuous_induced_rng h

theorem continuous_coinduced_rng {α : Type u} {β : Type v} {f : α → β} {t : topological_space α} : continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def))) fun (s : set β) (h : is_open s) => h

theorem continuous_coinduced_dom {α : Type u} {β : Type v} {γ : Type u_1} {f : α → β} {g : β → γ} {t₁ : topological_space α} {t₂ : topological_space γ} (h : continuous (g ∘ f)) : continuous g :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous g)) (propext continuous_def)))
    fun (s : set γ) (hs : is_open s) => eq.mp (Eq._oldrec (Eq.refl (continuous (g ∘ f))) (propext continuous_def)) h s hs

theorem continuous_le_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space α} {t₃ : topological_space β} (h₁ : t₂ ≤ t₁) (h₂ : continuous f) : continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) =>
      h₁ (f ⁻¹' s) (eq.mp (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)) h₂ s h)

theorem continuous_le_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space β} {t₃ : topological_space β} (h₁ : t₂ ≤ t₃) (h₂ : continuous f) : continuous f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)))
    fun (s : set β) (h : is_open s) => eq.mp (Eq._oldrec (Eq.refl (continuous f)) (propext continuous_def)) h₂ s (h₁ s h)

theorem continuous_sup_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space α} {t₃ : topological_space β} (h₁ : continuous f) (h₂ : continuous f) : continuous f := sorry

theorem continuous_sup_rng_left {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₃ : topological_space β} {t₂ : topological_space β} : continuous f → continuous f :=
  continuous_le_rng le_sup_left

theorem continuous_sup_rng_right {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₃ : topological_space β} {t₂ : topological_space β} : continuous f → continuous f :=
  continuous_le_rng le_sup_right

theorem continuous_Sup_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : set (topological_space α)} {t₂ : topological_space β} (h : ∀ (t : topological_space α), t ∈ t₁ → continuous f) : continuous f :=
  iff.mpr continuous_iff_le_induced
    (Sup_le fun (t : topological_space α) (ht : t ∈ t₁) => iff.mp continuous_iff_le_induced (h t ht))

theorem continuous_Sup_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : set (topological_space β)} {t : topological_space β} (h₁ : t ∈ t₂) (hf : continuous f) : continuous f :=
  iff.mpr continuous_iff_coinduced_le (le_Sup_of_le h₁ (iff.mp continuous_iff_coinduced_le hf))

theorem continuous_supr_dom {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2} {t₁ : ι → topological_space α} {t₂ : topological_space β} (h : ι → continuous f) : continuous f := sorry

theorem continuous_supr_rng {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2} {t₁ : topological_space α} {t₂ : ι → topological_space β} {i : ι} (h : continuous f) : continuous f :=
  continuous_Sup_rng (Exists.intro i rfl) h

theorem continuous_inf_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space β} {t₃ : topological_space β} (h₁ : continuous f) (h₂ : continuous f) : continuous f :=
  iff.mpr continuous_iff_coinduced_le
    (le_inf (iff.mp continuous_iff_coinduced_le h₁) (iff.mp continuous_iff_coinduced_le h₂))

theorem continuous_inf_dom_left {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space α} {t₃ : topological_space β} : continuous f → continuous f :=
  continuous_le_dom inf_le_left

theorem continuous_inf_dom_right {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : topological_space α} {t₃ : topological_space β} : continuous f → continuous f :=
  continuous_le_dom inf_le_right

theorem continuous_Inf_dom {α : Type u} {β : Type v} {f : α → β} {t₁ : set (topological_space α)} {t₂ : topological_space β} {t : topological_space α} (h₁ : t ∈ t₁) : continuous f → continuous f :=
  continuous_le_dom (Inf_le h₁)

theorem continuous_Inf_rng {α : Type u} {β : Type v} {f : α → β} {t₁ : topological_space α} {t₂ : set (topological_space β)} (h : ∀ (t : topological_space β), t ∈ t₂ → continuous f) : continuous f :=
  iff.mpr continuous_iff_coinduced_le
    (le_Inf fun (b : topological_space β) (hb : b ∈ t₂) => iff.mp continuous_iff_coinduced_le (h b hb))

theorem continuous_infi_dom {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2} {t₁ : ι → topological_space α} {t₂ : topological_space β} {i : ι} : continuous f → continuous f :=
  continuous_le_dom (infi_le t₁ i)

theorem continuous_infi_rng {α : Type u} {β : Type v} {f : α → β} {ι : Sort u_2} {t₁ : topological_space α} {t₂ : ι → topological_space β} (h : ι → continuous f) : continuous f :=
  iff.mpr continuous_iff_coinduced_le (le_infi fun (i : ι) => iff.mp continuous_iff_coinduced_le (h i))

theorem continuous_bot {α : Type u} {β : Type v} {f : α → β} {t : topological_space β} : continuous f :=
  iff.mpr continuous_iff_le_induced bot_le

theorem continuous_top {α : Type u} {β : Type v} {f : α → β} {t : topological_space α} : continuous f :=
  iff.mpr continuous_iff_coinduced_le le_top

/- 𝓝 in the induced topology -/

theorem mem_nhds_induced {α : Type u} {β : Type v} [T : topological_space α] (f : β → α) (a : β) (s : set β) : s ∈ nhds a ↔ ∃ (u : set α), ∃ (H : u ∈ nhds (f a)), f ⁻¹' u ⊆ s := sorry

theorem nhds_induced {α : Type u} {β : Type v} [T : topological_space α] (f : β → α) (a : β) : nhds a = filter.comap f (nhds (f a)) := sorry

theorem induced_iff_nhds_eq {α : Type u} {β : Type v} [tα : topological_space α] [tβ : topological_space β] (f : β → α) : tβ = topological_space.induced f tα ↔ ∀ (b : β), nhds b = filter.comap f (nhds (f b)) := sorry

theorem map_nhds_induced_of_surjective {α : Type u} {β : Type v} [T : topological_space α] {f : β → α} (hf : function.surjective f) (a : β) : filter.map f (nhds a) = nhds (f a) := sorry

theorem is_open_induced_eq {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β} {s : set α} : is_open s ↔ s ∈ set.preimage f '' set_of fun (s : set β) => is_open s :=
  iff.rfl

theorem is_open_induced {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β} {s : set β} (h : is_open s) : topological_space.is_open (topological_space.induced f t) (f ⁻¹' s) :=
  Exists.intro s { left := h, right := rfl }

theorem map_nhds_induced_eq {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β} {a : α} (h : set.range f ∈ nhds (f a)) : filter.map f (nhds a) = nhds (f a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (filter.map f (nhds a) = nhds (f a))) (nhds_induced f a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (filter.map f (filter.comap f (nhds (f a))) = nhds (f a))) (filter.map_comap h)))
      (Eq.refl (nhds (f a))))

theorem closure_induced {α : Type u_1} {β : Type u_2} [t : topological_space β] {f : α → β} {a : α} {s : set α} (hf : ∀ (x y : α), f x = f y → x = y) : a ∈ closure s ↔ f a ∈ closure (f '' s) := sorry

@[simp] theorem is_open_singleton_true : is_open (singleton True) :=
  topological_space.generate_open.basic (singleton True)
    (eq.mpr (id (propext ((fun {α : Type} (a : α) => iff_true_intro (set.mem_singleton a)) (singleton True)))) trivial)

theorem continuous_Prop {α : Type u_1} [topological_space α] {p : α → Prop} : continuous p ↔ is_open (set_of fun (x : α) => p x) := sorry

theorem is_open_supr_iff {α : Type u} {ι : Type v} {t : ι → topological_space α} {s : set α} : is_open s ↔ ι → is_open s := sorry

theorem is_closed_infi_iff {α : Type u} {ι : Type v} {t : ι → topological_space α} {s : set α} : is_closed s ↔ ι → is_closed s :=
  is_open_supr_iff


import analysis.special_functions.trigonometric.deriv
import analysis.special_functions.log.deriv

namespace real

example : differentiable ℝ (λ (x : ℝ), exp x) :=
by simp

example : differentiable ℝ (λ (x : ℝ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℝ) : deriv (λ (x : ℝ), (cos x)^2 + 1 + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ (x : ℝ), (1+x)^3 - x^3 - 3 * x^2 - 3 * x - 4) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℝ) : differentiable_at ℝ (λ x, (cos x, x)) x := by simp

example (x : ℝ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℝ) : differentiable_at ℝ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℝ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

example (x : ℝ) (h : x ≠ 0) : deriv (λ x, x * (log x - 1)) x = log x :=
by simp [h]

end real

namespace complex

example : differentiable ℂ  (λ (x : ℂ), exp x) :=
by simp

example : differentiable ℂ (λ (x : ℂ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℂ) : deriv (λ (x : ℂ), (cos x)^2 + I + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℂ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℂ) : differentiable_at ℂ (λ x, (cos x, x)) x := by simp

example (x : ℂ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℂ) : differentiable_at ℂ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℂ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

end complex

namespace polynomial
open_locale polynomial

variables {R : Type*} [comm_semiring R]

example : (2 : R[X]).derivative = 0 :=
by conv_lhs { simp }

example : (3 + X : R[X]).derivative = 1 :=
by conv_lhs { simp }

example : (2 * X ^ 2 : R[X]).derivative = 4 * X :=
by conv_lhs { simp, ring_nf, }

example : (X ^ 2 : R[X]).derivative = 2 * X :=
by conv_lhs { simp }

example : ((C 2 * X ^ 3).derivative : R[X]) = 6 * X ^ 2 :=
by conv_lhs { simp, ring_nf, }

end polynomial


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

! This file was ported from Lean 3 source module data.set.pointwise.big_operators
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Data.Set.Pointwise.Basic

/-!
# Results about pointwise operations on sets and big operators.

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

namespace Set

section BigOperators

open BigOperators Pointwise

open Function

variable {α : Type _} {ι : Type _} [CommMonoid α]

#print Set.mem_finset_prod /-
/-- The n-ary version of `set.mem_mul`. -/
@[to_additive " The n-ary version of `set.mem_add`. "]
theorem mem_finset_prod (t : Finset ι) (f : ι → Set α) (a : α) :
    (a ∈ ∏ i in t, f i) ↔ ∃ (g : ι → α)(hg : ∀ {i}, i ∈ t → g i ∈ f i), (∏ i in t, g i) = a := by
  classical
    induction' t using Finset.induction_on with i is hi ih generalizing a
    · simp_rw [Finset.prod_empty, Set.mem_one]
      exact ⟨fun h => ⟨fun i => a, fun i => False.elim, h.symm⟩, fun ⟨f, _, hf⟩ => hf.symm⟩
    rw [Finset.prod_insert hi, Set.mem_mul]
    simp_rw [Finset.prod_insert hi]
    simp_rw [ih]
    constructor
    · rintro ⟨x, y, hx, ⟨g, hg, rfl⟩, rfl⟩
      refine' ⟨Function.update g i x, fun j hj => _, _⟩
      obtain rfl | hj := finset.mem_insert.mp hj
      · rw [Function.update_same]
        exact hx
      · rw [update_noteq (ne_of_mem_of_not_mem hj hi)]
        exact hg hj
      rw [Finset.prod_update_of_not_mem hi, Function.update_same]
    · rintro ⟨g, hg, rfl⟩
      exact
        ⟨g i, is.prod g, hg (is.mem_insert_self _),
          ⟨g, fun i hi => hg (Finset.mem_insert_of_mem hi), rfl⟩, rfl⟩
#align set.mem_finset_prod Set.mem_finset_prod
#align set.mem_finset_sum Set.mem_finset_sum
-/

#print Set.mem_fintype_prod /-
/-- A version of `set.mem_finset_prod` with a simpler RHS for products over a fintype. -/
@[to_additive " A version of `set.mem_finset_sum` with a simpler RHS for sums over a fintype. "]
theorem mem_fintype_prod [Fintype ι] (f : ι → Set α) (a : α) :
    (a ∈ ∏ i, f i) ↔ ∃ (g : ι → α)(hg : ∀ i, g i ∈ f i), (∏ i, g i) = a :=
  by
  rw [mem_finset_prod]
  simp
#align set.mem_fintype_prod Set.mem_fintype_prod
#align set.mem_fintype_sum Set.mem_fintype_sum
-/

/- warning: set.list_prod_mem_list_prod -> Set.list_prod_mem_list_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : CommMonoid.{u1} α] (t : List.{u2} ι) (f : ι -> (Set.{u1} α)) (g : ι -> α), (forall (i : ι), (Membership.Mem.{u2, u2} ι (List.{u2} ι) (List.hasMem.{u2} ι) i t) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (g i) (f i))) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (List.prod.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (List.map.{u2, u1} ι α g t)) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (List.map.{u2, u1} ι (Set.{u1} α) f t)))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : CommMonoid.{u1} α] (t : List.{u2} ι) (f : ι -> (Set.{u1} α)) (g : ι -> α), (forall (i : ι), (Membership.mem.{u2, u2} ι (List.{u2} ι) (List.instMembershipList.{u2} ι) i t) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (g i) (f i))) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (List.prod.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (Monoid.toOne.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)) (List.map.{u2, u1} ι α g t)) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (Monoid.toOne.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (List.map.{u2, u1} ι (Set.{u1} α) f t)))
Case conversion may be inaccurate. Consider using '#align set.list_prod_mem_list_prod Set.list_prod_mem_list_prodₓ'. -/
/-- An n-ary version of `set.mul_mem_mul`. -/
@[to_additive " An n-ary version of `set.add_mem_add`. "]
theorem list_prod_mem_list_prod (t : List ι) (f : ι → Set α) (g : ι → α) (hg : ∀ i ∈ t, g i ∈ f i) :
    (t.map g).Prod ∈ (t.map f).Prod :=
  by
  induction' t with h tl ih
  · simp_rw [List.map_nil, List.prod_nil, Set.mem_one]
  · simp_rw [List.map_cons, List.prod_cons]
    exact
      mul_mem_mul (hg h <| List.mem_cons_self _ _)
        (ih fun i hi => hg i <| List.mem_cons_of_mem _ hi)
#align set.list_prod_mem_list_prod Set.list_prod_mem_list_prod
#align set.list_sum_mem_list_sum Set.list_sum_mem_list_sum

/- warning: set.list_prod_subset_list_prod -> Set.list_prod_subset_list_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : CommMonoid.{u1} α] (t : List.{u2} ι) (f₁ : ι -> (Set.{u1} α)) (f₂ : ι -> (Set.{u1} α)), (forall (i : ι), (Membership.Mem.{u2, u2} ι (List.{u2} ι) (List.hasMem.{u2} ι) i t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (f₁ i) (f₂ i))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (List.map.{u2, u1} ι (Set.{u1} α) f₁ t)) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (MulOneClass.toHasOne.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (List.map.{u2, u1} ι (Set.{u1} α) f₂ t)))
but is expected to have type
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : CommMonoid.{u1} α] (t : List.{u2} ι) (f₁ : ι -> (Set.{u1} α)) (f₂ : ι -> (Set.{u1} α)), (forall (i : ι), (Membership.mem.{u2, u2} ι (List.{u2} ι) (List.instMembershipList.{u2} ι) i t) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (f₁ i) (f₂ i))) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (Monoid.toOne.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (List.map.{u2, u1} ι (Set.{u1} α) f₁ t)) (List.prod.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1)))) (Set.one.{u1} α (Monoid.toOne.{u1} α (CommMonoid.toMonoid.{u1} α _inst_1))) (List.map.{u2, u1} ι (Set.{u1} α) f₂ t)))
Case conversion may be inaccurate. Consider using '#align set.list_prod_subset_list_prod Set.list_prod_subset_list_prodₓ'. -/
/-- An n-ary version of `set.mul_subset_mul`. -/
@[to_additive " An n-ary version of `set.add_subset_add`. "]
theorem list_prod_subset_list_prod (t : List ι) (f₁ f₂ : ι → Set α) (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) :
    (t.map f₁).Prod ⊆ (t.map f₂).Prod :=
  by
  induction' t with h tl ih
  · rfl
  · simp_rw [List.map_cons, List.prod_cons]
    exact
      mul_subset_mul (hf h <| List.mem_cons_self _ _)
        (ih fun i hi => hf i <| List.mem_cons_of_mem _ hi)
#align set.list_prod_subset_list_prod Set.list_prod_subset_list_prod
#align set.list_sum_subset_list_sum Set.list_sum_subset_list_sum

/- warning: set.list_prod_singleton -> Set.list_prod_singleton is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_2 : CommMonoid.{u1} M] (s : List.{u1} M), Eq.{succ u1} (Set.{u1} M) (List.prod.{u1} (Set.{u1} M) (Set.mul.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2)))) (Set.one.{u1} M (MulOneClass.toHasOne.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2)))) (List.map.{u1, u1} M (Set.{u1} M) (fun (i : M) => Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.hasSingleton.{u1} M) i) s)) (Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.hasSingleton.{u1} M) (List.prod.{u1} M (MulOneClass.toHasMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2))) (MulOneClass.toHasOne.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2))) s))
but is expected to have type
  forall {M : Type.{u1}} [_inst_2 : CommMonoid.{u1} M] (s : List.{u1} M), Eq.{succ u1} (Set.{u1} M) (List.prod.{u1} (Set.{u1} M) (Set.mul.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2)))) (Set.one.{u1} M (Monoid.toOne.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2))) (List.map.{u1, u1} M (Set.{u1} M) (fun (i : M) => Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.instSingletonSet.{u1} M) i) s)) (Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.instSingletonSet.{u1} M) (List.prod.{u1} M (MulOneClass.toMul.{u1} M (Monoid.toMulOneClass.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2))) (Monoid.toOne.{u1} M (CommMonoid.toMonoid.{u1} M _inst_2)) s))
Case conversion may be inaccurate. Consider using '#align set.list_prod_singleton Set.list_prod_singletonₓ'. -/
@[to_additive]
theorem list_prod_singleton {M : Type _} [CommMonoid M] (s : List M) :
    (s.map fun i => ({i} : Set M)).Prod = {s.Prod} :=
  (map_list_prod (singletonMonoidHom : M →* Set M) _).symm
#align set.list_prod_singleton Set.list_prod_singleton
#align set.list_sum_singleton Set.list_sum_singleton

#print Set.multiset_prod_mem_multiset_prod /-
/-- An n-ary version of `set.mul_mem_mul`. -/
@[to_additive " An n-ary version of `set.add_mem_add`. "]
theorem multiset_prod_mem_multiset_prod (t : Multiset ι) (f : ι → Set α) (g : ι → α)
    (hg : ∀ i ∈ t, g i ∈ f i) : (t.map g).Prod ∈ (t.map f).Prod :=
  by
  induction t using Quotient.inductionOn
  simp_rw [Multiset.quot_mk_to_coe, Multiset.coe_map, Multiset.coe_prod]
  exact list_prod_mem_list_prod _ _ _ hg
#align set.multiset_prod_mem_multiset_prod Set.multiset_prod_mem_multiset_prod
#align set.multiset_sum_mem_multiset_sum Set.multiset_sum_mem_multiset_sum
-/

#print Set.multiset_prod_subset_multiset_prod /-
/-- An n-ary version of `set.mul_subset_mul`. -/
@[to_additive " An n-ary version of `set.add_subset_add`. "]
theorem multiset_prod_subset_multiset_prod (t : Multiset ι) (f₁ f₂ : ι → Set α)
    (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) : (t.map f₁).Prod ⊆ (t.map f₂).Prod :=
  by
  induction t using Quotient.inductionOn
  simp_rw [Multiset.quot_mk_to_coe, Multiset.coe_map, Multiset.coe_prod]
  exact list_prod_subset_list_prod _ _ _ hf
#align set.multiset_prod_subset_multiset_prod Set.multiset_prod_subset_multiset_prod
#align set.multiset_sum_subset_multiset_sum Set.multiset_sum_subset_multiset_sum
-/

#print Set.multiset_prod_singleton /-
@[to_additive]
theorem multiset_prod_singleton {M : Type _} [CommMonoid M] (s : Multiset M) :
    (s.map fun i => ({i} : Set M)).Prod = {s.Prod} :=
  (map_multiset_prod (singletonMonoidHom : M →* Set M) _).symm
#align set.multiset_prod_singleton Set.multiset_prod_singleton
#align set.multiset_sum_singleton Set.multiset_sum_singleton
-/

#print Set.finset_prod_mem_finset_prod /-
/-- An n-ary version of `set.mul_mem_mul`. -/
@[to_additive " An n-ary version of `set.add_mem_add`. "]
theorem finset_prod_mem_finset_prod (t : Finset ι) (f : ι → Set α) (g : ι → α)
    (hg : ∀ i ∈ t, g i ∈ f i) : (∏ i in t, g i) ∈ ∏ i in t, f i :=
  multiset_prod_mem_multiset_prod _ _ _ hg
#align set.finset_prod_mem_finset_prod Set.finset_prod_mem_finset_prod
#align set.finset_sum_mem_finset_sum Set.finset_sum_mem_finset_sum
-/

#print Set.finset_prod_subset_finset_prod /-
/-- An n-ary version of `set.mul_subset_mul`. -/
@[to_additive " An n-ary version of `set.add_subset_add`. "]
theorem finset_prod_subset_finset_prod (t : Finset ι) (f₁ f₂ : ι → Set α)
    (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) : (∏ i in t, f₁ i) ⊆ ∏ i in t, f₂ i :=
  multiset_prod_subset_multiset_prod _ _ _ hf
#align set.finset_prod_subset_finset_prod Set.finset_prod_subset_finset_prod
#align set.finset_sum_subset_finset_sum Set.finset_sum_subset_finset_sum
-/

/- warning: set.finset_prod_singleton -> Set.finset_prod_singleton is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {ι : Type.{u2}} [_inst_2 : CommMonoid.{u1} M] (s : Finset.{u2} ι) (I : ι -> M), Eq.{succ u1} (Set.{u1} M) (Finset.prod.{u1, u2} (Set.{u1} M) ι (Set.commMonoid.{u1} M _inst_2) s (fun (i : ι) => Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.hasSingleton.{u1} M) (I i))) (Singleton.singleton.{u1, u1} M (Set.{u1} M) (Set.hasSingleton.{u1} M) (Finset.prod.{u1, u2} M ι _inst_2 s (fun (i : ι) => I i)))
but is expected to have type
  forall {M : Type.{u2}} {ι : Type.{u1}} [_inst_2 : CommMonoid.{u2} M] (s : Finset.{u1} ι) (I : ι -> M), Eq.{succ u2} (Set.{u2} M) (Finset.prod.{u2, u1} (Set.{u2} M) ι (Set.commMonoid.{u2} M _inst_2) s (fun (i : ι) => Singleton.singleton.{u2, u2} M (Set.{u2} M) (Set.instSingletonSet.{u2} M) (I i))) (Singleton.singleton.{u2, u2} M (Set.{u2} M) (Set.instSingletonSet.{u2} M) (Finset.prod.{u2, u1} M ι _inst_2 s (fun (i : ι) => I i)))
Case conversion may be inaccurate. Consider using '#align set.finset_prod_singleton Set.finset_prod_singletonₓ'. -/
@[to_additive]
theorem finset_prod_singleton {M ι : Type _} [CommMonoid M] (s : Finset ι) (I : ι → M) :
    (∏ i : ι in s, ({I i} : Set M)) = {∏ i : ι in s, I i} :=
  (map_prod (singletonMonoidHom : M →* Set M) _ _).symm
#align set.finset_prod_singleton Set.finset_prod_singleton
#align set.finset_sum_singleton Set.finset_sum_singleton

/-! TODO: define `decidable_mem_finset_prod` and `decidable_mem_finset_sum`. -/

end BigOperators

end Set


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

! This file was ported from Lean 3 source module model_theory.quotients
! leanprover-community/mathlib commit d78597269638367c3863d40d45108f52207e03cf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Quotient
import Mathbin.ModelTheory.Semantics

/-!
# Quotients of First-Order Structures
This file defines prestructures and quotients of first-order structures.

## Main Definitions
* If `s` is a setoid (equivalence relation) on `M`, a `first_order.language.prestructure s` is the
data for a first-order structure on `M` that will still be a structure when modded out by `s`.
* The structure `first_order.language.quotient_structure s` is the resulting structure on
`quotient s`.

-/

namespace FirstOrder

namespace Language

variable (L : Language) {M : Type _}

open FirstOrder

open Structure

/-- A prestructure is a first-order structure with a `setoid` equivalence relation on it,
  such that quotienting by that equivalence relation is still a structure. -/
class Prestructure (s : Setoid M) where
  toStructure : L.Structure M
  fun_equiv : ∀ {n} {f : L.Functions n} (x y : Fin n → M), x ≈ y → funMap f x ≈ funMap f y
  rel_equiv : ∀ {n} {r : L.Relations n} (x y : Fin n → M) (h : x ≈ y), RelMap r x = RelMap r y
#align first_order.language.prestructure FirstOrder.Language.Prestructure

variable {L} {s : Setoid M} [ps : L.Prestructure s]

instance quotientStructure : L.Structure (Quotient s)
    where
  funMap n f x :=
    Quotient.map (@funMap L M ps.toStructure n f) Prestructure.fun_equiv (Quotient.finChoice x)
  rel_map n r x :=
    Quotient.lift (@RelMap L M ps.toStructure n r) Prestructure.rel_equiv (Quotient.finChoice x)
#align first_order.language.quotient_structure FirstOrder.Language.quotientStructure

variable (s)

include s

theorem funMap_quotient_mk' {n : ℕ} (f : L.Functions n) (x : Fin n → M) :
    (funMap f fun i => ⟦x i⟧) = ⟦@funMap _ _ ps.toStructure _ f x⟧ :=
  by
  change
    Quotient.map (@fun_map L M ps.to_structure n f) prestructure.fun_equiv (Quotient.finChoice _) =
      _
  rw [Quotient.finChoice_eq, Quotient.map_mk]
#align first_order.language.fun_map_quotient_mk FirstOrder.Language.funMap_quotient_mk'

theorem relMap_quotient_mk' {n : ℕ} (r : L.Relations n) (x : Fin n → M) :
    (RelMap r fun i => ⟦x i⟧) ↔ @RelMap _ _ ps.toStructure _ r x :=
  by
  change
    Quotient.lift (@rel_map L M ps.to_structure n r) prestructure.rel_equiv (Quotient.finChoice _) ↔
      _
  rw [Quotient.finChoice_eq, Quotient.lift_mk]
#align first_order.language.rel_map_quotient_mk FirstOrder.Language.relMap_quotient_mk'

theorem Term.realize_quotient_mk' {β : Type _} (t : L.term β) (x : β → M) :
    (t.realize fun i => ⟦x i⟧) = ⟦@Term.realize _ _ ps.toStructure _ x t⟧ :=
  by
  induction' t with _ _ _ _ ih
  · rfl
  · simp only [ih, fun_map_quotient_mk, term.realize]
#align first_order.language.term.realize_quotient_mk FirstOrder.Language.Term.realize_quotient_mk'

end Language

end FirstOrder


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

import category_theory.limits.preserves.shapes.terminal

/-!

# Limits and the category of (co)cones

This files contains results that stem from the limit API. For the definition and the category
instance of `cone`, please refer to `category_theory/limits/cones.lean`.

A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of
categories of cones preserves limiting properties. We also provide the dual.

-/

namespace category_theory.limits

open category_theory

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C] {D : Type u₄} [category.{v₄} D]

/-- A cone is a limit cone iff it is terminal. -/
def cone.is_limit_equiv_is_terminal {F : J ⥤ C} (c : cone F) : is_limit c ≃ is_terminal c :=
is_limit.iso_unique_cone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_terminal.of_unique _,
  inv_fun := λ h s, ⟨⟨is_terminal.from h s⟩, λ a, is_terminal.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma is_limit.lift_cone_morphism_eq_is_terminal_from {F : J ⥤ C} {c : cone F} (hc : is_limit c)
  (s : cone F) : hc.lift_cone_morphism s =
    is_terminal.from (cone.is_limit_equiv_is_terminal _ hc) _ := rfl

lemma is_terminal.from_eq_lift_cone_morphism {F : J ⥤ C} {c : cone F} (hc : is_terminal c)
  (s : cone F) : is_terminal.from hc s =
    ((cone.is_limit_equiv_is_terminal _).symm hc).lift_cone_morphism s :=
by convert (is_limit.lift_cone_morphism_eq_is_terminal_from _ s).symm

/-- If `G : cone F ⥤ cone F'` preserves terminal objects, it preserves limit cones. -/
def is_limit.of_preserves_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [preserves_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit c) :
  is_limit (G.obj c) :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_obj _ _

/-- If `G : cone F ⥤ cone F'` reflects terminal objects, it reflects limit cones. -/
def is_limit.of_reflects_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [reflects_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit (G.obj c)) :
  is_limit c :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_of_obj _ _

/-- A cocone is a colimit cocone iff it is initial. -/
def cocone.is_colimit_equiv_is_initial {F : J ⥤ C} (c : cocone F) : is_colimit c ≃ is_initial c :=
is_colimit.iso_unique_cocone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_initial.of_unique _,
  inv_fun := λ h s, ⟨⟨is_initial.to h s⟩, λ a, is_initial.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma is_colimit.desc_cocone_morphism_eq_is_initial_to {F : J ⥤ C} {c : cocone F}
  (hc : is_colimit c) (s : cocone F) :
  hc.desc_cocone_morphism s =
    is_initial.to (cocone.is_colimit_equiv_is_initial _ hc) _ := rfl

lemma is_initial.to_eq_desc_cocone_morphism {F : J ⥤ C} {c : cocone F}
  (hc : is_initial c) (s : cocone F) :
  is_initial.to hc s = ((cocone.is_colimit_equiv_is_initial _).symm hc).desc_cocone_morphism s :=
by convert (is_colimit.desc_cocone_morphism_eq_is_initial_to _ s).symm

/-- If `G : cocone F ⥤ cocone F'` preserves initial objects, it preserves colimit cocones. -/
def is_colimit.of_preserves_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [preserves_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit c) :
  is_colimit (G.obj c) :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_obj _ _

/-- If `G : cocone F ⥤ cocone F'` reflects initial objects, it reflects colimit cocones. -/
def is_colimit.of_reflects_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [reflects_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit (G.obj c)) :
  is_colimit c :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_of_obj _ _

end category_theory.limits


import analysis.convex.basic
import analysis.inner_product_space.pi_L2
import geometry.euclidean.basic
import geometry.euclidean.triangle

/-
Polish Mathematical Olympiad 1998, Problem 5

Points D, E lie on side AB of the triangle ABC and satisfy

    (AD/DB) * (AE/EB) = (AC/CB)².

Prove that ∠ACD = ∠BCE.

-/

open_locale euclidean_geometry

theorem poland1998_q5
    (A B C D E: euclidean_space ℝ (fin 2))
--  TODO: something like (ht : triangle A B C)
    (hd : D ∈ segment ℝ A B)
    (he : E ∈ segment ℝ A B)
    (hr : (dist A D / dist D B) * (dist A E / dist E B) = (dist A C / dist C B)^2) :
    ∠ A C D = ∠ B C E :=
begin
  sorry
end


import SciLean.Core
import SciLean.Data.FunType
-- import SciLean.Tactic.AutoDiff.Main

open SciLean

variable {α β γ : Type}
variable {T X Y Z : Type} [Enumtype X] [Hilbert Y] [FunType T X Y] [FunType.HasIntro T] [FunType.HasSet T] [Vec Z]
variable {Y₁ Y₂ : Type} [Vec Y₁] [Vec Y₂]

-- set_option maxHeartbeats 20000000
-- set_option synthInstance.maxHeartbeats 500000
-- set_option synthInstance.maxSize 2048

-- This one is problematic. It clashes with this instance and it is
-- the reason why the instance is marked local.
-- local instance (priority := low-1) [AddCommMonoid Y] [DistribMulAction ℝ Y] : Module ℝ T := Module.mk
example : ∀ (i : X), IsSmooth λ (x : T) => ∥x[i]∥² := by infer_instance -- apply λ i => SciLean.comp.arg_x.isSmooth

example : ∀ (i : X), IsSmooth λ (x : T) => x[i] := by infer_instance
example (h : α → X) : IsSmooth (λ (x : T) (a : α) => x[h a]) := by infer_instance
example : IsSmooth (λ (x : T) => ∥x∥²) := by infer_instance
example : IsSmooth (λ (x : T) => ⟪x,x⟫) := by infer_instance
example (f : Y → Z) [IsSmooth f] : ∀ (i : X), IsSmooth λ (x : T) => f x[i] := by infer_instance
example (i : X) : IsSmooth λ (x : T) => ∥x[i]∥² := by infer_instance
example (i : X) : ∂ (λ (x : T) => x[i]) = λ (_ dx : T) => dx[i] := by simp
example (i) : ∂ (λ (x : T) => ∥x[i]∥²) = λ x dx => 2*⟪dx[i],x[i]⟫:= by simp
example : ∂ (λ (x : T) (i : X) => x[i]) = λ x dx i => dx[i] := by simp
example (h : α → X) : ∂ (λ (x : T) (a : α) => x[h a]) = λ x dx a => dx[h a] := by simp
example : ∂ (λ (x : T) => ∑ i, x[i]) = λ x dx => ∑ i, dx[i] := by simp
example : ∂ (λ (x : T) => ∑ i, ∥x[i]∥²) = λ x dx => ∑ i, 2*⟪dx[i],x[i]⟫ := by simp

section
  variable {T Y : Type} [Hilbert Y] [FunType T (Fin n) Y] [FunType.HasIntro T] [FunType.HasSet T] [Fact (n≠0)]
  example (h : Fin n) : ∂ (λ (x : T) => ∑ i, ∥x[i+h]∥²) = λ x dx => ∑ i, 2*⟪dx[i+h],x[i+h]⟫ := by simp
  example (h : Fin n) : ∂ (λ (x : T) => ∑ i, ∥x[i+h] - x[i]∥²) = λ x dx => ∑ i, 2*⟪dx[i+h] - dx[i], x[i+h] - x[i]⟫ := by simp
end

example : ∂† (λ (x : T) => ∑ i, ∥x[i]∥²) = λ x dx' => FunType.map (2*dx'*·) x := by simp


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yury Kudryashov
-/
import data.equiv.basic
import algebra.group.defs
import algebra.group.hom
import logic.embedding

/-!
# Definitions of group actions

This file defines a hierarchy of group action type-classes:

* `has_scalar M α` and its additive version `has_vadd G P` are notation typeclasses for
  `•` and `+ᵥ`, respectively;
* `mul_action M α` and its additive version `add_action G P` are typeclasses used for
  actions of multiplicative and additive monoids and groups;
* `distrib_mul_action M A` is a typeclass for an action of a multiplicative monoid on
  an additive monoid such that `a • (b + c) = a • b + a • c` and `a • 0 = 0`.

The hierarchy is extended further by `module`, defined elsewhere.

Also provided are type-classes regarding the interaction of different group actions,

* `smul_comm_class M N α` and its additive version `vadd_comm_class M N α`;
* `is_scalar_tower M N α` (no additive version).

## Notation

- `a • b` is used as notation for `has_scalar.smul a b`.
- `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.

## Implementation details

This file should avoid depending on other parts of `group_theory`, to avoid import cycles.
More sophisticated lemmas belong in `group_theory.group_action`.

## Tags

group action
-/

variables {M N G A B α β γ : Type*}

open function

/-- Type class for the `+ᵥ` notation. -/
class has_vadd (G : Type*) (P : Type*) := (vadd : G → P → P)

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
@[to_additive has_vadd]
class has_scalar (M : Type*) (α : Type*) := (smul : M → α → α)

infix ` +ᵥ `:65 := has_vadd.vadd
infixr ` • `:73 := has_scalar.smul

/-- Type class for additive monoid actions. -/
@[protect_proj] class add_action (G : Type*) (P : Type*) [add_monoid G] extends has_vadd G P :=
(zero_vadd : ∀ p : P, (0 : G) +ᵥ p = p)
(add_vadd : ∀ (g₁ g₂ : G) (p : P), (g₁ + g₂) +ᵥ p = g₁ +ᵥ (g₂ +ᵥ p))

/-- Typeclass for multiplicative actions by monoids. This generalizes group actions. -/
@[protect_proj, to_additive]
class mul_action (α : Type*) (β : Type*) [monoid α] extends has_scalar α β :=
(one_smul : ∀ b : β, (1 : α) • b = b)
(mul_smul : ∀ (x y : α) (b : β), (x * y) • b = x • y • b)

/-- A typeclass mixin saying that two additive actions on the same space commute. -/
class vadd_comm_class (M N α : Type*) [has_vadd M α] [has_vadd N α] : Prop :=
(vadd_comm : ∀ (m : M) (n : N) (a : α), m +ᵥ (n +ᵥ a) = n +ᵥ (m +ᵥ a))

/-- A typeclass mixin saying that two multiplicative actions on the same space commute. -/
@[to_additive] class smul_comm_class (M N α : Type*) [has_scalar M α] [has_scalar N α] : Prop :=
(smul_comm : ∀ (m : M) (n : N) (a : α), m • n • a = n • m • a)

export mul_action (mul_smul) add_action (add_vadd) smul_comm_class (smul_comm)
  vadd_comm_class (vadd_comm)

/--
Frequently, we find ourselves wanting to express a bilinear map `M →ₗ[R] N →ₗ[R] P` or an
equivalence between maps `(M →ₗ[R] N) ≃ₗ[R] (M' →ₗ[R] N')` where the maps have an associated ring
`R`. Unfortunately, using definitions like these requires that `R` satisfy `comm_semiring R`, and
not just `semiring R`. Using `M →ₗ[R] N →+ P` and `(M →ₗ[R] N) ≃+ (M' →ₗ[R] N')` avoids this
problem, but throws away structure that is useful for when we _do_ have a commutative (semi)ring.

To avoid making this compromise, we instead state these definitions as `M →ₗ[R] N →ₗ[S] P` or
`(M →ₗ[R] N) ≃ₗ[S] (M' →ₗ[R] N')` and require `smul_comm_class S R` on the appropriate modules. When
the caller has `comm_semiring R`, they can set `S = R` and `smul_comm_class_self` will populate the
instance. If the caller only has `semiring R` they can still set either `R = ℕ` or `S = ℕ`, and
`add_comm_monoid.nat_smul_comm_class` or `add_comm_monoid.nat_smul_comm_class'` will populate
the typeclass, which is still sufficient to recover a `≃+` or `→+` structure.

An example of where this is used is `linear_map.prod_equiv`.
-/
library_note "bundled maps over different rings"

/-- Commutativity of actions is a symmetric relation. This lemma can't be an instance because this
would cause a loop in the instance search graph. -/
@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_scalar M α] [has_scalar N α]
  [smul_comm_class M N α] : smul_comm_class N M α :=
⟨λ a' a b, (smul_comm a a' b).symm⟩

/-- Commutativity of additive actions is a symmetric relation. This lemma can't be an instance
because this would cause a loop in the instance search graph. -/
add_decl_doc vadd_comm_class.symm

@[to_additive] instance smul_comm_class_self (M α : Type*) [comm_monoid M] [mul_action M α] :
  smul_comm_class M M α :=
⟨λ a a' b, by rw [← mul_smul, mul_comm, mul_smul]⟩

/-- An instance of `is_scalar_tower M N α` states that the multiplicative
action of `M` on `α` is determined by the multiplicative actions of `M` on `N`
and `N` on `α`. -/
class is_scalar_tower (M N α : Type*) [has_scalar M N] [has_scalar N α] [has_scalar M α] : Prop :=
(smul_assoc : ∀ (x : M) (y : N) (z : α), (x • y) • z = x • (y • z))

@[simp] lemma smul_assoc {M N} [has_scalar M N] [has_scalar N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : N) (z : α) :
  (x • y) • z = x • y • z :=
is_scalar_tower.smul_assoc x y z

section
variables [monoid M] [mul_action M α]

@[to_additive] lemma smul_smul (a₁ a₂ : M) (b : α) : a₁ • a₂ • b = (a₁ * a₂) • b :=
(mul_smul _ _ _).symm

variable (M)
@[simp, to_additive] theorem one_smul (b : α) : (1 : M) • b = b := mul_action.one_smul _

variables {M}

/-- Pullback a multiplicative action along an injective map respecting `•`. -/
@[to_additive "Pullback an additive action along an injective map respecting `+ᵥ`."]
protected def function.injective.mul_action [has_scalar M β] (f : β → α)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ x, hf $ (smul _ _).trans $ one_smul _ (f x),
  mul_smul := λ c₁ c₂ x, hf $ by simp only [smul, mul_smul] }

/-- Pushforward a multiplicative action along a surjective map respecting `•`. -/
@[to_additive "Pushforward an additive action along a surjective map respecting `+ᵥ`."]
protected def function.surjective.mul_action [has_scalar M β] (f : α → β) (hf : surjective f)
  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ y, by { rcases hf y with ⟨x, rfl⟩, rw [← smul, one_smul] },
  mul_smul := λ c₁ c₂ y, by { rcases hf y with ⟨x, rfl⟩, simp only [← smul, mul_smul] } }

section ite

variables (p : Prop) [decidable p]

@[to_additive] lemma ite_smul (a₁ a₂ : M) (b : α) : (ite p a₁ a₂) • b = ite p (a₁ • b) (a₂ • b) :=
by split_ifs; refl

@[to_additive] lemma smul_ite (a : M) (b₁ b₂ : α) : a • (ite p b₁ b₂) = ite p (a • b₁) (a • b₂) :=
by split_ifs; refl

end ite

section

variables (M)

/-- The regular action of a monoid on itself by left multiplication.

This is promoted to a module by `semiring.to_module`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance monoid.to_mul_action : mul_action M M :=
{ smul := (*),
  one_smul := one_mul,
  mul_smul := mul_assoc }

/-- The regular action of a monoid on itself by left addition.

This is promoted to an `add_torsor` by `add_group_is_add_torsor`. -/
add_decl_doc add_monoid.to_add_action

@[simp, to_additive] lemma smul_eq_mul {a a' : M} : a • a' = a * a' := rfl

instance is_scalar_tower.left : is_scalar_tower M M α :=
⟨λ x y z, mul_smul x y z⟩

end

namespace mul_action

variables (M α)

/-- Embedding of `α` into functions `M → α` induced by a multiplicative action of `M` on `α`. -/
@[to_additive] def to_fun : α ↪ (M → α) :=
⟨λ y x, x • y, λ y₁ y₂ H, one_smul M y₁ ▸ one_smul M y₂ ▸ by convert congr_fun H 1⟩

/-- Embedding of `α` into functions `M → α` induced by an additive action of `M` on `α`. -/
add_decl_doc add_action.to_fun

variables {M α}

@[simp, to_additive] lemma to_fun_apply (x : M) (y : α) : mul_action.to_fun M α y x = x • y :=
rfl

variable (α)

/-- A multiplicative action of `M` on `α` and a monoid homomorphism `N → M` induce
a multiplicative action of `N` on `α`. -/
@[to_additive] def comp_hom [monoid N] (g : N →* M) :
  mul_action N α :=
{ smul := λ x b, (g x) • b,
  one_smul := by simp [g.map_one, mul_action.one_smul],
  mul_smul := by simp [g.map_mul, mul_action.mul_smul] }

/-- An additive action of `M` on `α` and an additive monoid homomorphism `N → M` induce
an additive action of `N` on `α`. -/
add_decl_doc add_action.comp_hom

end mul_action

end

section compatible_scalar

@[simp] lemma smul_one_smul {M} (N) [monoid N] [has_scalar M N] [mul_action N α] [has_scalar M α]
  [is_scalar_tower M N α] (x : M) (y : α) :
  (x • (1 : N)) • y = x • y :=
by rw [smul_assoc, one_smul]

end compatible_scalar

/-- Typeclass for multiplicative actions on additive structures. This generalizes group modules. -/
class distrib_mul_action (M : Type*) (A : Type*) [monoid M] [add_monoid A]
  extends mul_action M A :=
(smul_add : ∀(r : M) (x y : A), r • (x + y) = r • x + r • y)
(smul_zero : ∀(r : M), r • (0 : A) = 0)

section
variables [monoid M] [add_monoid A] [distrib_mul_action M A]

theorem smul_add (a : M) (b₁ b₂ : A) : a • (b₁ + b₂) = a • b₁ + a • b₂ :=
distrib_mul_action.smul_add _ _ _

@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
distrib_mul_action.smul_zero _

/-- Pullback a distributive multiplicative action along an injective additive monoid
homomorphism. -/
protected def function.injective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : B →+ A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, hf $ by simp only [smul, f.map_add, smul_add],
  smul_zero := λ c, hf $ by simp only [smul, f.map_zero, smul_zero],
  .. hf.mul_action f smul }

/-- Pushforward a distributive multiplicative action along a surjective additive monoid
homomorphism.-/
protected def function.surjective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : A →+ B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_add, ← smul, ← f.map_add] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero],
  .. hf.mul_action f smul }

variable (A)

/-- Compose a `distrib_mul_action` with a `monoid_hom`, with action `f r' • m` -/
def distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  distrib_mul_action N A :=
{ smul := (•) ∘ f,
  smul_zero := λ x, smul_zero (f x),
  smul_add := λ x, smul_add (f x),
  .. mul_action.comp_hom A f }

/-- Scalar multiplication by `r` as an `add_monoid_hom`. -/
def const_smul_hom (r : M) : A →+ A :=
{ to_fun := (•) r,
  map_zero' := smul_zero r,
  map_add' := smul_add r }

variable {A}

@[simp] lemma const_smul_hom_apply (r : M) (x : A) :
  const_smul_hom A r x = r • x := rfl

end

section
variables [monoid M] [add_group A] [distrib_mul_action M A]

@[simp] theorem smul_neg (r : M) (x : A) : r • (-x) = -(r • x) :=
eq_neg_of_add_eq_zero $ by rw [← smul_add, neg_add_self, smul_zero]

theorem smul_sub (r : M) (x y : A) : r • (x - y) = r • x - r • y :=
by rw [sub_eq_add_neg, sub_eq_add_neg, smul_add, smul_neg]

end


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.metric_space.polish
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.PiNat
import Mathbin.Topology.MetricSpace.Isometry
import Mathbin.Topology.MetricSpace.Gluing
import Mathbin.Analysis.Normed.Field.Basic

/-!
# Polish spaces

A topological space is Polish if its topology is second-countable and there exists a compatible
complete metric. This is the class of spaces that is well-behaved with respect to measure theory.
In this file, we establish the basic properties of Polish spaces.

## Main definitions and results

* `polish_space α` is a mixin typeclass on a topological space, requiring that the topology is
  second-countable and compatible with a complete metric. To endow the space with such a metric,
  use in a proof `letI := upgrade_polish_space α`.
  We register an instance from complete second-countable metric spaces to Polish spaces, not the
  other way around.
* We register that countable products and sums of Polish spaces are Polish.
* `is_closed.polish_space`: a closed subset of a Polish space is Polish.
* `is_open.polish_space`: an open subset of a Polish space is Polish.
* `exists_nat_nat_continuous_surjective`: any nonempty Polish space is the continuous image
  of the fundamental Polish space `ℕ → ℕ`.

A fundamental property of Polish spaces is that one can put finer topologies, still Polish,
with additional properties:

* `exists_polish_space_forall_le`: on a topological space, consider countably many topologies
  `t n`, all Polish and finer than the original topology. Then there exists another Polish
  topology which is finer than all the `t n`.
* `is_clopenable s` is a property of a subset `s` of a topological space, requiring that there
  exists a finer topology, which is Polish, for which `s` becomes open and closed. We show that
  this property is satisfied for open sets, closed sets, for complements, and for countable unions.
  Once Borel-measurable sets are defined in later files, it will follow that any Borel-measurable
  set is clopenable. Once the Lusin-Souslin theorem is proved using analytic sets, we will even
  show that a set is clopenable if and only if it is Borel-measurable, see
  `is_clopenable_iff_measurable_set`.
-/

noncomputable section

open Classical Topology Filter

open TopologicalSpace Set Metric Filter Function

variable {α : Type _} {β : Type _}

/-! ### Basic properties of Polish spaces -/

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`second_countable] [] -/
/-- A Polish space is a topological space with second countable topology, that can be endowed
with a metric for which it is complete.
We register an instance from complete second countable metric space to polish space, and not the
other way around as this is the most common use case.

To endow a Polish space with a complete metric space structure, do `letI := upgrade_polish_space α`.
-/
class PolishSpace (α : Type _) [h : TopologicalSpace α] : Prop where
  second_countable : SecondCountableTopology α
  complete :
    ∃ m : MetricSpace α, m.toUniformSpace.toTopologicalSpace = h ∧ @CompleteSpace α m.toUniformSpace
#align polish_space PolishSpace

/-- A convenience class, for a Polish space endowed with a complete metric. No instance of this
class should be registered: It should be used as `letI := upgrade_polish_space α` to endow a Polish
space with a complete metric. -/
class UpgradedPolishSpace (α : Type _) extends MetricSpace α, SecondCountableTopology α,
  CompleteSpace α
#align upgraded_polish_space UpgradedPolishSpace

instance (priority := 100) polishSpace_of_complete_second_countable [m : MetricSpace α]
    [h : SecondCountableTopology α] [h' : CompleteSpace α] : PolishSpace α
    where
  second_countable := h
  complete := ⟨m, rfl, h'⟩
#align polish_space_of_complete_second_countable polishSpace_of_complete_second_countable

/-- Construct on a Polish space a metric (compatible with the topology) which is complete. -/
def polishSpaceMetric (α : Type _) [ht : TopologicalSpace α] [h : PolishSpace α] : MetricSpace α :=
  h.complete.some.replaceTopology h.complete.choose_spec.1.symm
#align polish_space_metric polishSpaceMetric

theorem complete_polishSpaceMetric (α : Type _) [ht : TopologicalSpace α] [h : PolishSpace α] :
    @CompleteSpace α (polishSpaceMetric α).toUniformSpace :=
  by
  convert h.complete.some_spec.2
  exact MetricSpace.replaceTopology_eq _ _
#align complete_polish_space_metric complete_polishSpaceMetric

/-- This definition endows a Polish space with a complete metric. Use it as:
`letI := upgrade_polish_space α`. -/
def upgradePolishSpace (α : Type _) [ht : TopologicalSpace α] [h : PolishSpace α] :
    UpgradedPolishSpace α :=
  letI := polishSpaceMetric α
  { complete_polishSpaceMetric α, PolishSpace.second_countable α with }
#align upgrade_polish_space upgradePolishSpace

namespace PolishSpace

instance (priority := 100) t2Space (α : Type _) [TopologicalSpace α] [PolishSpace α] : T2Space α :=
  by
  letI := upgradePolishSpace α
  infer_instance
#align polish_space.t2_space PolishSpace.t2Space

/-- A countable product of Polish spaces is Polish. -/
instance pi_countable {ι : Type _} [Countable ι] {E : ι → Type _} [∀ i, TopologicalSpace (E i)]
    [∀ i, PolishSpace (E i)] : PolishSpace (∀ i, E i) :=
  by
  cases nonempty_encodable ι
  letI := fun i => upgradePolishSpace (E i)
  letI : MetricSpace (∀ i, E i) := PiCountable.metricSpace
  infer_instance
#align polish_space.pi_countable PolishSpace.pi_countable

/-- Without this instance, `polish_space (ℕ → ℕ)` is not found by typeclass inference. -/
instance nat_fun [TopologicalSpace α] [PolishSpace α] : PolishSpace (ℕ → α) := by infer_instance
#align polish_space.nat_fun PolishSpace.nat_fun

/-- A countable disjoint union of Polish spaces is Polish. -/
instance sigma {ι : Type _} [Countable ι] {E : ι → Type _} [∀ n, TopologicalSpace (E n)]
    [∀ n, PolishSpace (E n)] : PolishSpace (Σn, E n) :=
  by
  letI := fun n => upgradePolishSpace (E n)
  letI : MetricSpace (Σn, E n) := sigma.metric_space
  haveI : CompleteSpace (Σn, E n) := sigma.complete_space
  infer_instance
#align polish_space.sigma PolishSpace.sigma

/-- The disjoint union of two Polish spaces is Polish. -/
instance sum [TopologicalSpace α] [PolishSpace α] [TopologicalSpace β] [PolishSpace β] :
    PolishSpace (Sum α β) := by
  letI := upgradePolishSpace α
  letI := upgradePolishSpace β
  letI : MetricSpace (Sum α β) := metric_space_sum
  infer_instance
#align polish_space.sum PolishSpace.sum

/-- Any nonempty Polish space is the continuous image of the fundamental space `ℕ → ℕ`. -/
theorem exists_nat_nat_continuous_surjective (α : Type _) [TopologicalSpace α] [PolishSpace α]
    [Nonempty α] : ∃ f : (ℕ → ℕ) → α, Continuous f ∧ Surjective f :=
  letI := upgradePolishSpace α
  exists_nat_nat_continuous_surjective_of_completeSpace α
#align polish_space.exists_nat_nat_continuous_surjective PolishSpace.exists_nat_nat_continuous_surjective

/-- Given a closed embedding into a Polish space, the source space is also Polish. -/
theorem ClosedEmbedding.polishSpace [TopologicalSpace α] [TopologicalSpace β] [PolishSpace β]
    {f : α → β} (hf : ClosedEmbedding f) : PolishSpace α :=
  by
  letI := upgradePolishSpace β
  letI : MetricSpace α := hf.to_embedding.comap_metric_space f
  haveI : second_countable_topology α := hf.to_embedding.second_countable_topology
  have : CompleteSpace α :=
    by
    rw [completeSpace_iff_isComplete_range hf.to_embedding.to_isometry.uniform_inducing]
    apply IsClosed.isComplete
    exact hf.closed_range
  infer_instance
#align closed_embedding.polish_space ClosedEmbedding.polishSpace

/-- Pulling back a Polish topology under an equiv gives again a Polish topology. -/
theorem Equiv.polishSpace_induced [t : TopologicalSpace β] [PolishSpace β] (f : α ≃ β) :
    @PolishSpace α (t.induced f) :=
  letI : TopologicalSpace α := t.induced f
  (f.to_homeomorph_of_inducing ⟨rfl⟩).ClosedEmbedding.PolishSpace
#align equiv.polish_space_induced Equiv.polishSpace_induced

/-- A closed subset of a Polish space is also Polish. -/
theorem IsClosed.polishSpace {α : Type _} [TopologicalSpace α] [PolishSpace α] {s : Set α}
    (hs : IsClosed s) : PolishSpace s :=
  (IsClosed.closedEmbedding_subtype_val hs).PolishSpace
#align is_closed.polish_space IsClosed.polishSpace

/-- A sequence of type synonyms of a given type `α`, useful in the proof of
`exists_polish_space_forall_le` to endow each copy with a different topology. -/
@[nolint unused_arguments has_nonempty_instance]
def AuxCopy (α : Type _) {ι : Type _} (i : ι) : Type _ :=
  α
#align polish_space.aux_copy PolishSpace.AuxCopy

/-- Given a Polish space, and countably many finer Polish topologies, there exists another Polish
topology which is finer than all of them. -/
theorem exists_polishSpace_forall_le {ι : Type _} [Countable ι] [t : TopologicalSpace α]
    [p : PolishSpace α] (m : ι → TopologicalSpace α) (hm : ∀ n, m n ≤ t)
    (h'm : ∀ n, @PolishSpace α (m n)) :
    ∃ t' : TopologicalSpace α, (∀ n, t' ≤ m n) ∧ t' ≤ t ∧ @PolishSpace α t' :=
  by
  rcases isEmpty_or_nonempty ι with (hι | hι)
  · exact ⟨t, fun i => (IsEmpty.elim hι i : _), le_rfl, p⟩
  inhabit ι
  /- Consider the product of infinitely many copies of `α`, each endowed with the topology `m n`.
    This is a Polish space, as a product of Polish spaces. Pulling back this topology under the
    diagonal embedding of `α`, one gets a Polish topology which is finer than all the `m n`. -/
  letI : ∀ n : ι, TopologicalSpace (aux_copy α n) := fun n => m n
  haveI : ∀ n : ι, PolishSpace (aux_copy α n) := fun n => h'm n
  letI T : TopologicalSpace (∀ n : ι, aux_copy α n) := by infer_instance
  let f : α → ∀ n : ι, aux_copy α n := fun x n => x
  -- show that the induced topology is finer than all the `m n`.
  have T_le_m : ∀ n, T.induced f ≤ m n := by
    intro n s hs
    refine' ⟨Set.pi ({n} : Set ι) fun i => s, _, _⟩
    · apply isOpen_set_pi (finite_singleton _)
      intro a ha
      rw [mem_singleton_iff.1 ha]
      exact hs
    · ext x
      simp only [singleton_pi, mem_preimage]
  refine' ⟨T.induced f, fun n => T_le_m n, (T_le_m default).trans (hm default), _⟩
  -- show that the new topology is Polish, as the pullback of a Polish topology under a closed
  -- embedding.
  have A : range f = ⋂ n, { x | x n = x default } :=
    by
    ext x
    constructor
    · rintro ⟨y, rfl⟩
      exact mem_Inter.2 fun n => by simp only [mem_set_of_eq]
    · intro hx
      refine' ⟨x default, _⟩
      ext1 n
      symm
      exact (mem_Inter.1 hx n : _)
  have f_closed : IsClosed (range f) := by
    rw [A]
    apply isClosed_interᵢ fun n => _
    have C : ∀ i : ι, Continuous fun x : ∀ n, aux_copy α n => (id (x i) : α) :=
      by
      intro i
      apply Continuous.comp _ (continuous_apply i)
      apply continuous_def.2 fun s hs => _
      exact hm i s hs
    apply isClosed_eq (C n) (C default)
  have K : @_root_.embedding _ _ (T.induced f) T f :=
    by
    apply Function.Injective.embedding_induced
    intro x y hxy
    have : f x default = f y default := by rw [hxy]
    exact this
  have L : @ClosedEmbedding _ _ (T.induced f) T f :=
    by
    constructor
    · exact K
    · exact f_closed
  exact @ClosedEmbedding.polishSpace _ _ (T.induced f) T (by infer_instance) _ L
#align polish_space.exists_polish_space_forall_le PolishSpace.exists_polishSpace_forall_le

/-!
### An open subset of a Polish space is Polish

To prove this fact, one needs to construct another metric, giving rise to the same topology,
for which the open subset is complete. This is not obvious, as for instance `(0,1) ⊆ ℝ` is not
complete for the usual metric of `ℝ`: one should build a new metric that blows up close to the
boundary.
-/

section CompleteCopy

variable [MetricSpace α] {s : Set α}

/-- A type synonym for a subset `s` of a metric space, on which we will construct another metric
for which it will be complete. -/
@[nolint has_nonempty_instance]
def CompleteCopy {α : Type _} (s : Set α) : Type _ :=
  s
#align polish_space.complete_copy PolishSpace.CompleteCopy

/-- A distance on a subset `s` of a metric space, designed to make it complete if `s` is open.
It is given by `dist' x y = dist x y + |1 / dist x sᶜ - 1 / dist y sᶜ|`, where the second term
blows up close to the boundary to ensure that Cauchy sequences for `dist'` remain well
inside `s`. -/
def hasDistCompleteCopy (s : Set α) : Dist (CompleteCopy s) :=
  ⟨fun x y => dist x.1 y.1 + abs (1 / infDist x.1 (sᶜ) - 1 / infDist y.1 (sᶜ))⟩
#align polish_space.has_dist_complete_copy PolishSpace.hasDistCompleteCopy

attribute [local instance] has_dist_complete_copy

theorem dist_completeCopy_eq (x y : CompleteCopy s) :
    dist x y = dist x.1 y.1 + abs (1 / infDist x.1 (sᶜ) - 1 / infDist y.1 (sᶜ)) :=
  rfl
#align polish_space.dist_complete_copy_eq PolishSpace.dist_completeCopy_eq

theorem dist_le_dist_completeCopy (x y : CompleteCopy s) : dist x.1 y.1 ≤ dist x y :=
  (le_add_iff_nonneg_right _).2 (abs_nonneg _)
#align polish_space.dist_le_dist_complete_copy PolishSpace.dist_le_dist_completeCopy

/-- A metric space structure on a subset `s` of a metric space, designed to make it complete
if `s` is open. It is given by `dist' x y = dist x y + |1 / dist x sᶜ - 1 / dist y sᶜ|`, where the
second term blows up close to the boundary to ensure that Cauchy sequences for `dist'` remain well
inside `s`. -/
def completeCopyMetricSpace (s : Set α) : MetricSpace (CompleteCopy s)
    where
  dist_self x := by simp [dist_complete_copy_eq]
  dist_comm x y := by simp [dist_complete_copy_eq, dist_comm, abs_sub_comm]
  dist_triangle x y z :=
    calc
      dist x z = dist x.1 z.1 + abs (1 / infDist x.1 (sᶜ) - 1 / infDist z.1 (sᶜ)) := rfl
      _ ≤
          dist x.1 y.1 + dist y.1 z.1 +
            (abs (1 / infDist x.1 (sᶜ) - 1 / infDist y.1 (sᶜ)) +
              abs (1 / infDist y.1 (sᶜ) - 1 / infDist z.1 (sᶜ))) :=
        by
        rw [← Real.dist_eq, ← Real.dist_eq, ← Real.dist_eq]
        exact add_le_add (dist_triangle _ _ _) (dist_triangle _ _ _)
      _ = dist x y + dist y z :=
        by
        rw [dist_complete_copy_eq, dist_complete_copy_eq]
        abel

  eq_of_dist_eq_zero := by
    intro x y hxy
    apply Subtype.coe_injective
    refine' dist_le_zero.1 _
    rw [← hxy]
    exact dist_le_dist_complete_copy x y
#align polish_space.complete_copy_metric_space PolishSpace.completeCopyMetricSpace

attribute [local instance] complete_copy_metric_space

/-- The identity between the type synonym `complete_copy s` (with its modified metric) and the
original subtype `s` is a homeomorphism. -/
def completeCopyIdHomeo (hs : IsOpen s) (h's : sᶜ.Nonempty) : CompleteCopy s ≃ₜ s
    where
  toFun := id
  invFun := id
  left_inv x := rfl
  right_inv x := rfl
  continuous_toFun :=
    haveI : LipschitzWith 1 fun x : complete_copy s => (id x : s) :=
      by
      apply LipschitzWith.mk_one
      exact dist_le_dist_complete_copy
    this.continuous
  continuous_invFun := by
    apply continuous_iff_continuousAt.2 fun x => _
    suffices H :
      tendsto (fun b : s => dist b.1 x.1 + |1 / inf_dist b.1 (sᶜ) - 1 / inf_dist x.1 (sᶜ)|) (𝓝 x)
        (𝓝 (dist x.1 x.1 + abs (1 / inf_dist x.1 (sᶜ) - 1 / inf_dist x.1 (sᶜ))))
    · rw [ContinuousAt, tendsto_iff_dist_tendsto_zero]
      simpa only [sub_self, abs_zero, add_zero, dist_self] using H
    have I : 0 < inf_dist x.val (sᶜ) :=
      by
      rw [← hs.is_closed_compl.not_mem_iff_inf_dist_pos h's]
      simp
    apply tendsto.add
    · apply Continuous.tendsto
      exact continuous_subtype_coe.dist continuous_const
    · refine' (tendsto.sub_const _ _).abs
      refine' tendsto.div tendsto_const_nhds _ I.ne'
      exact ((continuous_inf_dist_pt _).comp continuous_subtype_val).Tendsto _
#align polish_space.complete_copy_id_homeo PolishSpace.completeCopyIdHomeo

theorem completeSpace_completeCopy [CompleteSpace α] (hs : IsOpen s) (h's : sᶜ.Nonempty) :
    CompleteSpace (CompleteCopy s) :=
  by
  refine' Metric.complete_of_convergent_controlled_sequences (fun n => (1 / 2) ^ n) (by simp) _
  intro u hu
  have A : CauchySeq fun n => (u n).1 :=
    by
    apply cauchySeq_of_le_tendsto_0 (fun n : ℕ => (1 / 2) ^ n) (fun n m N hNn hNm => _) _
    · exact (dist_le_dist_complete_copy (u n) (u m)).trans (hu N n m hNn hNm).le
    · exact tendsto_pow_atTop_nhds_0_of_lt_1 (by norm_num) (by norm_num)
  obtain ⟨x, xlim⟩ : ∃ x, tendsto (fun n => (u n).1) at_top (𝓝 x) :=
    haveI : Nonempty α := ⟨(u 0).1⟩
    ⟨_, A.tendsto_lim⟩
  suffices xs : x ∈ s
  · refine' ⟨⟨x, xs⟩, _⟩
    have L : tendsto (fun n => (id ⟨(u n).1, (u n).2⟩ : s)) at_top (𝓝 ⟨x, xs⟩) :=
      by
      apply embedding_subtype_coe.tendsto_nhds_iff.2
      exact xlim
    convert((complete_copy_id_homeo hs h's).symm.Continuous.Tendsto _).comp L
    ext1 n
    simp [complete_copy_id_homeo]
  obtain ⟨C, hC⟩ : ∃ C, ∀ n, 1 / inf_dist (u n).1 (sᶜ) < C :=
    by
    refine' ⟨(1 / 2) ^ 0 + dist (1 / inf_dist (u 0).1 (sᶜ)) 0, fun n => _⟩
    calc
      1 / inf_dist (u n).val (sᶜ) ≤ dist (1 / inf_dist (u n).val (sᶜ)) 0 :=
        by
        rw [Real.dist_0_eq_abs]
        exact le_abs_self _
      _ ≤
          dist (1 / inf_dist (u n).1 (sᶜ)) (1 / inf_dist (u 0).1 (sᶜ)) +
            dist (1 / inf_dist (u 0).1 (sᶜ)) 0 :=
        (dist_triangle _ _ _)
      _ ≤
          dist (u n).1 (u 0).1 + dist (1 / inf_dist (u n).1 (sᶜ)) (1 / inf_dist (u 0).1 (sᶜ)) +
            dist (1 / inf_dist (u 0).1 (sᶜ)) 0 :=
        (add_le_add (le_add_of_nonneg_left dist_nonneg) le_rfl)
      _ = dist (u n) (u 0) + dist (1 / inf_dist (u 0).1 (sᶜ)) 0 := rfl
      _ < (1 / 2) ^ 0 + dist (1 / inf_dist (u 0).1 (sᶜ)) 0 :=
        add_lt_add_right (hu 0 n 0 (zero_le _) le_rfl) _

  have Cpos : 0 < C := by
    apply lt_of_le_of_lt _ (hC 0)
    simp [inf_dist_nonneg]
  have I : ∀ n, 1 / C ≤ inf_dist (u n).1 (sᶜ) :=
    by
    intro n
    have : 0 < inf_dist (u n).val (sᶜ) :=
      by
      apply (hs.is_closed_compl.not_mem_iff_inf_dist_pos h's).1
      simp
    rw [div_le_iff' Cpos]
    exact (div_le_iff this).1 (hC n).le
  have I' : 1 / C ≤ inf_dist x (sᶜ) :=
    haveI : tendsto (fun n => inf_dist (u n).1 (sᶜ)) at_top (𝓝 (inf_dist x (sᶜ))) :=
      ((continuous_inf_dist_pt (sᶜ)).Tendsto x).comp xlim
    ge_of_tendsto' this I
  suffices x ∉ sᶜ by simpa
  apply (hs.is_closed_compl.not_mem_iff_inf_dist_pos h's).2 (lt_of_lt_of_le _ I')
  simp [Cpos]
#align polish_space.complete_space_complete_copy PolishSpace.completeSpace_completeCopy

/-- An open subset of a Polish space is also Polish. -/
theorem IsOpen.polishSpace {α : Type _} [TopologicalSpace α] [PolishSpace α] {s : Set α}
    (hs : IsOpen s) : PolishSpace s :=
  by
  rcases eq_empty_or_nonempty (sᶜ) with (h's | h's)
  · simp at h's
    apply IsClosed.polishSpace
    rw [h's]
    exact isClosed_univ
  · letI := upgradePolishSpace α
    haveI : CompleteSpace (complete_copy s) := complete_space_complete_copy hs h's
    haveI : second_countable_topology (complete_copy s) :=
      (complete_copy_id_homeo hs h's).Embedding.SecondCountableTopology
    exact (complete_copy_id_homeo hs h's).symm.ClosedEmbedding.PolishSpace
#align is_open.polish_space IsOpen.polishSpace

end CompleteCopy

/-! ### Clopenable sets in Polish spaces -/

/-- A set in a topological space is clopenable if there exists a finer Polish topology for which
this set is open and closed. It turns out that this notion is equivalent to being Borel-measurable,
but this is nontrivial (see `is_clopenable_iff_measurable_set`). -/
def IsClopenable [t : TopologicalSpace α] (s : Set α) : Prop :=
  ∃ t' : TopologicalSpace α, t' ≤ t ∧ @PolishSpace α t' ∧ is_closed[t'] s ∧ is_open[t'] s
#align polish_space.is_clopenable PolishSpace.IsClopenable

/-- Given a closed set `s` in a Polish space, one can construct a finer Polish topology for
which `s` is both open and closed. -/
theorem IsClosed.isClopenable [TopologicalSpace α] [PolishSpace α] {s : Set α} (hs : IsClosed s) :
    IsClopenable s :=
  by
  /- Both sets `s` and `sᶜ` admit a Polish topology. So does their disjoint union `s ⊕ sᶜ`.
    Pulling back this topology by the canonical bijection with `α` gives the desired Polish
    topology in which `s` is both open and closed. -/
  haveI : PolishSpace s := hs.polish_space
  let t : Set α := sᶜ
  haveI : PolishSpace t := hs.is_open_compl.polish_space
  let f : α ≃ Sum s t := (Equiv.Set.sumCompl s).symm
  letI T : TopologicalSpace (Sum s t) := by infer_instance
  let t' : TopologicalSpace α := T.induced f
  let g := @Equiv.toHomeomorphOfInducing _ _ t' T f { induced := rfl }
  have A : g ⁻¹' range (Sum.inl : s → Sum s t) = s :=
    by
    ext x
    by_cases h : x ∈ s
    ·
      simp only [Equiv.Set.sumCompl_symm_apply_of_mem, h, mem_preimage, Equiv.toFun_as_coe,
        mem_range_self, Equiv.toHomeomorphOfInducing_apply]
    ·
      simp only [Equiv.Set.sumCompl_symm_apply_of_not_mem, h, not_false_iff, mem_preimage,
        Equiv.toHomeomorphOfInducing_apply, Equiv.toFun_as_coe, mem_range, exists_false]
  refine' ⟨t', _, f.polish_space_induced, _, _⟩
  · intro u hu
    change ∃ s' : Set (Sum (↥s) ↥t), T.is_open s' ∧ f ⁻¹' s' = u
    refine' ⟨f.symm ⁻¹' u, _, by simp only [Equiv.symm_symm, Equiv.symm_preimage_preimage]⟩
    refine' isOpen_sum_iff.2 ⟨_, _⟩
    · have : IsOpen ((coe : s → α) ⁻¹' u) := IsOpen.preimage continuous_subtype_val hu
      have : Sum.inl ⁻¹' (⇑f.symm ⁻¹' u) = (coe : s → α) ⁻¹' u :=
        by
        ext x
        simp only [Equiv.symm_symm, mem_preimage, Equiv.Set.sumCompl_apply_inl]
      rwa [this]
    · have : IsOpen ((coe : t → α) ⁻¹' u) := IsOpen.preimage continuous_subtype_val hu
      have : Sum.inr ⁻¹' (⇑f.symm ⁻¹' u) = (coe : t → α) ⁻¹' u :=
        by
        ext x
        simp only [Equiv.symm_symm, mem_preimage, Equiv.Set.sumCompl_apply_inr]
      rwa [this]
  · have : is_closed[t'] (g ⁻¹' range (Sum.inl : s → Sum s t)) :=
      by
      apply IsClosed.preimage
      · exact @Homeomorph.continuous _ _ t' _ g
      · exact isClosed_range_inl
    convert this
    exact A.symm
  · have : is_open[t'] (g ⁻¹' range (Sum.inl : s → Sum s t)) :=
      by
      apply IsOpen.preimage
      · exact @Homeomorph.continuous _ _ t' _ g
      · exact isOpen_range_inl
    convert this
    exact A.symm
#align is_closed.is_clopenable IsClosed.isClopenable

theorem IsClopenable.compl [TopologicalSpace α] {s : Set α} (hs : IsClopenable s) :
    IsClopenable (sᶜ) := by
  rcases hs with ⟨t, t_le, t_polish, h, h'⟩
  exact ⟨t, t_le, t_polish, @IsOpen.isClosed_compl α t s h', @IsClosed.isOpen_compl α t s h⟩
#align polish_space.is_clopenable.compl PolishSpace.IsClopenable.compl

theorem IsOpen.isClopenable [TopologicalSpace α] [PolishSpace α] {s : Set α} (hs : IsOpen s) :
    IsClopenable s := by simpa using hs.is_closed_compl.is_clopenable.compl
#align is_open.is_clopenable IsOpen.isClopenable

theorem IsClopenable.unionᵢ [t : TopologicalSpace α] [PolishSpace α] {s : ℕ → Set α}
    (hs : ∀ n, IsClopenable (s n)) : IsClopenable (⋃ n, s n) :=
  by
  choose m mt m_polish m_closed m_open using hs
  obtain ⟨t', t'm, -, t'_polish⟩ :
    ∃ t' : TopologicalSpace α, (∀ n : ℕ, t' ≤ m n) ∧ t' ≤ t ∧ @PolishSpace α t' :=
    exists_polish_space_forall_le m mt m_polish
  have A : is_open[t'] (⋃ n, s n) := by
    apply isOpen_unionᵢ
    intro n
    apply t'm n
    exact m_open n
  obtain ⟨t'', t''_le, t''_polish, h1, h2⟩ :
    ∃ t'' : TopologicalSpace α,
      t'' ≤ t' ∧ @PolishSpace α t'' ∧ is_closed[t''] (⋃ n, s n) ∧ is_open[t''] (⋃ n, s n) :=
    @IsOpen.isClopenable α t' t'_polish _ A
  exact ⟨t'', t''_le.trans ((t'm 0).trans (mt 0)), t''_polish, h1, h2⟩
#align polish_space.is_clopenable.Union PolishSpace.IsClopenable.unionᵢ

end PolishSpace


import galois.tactic

inductive ext (A : Type) : Type
| inj {} : A → ext
| inf {} : ext
| neg_inf {} : ext

namespace ext
section
parameters (A : Type) [decidable_linear_order A]

def le : ext A → ext A → Prop
| neg_inf   _      := true
| _        inf     := true
| (inj _)  neg_inf := false
| (inj x)  (inj y) := x ≤ y
| inf      (inj _) := false
| inf      neg_inf := false

instance : has_le (ext A) := ⟨ le ⟩

inductive lt (x y : ext A) : Prop
| mk : ∀ (le : x ≤ y) (not_rev_le : ¬ (y ≤ x)), lt

instance : has_lt (ext A) := ⟨ lt ⟩

instance le_decidable : decidable_rel (@has_le.le (ext A) _) :=
begin
intros x y,
induction x; induction y; simp [(≤), le];
  apply_instance,
end

lemma lt_equiv (a b : ext A) : a < b ↔ a ≤ b ∧ ¬b ≤ a
:= begin
split; intros H; induction H; split; assumption,
end

instance lt_decidable : decidable_rel (@has_lt.lt (ext A) _) :=
begin
intros x y, rw lt_equiv, apply_instance,
end

lemma le_refl (x : ext A) : x ≤ x :=
begin
simp only [(≤)], induction x; simp only [le],
end

lemma le_trans {x y z : ext A} (H : x ≤ y) (H' : y ≤ z)
  : x ≤ z :=
begin
simp only [(≤)] at *,
induction x; induction y; induction z; simp only [le] at *;
  try { contradiction },
apply le_trans; assumption
end

lemma le_antisymm (a b : ext A) : a ≤ b → b ≤ a → a = b
:= begin
simp only [(≤)], intros H H', induction a; induction b;
  simp only [le] at *; try { contradiction },
f_equal, apply le_antisymm; assumption
end

lemma le_total (a b : ext A) : a ≤ b ∨ b ≤ a
:= begin
simp only [(≤)], induction a; induction b;
  simp only [le]; try {cc},
  apply le_total,
end

lemma neg_inf_le (x : ext A) : neg_inf ≤ x
:= begin
simp only [(≤)], induction x; simp [le],
end

lemma le_inf (x : ext A) : x ≤ inf
:= begin
simp only [(≤)], induction x; simp [le],
end

instance eq_decidable : decidable_eq (ext A) :=
  by tactic.mk_dec_eq_instance

instance linear_order_decidable : decidable_linear_order (ext A) :=
begin
constructor, apply ext.le_decidable,
apply_instance, apply ext.lt_decidable,
apply le_refl, apply le_trans,
unfold auto_param, intros,
apply lt_equiv, apply le_antisymm,
apply le_total,
end

end
end ext

namespace list

def maximum_ext {α:Type _} [decidable_linear_order α] : list (ext α) → ext α
  := list.foldr max ext.neg_inf

def minimum_ext {α:Type _} [decidable_linear_order α] : list (ext α) → ext α
  := list.foldr min ext.inf

end list

lemma maximum_ext_le {α: Type _} [decidable_linear_order α]
  (xs : list (ext α)) (u : ext α)
  (H : ∀ x : ext α, x ∈ xs → x ≤ u)
  : xs.maximum_ext ≤ u
:= begin
unfold list.maximum_ext,
induction xs; dsimp [list.foldr],
apply ext.neg_inf_le,
apply max_le, apply H, rw list.mem_cons_eq,
left, reflexivity, apply ih_1, intros,
apply H,rw list.mem_cons_eq, right, assumption
end

lemma le_minimum_ext {α: Type _} [decidable_linear_order α]
  (xs : list (ext α)) (l : ext α)
  (H : ∀ x : ext α, x ∈ xs → l ≤ x)
  : l ≤ xs.minimum_ext
:= begin
unfold list.minimum_ext,
induction xs; dsimp [list.foldr],
apply ext.le_inf,
apply le_min, apply H, rw list.mem_cons_eq,
left, reflexivity, apply ih_1, intros,
apply H,rw list.mem_cons_eq, right, assumption
end

theorem le_ext_maximum_minimum {α: Type _} [decidable_linear_order α]
  (ll ul : list (ext α))
  (pr : ∀ (l u : ext α), l ∈ ll → u ∈ ul → l ≤ u)
  : ll.maximum_ext ≤ ul.minimum_ext
:= begin
apply maximum_ext_le,
intros, apply le_minimum_ext, intros, apply pr; assumption
end