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

/-!
# The shrinking lemma

In this file we prove a few versions of the shrinking lemma. The lemma says that in a normal
topological space a point finite open covering can be “shrunk”: for a point finite open covering
`u : ι → set X` there exists a refinement `v : ι → set X` such that `closure (v i) ⊆ u i`.

For finite or countable coverings this lemma can be proved without the axiom of choice, see
[ncatlab](https://ncatlab.org/nlab/show/shrinking+lemma) for details. We only formalize the most
general result that works for any covering but needs the axiom of choice.

We prove two versions of the lemma:

* `exists_subset_Union_closure_subset` deals with a covering of a closed set in a normal space;
* `exists_Union_eq_closure_subset` deals with a covering of the whole space.

## Tags

normal space, shrinking lemma
-/

open set zorn function
open_locale classical
noncomputable theory

variables {ι X : Type*} [topological_space X] [normal_space X]

namespace shrinking_lemma

/-- Auxiliary definition for the proof of `shrinking_lemma`. A partial refinement of a covering
`⋃ i, u i` of a set `s` is a map `v : ι → set X` and a set `carrier : set ι` such that

* `s ⊆ ⋃ i, v i`;
* all `v i` are open;
* if `i ∈ carrier v`, then `closure (v i) ⊆ u i`;
* if `i ∉ carrier`, then `v i = u i`.

This type is equipped with the folowing partial order: `v ≤ v'` if `v.carrier ⊆ v'.carrier`
and `v i = v' i` for `i ∈ v.carrier`. We will use Zorn's lemma to prove that this type has
a maximal element, then show that the maximal element must have `carrier = univ`. -/
@[nolint has_inhabited_instance] -- the trivial refinement needs `u` to be a covering
structure partial_refinement (u : ι → set X) (s : set X) :=
(to_fun : ι → set X)
(carrier : set ι)
(is_open' : ∀ i, is_open (to_fun i))
(subset_Union' : s ⊆ ⋃ i, to_fun i)
(closure_subset' : ∀ i ∈ carrier, closure (to_fun i) ⊆ (u i))
(apply_eq' : ∀ i ∉ carrier, to_fun i = u i)

namespace partial_refinement

variables {u : ι → set X} {s : set X}

instance : has_coe_to_fun (partial_refinement u s) := ⟨_, to_fun⟩

lemma subset_Union (v : partial_refinement u s) : s ⊆ ⋃ i, v i := v.subset_Union'

lemma closure_subset (v : partial_refinement u s) {i : ι} (hi : i ∈ v.carrier) :
  closure (v i) ⊆ (u i) :=
v.closure_subset' i hi

lemma apply_eq (v : partial_refinement u s) {i : ι} (hi : i ∉ v.carrier) : v i = u i :=
v.apply_eq' i hi

protected

protected lemma subset (v : partial_refinement u s) (i : ι) : v i ⊆ u i :=
if h : i ∈ v.carrier then subset.trans subset_closure (v.closure_subset h)
else (v.apply_eq h).le

attribute [ext] partial_refinement

instance : partial_order (partial_refinement u s) :=
{ le := λ v₁ v₂, v₁.carrier ⊆ v₂.carrier ∧ ∀ i ∈ v₁.carrier, v₁ i = v₂ i,
  le_refl := λ v, ⟨subset.refl _, λ _ _, rfl⟩,
  le_trans := λ v₁ v₂ v₃ h₁₂ h₂₃,
    ⟨subset.trans h₁₂.1 h₂₃.1, λ i hi, (h₁₂.2 i hi).trans (h₂₃.2 i $ h₁₂.1 hi)⟩,
  le_antisymm := λ v₁ v₂ h₁₂ h₂₁,
    have hc : v₁.carrier = v₂.carrier, from subset.antisymm h₁₂.1 h₂₁.1,
    ext _ _ (funext $ λ x,
      if hx : x ∈ v₁.carrier then h₁₂.2 _ hx
      else (v₁.apply_eq hx).trans (eq.symm $ v₂.apply_eq $ hc ▸ hx)) hc }

/-- If two partial refinements `v₁`, `v₂` belong to a chain (hence, they are comparable)
and `i` belongs to the carriers of both partial refinements, then `v₁ i = v₂ i`. -/
lemma apply_eq_of_chain {c : set (partial_refinement u s)} (hc : chain (≤) c) {v₁ v₂}
  (h₁ : v₁ ∈ c) (h₂ : v₂ ∈ c) {i} (hi₁ : i ∈ v₁.carrier) (hi₂ : i ∈ v₂.carrier) :
  v₁ i = v₂ i :=
begin
  wlog hle : v₁ ≤ v₂ := hc.total_of_refl h₁ h₂ using [v₁ v₂, v₂ v₁],
  exact hle.2 _ hi₁,
end

/-- The carrier of the least upper bound of a non-empty chain of partial refinements
is the union of their carriers. -/
def chain_Sup_carrier (c : set (partial_refinement u s)) : set ι :=
⋃ v ∈ c, carrier v

/-- Choice of an element of a nonempty chain of partial refinements. If `i` belongs to one of
`carrier v`, `v ∈ c`, then `find c ne i` is one of these partial refinements. -/
def find (c : set (partial_refinement u s)) (ne : c.nonempty) (i : ι) :
  partial_refinement u s :=
if hi : ∃ v ∈ c, i ∈ carrier v then hi.some else ne.some

lemma find_mem {c : set (partial_refinement u s)} (i : ι) (ne : c.nonempty) :
  find c ne i ∈ c :=
by { rw find, split_ifs, exacts [h.some_spec.fst, ne.some_spec] }

lemma mem_find_carrier_iff {c : set (partial_refinement u s)} {i : ι} (ne : c.nonempty) :
  i ∈ (find c ne i).carrier ↔ i ∈ chain_Sup_carrier c :=
begin
  rw find,
  split_ifs,
  { have : i ∈ h.some.carrier ∧ i ∈ chain_Sup_carrier c,
      from ⟨h.some_spec.snd, mem_bUnion_iff.2 h⟩,
    simp only [this] },
  { have : i ∉ ne.some.carrier ∧ i ∉ chain_Sup_carrier c,
      from ⟨λ hi, h ⟨_, ne.some_spec, hi⟩, mt mem_bUnion_iff.1 h⟩,
    simp only [this] }
end

lemma find_apply_of_mem {c : set (partial_refinement u s)} (hc : chain (≤) c) (ne : c.nonempty)
  {i v} (hv : v ∈ c) (hi : i ∈ carrier v) :
  find c ne i i = v i :=
apply_eq_of_chain hc (find_mem _ _) hv
  ((mem_find_carrier_iff _).2 $ mem_bUnion_iff.2 ⟨v, hv, hi⟩) hi

/-- Least upper bound of a nonempty chain of partial refinements. -/
def chain_Sup (c : set (partial_refinement u s)) (hc : chain (≤) c)
  (ne : c.nonempty) (hfin : ∀ x ∈ s, finite {i | x ∈ u i}) (hU : s ⊆ ⋃ i, u i) :
  partial_refinement u s :=
begin
  refine ⟨λ i, find c ne i i, chain_Sup_carrier c,
    λ i, (find _ _ _).is_open i,
    λ x hxs, mem_Union.2 _,
    λ i hi, (find c ne i).closure_subset ((mem_find_carrier_iff _).2 hi),
    λ i hi, (find c ne i).apply_eq (mt (mem_find_carrier_iff _).1 hi)⟩,
  rcases em (∃ i ∉ chain_Sup_carrier c, x ∈ u i) with ⟨i, hi, hxi⟩|hx,
  { use i,
    rwa (find c ne i).apply_eq (mt (mem_find_carrier_iff _).1 hi) },
  { simp_rw [not_exists, not_imp_not, chain_Sup_carrier, mem_bUnion_iff] at hx,
    haveI : nonempty (partial_refinement u s) := ⟨ne.some⟩,
    choose! v hvc hiv using hx,
    rcases (hfin x hxs).exists_maximal_wrt v _ (mem_Union.1 (hU hxs))
      with ⟨i, hxi : x ∈ u i, hmax : ∀ j, x ∈ u j → v i ≤ v j → v i = v j⟩,
    rcases mem_Union.1 ((v i).subset_Union hxs) with ⟨j, hj⟩,
    use j,
    have hj' : x ∈ u j := (v i).subset _ hj,
    have : v j ≤ v i,
      from (hc.total_of_refl (hvc _ hxi) (hvc _ hj')).elim (λ h, (hmax j hj' h).ge) id,
    rwa find_apply_of_mem hc ne (hvc _ hxi) (this.1 $ hiv _ hj') }
end

/-- `chain_Sup hu c hc ne hfin hU` is an upper bound of the chain `c`. -/
lemma le_chain_Sup {c : set (partial_refinement u s)} (hc : chain (≤) c)
  (ne : c.nonempty) (hfin : ∀ x ∈ s, finite {i | x ∈ u i}) (hU : s ⊆ ⋃ i, u i)
  {v} (hv : v ∈ c) :
  v ≤ chain_Sup c hc ne hfin hU :=
⟨λ i hi, mem_bUnion hv hi, λ i hi, (find_apply_of_mem hc _ hv hi).symm⟩

/-- If `s` is a closed set, `v` is a partial refinement, and `i` is an index such that
`i ∉ v.carrier`, then there exists a partial refinement that is strictly greater than `v`. -/
lemma exists_gt (v : partial_refinement u s) (hs : is_closed s) (i : ι) (hi : i ∉ v.carrier) :
  ∃ v' : partial_refinement u s, v < v' :=
begin
  have I : s ∩ (⋂ j ≠ i, (v j)ᶜ) ⊆ v i,
  { simp only [subset_def, mem_inter_eq, mem_Inter, and_imp],
    intros x hxs H,
    rcases mem_Union.1 (v.subset_Union hxs) with ⟨j, hj⟩,
    exact (em (j = i)).elim (λ h, h ▸ hj) (λ h, (H j h hj).elim) },
  have C : is_closed (s ∩ (⋂ j ≠ i, (v j)ᶜ)),
    from is_closed_inter hs (is_closed_bInter $ λ _ _, is_closed_compl_iff.2 $ v.is_open _),
  rcases normal_exists_closure_subset C (v.is_open i) I with ⟨vi, ovi, hvi, cvi⟩,
  refine ⟨⟨update v i vi, insert i v.carrier, _, _, _, _⟩, _, _⟩,
  { intro j, by_cases h : j = i; simp [h, ovi, v.is_open] },
  { refine λ x hx, mem_Union.2 _,
    rcases em (∃ j ≠ i, x ∈ v j) with ⟨j, hji, hj⟩|h,
    { use j, rwa update_noteq hji },
    { push_neg at h, use i, rw update_same, exact hvi ⟨hx, mem_bInter h⟩ } },
  { rintro j (rfl|hj),
    { rwa [update_same, ← v.apply_eq hi] },
    { rw update_noteq (ne_of_mem_of_not_mem hj hi), exact v.closure_subset hj } },
  { intros j hj,
    rw [mem_insert_iff, not_or_distrib] at hj,
    rw [update_noteq hj.1, v.apply_eq hj.2] },
  { refine ⟨subset_insert _ _, λ j hj, _⟩,
    exact (update_noteq (ne_of_mem_of_not_mem hj hi) _ _).symm },
  { exact λ hle, hi (hle.1 $ mem_insert _ _) }
end

end partial_refinement

end shrinking_lemma

open shrinking_lemma

variables {u : ι → set X} {s : set X}

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new open cover so that the closure of each new open set is contained in the corresponding
original open set. -/
lemma exists_subset_Union_closure_subset (hs : is_closed s) (uo : ∀ i, is_open (u i))
  (uf : ∀ x ∈ s, finite {i | x ∈ u i}) (us : s ⊆ ⋃ i, u i) :
  ∃ v : ι → set X, s ⊆ Union v ∧ (∀ i, is_open (v i)) ∧ ∀ i, closure (v i) ⊆ u i :=
begin
  classical,
  haveI : nonempty (partial_refinement u s) := ⟨⟨u, ∅, uo, us, λ _, false.elim, λ _ _, rfl⟩⟩,
  have : ∀ c : set (partial_refinement u s), chain (≤) c → c.nonempty → ∃ ub, ∀ v ∈ c, v ≤ ub,
    from λ c hc ne, ⟨partial_refinement.chain_Sup c hc ne uf us,
      λ v hv, partial_refinement.le_chain_Sup _ _ _ _ hv⟩,
  rcases zorn_nonempty_partial_order this with ⟨v, hv⟩,
  suffices : ∀ i, i ∈ v.carrier,
    from ⟨v, v.subset_Union, λ i, v.is_open _, λ i, v.closure_subset (this i)⟩,
  contrapose! hv,
  rcases hv with ⟨i, hi⟩,
  rcases v.exists_gt hs i hi with ⟨v', hlt⟩,
  exact ⟨v', hlt.le, hlt.ne'⟩
end

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new closed cover so that each new closed set is contained in the corresponding original open
set. See also `exists_subset_Union_closure_subset` for a stronger statement. -/
lemma exists_subset_Union_closed_subset (hs : is_closed s) (uo : ∀ i, is_open (u i))
  (uf : ∀ x ∈ s, finite {i | x ∈ u i}) (us : s ⊆ ⋃ i, u i) :
  ∃ v : ι → set X, s ⊆ Union v ∧ (∀ i, is_closed (v i)) ∧ ∀ i, v i ⊆ u i :=
let ⟨v, hsv, hvo, hv⟩ := exists_subset_Union_closure_subset hs uo uf us
in ⟨λ i, closure (v i), subset.trans hsv (Union_subset_Union $ λ i, subset_closure),
  λ i, is_closed_closure, hv⟩

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new open cover so that the closure of each new open set is contained in the corresponding
original open set. -/
lemma exists_Union_eq_closure_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, finite {i | x ∈ u i})
  (uU : (⋃ i, u i) = univ) :
  ∃ v : ι → set X, Union v = univ ∧ (∀ i, is_open (v i)) ∧ ∀ i, closure (v i) ⊆ u i :=
let ⟨v, vU, hv⟩ := exists_subset_Union_closure_subset is_closed_univ uo (λ x _, uf x) uU.ge
in ⟨v, univ_subset_iff.1 vU, hv⟩

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new closed cover so that each of the new closed sets is contained in the corresponding
original open set. See also `exists_Union_eq_closure_subset` for a stronger statement. -/
lemma exists_Union_eq_closed_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, finite {i | x ∈ u i})
  (uU : (⋃ i, u i) = univ) :
  ∃ v : ι → set X, Union v = univ ∧ (∀ i, is_closed (v i)) ∧ ∀ i, v i ⊆ u i :=
let ⟨v, vU, hv⟩ := exists_subset_Union_closed_subset is_closed_univ uo (λ x _, uf x) uU.ge
in ⟨v, univ_subset_iff.1 vU, hv⟩


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Group.basic
import Mathlib.group_theory.free_abelian_group
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
The free abelian group on a type is the left adjoint of the
forgetful functor from abelian groups to types.
-/

namespace AddCommGroup

/--
The free functor `Type u ⥤ AddCommGroup` sending a type `X` to the
free abelian group with generators `x : X`.
-/
def free : Type u ⥤ AddCommGroup :=
  category_theory.functor.mk (fun (α : Type u) => of (free_abelian_group α)) fun (X Y : Type u) => free_abelian_group.map

@[simp] theorem free_obj_coe {α : Type u} : ↥(category_theory.functor.obj free α) = free_abelian_group α :=
  rfl

@[simp] theorem free_map_coe {α : Type u} {β : Type u} {f : α → β} (x : free_abelian_group α) : coe_fn (category_theory.functor.map free f) x = f <$> x :=
  rfl

/--
The free-forgetful adjunction for abelian groups.
-/
def adj : free ⊣ category_theory.forget AddCommGroup :=
  category_theory.adjunction.mk_of_hom_equiv
    (category_theory.adjunction.core_hom_equiv.mk
      fun (X : Type u) (G : AddCommGroup) => free_abelian_group.hom_equiv X ↥G)


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

Borel (measurable) space -- the smallest σ-algebra generated by open sets

It would be nice to encode this in the topological space type class, i.e. each topological space
carries a measurable space, the Borel space. This would be similar how each uniform space carries a
topological space. The idea is to allow definitional equality for product instances.
We would like to have definitional equality for

  borel t₁ × borel t₂ = borel (t₁ × t₂)

Unfortunately, this only holds if t₁ and t₂ are second-countable topologies.
-/
import measure_theory.measurable_space topology.instances.ennreal
noncomputable theory

open classical set lattice real
local attribute [instance] prop_decidable

universes u v w x y
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} {ι : Sort y} {s t u : set α}

namespace measure_theory
open measurable_space topological_space

@[instance, priority 900] def borel (α : Type u) [topological_space α] : measurable_space α :=
generate_from {s : set α | is_open s}

lemma borel_eq_generate_from_of_subbasis {s : set (set α)}
  [t : topological_space α] [second_countable_topology α] (hs : t = generate_from s) :
  borel α = generate_from s :=
le_antisymm
  (generate_from_le $ assume u (hu : t.is_open u),
    begin
      rw [hs] at hu,
      induction hu,
      case generate_open.basic : u hu
      { exact generate_measurable.basic u hu },
      case generate_open.univ
      { exact @is_measurable.univ α (generate_from s) },
      case generate_open.inter : s₁ s₂ _ _ hs₁ hs₂
      { exact @is_measurable.inter α (generate_from s) _ _ hs₁ hs₂ },
      case generate_open.sUnion : f hf ih {
        rcases is_open_sUnion_countable f (by rwa hs) with ⟨v, hv, vf, vu⟩,
        rw ← vu,
        exact @is_measurable.sUnion α (generate_from s) _ hv
          (λ x xv, ih _ (vf xv)) }
    end)
  (generate_from_le $ assume u hu, generate_measurable.basic _ $
    show t.is_open u, by rw [hs]; exact generate_open.basic _ hu)

lemma borel_eq_generate_Iio (α)
  [topological_space α] [second_countable_topology α]
  [linear_order α] [orderable_topology α] :
  borel α = generate_from (range Iio) :=
begin
  refine le_antisymm _ (generate_from_le _),
  { rw borel_eq_generate_from_of_subbasis (orderable_topology.topology_eq_generate_intervals α),
    have H : ∀ a:α, is_measurable (measurable_space.generate_from (range Iio)) (Iio a) :=
      λ a, generate_measurable.basic _ ⟨_, rfl⟩,
    refine generate_from_le _, rintro _ ⟨a, rfl | rfl⟩; [skip, apply H],
    by_cases h : ∃ a', ∀ b, a < b ↔ a' ≤ b,
    { rcases h with ⟨a', ha'⟩,
      rw (_ : {b | a < b} = -Iio a'), {exact (H _).compl _},
      simp [set.ext_iff, ha'] },
    { rcases is_open_Union_countable
        (λ a' : {a' : α // a < a'}, {b | a'.1 < b})
        (λ a', is_open_lt' _) with ⟨v, ⟨hv⟩, vu⟩,
      simp [set.ext_iff] at vu,
      have : {b | a < b} = ⋃ x : v, -Iio x.1.1,
      { simp [set.ext_iff],
        refine λ x, ⟨λ ax, _, λ ⟨a', ⟨h, av⟩, ax⟩, lt_of_lt_of_le h ax⟩,
        rcases (vu x).2 _ with ⟨a', h₁, h₂⟩,
        { exact ⟨a', h₁, le_of_lt h₂⟩ },
        refine not_imp_comm.1 (λ h, _) h,
        exact ⟨x, λ b, ⟨λ ab, le_of_not_lt (λ h', h ⟨b, ab, h'⟩),
          lt_of_lt_of_le ax⟩⟩ },
      rw this, resetI,
      apply is_measurable.Union,
      exact λ _, (H _).compl _ } },
  { simp, rintro _ a rfl,
    exact generate_measurable.basic _ is_open_Iio }
end

lemma borel_eq_generate_Ioi (α)
  [topological_space α] [second_countable_topology α]
  [linear_order α] [orderable_topology α] :
  borel α = generate_from (range (λ a, {x | a < x})) :=
begin
  refine le_antisymm _ (generate_from_le _),
  { rw borel_eq_generate_from_of_subbasis (orderable_topology.topology_eq_generate_intervals α),
    have H : ∀ a:α, is_measurable (measurable_space.generate_from (range (λ a, {x | a < x}))) {x | a < x} :=
      λ a, generate_measurable.basic _ ⟨_, rfl⟩,
    refine generate_from_le _, rintro _ ⟨a, rfl | rfl⟩, {apply H},
    by_cases h : ∃ a', ∀ b, b < a ↔ b ≤ a',
    { rcases h with ⟨a', ha'⟩,
      rw (_ : {b | b < a} = -{x | a' < x}), {exact (H _).compl _},
      simp [set.ext_iff, ha'] },
    { rcases is_open_Union_countable
        (λ a' : {a' : α // a' < a}, {b | b < a'.1})
        (λ a', is_open_gt' _) with ⟨v, ⟨hv⟩, vu⟩,
      simp [set.ext_iff] at vu,
      have : {b | b < a} = ⋃ x : v, -{b | x.1.1 < b},
      { simp [set.ext_iff],
        refine λ x, ⟨λ ax, _, λ ⟨a', ⟨h, av⟩, ax⟩, lt_of_le_of_lt ax h⟩,
        rcases (vu x).2 _ with ⟨a', h₁, h₂⟩,
        { exact ⟨a', h₁, le_of_lt h₂⟩ },
        refine not_imp_comm.1 (λ h, _) h,
        exact ⟨x, λ b, ⟨λ ab, le_of_not_lt (λ h', h ⟨b, ab, h'⟩),
          λ h, lt_of_le_of_lt h ax⟩⟩ },
      rw this, resetI,
      apply is_measurable.Union,
      exact λ _, (H _).compl _ } },
  { simp, rintro _ a rfl,
    exact generate_measurable.basic _ (is_open_lt' _) }
end

lemma borel_comap {f : α → β} {t : topological_space β} :
  @borel α (t.induced f) = (@borel β t).comap f :=
calc @borel α (t.induced f) =
    measurable_space.generate_from (preimage f '' {s | is_open s }) :
      congr_arg measurable_space.generate_from $ set.ext $ assume s : set α,
      show (t.induced f).is_open s ↔ s ∈ preimage f '' {s | is_open s},
        by simp [topological_space.induced, set.image, eq_comm]; refl
  ... = (@borel β t).comap f : comap_generate_from.symm

section
variables [topological_space α]

lemma is_measurable_of_is_open : is_open s → is_measurable s := generate_measurable.basic s

lemma is_measurable_interior : is_measurable (interior s) :=
is_measurable_of_is_open is_open_interior

lemma is_measurable_of_is_closed (h : is_closed s) : is_measurable s :=
is_measurable.compl_iff.1 $ is_measurable_of_is_open h

lemma is_measurable_closure : is_measurable (closure s) :=
is_measurable_of_is_closed is_closed_closure

lemma measurable_of_continuous [topological_space β] {f : α → β} (h : continuous f) :
  measurable f :=
measurable_generate_from $ assume t ht, is_measurable_of_is_open $ h t ht

lemma borel_prod_le [topological_space β] :
  prod.measurable_space ≤ borel (α × β) :=
sup_le
  (comap_le_iff_le_map.mpr $ measurable_of_continuous continuous_fst)
  (comap_le_iff_le_map.mpr $ measurable_of_continuous continuous_snd)

lemma borel_induced [t : topological_space β] (f : α → β) :
  @borel α (t.induced f) = (borel β).comap f :=
comap_generate_from.symm

lemma borel_eq_subtype [topological_space α] (s : set α) : borel s = subtype.measurable_space :=
borel_induced coe

lemma borel_prod [second_countable_topology α] [topological_space β] [second_countable_topology β] :
  prod.measurable_space = borel (α × β) :=
let ⟨a, ha₁, ha₂, ha₃, ha₄, ha₅⟩ := @is_open_generated_countable_inter α _ _ in
let ⟨b, hb₁, hb₂, hb₃, hb₄, hb₅⟩ := @is_open_generated_countable_inter β _ _ in
le_antisymm borel_prod_le begin
    have : prod.topological_space = generate_from {g | ∃u∈a, ∃v∈b, g = set.prod u v},
    { rw [ha₅, hb₅], exact prod_generate_from_generate_from_eq ha₄ hb₄ },
    rw [borel_eq_generate_from_of_subbasis this],
    exact generate_from_le (assume p ⟨u, hu, v, hv, eq⟩,
      have hu : is_open u, by rw [ha₅]; exact generate_open.basic _ hu,
      have hv : is_open v, by rw [hb₅]; exact generate_open.basic _ hv,
      eq.symm ▸ is_measurable_set_prod (is_measurable_of_is_open hu) (is_measurable_of_is_open hv))
end

lemma measurable_of_continuous2
  [topological_space α] [second_countable_topology α]
  [topological_space β] [second_countable_topology β]
  [topological_space γ] [measurable_space δ] {f : δ → α} {g : δ → β} {c : α → β → γ}
  (h : continuous (λp:α×β, c p.1 p.2)) (hf : measurable f) (hg : measurable g) :
  measurable (λa, c (f a) (g a)) :=
show measurable ((λp:α×β, c p.1 p.2) ∘ (λa, (f a, g a))),
begin
  apply measurable.comp,
  { exact measurable_prod_mk hf hg },
  { rw borel_prod,
    exact measurable_of_continuous h }
end

lemma measurable_add
  [add_monoid α] [topological_add_monoid α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a + g a) :=
measurable_of_continuous2 continuous_add'

lemma measurable_finset_sum {ι : Type*}
  [add_comm_monoid α] [topological_add_monoid α] [second_countable_topology α] [measurable_space β]
  {f : ι → β → α} (s : finset ι) (hf : ∀i, measurable (f i)) : measurable (λa, s.sum (λi, f i a)) :=
finset.induction_on s
  (by simpa using measurable_const)
  (assume i s his ih, by simpa [his] using measurable_add (hf i) ih)

lemma measurable_neg
  [add_group α] [topological_add_group α] [measurable_space β] {f : β → α}
  (hf : measurable f) : measurable (λa, - f a) :=
hf.comp (measurable_of_continuous continuous_neg')

lemma measurable_sub
  [add_group α] [topological_add_group α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a - g a) :=
measurable_of_continuous2 continuous_sub'

lemma measurable_mul
  [monoid α] [topological_monoid α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a * g a) :=
measurable_of_continuous2 continuous_mul'

lemma measurable_le {α β}
  [topological_space α] [partial_order α] [ordered_topology α] [second_countable_topology α]
  [measurable_space β] {f : β → α} {g : β → α} (hf : measurable f) (hg : measurable g) :
  is_measurable {a | f a ≤ g a} :=
have is_measurable {p : α × α | p.1 ≤ p.2},
  by rw borel_prod; exact is_measurable_of_is_closed (ordered_topology.is_closed_le' _),
show is_measurable {a | (f a, g a).1 ≤ (f a, g a).2},
begin
  refine measurable.preimage _ this,
  exact measurable_prod_mk hf hg
end

-- generalize
lemma measurable_coe_int_real : measurable (λa, a : ℤ → ℝ) :=
assume s (hs : is_measurable s), by trivial

section ordered_topology
variables [linear_order α] [topological_space α] [ordered_topology α] {a b c : α}

lemma is_measurable_Ioo : is_measurable (Ioo a b) := is_measurable_of_is_open is_open_Ioo

lemma is_measurable_Iio : is_measurable (Iio a) := is_measurable_of_is_open is_open_Iio

lemma is_measurable_Ico : is_measurable (Ico a b) :=
(is_measurable_of_is_closed $ is_closed_le continuous_const continuous_id).inter
  is_measurable_Iio

end ordered_topology

lemma measurable.is_lub {α} [topological_space α] [linear_order α]
  [orderable_topology α] [second_countable_topology α]
  {β} [measurable_space β] {ι} [encodable ι]
  {f : ι → β → α} {g : β → α} (hf : ∀ i, measurable (f i))
  (hg : ∀ b, is_lub {a | ∃ i, f i b = a} (g b)) :
  measurable g :=
begin
  rw borel_eq_generate_Ioi α,
  apply measurable_generate_from,
  rintro _ ⟨a, rfl⟩,
  have : {b | a < g b} = ⋃ i, {b | a < f i b},
  { simp [set.ext_iff], intro b, rw [lt_is_lub_iff (hg b)],
    exact ⟨λ ⟨_, ⟨i, rfl⟩, h⟩, ⟨i, h⟩, λ ⟨i, h⟩, ⟨_, ⟨i, rfl⟩, h⟩⟩ },
  show is_measurable {b | a < g b}, rw this,
  exact is_measurable.Union (λ i, hf i _
    (is_measurable_of_is_open (is_open_lt' _)))
end

lemma measurable.is_glb {α} [topological_space α] [linear_order α]
  [orderable_topology α] [second_countable_topology α]
  {β} [measurable_space β] {ι} [encodable ι]
  {f : ι → β → α} {g : β → α} (hf : ∀ i, measurable (f i))
  (hg : ∀ b, is_glb {a | ∃ i, f i b = a} (g b)) :
  measurable g :=
begin
  rw borel_eq_generate_Iio α,
  apply measurable_generate_from,
  rintro _ ⟨a, rfl⟩,
  have : {b | g b < a} = ⋃ i, {b | f i b < a},
  { simp [set.ext_iff], intro b, rw [is_glb_lt_iff (hg b)],
    exact ⟨λ ⟨_, ⟨i, rfl⟩, h⟩, ⟨i, h⟩, λ ⟨i, h⟩, ⟨_, ⟨i, rfl⟩, h⟩⟩ },
  show is_measurable {b | g b < a}, rw this,
  exact is_measurable.Union (λ i, hf i _
    (is_measurable_of_is_open (is_open_gt' _)))
end

lemma measurable.supr {α} [topological_space α] [complete_linear_order α]
  [orderable_topology α] [second_countable_topology α]
  {β} [measurable_space β] {ι} [encodable ι]
  {f : ι → β → α} (hf : ∀ i, measurable (f i)) :
  measurable (λ b, ⨆ i, f i b) :=
measurable.is_lub hf $ λ b, is_lub_supr

lemma measurable.infi {α} [topological_space α] [complete_linear_order α]
  [orderable_topology α] [second_countable_topology α]
  {β} [measurable_space β] {ι} [encodable ι]
  {f : ι → β → α} (hf : ∀ i, measurable (f i)) :
  measurable (λ b, ⨅ i, f i b) :=
measurable.is_glb hf $ λ b, is_glb_infi

end

end measure_theory

def homemorph.to_measurable_equiv [topological_space α] [topological_space β] (h : α ≃ₜ β) :
  measurable_equiv α β :=
{ to_equiv := h.to_equiv,
  measurable_to_fun := measure_theory.measurable_of_continuous h.continuous_to_fun,
  measurable_inv_fun := measure_theory.measurable_of_continuous h.continuous_inv_fun }

namespace real
open measure_theory measurable_space

lemma borel_eq_generate_from_Ioo_rat :
  borel ℝ = generate_from (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
borel_eq_generate_from_of_subbasis is_topological_basis_Ioo_rat.2.2

lemma borel_eq_generate_from_Iio_rat :
  borel ℝ = generate_from (⋃a:ℚ, {Iio a}) :=
begin
  let g, swap,
  apply le_antisymm (_ : _ ≤ g) (measurable_space.generate_from_le (λ t, _)),
  { rw borel_eq_generate_from_Ioo_rat,
    refine generate_from_le (λ t, _),
    simp only [mem_Union], rintro ⟨a, b, h, rfl|⟨⟨⟩⟩⟩,
    rw (set.ext (λ x, _) : Ioo (a:ℝ) b = (⋃c>a, - Iio c) ∩ Iio b),
    { have hg : ∀q:ℚ, g.is_measurable (Iio q) :=
        λ q, generate_measurable.basic _ (by simp; exact ⟨_, rfl⟩),
      refine @is_measurable.inter _ g _ _ _ (hg _),
      refine @is_measurable.bUnion _ _ g _ _ (countable_encodable _) (λ c h, _),
      exact @is_measurable.compl _ _ g (hg _) },
    { simp [Ioo, Iio],
      refine and_congr _ iff.rfl,
      exact ⟨λ h,
        let ⟨c, ac, cx⟩ := exists_rat_btwn h in
        ⟨c, rat.cast_lt.1 ac, le_of_lt cx⟩,
       λ ⟨c, ac, cx⟩, lt_of_lt_of_le (rat.cast_lt.2 ac) cx⟩ } },
  { simp, rintro r rfl,
    exact is_measurable_of_is_open (is_open_gt' _) }
end

end real

namespace ennreal
open filter measure_theory

lemma measurable_coe : measurable (coe : nnreal → ennreal) :=
measurable_of_continuous (continuous_coe.2 continuous_id)

def ennreal_equiv_nnreal : measurable_equiv {r : ennreal | r < ⊤} nnreal :=
{ to_fun    := λr, ennreal.to_nnreal r.1,
  inv_fun   := λr, ⟨r, coe_lt_top⟩,
  left_inv  := assume ⟨r, hr⟩, by simp [coe_to_nnreal (ne_of_lt hr)],
  right_inv := assume r, to_nnreal_coe,
  measurable_to_fun  :=
  begin
    rw [← borel_eq_subtype],
    refine measurable_of_continuous (continuous_iff_continuous_at.2 _),
    rintros ⟨r, hr⟩,
    simp [continuous_at, nhds_subtype_eq_comap],
    refine tendsto.comp tendsto_comap (tendsto_to_nnreal (ne_of_lt hr))
  end,
  measurable_inv_fun := measurable_subtype_mk measurable_coe }

lemma measurable_of_measurable_nnreal [measurable_space α] {f : ennreal → α}
  (h : measurable (λp:nnreal, f p)) : measurable f :=
begin
  refine measurable_of_measurable_union_cover {⊤} {r : ennreal | r < ⊤}
    (is_measurable_of_is_closed $ is_closed_singleton)
    (is_measurable_of_is_open $ is_open_gt' _)
    (assume r _, by cases r; simp [ennreal.none_eq_top, ennreal.some_eq_coe])
    _
    _,
  exact (measurable_equiv.set.singleton ⊤).symm.measurable_coe_iff.1 (measurable_unit _),
  exact (ennreal_equiv_nnreal.symm.measurable_coe_iff.1 h)
end

def ennreal_equiv_sum :
  @measurable_equiv ennreal (nnreal ⊕ unit) _ sum.measurable_space :=
{ to_fun    :=
    @option.rec nnreal (λ_, nnreal ⊕ unit) (sum.inr ()) (sum.inl : nnreal → nnreal ⊕ unit),
  inv_fun   :=
    @sum.rec nnreal unit (λ_, ennreal) (coe : nnreal → ennreal) (λ_, ⊤),
  left_inv  := assume s, by cases s; refl,
  right_inv := assume s, by rcases s with r | ⟨⟨⟩⟩; refl,
  measurable_to_fun  := measurable_of_measurable_nnreal measurable_inl,
  measurable_inv_fun := measurable_sum measurable_coe (@measurable_const ennreal unit _ _ ⊤) }

lemma measurable_of_measurable_nnreal_nnreal [measurable_space α] [measurable_space β]
  (f : ennreal → ennreal → β) {g : α → ennreal} {h : α → ennreal}
  (h₁ : measurable (λp:nnreal × nnreal, f p.1 p.2))
  (h₂ : measurable (λr:nnreal, f ⊤ r))
  (h₃ : measurable (λr:nnreal, f r ⊤))
  (hg : measurable g) (hh : measurable h) : measurable (λa, f (g a) (h a)) :=
let e : measurable_equiv (ennreal × ennreal)
  (((nnreal × nnreal) ⊕ (nnreal × unit)) ⊕ ((unit × nnreal) ⊕ (unit × unit))) :=
  (measurable_equiv.prod_congr ennreal_equiv_sum ennreal_equiv_sum).trans
    (measurable_equiv.sum_prod_sum _ _ _ _) in
have measurable (λp:ennreal×ennreal, f p.1 p.2),
begin
  refine e.symm.measurable_coe_iff.1 (measurable_sum (measurable_sum _ _) (measurable_sum _ _)),
  { show measurable (λp:nnreal × nnreal, f p.1 p.2),
    exact h₁ },
  { show measurable (λp:nnreal × unit, f p.1 ⊤),
    exact (measurable_fst measurable_id).comp h₃ },
  { show measurable ((λp:nnreal, f ⊤ p) ∘ (λp:unit × nnreal, p.2)),
    exact measurable.comp (measurable_snd measurable_id) h₂ },
  { show measurable (λp:unit × unit, f ⊤ ⊤),
    exact measurable_const }
end,
(measurable_prod_mk hg hh).comp this

lemma measurable_mul {α : Type*} [measurable_space α] {f g : α → ennreal} :
  measurable f → measurable g → measurable (λa, f a * g a) :=
begin
  refine measurable_of_measurable_nnreal_nnreal (*) _ _ _,
  { simp only [ennreal.coe_mul.symm],
    exact (measurable_mul (measurable_fst measurable_id) (measurable_snd measurable_id)).comp
      measurable_coe },
  { simp [top_mul],
    exact measurable.if
      (is_measurable_of_is_closed $ is_closed_eq continuous_id continuous_const)
      measurable_const
      measurable_const },
  { simp [mul_top],
    exact measurable.if
      (is_measurable_of_is_closed $ is_closed_eq continuous_id continuous_const)
      measurable_const
      measurable_const }
end

end ennreal


import data.nat.prime
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We will use basic definitions about primes and divisibility taken from the mathlib
 library.  The home page of the library is
 https://github.com/leanprover/mathlib
 and you can browse and search the source code there.  If you set things up in a standard
 way, you should have a copy of the library in more or less the same place as your own
 Lean files, with directory structure like this:

.git: a director that we can ignore.

.gitignore,
      leanpkg.path,
      leanpkg.toml: files that we can ignore

_target

deps

mathlib

Subdirectories algebra, analysis, category, computability, data, ....
         These contain uncompiled, human-readable files with extension .lean,
	 and also compiled files with extension .olean.

src

Your own Lean files, such as the one shown here.

 The line `import data.nat.prime` allows us to use definitions
 and results from the file data/nat/prime.lean.  For
 example, that file proves that $2$ is prime, and gives the name
 `prime_two` to that fact.  (However, see the comment on the next line.)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
open nat
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  The file data/nat/prime.lean proves
  a nnumber of facts.  For example, it proves that $2$
  is prime, and gives the name `prime_two` to that fact.
  However, the same file also says `namespace nat` near the top.
  Because of this, the full name of the relevant theorem is really
  `nat.prime_two`.  The line `open nat`
  in the current file allows us to drop the `nat` prefix.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/

lemma larger_prime : ∀ n : ℕ, ∃ p, (prime p) ∧ (p > n) :=
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  This line states the result that we want to prove, and attaches the name
  `larger_prime` to the result.

There are various symbols that do not appear on your keyboard.  These
    can usually be entered in Visual Studio Code using LaTeX syntax.  For example,
    you can type `\forall` followed by a space, and the
    `\forall` will automatically turn into into
    `∀`.  For
    `ℕ`, `ℤ`,
    `ℚ` and `ℝ` one can enter
    `\nat`, `\int`,
    `\rat` and `\real`.

To indicate that $n$ is in $ℕ$ we write `n : ℕ`
    rather than `n ∈ ℕ`, following the conventions of type
    theory rather than set theory.

The expression `prime p` refers to the definition of primality
    taken from the file data/nat/prime.lean.
    That definition essentially gives a function from natural numbers to
    truth values.  To apply that function to the argument $p$, we write `prime p`
    (following the conventions of Lisp-like programming languages) rather than
    `prime(p)` as in traditional functional notation.
    Note that if we had not had the line `open nat`, we
    would have had to say `nat.prime p` instead of
    `prime p`.

Note the commas associated with the quantifiers, and the
    `:=` at the end of the line.  If you have this file
    open in Visual Studio Code, and you take out the first comma, then you should
    see three error messages in the Lean messages window.  (If you do not see the
    relevant window, you should press CTRL-SHIFT-ENTER, or click the
     icon near the top of the screen.)
    None of those error messages is optimal, but
    unknown identifier 'n' gives some indication of
    the location of the problem.  On the other hand, if you leave out the
    := then the error messages are completely opaque.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
begin
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  This marks the beginning of the proof.  For some simple kinds of proofs
  it is not necessary to have a `begin ... end` wrapper.  For some
  complicated proofs there will be nested `begin ... end` blocks to
  prove various intermediate claims that arise in the course of the proof.

  Inside the `begin ... end` block, we enter
  "tactic mode", as discussed in Chapter 5 of the book
  Theorem
  Proving in Lean.  (References to "Chapter n" or "Section p.q" below
  will always refer to this book.)  This can be explained as follows.  A
  Lean proof is a kind of complex data structure.  Outside of tactic mode,
  we can construct a proof by programming methods, in which we explicitly
  apply various functions to simpler structures that we have already defined.
  Inside tactic mode, we can construct proofs by a kind of dialogue with
  the proof assistant, which is much more similar to a traditional
  writer's imagined dialogue with the reader.

  If you have this file open in Visual Studio Code, and you click at the
  end of the word `begin`, you should see a message like this in the
  Lean messages window:

   ⊢ ∀ (n : ℕ), ∃ (p : ℕ), prime p ∧ p > n

  This states our current proof goal.  (If you do not see the relevant
  window, you should press CTRL-SHIFT-ENTER, or click the
   icon near the top of the
  screen.)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 intro n,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  We are aiming to prove a statement that is universally quantified over the
  natural numbers.  In traditional writing, we would start by saying "let $n$
  be an arbitrary natural number", or some similar phrase.  The line
  `intro n,` plays a similar role in Lean.

  If you click on the end of this line in VS Code, you will see that the tactic
  state has changed to

    n : ℕ
    ⊢ ∃ (p : ℕ), prime p ∧ p > n

  This means, essentially, that we are working in a context where we have a given
  natural number $n$, and we aim to prove that there is a prime $p$ with $p>n$.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 let m := fact n + 1,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  We now define $m$ to be $n!+1$.  Again note the terminating comma.  The tactic
  state changes to

   n : ℕ,
   m : ℕ := fact n + 1
   ⊢ ∃ (p : ℕ), prime p ∧ p > n

  incorporating the definition of $m$ in the context.

  In VS Code you can hover over the word `fact` with
  your mouse to see that the full name is `nat.fact`
  and that the type is `ℕ → ℕ`, and there is also a
  comment explaining that `fact` is the factorial
  function.  If you hold the CTRL key while hovering, you will see the actual
  recursive definition of the function.  If you hold the CTRL key and click,
  then you will jump to the file where that definition appears.  Alternatively,
  you can right-click and then type F12 or Alt-F12.
  For this particular definition, the relevant file is
  data/nat/basic.lean.  Note that we did not
  explicitly import `data.nat.basic`, but we
  imported `data.nat.prime`, which imports
  `data.nat.sqrt`, which imports
  `data.nat.basic`.  Some standard properties of
  factorials are proved in the same place.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 let p := min_fac m,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 This line defines $p$ using the function `min_fac`
 defined in data/nat/basic.lean.  This is
 supposed to be defined by the requirement that
 `min_fac k` is the smallest $d>1$ such that $d$
 divides $k$.  This makes sense for $k=0$ (with
 `min_fac 0 = 2`) and for $k>1$, but this
 characterisation would leave `min_fac 1` undefined.
 The approach taken by the Lean library is to arbitrarily define
 `min_fac 1 = 1`.  This of course means that some
 theorems about the properties of `min_fac` will
 need auxiliary hypotheses.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have m_gt_1 : m > 1, {apply nat.succ_lt_succ,apply fact_pos},
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now want to show that $m>1$.  We use the keyword
 `have` to state this fact, and introduce the name
 `m_gt_1` for it.  (It is possible to reorganise
 the proof to avoid introducing names for minor intermediate facts like this,
 and many experts seem to prefer that style.  However, we feel that such
 names make it much easier for the neophyte to understand what is happening.)
 The proof of `m_gt_1` involves two ingredients:

The fact that $n!>0$, which is proved in
   data/nat/basic.lean under the name
   `fact_pos`.

The fact that $a>b$ implies $a+1>b+1$.  This does not come from mathlib,
   but from the core Lean library.  The relevant file is
   init/data/nat/lemmas.lean under the
   lib/lean/library/ directory of the Lean
   installation, which may well be a system directory rather than a user
   directory.  The name of this fact is `succ_lt_succ`.  (Here `lt` stands
   for "less than", and `succ` refers to the successor operation
   $a\mapsto a+1$.  As in Peano arithmetic, addition is actually defined in
   terms of the successor operation rather than the other way around.)

  In VS Code, it is illuminating to click in various places in the above
  line and examine how the goal state changes as we state the claim that
  $m>1$, use `succ_lt_succ` to reduce to the claim that $n!>0$, and then
  appeal to `fact_pos` to prove the reduced claim.  Note also that the
  keyword  `apply` refers to a "tactic", which manipulates the goal
  state.  Proof tactics in general are described in
  Chapter 5.  One can hover over the word
  `apply` to see some information about how this tactic works.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have m_ne_1 : m ≠ 1 := ne_of_gt m_gt_1,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now deduce that $m\neq 1$.  This uses the result named `ne_of_gt`,
 which says that $a>b\Rightarrow a\neq b$.  Systems like Lean are set
 up so that a proof of $P\Rightarrow Q$ is essentially the same thing
 as a function from proofs of $P$ to proofs of $Q$.  Here `m_gt_1` is
 a proof that $m>1$, and we are applying `ne_of_gt` to it to get a
 proof that $m\neq 1$.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have p_gt_0 : p > 0, {apply min_fac_pos},
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now state that $p>0$, attach the name `p_gt_0` to this claim, and
 prove it by applying the theorem named `min_fac_pos` from
 data/nat/prime.lean.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have p_prime : prime p := min_fac_prime m_ne_1,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now state that $p$ is prime, attach the name `p_prime`
 to this claim, and prove it by applying the theorem named
 `min_fac_prime` from
 data/nat/prime.lean.

 Recall that `min_fac n` was arbitrarily defined to be
 $1$ when $n=1$, so the theorem that `min_fac n` is prime
 is only valid with the side condition that $n\neq 1$.  The theorem
 `min_fac_prime` is essentially a function that takes
 as input a natural number $n$ together with a proof that $n\neq 1$, and produces
 a proof that `min_fac n` is prime.  However, things are
 set up in such a way that a proof of $n\neq 1$ contains the value of $n$ as part
 of the data, so we do not need to supply $n$ explicitly.  This kind of thing
 is handled by Lean's framework of implicit arguments.  The declaration of
 `min_fac_prime` has the shape

  theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) := ...

 with the curly brackets around `{n : ℕ}` indicating that
 $n$ will be determined from the context.  (If for some reason we want to supply
 $n$ explicitly, we can use the notation `@min_fac_prime`
 instead of `min_fac_prime`.)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have not_p_le_n : ¬ p ≤ n, {
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now state and prove the negation of $p\leq n$.  It is part of the basic logical
 framework of Lean that a proof of this negation is the same as a procedure that
 takes a hypothetical proof of $p\leq n$ and produces a contradiction.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
  intro p_le_n,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 This line means: "let `p_le_n` be a hypothetical proof
 that $p\leq n$".  Given such a hypothetical proof, we need to produce a contradiction.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
  have d0 : p ∣ fact n := dvd_fact p_gt_0 p_le_n,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  We now prove that $p$ divides $n!$.  The proof appeals to the fact (named
  `dvd_fact`) that $a$ divides
  $b!$ whenever $a>0$ and $a\leq b$.  We supply the explicit arguments
  `p_gt_0` and `p_le_n` to
  verify the hypotheses; the implicit arguments $p$ and $n$ are deduced from
  the context.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
  have d1 : p ∣ fact n + 1 := min_fac_dvd m,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now claim that $p$ divides $m=n! + 1$.  As $p$ was defined to be
 `min_fac m`, this amounts to the claim that the
 `min_fac` function was correctly defined.  This was proved in
 `prime.lean` under the name
 `min_fac_dvd`.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
  have d  : p ∣ 1 := (nat.dvd_add_iff_right d0).mpr d1,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now want to prove that $p$ divides $1$.  For this we appeal to the fact that
 if $a$ divides $b$, then $a$ divides $c$ iff $a$ divides $b+c$.  This fact has
 the name `dvd_add_iff_right`.  Unfortunately, there are
 two versions of this fact that are currently visible.  One of them comes from
 the file init/algebra/ring.lean, and applies
 to an arbitrary commutative ring.  The other comes from
 init/data/nat/lemmas.lean, and
 applies only to `ℕ` (which is a semiring rather than a ring).
 Note that both of these are in the core Lean library, not in mathlib.  We need to
 use the version for `ℕ`, so we need to resolve the
 ambiguity by providing the explicit prefix in
 `nat.dvd_add_iff_right`.

 By applying `nat.dvd_add_iff_right` to
 `d0`, we obtain a proof that $p$ divides $n!+1$ iff $p$
 divides $1$.  The syntax `(...).mpr` extracts the
 right-to-left half of this equivalence, which we can then apply to the fact
 `d1` to obtain a proof that $p$ divides $1$.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
  exact prime.not_dvd_one p_prime d
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Our goal is to produce a contradiction, or equivalently to prove the proposition
 `false`.  We do this using the keyword
 `exact` (which is the name of a kind of tautological tactic)
 followed by an expression that evaluates to `false`.  The
 theorem `prime.not_dvd_one` says that no prime divides $1$.
 Equivalently, it is a function that accepts a proof that a number is prime, together
 with a proof that that number divides $1$, and produces
 `false`.  We can thus apply
 `prime.not_dvd_one` to the ingredients
 `p_prime` and `d` to obtain the
 required contradiction.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 },
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 have p_gt_n : p > n := lt_of_not_ge not_p_le_n,
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We now use the result `lt_of_not_ge` to convert our proof
 of `¬ p ≤ n` to a proof of $p > n$.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
 existsi p,split,exact p_prime,exact p_gt_n
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We are now ready to wrap up.  The proof goal is to prove that there exists a number
 with certain properties.  We use the `existsi` tactic to
 introduce the number that we claim has the relevant properties.  This changes the
 proof goal: we now need to prove that $p$ is prime and $p>n$.  These two claims are
 initially combined as the single goal `(prime p) ∧ (p > n)`.
 We use the `split` tactic to divide this into two goals
 `prime p` and `p > n`.  We have
 already proved these two facts under the names `p_prime`
 and `p_gt_n`, so we can just use the
 `exact` tactic twice to complete the proof.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/
end
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/

#check larger_prime
/-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Lean accepts correct proofs without explicit acknowledgement.  To
get more positive feedback, we can enter
`#check larger_prime`: this will restate
the fact that we have proved in the message window.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-/


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

! This file was ported from Lean 3 source module order.filter.countable_Inter
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Basic
import Mathlib.Data.Set.Countable

/-!
# Filters with countable intersection property

In this file we define `CountableInterFilter` to be the class of filters with the following
property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.

Two main examples are the `residual` filter defined in `Mathlib.Topology.MetricSpace.Baire` and
the `measure.ae` filter defined in `measure_theory.measure_space`.

We reformulate the definition in terms of indexed intersection and in terms of `filter.eventually`
and provide instances for some basic constructions (`⊥`, `⊤`, `Filter.principal`, `Filter.map`,
`Filter.comap`, `Inf.inf`). We also provide a custom constructor `Filter.ofCountableInter`
that deduces two axioms of a `Filter` from the countable intersection property.

## Tags
filter, countable
-/

open Set Filter

open Filter

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

/-- A filter `l` has the countable intersection property if for any countable collection
of sets `s ∈ l` their intersection belongs to `l` as well. -/
class CountableInterFilter (l : Filter α) : Prop where
  /-- For a countable collection of sets `s ∈ l`, their intersection belongs to `l` as well. -/
  countable_interₛ_mem : ∀ S : Set (Set α), S.Countable → (∀ s ∈ S, s ∈ l) → ⋂₀ S ∈ l
#align countable_Inter_filter CountableInterFilter

variable {l : Filter α} [CountableInterFilter l]

theorem countable_interₛ_mem {S : Set (Set α)} (hSc : S.Countable) : ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
  ⟨fun hS _s hs => mem_of_superset hS (interₛ_subset_of_mem hs),
    CountableInterFilter.countable_interₛ_mem _ hSc⟩
#align countable_sInter_mem countable_interₛ_mem

theorem countable_interᵢ_mem [Countable ι] {s : ι → Set α} : (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
  interₛ_range s ▸ (countable_interₛ_mem (countable_range _)).trans forall_range_iff
#align countable_Inter_mem countable_interᵢ_mem

theorem countable_bInter_mem {ι : Type _} {S : Set ι} (hS : S.Countable) {s : ∀ i ∈ S, Set α} :
    (⋂ i, ⋂ hi : i ∈ S, s i ‹_›) ∈ l ↔ ∀ i, ∀ hi : i ∈ S, s i ‹_› ∈ l := by
  rw [binterᵢ_eq_interᵢ]
  haveI := hS.toEncodable
  exact countable_interᵢ_mem.trans Subtype.forall
#align countable_bInter_mem countable_bInter_mem

theorem eventually_countable_forall [Countable ι] {p : α → ι → Prop} :
    (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i := by
  simpa only [Filter.Eventually, setOf_forall] using
    @countable_interᵢ_mem _ _ l _ _ fun i => { x | p x i }
#align eventually_countable_forall eventually_countable_forall

theorem eventually_countable_ball {ι : Type _} {S : Set ι} (hS : S.Countable)
    {p : α → ∀ i ∈ S, Prop} :
    (∀ᶠ x in l, ∀ i hi, p x i hi) ↔ ∀ i hi, ∀ᶠ x in l, p x i hi := by
  simpa only [Filter.Eventually, setOf_forall] using
    @countable_bInter_mem _ l _ _ _ hS fun i hi => { x | p x i hi }
#align eventually_countable_ball eventually_countable_ball

theorem EventuallyLE.countable_unionᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
    (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
  (eventually_countable_forall.2 h).mono fun _ hst hs => mem_unionᵢ.2 <| (mem_unionᵢ.1 hs).imp hst
#align eventually_le.countable_Union EventuallyLE.countable_unionᵢ

theorem EventuallyEq.countable_unionᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i =ᶠ[l] t i) :
    (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
  (EventuallyLE.countable_unionᵢ fun i => (h i).le).antisymm
    (EventuallyLE.countable_unionᵢ fun i => (h i).symm.le)
#align eventually_eq.countable_Union EventuallyEq.countable_unionᵢ

theorem EventuallyLE.countable_bUnion {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i hi, s i hi ≤ᶠ[l] t i hi) :
    (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› := by
  simp only [bunionᵢ_eq_unionᵢ]
  haveI := hS.toEncodable
  exact EventuallyLE.countable_unionᵢ fun i => h i i.2
#align eventually_le.countable_bUnion EventuallyLE.countable_bUnion

theorem EventuallyEq.countable_bUnion {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i hi, s i hi =ᶠ[l] t i hi) :
    (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
  (EventuallyLE.countable_bUnion hS fun i hi => (h i hi).le).antisymm
    (EventuallyLE.countable_bUnion hS fun i hi => (h i hi).symm.le)
#align eventually_eq.countable_bUnion EventuallyEq.countable_bUnion

theorem EventuallyLE.countable_interᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
    (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
  (eventually_countable_forall.2 h).mono fun _ hst hs =>
    mem_interᵢ.2 fun i => hst _ (mem_interᵢ.1 hs i)
#align eventually_le.countable_Inter EventuallyLE.countable_interᵢ

theorem EventuallyEq.countable_interᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i =ᶠ[l] t i) :
    (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
  (EventuallyLE.countable_interᵢ fun i => (h i).le).antisymm
    (EventuallyLE.countable_interᵢ fun i => (h i).symm.le)
#align eventually_eq.countable_Inter EventuallyEq.countable_interᵢ

theorem EventuallyLE.countable_bInter {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i hi, s i hi ≤ᶠ[l] t i hi) :
    (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› := by
  simp only [binterᵢ_eq_interᵢ]
  haveI := hS.toEncodable
  exact EventuallyLE.countable_interᵢ fun i => h i i.2
#align eventually_le.countable_bInter EventuallyLE.countable_bInter

theorem EventuallyEq.countable_bInter {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i hi, s i hi =ᶠ[l] t i hi) :
    (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
  (EventuallyLE.countable_bInter hS fun i hi => (h i hi).le).antisymm
    (EventuallyLE.countable_bInter hS fun i hi => (h i hi).symm.le)
#align eventually_eq.countable_bInter EventuallyEq.countable_bInter

/-- Construct a filter with countable intersection property. This constructor deduces
`Filter.univ_sets` and `Filter.inter_sets` from the countable intersection property. -/
def Filter.ofCountableInter (l : Set (Set α))
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l)
    (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) : Filter α
    where
  sets := l
  univ_sets := @interₛ_empty α ▸ hp _ countable_empty (empty_subset _)
  sets_of_superset := h_mono _ _
  inter_sets {s t} hs ht := interₛ_pair s t ▸
    hp _ ((countable_singleton _).insert _) (insert_subset.2 ⟨hs, singleton_subset_iff.2 ht⟩)
#align filter.of_countable_Inter Filter.ofCountableInter

instance Filter.countable_Inter_ofCountableInter (l : Set (Set α))
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l)
    (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
    CountableInterFilter (Filter.ofCountableInter l hp h_mono) :=
  ⟨hp⟩
#align filter.countable_Inter_of_countable_Inter Filter.countable_Inter_ofCountableInter

@[simp]
theorem Filter.mem_ofCountableInter {l : Set (Set α)}
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l) (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l)
    {s : Set α} : s ∈ Filter.ofCountableInter l hp h_mono ↔ s ∈ l :=
  Iff.rfl
#align filter.mem_of_countable_Inter Filter.mem_ofCountableInter

instance countableInterFilter_principal (s : Set α) : CountableInterFilter (𝓟 s) :=
  ⟨fun _ _ hS => subset_interₛ hS⟩
#align countable_Inter_filter_principal countableInterFilter_principal

instance countableInterFilter_bot : CountableInterFilter (⊥ : Filter α) := by
  rw [← principal_empty]
  apply countableInterFilter_principal
#align countable_Inter_filter_bot countableInterFilter_bot

instance countableInterFilter_top : CountableInterFilter (⊤ : Filter α) := by
  rw [← principal_univ]
  apply countableInterFilter_principal
#align countable_Inter_filter_top countableInterFilter_top

instance (l : Filter β) [CountableInterFilter l] (f : α → β) :
    CountableInterFilter (comap f l) := by
  refine' ⟨fun S hSc hS => _⟩
  choose! t htl ht using hS
  have : (⋂ s ∈ S, t s) ∈ l := (countable_bInter_mem hSc).2 htl
  refine' ⟨_, this, _⟩
  simpa [preimage_interᵢ] using interᵢ₂_mono ht

instance (l : Filter α) [CountableInterFilter l] (f : α → β) : CountableInterFilter (map f l) := by
  refine' ⟨fun S hSc hS => _⟩
  simp only [mem_map, interₛ_eq_binterᵢ, preimage_interᵢ₂] at hS⊢
  exact (countable_bInter_mem hSc).2 hS

/-- Infimum of two `countable_Inter_filter`s is a `countable_Inter_filter`. This is useful, e.g.,
to automatically get an instance for `residual α ⊓ 𝓟 s`. -/
instance countableInterFilter_inf (l₁ l₂ : Filter α) [CountableInterFilter l₁]
    [CountableInterFilter l₂] : CountableInterFilter (l₁ ⊓ l₂) := by
  refine' ⟨fun S hSc hS => _⟩
  choose s hs t ht hst using hS
  replace hs : (⋂ i ∈ S, s i ‹_›) ∈ l₁ := (countable_bInter_mem hSc).2 hs
  replace ht : (⋂ i ∈ S, t i ‹_›) ∈ l₂ := (countable_bInter_mem hSc).2 ht
  refine' mem_of_superset (inter_mem_inf hs ht) (subset_interₛ fun i hi => _)
  rw [hst i hi]
  apply inter_subset_inter <;> exact interᵢ_subset_of_subset i (interᵢ_subset _ _)
#align countable_Inter_filter_inf countableInterFilter_inf

/-- Supremum of two `countable_Inter_filter`s is a `countable_Inter_filter`. -/
instance countableInterFilter_sup (l₁ l₂ : Filter α) [CountableInterFilter l₁]
    [CountableInterFilter l₂] : CountableInterFilter (l₁ ⊔ l₂) := by
  refine' ⟨fun S hSc hS => ⟨_, _⟩⟩ <;> refine' (countable_interₛ_mem hSc).2 fun s hs => _
  exacts[(hS s hs).1, (hS s hs).2]
#align countable_Inter_filter_sup countableInterFilter_sup


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
-- 1. Inportar la librería de tácticas.
-- 2. Declarar α como una variable de tipos.
-- 3. Declarar P una variable sobre las propiedades de α.
-- ----------------------------------------------------------------------

import tactic              -- 1
variables {α : Type*}      -- 2
variables (P : α → Prop)   -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que si
--    ¬ ∃ x, P x
-- entonces
--    ∀ x, ¬ P x
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (h : ¬ ∃ x, P x)
  : ∀ x, ¬ P x :=
begin
  intros x h1,
  apply h,
  existsi x,
  exact h1,
end

-- Prueba
-- ======

/-
α : Type u_1,
P : α → Prop,
h : ¬∃ (x : α), P x
⊢ ∀ (x : α), ¬P x
  >> intros x h1,
x : α,
h1 : P x
⊢ false
  >> apply h,
⊢ ∃ (x : α), P x
  >> existsi x,
⊢ P x
  >> exact h1,
no goals
-/

-- Comentario: La táctica (existsi e) (ver https://bit.ly/3j21TtU) es la
-- regla de introducción del existencial; es decir, sustituye en el
-- cuerpo del objetivo existencial su variable por e

example
  (h : ¬ ∃ x, P x)
  : ∀ x, ¬ P x :=
not_exists.mp h

-- 3ª demostración
-- ===============

example
  (h : ¬ ∃ x, P x)
  : ∀ x, ¬ P x :=
by finish

-- 4ª demostración
-- ===============

example
  (h : ¬ ∃ x, P x)
  : ∀ x, ¬ P x :=
by clarify

-- 4ª demostración
-- ===============

example
  (h : ¬ ∃ x, P x)
  : ∀ x, ¬ P x :=
by safe

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que si
--    ∀ x, ¬ P x
-- entonces
--    ¬ ∃ x, P x
-- ----------------------------------------------------------------------

example
  (h : ∀ x, ¬ P x)
  : ¬ ∃ x, P x :=
begin
  intro h1,
  cases h1 with x hx,
  specialize h x,
  apply h hx,
end

-- Prueba
-- ======

/-
α : Type u_1,
P : α → Prop,
h : ∀ (x : α), ¬P x
⊢ ¬∃ (x : α), P x
  >> intro h1,
h1 : ∃ (x : α), P x
⊢ false
  >> cases h1 with x hx,
x : α,
hx : P x
⊢ false
  >> specialize h x,
h : ¬P x
⊢ false
  >> apply h hx,
no goals
-/

-- Comentario: La táctica (specialize h e) (ver https://bit.ly/328xYKy)
-- aplica la rela de eliminación del cuantificador universal a la
-- hipótesis h cambiando su variable  por e.

-- 2ª demostración
-- ===============

example
  (h : ∀ x, ¬ P x)
  : ¬ ∃ x, P x :=
not_exists_of_forall_not h

-- 2ª demostración
-- ===============

example
  (h : ∀ x, ¬ P x)
  : ¬ ∃ x, P x :=
by finish

-- ---------------------------------------------------------------------
-- Ejercicio 4. Habilitar el uso de las reglas de la lógica clásica.
-- ----------------------------------------------------------------------

open_locale classical

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que si
--    ¬ ∀ x, P x
-- entonces
--    ∃ x, ¬ P x
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (h : ¬ ∀ x, P x)
  : ∃ x, ¬ P x :=
begin
  by_contradiction h',
  apply h,
  intro x,
  by_contradiction h'',
  exact h' ⟨x, h''⟩,
end

-- Prueba
-- ======

/-
α : Type u_1,
P : α → Prop,
h : ¬∀ (x : α), P x
⊢ ∃ (x : α), ¬P x
  >> by_contradiction h',
h' : ¬∃ (x : α), ¬P x
⊢ false
  >> apply h,
⊢ ∀ (x : α), P x
  >> intro x,
x : α
⊢ P x
  >> by_contradiction h'',
h'' : ¬P x
⊢ false
  >> exact h' ⟨x, h''⟩,
no goals
-/

-- Comentarios:
-- 1. La táctica (by_contradiction h) es la regla de reducción al
--    absurdo; es decir, si el objetivo es p añade la hipótesis (h : p) y
--    reduce el objetico a false (ver https://bit.ly/2Ckmadb).
-- 2. La táctica (exact h1 ⟨x, h2⟩) es la regla de inntroducción del
--    cuantificador existencial; es decir, si el objetivo es de la forma
--    (∃y, P y) demuestra (P x) con h2 y unifica h1 con (∃x, P x).
--    (ver https://bit.ly/303lLE4).

-- 2ª demostración
-- ===============

example
  (h : ¬ ∀ x, P x)
  : ∃ x, ¬ P x :=
not_forall.mp h

-- 2ª demostración
-- ===============

example
  (h : ¬ ∀ x, P x)
  : ∃ x, ¬ P x :=
by finish

-- ---------------------------------------------------------------------
-- Ejercicio 6. Demostrar que si
--    ∃ x, ¬ P x
-- entonces
--    ¬ ∀ x, P x
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (h : ∃ x, ¬ P x)
  : ¬ ∀ x, P x :=
begin
  intro h1,
  cases h with x hx,
  apply hx,
  exact (h1 x),
end

-- Prueba
-- ======

/-
α : Type u_1,
P : α → Prop,
h : ∃ (x : α), ¬P x
⊢ ¬∀ (x : α), P x
  >> intro h1,
h1 : ∀ (x : α), P x
⊢ false
  >> cases h with x hx,
x : α,
hx : ¬P x
⊢ false
  >> apply hx,
⊢ P x
  >> exact (h1 x)
no goals
-/

-- Comentarios:
-- 1. La táctica (intro h), cuando el objetivo es una negación, es la
--    regla de introducción de la negación; es decir, si el objetivo es
--    ¬P entonces añade la hipótesis (h : P) y cambia el objetivo a
--    false.
-- 2. La táctica (cases h with x hx), cuando la hipótesis es un
--    existencial, es la regla de eliminación del existencial; es decir,
--    si h es (∃ (y : α), P y) añade las hipótesis (x : α) y (hx : P x).

-- 2ª demostración
-- ===============

example
  (h : ∃ x, ¬ P x)
  : ¬ ∀ x, P x :=
not_forall.mpr h

-- 3ª demostración
-- ===============

example
  (h : ∃ x, ¬ P x)
  : ¬ ∀ x, P x :=
by finish


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

/-!
# Tensor products of Lie modules

Tensor products of Lie modules carry natural Lie module structures.

## Tags

lie module, tensor product, universal property
-/

universes u v w w₁ w₂ w₃

variables {R : Type u} [comm_ring R]

namespace tensor_product

open_locale tensor_product

namespace lie_module

open lie_module

variables {L : Type v} {M : Type w} {N : Type w₁} {P : Type w₂} {Q : Type w₃}
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables [add_comm_group P] [module R P] [lie_ring_module L P] [lie_module R L P]
variables [add_comm_group Q] [module R Q] [lie_ring_module L Q] [lie_module R L Q]

/-- It is useful to define the bracket via this auxiliary function so that we have a type-theoretic
expression of the fact that `L` acts by linear endomorphisms. It simplifies the proofs in
`lie_ring_module` below. -/
def has_bracket_aux (x : L) : module.End R (M ⊗[R] N) :=
  (to_endomorphism R L M x).rtensor N + (to_endomorphism R L N x).ltensor M

/-- The tensor product of two Lie modules is a Lie ring module. -/
instance lie_ring_module : lie_ring_module L (M ⊗[R] N) :=
{ bracket     := λ x, has_bracket_aux x,
  add_lie     := λ x y t, by
    { simp only [has_bracket_aux, linear_map.ltensor_add, linear_map.rtensor_add, lie_hom.map_add,
        linear_map.add_apply], abel, },
  lie_add     := λ x, linear_map.map_add _,
  leibniz_lie := λ x y t, by
    { suffices : (has_bracket_aux x).comp (has_bracket_aux y) =
                  has_bracket_aux ⁅x,y⁆ + (has_bracket_aux y).comp (has_bracket_aux x),
      { simp only [← linear_map.comp_apply, ← linear_map.add_apply], rw this, },
      ext m n,
      simp only [has_bracket_aux, lie_ring.of_associative_ring_bracket, linear_map.mul_apply,
        mk_apply, linear_map.ltensor_sub, linear_map.compr₂_apply, function.comp_app,
        linear_map.coe_comp, linear_map.rtensor_tmul, lie_hom.map_lie,
        to_endomorphism_apply_apply, linear_map.add_apply, linear_map.map_add,
        linear_map.rtensor_sub, linear_map.sub_apply, linear_map.ltensor_tmul],
      abel, }, }

/-- The tensor product of two Lie modules is a Lie module. -/
instance lie_module : lie_module R L (M ⊗[R] N) :=
{ smul_lie := λ c x t, by
  { change has_bracket_aux (c • x) _ = c • has_bracket_aux _ _,
    simp only [has_bracket_aux, smul_add, linear_map.rtensor_smul, linear_map.smul_apply,
      linear_map.ltensor_smul, lie_hom.map_smul, linear_map.add_apply], },
  lie_smul := λ c x, linear_map.map_smul _ c, }

@[simp] lemma lie_tmul_right (x : L) (m : M) (n : N) :
  ⁅x, m ⊗ₜ[R] n⁆ = ⁅x, m⁆ ⊗ₜ n + m ⊗ₜ ⁅x, n⁆ :=
show has_bracket_aux x (m ⊗ₜ[R] n) = _,
by simp only [has_bracket_aux, linear_map.rtensor_tmul, to_endomorphism_apply_apply,
  linear_map.add_apply, linear_map.ltensor_tmul]

variables (R L M N P Q)

/-- The universal property for tensor product of modules of a Lie algebra: the `R`-linear
tensor-hom adjunction is equivariant with respect to the `L` action. -/
def lift : (M →ₗ[R] N →ₗ[R] P) ≃ₗ⁅R,L⁆ (M ⊗[R] N →ₗ[R] P) :=
{ map_lie'  := λ x f, by
    { ext m n, simp only [mk_apply, linear_map.compr₂_apply, lie_tmul_right, linear_map.sub_apply,
        lift.equiv_apply, linear_equiv.to_fun_eq_coe, lie_hom.lie_apply, linear_map.map_add],
      abel, },
  ..tensor_product.lift.equiv R M N P }

@[simp] lemma lift_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) :
  lift R L M N P f (m ⊗ₜ n) = f m n :=
lift.equiv_apply R M N P f m n

/-- A weaker form of the universal property for tensor product of modules of a Lie algebra.

Note that maps `f` of type `M →ₗ⁅R,L⁆ N →ₗ[R] P` are exactly those `R`-bilinear maps satisfying
`⁅x, f m n⁆ = f ⁅x, m⁆ n + f m ⁅x, n⁆` for all `x, m, n` (see e.g, `lie_module_hom.map_lie₂`). -/
def lift_lie : (M →ₗ⁅R,L⁆ N →ₗ[R] P) ≃ₗ[R] (M ⊗[R] N →ₗ⁅R,L⁆ P) :=
(max_triv_linear_map_equiv_lie_module_hom.symm.trans
↑(max_triv_equiv (lift R L M N P))).trans
max_triv_linear_map_equiv_lie_module_hom

@[simp] lemma coe_lift_lie_eq_lift_coe (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) :
  ⇑(lift_lie R L M N P f) = lift R L M N P f :=
begin
  suffices : (lift_lie R L M N P f : M ⊗[R] N →ₗ[R] P) = lift R L M N P f,
  { rw [← this, lie_module_hom.coe_to_linear_map], },
  ext m n,
  simp only [lift_lie, linear_equiv.trans_apply, lie_module_equiv.coe_to_linear_equiv,
    coe_linear_map_max_triv_linear_map_equiv_lie_module_hom, coe_max_triv_equiv_apply,
    coe_linear_map_max_triv_linear_map_equiv_lie_module_hom_symm],
end

lemma lift_lie_apply (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) (m : M) (n : N) :
  lift_lie R L M N P f (m ⊗ₜ n) = f m n :=
by simp only [coe_lift_lie_eq_lift_coe, lie_module_hom.coe_to_linear_map, lift_apply]

variables {R L M N P Q}

/-- A pair of Lie module morphisms `f : M → P` and `g : N → Q`, induce a Lie module morphism:
`M ⊗ N → P ⊗ Q`. -/
def map (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) : M ⊗[R] N →ₗ⁅R,L⁆ P ⊗[R] Q :=
{ map_lie' := λ x t, by
    { simp only [linear_map.to_fun_eq_coe],
      apply t.induction_on,
      { simp only [linear_map.map_zero, lie_zero], },
      { intros m n, simp only [lie_module_hom.coe_to_linear_map, lie_tmul_right,
          lie_module_hom.map_lie, map_tmul, linear_map.map_add], },
      { intros t₁ t₂ ht₁ ht₂, simp only [ht₁, ht₂, lie_add, linear_map.map_add], }, },
  .. map (f : M →ₗ[R] P) (g : N →ₗ[R] Q), }

@[simp] lemma coe_linear_map_map (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) :
  (map f g : M ⊗[R] N →ₗ[R] P ⊗[R] Q) = tensor_product.map (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :=
rfl

@[simp] lemma map_tmul (f : M →ₗ⁅R,L⁆ P) (g : N →ₗ⁅R,L⁆ Q) (m : M) (n : N) :
  map f g (m ⊗ₜ n) = (f m) ⊗ₜ (g n) :=
map_tmul f g m n

/-- Given Lie submodules `M' ⊆ M` and `N' ⊆ N`, this is the natural map: `M' ⊗ N' → M ⊗ N`. -/
def map_incl (M' : lie_submodule R L M) (N' : lie_submodule R L N) :
  M' ⊗[R] N' →ₗ⁅R,L⁆ M ⊗[R] N :=
map M'.incl N'.incl

@[simp] lemma map_incl_def (M' : lie_submodule R L M) (N' : lie_submodule R L N) :
  map_incl M' N' = map M'.incl N'.incl :=
rfl

end lie_module

end tensor_product

namespace lie_module

open_locale tensor_product

variables (R) (L : Type v) (M : Type w)
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]

/-- The action of the Lie algebra on one of its modules, regarded as a morphism of Lie modules. -/
def to_module_hom : L ⊗[R] M →ₗ⁅R,L⁆ M :=
tensor_product.lie_module.lift_lie R L L M M
{ map_lie' := λ x m, by { ext n, simp [lie_ring.of_associative_ring_bracket], },
  ..(to_endomorphism R L M : L →ₗ[R] M →ₗ[R] M), }

@[simp] lemma to_module_hom_apply (x : L) (m : M) :
  to_module_hom R L M (x ⊗ₜ m) = ⁅x, m⁆ :=
by simp only [to_module_hom, tensor_product.lie_module.lift_lie_apply, to_endomorphism_apply_apply,
  lie_hom.coe_to_linear_map, lie_module_hom.coe_mk, linear_map.to_fun_eq_coe]

end lie_module

namespace lie_submodule

open_locale tensor_product

open tensor_product.lie_module
open lie_module

variables {L : Type v} {M : Type w}
variables [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables (I : lie_ideal R L) (N : lie_submodule R L M)

/-- A useful alternative characterisation of Lie ideal operations on Lie submodules.

Given a Lie ideal `I ⊆ L` and a Lie submodule `N ⊆ M`, by tensoring the inclusion maps and then
applying the action of `L` on `M`, we obtain morphism of Lie modules `f : I ⊗ N → L ⊗ M → M`.

This lemma states that `⁅I, N⁆ = range f`. -/
lemma lie_ideal_oper_eq_tensor_map_range :
  ⁅I, N⁆ = ((to_module_hom R L M).comp (map_incl I N : ↥I ⊗ ↥N →ₗ⁅R,L⁆ L ⊗ M)).range :=
begin
  rw [← coe_to_submodule_eq_iff, lie_ideal_oper_eq_linear_span, lie_module_hom.coe_submodule_range,
    lie_module_hom.coe_linear_map_comp, linear_map.range_comp, map_incl_def, coe_linear_map_map,
    tensor_product.map_range_eq_span_tmul, submodule.map_span],
  congr, ext m, split,
  { rintros ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, use x ⊗ₜ n, split,
    { use [⟨x, hx⟩, ⟨n, hn⟩], simp, },
    { simp, }, },
  { rintros ⟨t, ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, h⟩, rw ← h, use [⟨x, hx⟩, ⟨n, hn⟩], simp, },
end

end lie_submodule


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/
import set_theory.ordinal.arithmetic
import topology.order.basic

/-!
### Topology of ordinals

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

We prove some miscellaneous results involving the order topology of ordinals.

### Main results

* `ordinal.is_closed_iff_sup` / `ordinal.is_closed_iff_bsup`: A set of ordinals is closed iff it's
  closed under suprema.
* `ordinal.is_normal_iff_strict_mono_and_continuous`: A characterization of normal ordinal
  functions.
* `ordinal.enum_ord_is_normal_iff_is_closed`: The function enumerating the ordinals of a set is
  normal iff the set is closed.
-/

noncomputable theory

universes u v

open cardinal order

namespace ordinal

variables {s : set ordinal.{u}} {a : ordinal.{u}}

instance : topological_space ordinal.{u} :=
preorder.topology ordinal.{u}

instance : order_topology ordinal.{u} :=
⟨rfl⟩

theorem is_open_singleton_iff : is_open ({a} : set ordinal) ↔ ¬ is_limit a :=
begin
  refine ⟨λ h ha, _, λ ha, _⟩,
  { obtain ⟨b, c, hbc, hbc'⟩ := (mem_nhds_iff_exists_Ioo_subset'
      ⟨0, ordinal.pos_iff_ne_zero.2 ha.1⟩ ⟨_, lt_succ a⟩).1 (h.mem_nhds rfl),
    have hba := ha.2 b hbc.1,
    exact hba.ne (hbc' ⟨lt_succ b, hba.trans hbc.2⟩) },
  { rcases zero_or_succ_or_limit a with rfl | ⟨b, hb⟩ | ha',
    { convert is_open_gt' (1 : ordinal),
      ext,
      exact ordinal.lt_one_iff_zero.symm },
    { convert @is_open_Ioo _ _ _ _ b (a + 1),
      ext c,
      refine ⟨λ hc, _, _⟩,
      { rw set.mem_singleton_iff.1 hc,
        refine ⟨_, lt_succ a⟩,
        rw hb,
        exact lt_succ b },
      { rintro ⟨hc, hc'⟩,
        apply le_antisymm (le_of_lt_succ hc'),
        rw hb,
        exact succ_le_of_lt hc } },
    { exact (ha ha').elim } }
end

theorem is_open_iff : is_open s ↔ ∀ o ∈ s, is_limit o → ∃ a < o, set.Ioo a o ⊆ s :=
begin
  classical,
  refine ⟨_, λ h, _⟩,
  { rw is_open_iff_generate_intervals,
    intros h o hos ho,
    have ho₀ := ordinal.pos_iff_ne_zero.2 ho.1,
    induction h with t ht t u ht hu ht' hu' t ht H,
    { rcases ht with ⟨a, rfl | rfl⟩,
      { exact ⟨a, hos, λ b hb, hb.1⟩ },
      { exact ⟨0, ho₀, λ b hb, hb.2.trans hos⟩ } },
    { exact ⟨0, ho₀, λ b _, set.mem_univ b⟩ },
    { rcases ht' hos.1 with ⟨a, ha, ha'⟩,
      rcases hu' hos.2 with ⟨b, hb, hb'⟩,
      exact ⟨_, max_lt ha hb, λ c hc, ⟨
        ha' ⟨(le_max_left a b).trans_lt hc.1, hc.2⟩,
        hb' ⟨(le_max_right a b).trans_lt hc.1, hc.2⟩⟩⟩ },
    { rcases hos with ⟨u, hu, hu'⟩,
      rcases H u hu hu' with ⟨a, ha, ha'⟩,
      exact ⟨a, ha, λ b hb, ⟨u, hu, ha' hb⟩⟩ } },
  { let f : s → set ordinal := λ o,
      if ho : is_limit o.val
      then set.Ioo (classical.some (h o.val o.prop ho)) (o + 1)
      else {o.val},
    have : ∀ a, is_open (f a) := λ a, begin
      change is_open (dite _ _ _),
      split_ifs,
      { exact is_open_Ioo },
      { rwa is_open_singleton_iff }
    end,
    convert is_open_Union this,
    ext o,
    refine ⟨λ ho, set.mem_Union.2 ⟨⟨o, ho⟩, _⟩, _⟩,
    { split_ifs with ho',
      { refine ⟨_, lt_succ o⟩,
        cases classical.some_spec (h o ho ho') with H,
        exact H },
      { exact set.mem_singleton o } },
    { rintro ⟨t, ⟨a, ht⟩, hoa⟩,
      change dite _ _ _ = t at ht,
      split_ifs at ht with ha;
      subst ht,
      { cases classical.some_spec (h a.val a.prop ha) with H has,
        rcases lt_or_eq_of_le (le_of_lt_succ hoa.2) with hoa' | rfl,
        { exact has ⟨hoa.1, hoa'⟩ },
        { exact a.prop } },
      { convert a.prop } } }
end

theorem mem_closure_iff_sup : a ∈ closure s ↔ ∃ {ι : Type u} [nonempty ι] (f : ι → ordinal),
  (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
begin
  refine mem_closure_iff.trans ⟨λ h, _, _⟩,
  { by_cases has : a ∈ s,
    { exact ⟨punit, by apply_instance, λ _, a, λ _, has, sup_const a⟩ },
    { have H := λ b (hba : b < a), h _ (@is_open_Ioo _ _ _ _ b (a + 1)) ⟨hba, lt_succ a⟩,
      let f : a.out.α → ordinal := λ i, classical.some (H (typein (<) i) (typein_lt_self i)),
      have hf : ∀ i, f i ∈ set.Ioo (typein (<) i) (a + 1) ∩ s :=
        λ i, classical.some_spec (H _ _),
      rcases eq_zero_or_pos a with rfl | ha₀,
      { rcases h _ (is_open_singleton_iff.2 not_zero_is_limit) rfl with ⟨b, hb, hb'⟩,
        rw set.mem_singleton_iff.1 hb at *,
        exact (has hb').elim },
      refine ⟨_, out_nonempty_iff_ne_zero.2 (ordinal.pos_iff_ne_zero.1 ha₀), f,
        λ i, (hf i).2, le_antisymm (sup_le (λ i, le_of_lt_succ (hf i).1.2)) _⟩,
      by_contra' h,
      cases H _ h with b hb,
      rcases eq_or_lt_of_le (le_of_lt_succ hb.1.2) with rfl | hba,
      { exact has hb.2 },
      { have : b < f (enum (<) b (by rwa type_lt)) := begin
          have := (hf (enum (<) b (by rwa type_lt))).1.1,
          rwa typein_enum at this
        end,
        have : b ≤ sup.{u u} f := this.le.trans (le_sup f _),
        exact this.not_lt hb.1.1 } } },
  { rintro ⟨ι, ⟨i⟩, f, hf, rfl⟩ t ht hat,
    cases eq_zero_or_pos (sup.{u u} f) with ha₀ ha₀,
    { rw ha₀ at hat,
      use [0, hat],
      convert hf i,
      exact (sup_eq_zero_iff.1 ha₀ i).symm },
    rcases (mem_nhds_iff_exists_Ioo_subset' ⟨0, ha₀⟩ ⟨_, lt_succ _⟩).1 (ht.mem_nhds hat) with
      ⟨b, c, ⟨hab, hac⟩, hbct⟩,
    cases lt_sup.1 hab with i hi,
    exact ⟨_, hbct ⟨hi, (le_sup.{u u} f i).trans_lt hac⟩, hf i⟩ }
end

theorem mem_closed_iff_sup (hs : is_closed s) :
  a ∈ s ↔ ∃ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
  (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
by rw [←mem_closure_iff_sup, hs.closure_eq]

theorem mem_closure_iff_bsup :
  a ∈ closure s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
mem_closure_iff_sup.trans ⟨
  λ ⟨ι, ⟨i⟩, f, hf, ha⟩, ⟨_, λ h, (type_eq_zero_iff_is_empty.1 h).elim i, bfamily_of_family f,
    λ i hi, hf _, by rwa bsup_eq_sup⟩,
  λ ⟨o, ho, f, hf, ha⟩, ⟨_, out_nonempty_iff_ne_zero.2 ho, family_of_bfamily o f,
    λ i, hf _ _, by rwa sup_eq_bsup⟩⟩

theorem mem_closed_iff_bsup (hs : is_closed s) :
  a ∈ s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
by rw [←mem_closure_iff_bsup, hs.closure_eq]

theorem is_closed_iff_sup :
  is_closed s ↔ ∀ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
  (∀ i, f i ∈ s) → sup.{u u} f ∈ s :=
begin
  use λ hs ι hι f hf, (mem_closed_iff_sup hs).2 ⟨ι, hι, f, hf, rfl⟩,
  rw ←closure_subset_iff_is_closed,
  intros h x hx,
  rcases mem_closure_iff_sup.1 hx with ⟨ι, hι, f, hf, rfl⟩,
  exact h hι f hf
end

theorem is_closed_iff_bsup :
  is_closed s ↔ ∀ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
  (∀ i hi, f i hi ∈ s) → bsup.{u u} o f ∈ s :=
begin
  rw is_closed_iff_sup,
  refine ⟨λ H o ho f hf, H (out_nonempty_iff_ne_zero.2 ho) _ _, λ  H ι hι f hf, _⟩,
  { exact λ i, hf _ _ },
  { rw ←bsup_eq_sup,
    apply H (type_ne_zero_iff_nonempty.2 hι),
    exact λ i hi, hf _ }
end

theorem is_limit_of_mem_frontier (ha : a ∈ frontier s) : is_limit a :=
begin
  simp only [frontier_eq_closure_inter_closure, set.mem_inter_iff, mem_closure_iff] at ha,
  by_contra h,
  rw ←is_open_singleton_iff at h,
  rcases ha.1 _ h rfl with ⟨b, hb, hb'⟩,
  rcases ha.2 _ h rfl with ⟨c, hc, hc'⟩,
  rw set.mem_singleton_iff at *,
  subst hb, subst hc,
  exact hc' hb'
end

theorem is_normal_iff_strict_mono_and_continuous (f : ordinal.{u} → ordinal.{u}) :
  is_normal f ↔ strict_mono f ∧ continuous f :=
begin
  refine ⟨λ h, ⟨h.strict_mono, _⟩, _⟩,
  { rw continuous_def,
    intros s hs,
    rw is_open_iff at *,
    intros o ho ho',
    rcases hs _ ho (h.is_limit ho') with ⟨a, ha, has⟩,
    rw [←is_normal.bsup_eq.{u u} h ho', lt_bsup] at ha,
    rcases ha with ⟨b, hb, hab⟩,
    exact ⟨b, hb, λ c hc,
      set.mem_preimage.2 (has ⟨hab.trans (h.strict_mono hc.1), h.strict_mono hc.2⟩)⟩ },
  { rw is_normal_iff_strict_mono_limit,
    rintro ⟨h, h'⟩,
    refine ⟨h, λ o ho a h, _⟩,
    suffices : o ∈ (f ⁻¹' set.Iic a), from set.mem_preimage.1 this,
    rw mem_closed_iff_sup (is_closed.preimage h' (@is_closed_Iic _ _ _ _  a)),
    exact ⟨_, out_nonempty_iff_ne_zero.2 ho.1, typein (<),
      λ i, h _ (typein_lt_self i), sup_typein_limit ho.2⟩ }
end

theorem enum_ord_is_normal_iff_is_closed (hs : s.unbounded (<)) :
  is_normal (enum_ord s) ↔ is_closed s :=
begin
  have Hs := enum_ord_strict_mono hs,
  refine ⟨λ h, is_closed_iff_sup.2 (λ ι hι f hf, _),
    λ h, (is_normal_iff_strict_mono_limit _).2 ⟨Hs, λ a ha o H, _⟩⟩,
  { let g : ι → ordinal.{u} := λ i, (enum_ord_order_iso hs).symm ⟨_, hf i⟩,
    suffices : enum_ord s (sup.{u u} g) = sup.{u u} f,
    { rw ←this, exact enum_ord_mem hs _ },
    rw @is_normal.sup.{u u u} _ h ι g hι,
    congr, ext,
    change ((enum_ord_order_iso hs) _).val = f x,
    rw order_iso.apply_symm_apply },
  { rw is_closed_iff_bsup at h,
    suffices : enum_ord s a ≤ bsup.{u u} a (λ b < a, enum_ord s b), from this.trans (bsup_le H),
    cases enum_ord_surjective hs _ (h ha.1 (λ b hb, enum_ord s b) (λ b hb, enum_ord_mem hs b))
      with b hb,
    rw ←hb,
    apply Hs.monotone,
    by_contra' hba,
    apply (Hs (lt_succ b)).not_le,
    rw hb,
    exact le_bsup.{u u} _ _ (ha.2 _ hba) }
end

end ordinal


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Mon.limits
import algebra.category.Group.preadditive
import category_theory.over
import category_theory.limits.concrete_category
import category_theory.limits.shapes.concrete_category
import group_theory.subgroup.basic

/-!
# The category of (commutative) (additive) groups has all limits

Further, these limits are preserved by the forgetful functor --- that is,
the underlying types are just the limits in the category of types.

-/

open category_theory
open category_theory.limits

universe u

noncomputable theory

variables {J : Type u} [small_category J]

namespace Group

@[to_additive]
instance group_obj (F : J ⥤ Group) (j) :
  group ((F ⋙ forget Group).obj j) :=
by { change group (F.obj j), apply_instance }

/--
The flat sections of a functor into `Group` form a subgroup of all sections.
-/
@[to_additive
  "The flat sections of a functor into `AddGroup` form an additive subgroup of all sections."]
def sections_subgroup (F : J ⥤ Group) :
  subgroup (Π j, F.obj j) :=
{ carrier := (F ⋙ forget Group).sections,
  inv_mem' := λ a ah j j' f,
  begin
    simp only [forget_map_eq_coe, functor.comp_map, pi.inv_apply, monoid_hom.map_inv, inv_inj],
    dsimp [functor.sections] at ah,
    rw ah f,
  end,
  ..(Mon.sections_submonoid (F ⋙ forget₂ Group Mon)) }

@[to_additive]
instance limit_group (F : J ⥤ Group) :
  group (types.limit_cone (F ⋙ forget Group.{u})).X :=
begin
  change group (sections_subgroup F),
  apply_instance,
end

/-- We show that the forgetful functor `Group ⥤ Mon` creates limits.

All we need to do is notice that the limit point has a `group` instance available, and then reuse
the existing limit. -/
@[to_additive "We show that the forgetful functor `AddGroup ⥤ AddMon` creates limits.

All we need to do is notice that the limit point has an `add_group` instance available, and then
reuse the existing limit."]
instance (F : J ⥤ Group) : creates_limit F (forget₂ Group Mon.{u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := Group.of (types.limit_cone (F ⋙ forget Group)).X,
    π :=
    { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ Group Mon.{u}),
      naturality' := (Mon.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Mon.has_limits.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ Group Mon.{u}) (Mon.has_limits.limit_cone_is_limit _)
    (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ Group) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ Group Mon.{u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ Group) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of groups has all limits. -/
@[to_additive "The category of additive groups has all limits."]
instance has_limits : has_limits Group :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ Group Mon) } } -- TODO use the above instead?

/-- The forgetful functor from groups to monoids preserves all limits.

This means the underlying monoid of a limit can be computed as a limit in the category of monoids.
-/
@[to_additive AddGroup.forget₂_AddMon_preserves_limits "The forgetful functor from additive groups
to additive monoids preserves all limits.

This means the underlying additive monoid of a limit can be computed as a limit in the category of
additive monoids."]
instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ Group Mon) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

/-- The forgetful functor from groups to types preserves all limits.

This means the underlying type of a limit can be computed as a limit in the category of types. -/
@[to_additive "The forgetful functor from additive groups to types preserves all limits.

This means the underlying type of a limit can be computed as a limit in the category of types."]
instance forget_preserves_limits : preserves_limits (forget Group) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ Group Mon) (forget Mon) } }

end Group

namespace CommGroup

@[to_additive]
instance comm_group_obj (F : J ⥤ CommGroup) (j) :
  comm_group ((F ⋙ forget CommGroup).obj j) :=
by { change comm_group (F.obj j), apply_instance }

@[to_additive]
instance limit_comm_group (F : J ⥤ CommGroup) :
  comm_group (types.limit_cone (F ⋙ forget CommGroup.{u})).X :=
@subgroup.to_comm_group (Π j, F.obj j) _
  (Group.sections_subgroup (F ⋙ forget₂ CommGroup Group.{u}))

/--
We show that the forgetful functor `CommGroup ⥤ Group` creates limits.

All we need to do is notice that the limit point has a `comm_group` instance available,
and then reuse the existing limit.
-/
@[to_additive]
instance (F : J ⥤ CommGroup) : creates_limit F (forget₂ CommGroup Group.{u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := CommGroup.of (types.limit_cone (F ⋙ forget CommGroup)).X,
    π :=
    { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ CommGroup Group.{u} ⋙ forget₂ Group Mon),
      naturality' := (Mon.has_limits.limit_cone _).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Group.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ _ Group.{u} ⋙ forget₂ _ Mon.{u})
    (by apply Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ CommGroup) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ CommGroup Group.{u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just wantto use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ CommGroup) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of commutative groups has all limits. -/
@[to_additive]
instance has_limits : has_limits CommGroup :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ CommGroup Group) } }

/--
The forgetful functor from commutative groups to groups preserves all limits.
(That is, the underlying group could have been computed instead as limits in the category
of groups.)
-/
@[to_additive AddCommGroup.forget₂_AddGroup_preserves_limits]
instance forget₂_Group_preserves_limits : preserves_limits (forget₂ CommGroup Group) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

/--
An auxiliary declaration to speed up typechecking.
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits_aux
  "An auxiliary declaration to speed up typechecking."]
def forget₂_CommMon_preserves_limits_aux (F : J ⥤ CommGroup) :
  is_limit ((forget₂ CommGroup CommMon).map_cone (limit_cone F)) :=
CommMon.limit_cone_is_limit (F ⋙ forget₂ CommGroup CommMon)

/--
The forgetful functor from commutative groups to commutative monoids preserves all limits.
(That is, the underlying commutative monoids could have been computed instead as limits
in the category of commutative monoids.)
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits]
instance forget₂_CommMon_preserves_limits : preserves_limits (forget₂ CommGroup CommMon) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone
    (limit_cone_is_limit F) (forget₂_CommMon_preserves_limits_aux F) } }

/--
The forgetful functor from commutative groups to types preserves all limits. (That is, the
underlying types could have been computed instead as limits in the category of types.)
-/
@[to_additive AddCommGroup.forget_preserves_limits]
instance forget_preserves_limits : preserves_limits (forget CommGroup) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommGroup Group) (forget Group) } }

end CommGroup

namespace AddCommGroup

/--
The categorical kernel of a morphism in `AddCommGroup`
agrees with the usual group-theoretical kernel.
-/
def kernel_iso_ker {G H : AddCommGroup} (f : G ⟶ H) :
  kernel f ≅ AddCommGroup.of f.ker :=
{ hom :=
  { to_fun := λ g, ⟨kernel.ι f g,
    begin
      -- TODO where is this `has_coe_t_aux.coe` coming from? can we prevent it appearing?
      change (kernel.ι f) g ∈ f.ker,
      simp [add_monoid_hom.mem_ker],
    end⟩,
    map_zero' := by { ext, simp, },
    map_add' := λ g g', by { ext, simp, }, },
  inv := kernel.lift f (add_subgroup.subtype f.ker) (by tidy),
  hom_inv_id' := by { apply equalizer.hom_ext _, ext, simp, },
  inv_hom_id' :=
  begin
    apply AddCommGroup.ext,
    simp only [add_monoid_hom.coe_mk, coe_id, coe_comp],
    rintro ⟨x, mem⟩,
    simp,
  end, }.

@[simp]
lemma kernel_iso_ker_hom_comp_subtype {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).hom ≫ add_subgroup.subtype f.ker = kernel.ι f :=
by ext; refl

@[simp]
lemma kernel_iso_ker_inv_comp_ι {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).inv ≫ kernel.ι f = add_subgroup.subtype f.ker :=
begin
  ext,
  simp [kernel_iso_ker],
end

/--
The categorical kernel inclusion for `f : G ⟶ H`, as an object over `G`,
agrees with the `subtype` map.
-/
@[simps]
def kernel_iso_ker_over {G H : AddCommGroup.{u}} (f : G ⟶ H) :
  over.mk (kernel.ι f) ≅ @over.mk _ _ G (AddCommGroup.of f.ker) (add_subgroup.subtype f.ker) :=
over.iso_mk (kernel_iso_ker f) (by simp)

end AddCommGroup


def f : Bool → Bool → Nat
  | true, true => 0
  | _, _       => 3

example : f true true = 0 :=
  rfl

def g : Bool → Bool → Bool → Nat
  | true, _,    true  => 1
  | _,   false, false => 2
  | a,   _,     b     => f a b

theorem ex1 : g true true true = 1 := rfl
theorem ex2 : g true false true = 1 := rfl
theorem ex3 : g true false false = 2 := rfl
theorem ex4 : g false false false = 2 := rfl
theorem ex5 : g false true true = 3 := rfl

theorem f_eq (h : a = true → b = true → False) : f a b = 3 := by
  simp [f]
  split
  . contradiction
  . rfl

theorem ex6 : g x y z > 0 := by
  simp [g]
  split
  next => decide
  next => decide
  next a b c h₁ h₂ => simp [f_eq h₁]


import incidence_world.level02--hide
open IncidencePlane --hide

/-
Using the lemma `point_in_line_not_point` that you proved in the previous
level, we can prove a stronger version of the existence axiom. Remember that
this axiom says that there are three distinct non-collinear points. The
result in this level says that if we fix one point P, then we can find
two other distinct points such that the three of them are non-collinear.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma :
Given a point P, there exist two points Q and R, such that the three points are not collinear.
-/
lemma point_existence_postulate (P : Ω) : ∃ (Q R : Ω), P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧
R ∉ (line_through P Q) :=
begin
  rcases existence Ω with ⟨A, B, C, ⟨hAB, hAC, hBC, h⟩⟩,
  by_cases hA : P = A,
  {
    rw hA,
    use B, use C,
    exact ⟨hAB, hAC, hBC, h⟩,
  },
  {
    have htmp := exists_point_not_in_line (line_through' P A),
    cases htmp with D hD,
    use A, use D,
    have hPD := point_in_line_not_point (line_through_left P A) hD,
    have hAD := point_in_line_not_point (line_through_right P A) hD,
    exact ⟨hA, hPD, hAD, hD⟩,
  }

end