/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.times_cont_mdiff

/-!
# Smooth monoid
A smooth monoid is a monoid that is also a smooth manifold, in which multiplication is a smooth map
of the product manifold `G` × `G` into `G`.

In this file we define the basic structures to talk about smooth monoids: `has_smooth_mul` and its
additive counterpart `has_smooth_add`. These structures are general enough to also talk about smooth
semigroups.
-/

section

set_option old_structure_cmd true

/--
1. All smooth algebraic structures on `G` are `Prop`-valued classes that extend
`smooth_manifold_with_corners I G`. This way we save users from adding both
`[smooth_manifold_with_corners I G]` and `[has_smooth_mul I G]` to the assumptions. While many API
lemmas hold true without the `smooth_manifold_with_corners I G` assumption, we're not aware of a
mathematically interesting monoid on a topological manifold such that (a) the space is not a
`smooth_manifold_with_corners`; (b) the multiplication is smooth at `(a, b)` in the charts
`ext_chart_at I a`, `ext_chart_at I b`, `ext_chart_at I (a * b)`.

2. Because of `model_prod` we can't assume, e.g., that a `lie_group` is modelled on `𝓘(𝕜, E)`. So,
we formulate the definitions and lemmas for any model.

3. While smoothness of an operation implies its continuity, lemmas like
`has_continuous_mul_of_smooth` can't be instances becausen otherwise Lean would have to search for
`has_smooth_mul I G` with unknown `𝕜`, `E`, `H`, and `I : model_with_corners 𝕜 E H`. If users needs
`[has_continuous_mul G]` in a proof about a smooth monoid, then they need to either add
`[has_continuous_mul G]` as an assumption (worse) or use `haveI` in the proof (better). -/
library_note "Design choices about smooth algebraic structures"

/-- Basic hypothesis to talk about a smooth (Lie) additive monoid or a smooth additive
semigroup. A smooth additive monoid over `α`, for example, is obtained by requiring both the
instances `add_monoid α` and `has_smooth_add α`. -/
-- See note [Design choices about smooth algebraic structures]
@[ancestor smooth_manifold_with_corners]
class has_smooth_add {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [has_add G] [topological_space G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_add : smooth (I.prod I) I (λ p : G×G, p.1 + p.2))

/-- Basic hypothesis to talk about a smooth (Lie) monoid or a smooth semigroup.
A smooth monoid over `G`, for example, is obtained by requiring both the instances `monoid G`
and `has_smooth_mul I G`. -/
-- See note [Design choices about smooth algebraic structures]
@[ancestor smooth_manifold_with_corners, to_additive]
class has_smooth_mul {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [has_mul G] [topological_space G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2))

end

section has_smooth_mul

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [has_mul G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M]

section

variables (I)

@[to_additive]
lemma smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2) :=
has_smooth_mul.smooth_mul

/-- If the multiplication is smooth, then it is continuous. This is not an instance for technical
reasons, see note [Design choices about smooth algebraic structures]. -/
@[to_additive
"If the addition is smooth, then it is continuous. This is not an instance for technical reasons,
see note [Design choices about smooth algebraic structures]."]
lemma has_continuous_mul_of_smooth : has_continuous_mul G :=
⟨(smooth_mul I).continuous⟩

end

@[to_additive]
lemma smooth.mul {f : M → G} {g : M → G} (hf : smooth I' I f) (hg : smooth I' I g) :
  smooth I' I (f * g) :=
(smooth_mul I).comp (hf.prod_mk hg)

@[to_additive]
lemma smooth_mul_left {a : G} : smooth I I (λ b : G, a * b) :=
smooth_const.mul smooth_id

@[to_additive]
lemma smooth_mul_right {a : G} : smooth I I (λ b : G, b * a) :=
smooth_id.mul smooth_const

@[to_additive]
lemma smooth_on.mul {f : M → G} {g : M → G} {s : set M}
  (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
  smooth_on I' I (f * g) s :=
((smooth_mul I).comp_smooth_on (hf.prod_mk hg) : _)

/- Instance of product -/
@[to_additive]
instance has_smooth_mul.prod {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
  (G : Type*) [topological_space G] [charted_space H G]
  [has_mul G] [has_smooth_mul I G]
  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
  (G' : Type*) [topological_space G'] [charted_space H' G']
  [has_mul G'] [has_smooth_mul I' G'] :
  has_smooth_mul (I.prod I') (G×G') :=
{ smooth_mul := ((smooth_fst.comp smooth_fst).smooth.mul (smooth_fst.comp smooth_snd)).prod_mk
    ((smooth_snd.comp smooth_fst).smooth.mul (smooth_snd.comp smooth_snd)),
  .. smooth_manifold_with_corners.prod G G' }

variable (I)

end has_smooth_mul

section monoid

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{H' : Type*} [topological_space H']
{E' : Type*} [normed_group E'] [normed_space 𝕜 E'] {I' : model_with_corners 𝕜 E' H'}
{G' : Type*} [monoid G'] [topological_space G'] [charted_space H' G'] [has_smooth_mul I' G']

lemma smooth_pow : ∀ n : ℕ, smooth I I (λ a : G, a ^ n)
| 0 := by { simp only [pow_zero], exact smooth_const }
| (k+1) := by simpa [pow_succ] using smooth_id.mul (smooth_pow _)

/-- Morphism of additive smooth monoids. -/
structure smooth_add_monoid_morphism
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
  (G : Type*) [topological_space G] [charted_space H G] [add_monoid G] [has_smooth_add I G]
  (G' : Type*) [topological_space G'] [charted_space H' G'] [add_monoid G'] [has_smooth_add I' G']
  extends G →+ G' :=
(smooth_to_fun : smooth I I' to_fun)

/-- Morphism of smooth monoids. -/
@[to_additive] structure smooth_monoid_morphism
  (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
  (G : Type*) [topological_space G] [charted_space H G] [monoid G] [has_smooth_mul I G]
  (G' : Type*) [topological_space G'] [charted_space H' G'] [monoid G'] [has_smooth_mul I' G']
  extends G →* G' :=
(smooth_to_fun : smooth I I' to_fun)

@[to_additive]
instance : has_one (smooth_monoid_morphism I I' G G') :=
⟨{ smooth_to_fun := smooth_const, to_monoid_hom := 1 }⟩

@[to_additive]
instance : inhabited (smooth_monoid_morphism I I' G G') := ⟨1⟩

@[to_additive]
instance : has_coe_to_fun (smooth_monoid_morphism I I' G G') := ⟨_, λ a, a.to_fun⟩

end monoid

section comm_monoid

open_locale big_operators

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{G : Type*} [comm_monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M]

@[to_additive]
lemma smooth_finset_prod' {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
  smooth I' I (∏ i in s, f i) :=
finset.prod_induction _ _ (λ f g hf hg, hf.mul hg)
  (@smooth_const _ _ _ _ _ _ _ I' _ _ _ _ _ _ _ _ I _ _ _ 1) h

@[to_additive]
lemma smooth_finset_prod {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
  smooth I' I (λ x, ∏ i in s, f i x) :=
by { simp only [← finset.prod_apply], exact smooth_finset_prod' h }

open function filter

@[to_additive]
lemma smooth_finprod {ι} {f : ι → M → G} (h : ∀ i, smooth I' I (f i))
  (hfin : locally_finite (λ i, mul_support (f i))) :
  smooth I' I (λ x, ∏ᶠ i, f i x) :=
begin
  intro x,
  rcases hfin x with ⟨U, hxU, hUf⟩,
  have : smooth_at I' I (λ x, ∏ i in hUf.to_finset, f i x) x,
    from smooth_finset_prod (λ i hi, h i) x,
  refine this.congr_of_eventually_eq (mem_sets_of_superset hxU $ λ y hy, _),
  refine finprod_eq_prod_of_mul_support_subset _ (λ i hi, _),
  rw [hUf.coe_to_finset],
  exact ⟨y, hi, hy⟩
end

@[to_additive]
lemma smooth_finprod_cond {ι} {f : ι → M → G} {p : ι → Prop} (hc : ∀ i, p i → smooth I' I (f i))
  (hf : locally_finite (λ i, mul_support (f i))) :
  smooth I' I (λ x, ∏ᶠ i (hi : p i), f i x) :=
begin
  simp only [← finprod_subtype_eq_finprod_cond],
  exact smooth_finprod (λ i, hc i i.2) (hf.comp_injective subtype.coe_injective)
end

end comm_monoid


/-
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
-/
import analysis.convex.function
import analysis.convex.strict_convex_space
import measure_theory.function.ae_eq_of_integral
import measure_theory.integral.average

/-!
# Jensen's inequality for integrals

In this file we prove several forms of Jensen's inequality for integrals.

- for convex sets: `convex.average_mem`, `convex.set_average_mem`, `convex.integral_mem`;

- for convex functions: `convex.on.average_mem_epigraph`, `convex_on.map_average_le`,
  `convex_on.set_average_mem_epigraph`, `convex_on.map_set_average_le`, `convex_on.map_integral_le`;

- for strictly convex sets: `strict_convex.ae_eq_const_or_average_mem_interior`;

- for a closed ball in a strictly convex normed space:
  `ae_eq_const_or_norm_integral_lt_of_norm_le_const`;

- for strictly convex functions: `strict_convex_on.ae_eq_const_or_map_average_lt`.

## TODO

- Use a typeclass for strict convexity of a closed ball.

## Tags

convex, integral, center mass, average value, Jensen's inequality
-/

open measure_theory measure_theory.measure metric set filter topological_space function
open_locale topology big_operators ennreal convex

variables {α E F : Type*} {m0 : measurable_space α}
  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
  [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
  {μ : measure α} {s : set E} {t : set α} {f : α → E} {g : E → ℝ} {C : ℝ}

/-!
### Non-strict Jensen's inequality
-/

/-- If `μ` is a probability measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the expected value of `f` belongs to `s`:
`∫ x, f x ∂μ ∈ s`. See also `convex.sum_mem` for a finite sum version of this lemma. -/
lemma convex.integral_mem [is_probability_measure μ] (hs : convex ℝ s) (hsc : is_closed s)
  (hf : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  ∫ x, f x ∂μ ∈ s :=
begin
  borelize E,
  rcases hfi.ae_strongly_measurable with ⟨g, hgm, hfg⟩,
  haveI : separable_space (range g ∩ s : set E) :=
    (hgm.is_separable_range.mono (inter_subset_left _ _)).separable_space,
  obtain ⟨y₀, h₀⟩ : (range g ∩ s).nonempty,
  { rcases (hf.and hfg).exists with ⟨x₀, h₀⟩,
    exact ⟨f x₀, by simp only [h₀.2, mem_range_self], h₀.1⟩ },
  rw [integral_congr_ae hfg], rw [integrable_congr hfg] at hfi,
  have hg : ∀ᵐ x ∂μ, g x ∈ closure (range g ∩ s),
  { filter_upwards [hfg.rw (λ x y, y ∈ s) hf] with x hx,
    apply subset_closure,
    exact ⟨mem_range_self _, hx⟩ },
  set G : ℕ → simple_func α E := simple_func.approx_on _ hgm.measurable (range g ∩ s) y₀ h₀,
  have : tendsto (λ n, (G n).integral μ) at_top (𝓝 $ ∫ x, g x ∂μ),
    from tendsto_integral_approx_on_of_measurable hfi _ hg _ (integrable_const _),
  refine hsc.mem_of_tendsto this (eventually_of_forall $ λ n, hs.sum_mem _ _ _),
  { exact λ _ _, ennreal.to_real_nonneg },
  { rw [← ennreal.to_real_sum, (G n).sum_range_measure_preimage_singleton, measure_univ,
      ennreal.one_to_real],
    exact λ _ _, measure_ne_top _ _ },
  { simp only [simple_func.mem_range, forall_range_iff],
    assume x,
    apply inter_subset_right (range g),
    exact simple_func.approx_on_mem hgm.measurable _ _ _ },
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/
lemma convex.average_mem [is_finite_measure μ] (hs : convex ℝ s) (hsc : is_closed s) (hμ : μ ≠ 0)
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  ⨍ x, f x ∂μ ∈ s :=
begin
  haveI : is_probability_measure ((μ univ)⁻¹ • μ),
    from is_probability_measure_smul hμ,
  refine hs.integral_mem hsc (ae_mono' _ hfs) hfi.to_average,
  exact absolutely_continuous.smul (refl _) _
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/
lemma convex.set_average_mem (hs : convex ℝ s) (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞)
  (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) :
  ⨍ x in t, f x ∂μ ∈ s :=
begin
  haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩,
  refine hs.average_mem hsc _ hfs hfi,
  rwa [ne.def, restrict_eq_zero]
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex set in `E`, and `f` is an integrable
function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `closure s`:
`⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/
lemma convex.set_average_mem_closure (hs : convex ℝ s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞)
  (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) :
  ⨍ x in t, f x ∂μ ∈ closure s :=
hs.closure.set_average_mem is_closed_closure h0 ht (hfs.mono $ λ x hx, subset_closure hx) hfi

lemma convex_on.average_mem_epigraph [is_finite_measure μ] (hg : convex_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} :=
have ht_mem : ∀ᵐ x ∂μ, (f x, g (f x)) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2},
  from hfs.mono (λ x hx, ⟨hx, le_rfl⟩),
by simpa only [average_pair hfi hgi]
  using hg.convex_epigraph.average_mem (hsc.epigraph hgc) hμ ht_mem (hfi.prod_mk hgi)

lemma concave_on.average_mem_hypograph [is_finite_measure μ] (hg : concave_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} :=
by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff]
  using hg.neg.average_mem_epigraph hgc.neg hsc hμ hfs hfi hgi.neg

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points to `s`, then the value of `g` at the average value of `f` is less than or equal to
the average value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also
`convex_on.map_center_mass_le` for a finite sum version of this lemma. -/
lemma convex_on.map_average_le [is_finite_measure μ] (hg : convex_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  g (⨍ x, f x ∂μ) ≤ ⨍ x, g (f x) ∂μ :=
(hg.average_mem_epigraph hgc hsc hμ hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points to `s`, then the average value of `g ∘ f` is less than or equal to the value of `g`
at the average value of `f` provided that both `f` and `g ∘ f` are integrable. See also
`concave_on.le_map_center_mass` for a finite sum version of this lemma. -/
lemma concave_on.le_map_average [is_finite_measure μ] (hg : concave_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  ⨍ x, g (f x) ∂μ ≤ g (⨍ x, f x ∂μ) :=
(hg.average_mem_hypograph hgc hsc hμ hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is
less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are
integrable. -/
lemma convex_on.set_average_mem_epigraph (hg : convex_on ℝ s g) (hgc : continuous_on g s)
  (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s)
  (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) :
  (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} :=
begin
  haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩,
  refine hg.average_mem_epigraph hgc hsc _ hfs hfi hgi,
  rwa [ne.def, restrict_eq_zero]
end

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or
equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f`
are integrable. -/
lemma concave_on.set_average_mem_hypograph (hg : concave_on ℝ s g) (hgc : continuous_on g s)
  (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s)
  (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) :
  (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} :=
by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff]
  using hg.neg.set_average_mem_epigraph hgc.neg hsc h0 ht hfs hfi hgi.neg

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is
less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are
integrable. -/
lemma convex_on.map_set_average_le (hg : convex_on ℝ s g) (hgc : continuous_on g s)
  (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s)
  (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) :
  g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ :=
(hg.set_average_mem_epigraph hgc hsc h0 ht hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or
equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f`
are integrable. -/
lemma concave_on.le_map_set_average (hg : concave_on ℝ s g) (hgc : continuous_on g s)
  (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s)
  (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) :
  ⨍ x in t, g (f x) ∂μ ≤ g (⨍ x in t, f x ∂μ) :=
(hg.set_average_mem_hypograph hgc hsc h0 ht hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e.  points
to `s`, then the value of `g` at the expected value of `f` is less than or equal to the expected
value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also
`convex_on.map_center_mass_le` for a finite sum version of this lemma. -/
lemma convex_on.map_integral_le [is_probability_measure μ] (hg : convex_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ)
  (hgi : integrable (g ∘ f) μ) :
  g (∫ x, f x ∂μ) ≤ ∫ x, g (f x) ∂μ :=
by simpa only [average_eq_integral]
  using hg.map_average_le hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e.  points
to `s`, then the expected value of `g ∘ f` is less than or equal to the value of `g` at the expected
value of `f` provided that both `f` and `g ∘ f` are integrable. -/
lemma concave_on.le_map_integral [is_probability_measure μ] (hg : concave_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ)
  (hgi : integrable (g ∘ f) μ) :
  ∫ x, g (f x) ∂μ ≤ g (∫ x, f x ∂μ) :=
by simpa only [average_eq_integral]
  using hg.le_map_average hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi

/-!
### Strict Jensen's inequality
-/

/-- If `f : α → E` is an integrable function, then either it is a.e. equal to the constant
`⨍ x, f x ∂μ` or there exists a measurable set such that `μ t ≠ 0`, `μ tᶜ ≠ 0`, and the average
values of `f` over `t` and `tᶜ` are different. -/
lemma ae_eq_const_or_exists_average_ne_compl [is_finite_measure μ] (hfi : integrable f μ) :
  (f =ᵐ[μ] const α (⨍ x, f x ∂μ)) ∨ ∃ t, measurable_set t ∧ μ t ≠ 0 ∧ μ tᶜ ≠ 0 ∧
    ⨍ x in t, f x ∂μ ≠ ⨍ x in tᶜ, f x ∂μ :=
begin
  refine or_iff_not_imp_right.mpr (λ H, _), push_neg at H,
  refine hfi.ae_eq_of_forall_set_integral_eq _ _ (integrable_const _) (λ t ht ht', _), clear ht',
  simp only [const_apply, set_integral_const],
  by_cases h₀ : μ t = 0,
  { rw [restrict_eq_zero.2 h₀, integral_zero_measure, h₀, ennreal.zero_to_real, zero_smul] },
  by_cases h₀' : μ tᶜ = 0,
  { rw ← ae_eq_univ at h₀',
    rw [restrict_congr_set h₀', restrict_univ, measure_congr h₀', measure_smul_average] },
  have := average_mem_open_segment_compl_self ht.null_measurable_set h₀ h₀' hfi,
  rw [← H t ht h₀ h₀', open_segment_same, mem_singleton_iff] at this,
  rw [this, measure_smul_set_average _ (measure_ne_top μ _)]
end

/-- If an integrable function `f : α → E` takes values in a convex set `s` and for some set `t` of
positive measure, the average value of `f` over `t` belongs to the interior of `s`, then the average
of `f` over the whole space belongs to the interior of `s`. -/
lemma convex.average_mem_interior_of_set [is_finite_measure μ] (hs : convex ℝ s) (h0 : μ t ≠ 0)
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (ht : ⨍ x in t, f x ∂μ ∈ interior s) :
  ⨍ x, f x ∂μ ∈ interior s :=
begin
  rw ← measure_to_measurable at h0, rw ← restrict_to_measurable (measure_ne_top μ t) at ht,
  by_cases h0' : μ (to_measurable μ t)ᶜ = 0,
  { rw ← ae_eq_univ at h0',
    rwa [restrict_congr_set h0', restrict_univ] at ht },
  exact hs.open_segment_interior_closure_subset_interior ht
    (hs.set_average_mem_closure h0' (measure_ne_top _ _) (ae_restrict_of_ae hfs) hfi.integrable_on)
    (average_mem_open_segment_compl_self (measurable_set_to_measurable μ t).null_measurable_set
      h0 h0' hfi)
end

/-- If an integrable function `f : α → E` takes values in a strictly convex closed set `s`, then
either it is a.e. equal to its average value, or its average value belongs to the interior of
`s`. -/
lemma strict_convex.ae_eq_const_or_average_mem_interior [is_finite_measure μ]
  (hs : strict_convex ℝ s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, f x ∂μ ∈ interior s :=
begin
  have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s,
    from λ t ht, hs.convex.set_average_mem hsc ht (measure_ne_top _ _) (ae_restrict_of_ae hfs)
      hfi.integrable_on,
  refine (ae_eq_const_or_exists_average_ne_compl hfi).imp_right _,
  rintro ⟨t, hm, h₀, h₀', hne⟩,
  exact hs.open_segment_subset (this h₀) (this h₀') hne
    (average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' hfi)
end

/-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a
convex closed set `s`, and `g : E → ℝ` is continuous and strictly convex on `s`, then
either `f` is a.e. equal to its average value, or `g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ`. -/
lemma strict_convex_on.ae_eq_const_or_map_average_lt [is_finite_measure μ]
  (hg : strict_convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s)
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ :=
begin
  have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s ∧ g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ,
    from λ t ht, hg.convex_on.set_average_mem_epigraph hgc hsc ht (measure_ne_top _ _)
      (ae_restrict_of_ae hfs) hfi.integrable_on hgi.integrable_on,
  refine (ae_eq_const_or_exists_average_ne_compl hfi).imp_right _,
  rintro ⟨t, hm, h₀, h₀', hne⟩,
  rcases average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' (hfi.prod_mk hgi)
    with ⟨a, b, ha, hb, hab, h_avg⟩,
  simp only [average_pair hfi hgi, average_pair hfi.integrable_on hgi.integrable_on, prod.smul_mk,
    prod.mk_add_mk, prod.mk.inj_iff, (∘)] at h_avg,
  rw [← h_avg.1, ← h_avg.2],
  calc g (a • ⨍ x in t, f x ∂μ + b • ⨍ x in tᶜ, f x ∂μ)
      < a * g (⨍ x in t, f x ∂μ) + b * g (⨍ x in tᶜ, f x ∂μ) :
    hg.2 (this h₀).1 (this h₀').1 hne ha hb hab
  ... ≤ a * ⨍ x in t, g (f x) ∂μ + b * ⨍ x in tᶜ, g (f x) ∂μ :
    add_le_add (mul_le_mul_of_nonneg_left (this h₀).2 ha.le)
      (mul_le_mul_of_nonneg_left (this h₀').2 hb.le)
end

/-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a
convex closed set `s`, and `g : E → ℝ` is continuous and strictly concave on `s`, then
either `f` is a.e. equal to its average value, or `⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ)`. -/
lemma strict_concave_on.ae_eq_const_or_lt_map_average [is_finite_measure μ]
  (hg : strict_concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s)
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ) :=
by simpa only [pi.neg_apply, average_neg, neg_lt_neg_iff]
  using hg.neg.ae_eq_const_or_map_average_lt hgc.neg hsc hfs hfi hgi.neg

/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C`
a.e., then either this function is a.e. equal to its average value, or the norm of its average value
is strictly less than `C`. -/
lemma ae_eq_const_or_norm_average_lt_of_norm_le_const [strict_convex_space ℝ E]
  (h_le : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
  (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ‖⨍ x, f x ∂μ‖ < C :=
begin
  cases le_or_lt C 0 with hC0 hC0,
  { have : f =ᵐ[μ] 0, from h_le.mono (λ x hx, norm_le_zero_iff.1 (hx.trans hC0)),
    simp only [average_congr this, pi.zero_apply, average_zero],
    exact or.inl this },
  by_cases hfi : integrable f μ, swap,
    by simp [average_eq, integral_undef hfi, hC0, ennreal.to_real_pos_iff],
  cases (le_top : μ univ ≤ ∞).eq_or_lt with hμt hμt, { simp [average_eq, hμt, hC0] },
  haveI : is_finite_measure μ := ⟨hμt⟩,
  replace h_le : ∀ᵐ x ∂μ, f x ∈ closed_ball (0 : E) C, by simpa only [mem_closed_ball_zero_iff],
  simpa only [interior_closed_ball _ hC0.ne', mem_ball_zero_iff]
    using (strict_convex_closed_ball ℝ (0 : E) C).ae_eq_const_or_average_mem_interior
      is_closed_ball h_le hfi
end

/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C`
a.e., then either this function is a.e. equal to its average value, or the norm of its integral is
strictly less than `(μ univ).to_real * C`. -/
lemma ae_eq_const_or_norm_integral_lt_of_norm_le_const [strict_convex_space ℝ E]
  [is_finite_measure μ] (h_le : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
  (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ‖∫ x, f x ∂μ‖ < (μ univ).to_real * C :=
begin
  cases eq_or_ne μ 0 with h₀ h₀, { left, simp [h₀] },
  have hμ : 0 < (μ univ).to_real,
    by simp [ennreal.to_real_pos_iff, pos_iff_ne_zero, h₀, measure_lt_top],
  refine (ae_eq_const_or_norm_average_lt_of_norm_le_const h_le).imp_right (λ H, _),
  rwa [average_eq, norm_smul, norm_inv, real.norm_eq_abs, abs_of_pos hμ,
    ← div_eq_inv_mul, div_lt_iff' hμ] at H
end

/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C`
a.e. on a set `t` of finite measure, then either this function is a.e. equal to its average value on
`t`, or the norm of its integral over `t` is strictly less than `(μ t).to_real * C`. -/
lemma ae_eq_const_or_norm_set_integral_lt_of_norm_le_const [strict_convex_space ℝ E]
  (ht : μ t ≠ ∞) (h_le : ∀ᵐ x ∂μ.restrict t, ‖f x‖ ≤ C) :
  (f =ᵐ[μ.restrict t] const α ⨍ x in t, f x ∂μ) ∨ ‖∫ x in t, f x ∂μ‖ < (μ t).to_real * C :=
begin
  haveI := fact.mk ht.lt_top,
  rw [← restrict_apply_univ],
  exact ae_eq_const_or_norm_integral_lt_of_norm_le_const h_le
end


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.calculus.extend_deriv
import analysis.calculus.iterated_deriv
import analysis.special_functions.exp_log
import analysis.normed_space.euclidean_dist
import topology.algebra.polynomial

/-!
# Infinitely smooth bump function

In this file we construct several infinitely smooth functions with properties that an analytic
function cannot have:

* `exp_neg_inv_glue` is equal to zero for `x ≤ 0` and is strictly positive otherwise; it is given by
  `x ↦ exp (-1/x)` for `x > 0`;

* `real.smooth_transition` is equal to zero for `x ≤ 0` and is equal to one for `x ≥ 1`; it is given
  by `exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x))`;

* `f : times_cont_diff_bump_of_inner c`, where `c` is a point in an inner product space, is
  a bundled smooth function such that

  - `f` is equal to `1` in `metric.closed_ball c f.r`;
  - `support f = metric.ball c f.R`;
  - `0 ≤ f x ≤ 1` for all `x`.

  The structure `times_cont_diff_bump_of_inner` contains the data required to construct the
  function: real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available
  through `coe_fn`.

* `f : times_cont_diff_bump c`, where `c` is a point in a finite dimensional real vector space, is a
  bundled smooth function such that

  - `f` is equal to `1` in `euclidean.closed_ball c f.r`;
  - `support f = euclidean.ball c f.R`;
  - `0 ≤ f x ≤ 1` for all `x`.

  The structure `times_cont_diff_bump` contains the data required to construct the function: real
  numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through `coe_fn`.
-/

noncomputable theory
open_locale classical topological_space

open polynomial real filter set function

/-- `exp_neg_inv_glue` is the real function given by `x ↦ exp (-1/x)` for `x > 0` and `0`
for `x ≤ 0`. It is a basic building block to construct smooth partitions of unity. Its main property
is that it vanishes for `x ≤ 0`, it is positive for `x > 0`, and the junction between the two
behaviors is flat enough to retain smoothness. The fact that this function is `C^∞` is proved in
`exp_neg_inv_glue.smooth`. -/
def exp_neg_inv_glue (x : ℝ) : ℝ := if x ≤ 0 then 0 else exp (-x⁻¹)

namespace exp_neg_inv_glue

/-- Our goal is to prove that `exp_neg_inv_glue` is `C^∞`. For this, we compute its successive
derivatives for `x > 0`. The `n`-th derivative is of the form `P_aux n (x) exp(-1/x) / x^(2 n)`,
where `P_aux n` is computed inductively. -/
noncomputable def P_aux : ℕ → polynomial ℝ
| 0 := 1
| (n+1) := X^2 * (P_aux n).derivative  + (1 - C ↑(2 * n) * X) * (P_aux n)

/-- Formula for the `n`-th derivative of `exp_neg_inv_glue`, as an auxiliary function `f_aux`. -/
def f_aux (n : ℕ) (x : ℝ) : ℝ :=
if x ≤ 0 then 0 else (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)

/-- The `0`-th auxiliary function `f_aux 0` coincides with `exp_neg_inv_glue`, by definition. -/
lemma f_aux_zero_eq : f_aux 0 = exp_neg_inv_glue :=
begin
   ext x,
   by_cases h : x ≤ 0,
   { simp [exp_neg_inv_glue, f_aux, h] },
   { simp [h, exp_neg_inv_glue, f_aux, ne_of_gt (not_le.1 h), P_aux] }
end

/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n`
(given in this statement in unfolded form) is the `n+1`-th auxiliary function, since
the polynomial `P_aux (n+1)` was chosen precisely to ensure this. -/
lemma f_aux_deriv (n : ℕ) (x : ℝ) (hx : x ≠ 0) :
  has_deriv_at (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n))
    ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x :=
begin
  have A : ∀k:ℕ, 2 * (k + 1) - 1 = 2 * k + 1,
  { assume k,
    rw nat.sub_eq_iff_eq_add,
    { ring },
    { simpa [mul_add] using add_le_add (zero_le (2 * k)) one_le_two } },
  convert (((P_aux n).has_deriv_at x).mul
               (((has_deriv_at_exp _).comp x (has_deriv_at_inv hx).neg))).div
            (has_deriv_at_pow (2 * n) x) (pow_ne_zero _ hx) using 1,
  field_simp [hx, P_aux],
  -- `ring_exp` can't solve `p ∨ q` goal generated by `mul_eq_mul_right_iff`
  cases n; simp [nat.succ_eq_add_one, A, -mul_eq_mul_right_iff]; ring_exp
end

/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n`
is the `n+1`-th auxiliary function. -/
lemma f_aux_deriv_pos (n : ℕ) (x : ℝ) (hx : 0 < x) :
  has_deriv_at (f_aux n) ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x :=
begin
  apply (f_aux_deriv n x (ne_of_gt hx)).congr_of_eventually_eq,
  filter_upwards [lt_mem_nhds hx],
  assume y hy,
  simp [f_aux, hy.not_le]
end

/-- To get differentiability at `0` of the auxiliary functions, we need to know that their limit
is `0`, to be able to apply general differentiability extension theorems. This limit is checked in
this lemma. -/
lemma f_aux_limit (n : ℕ) :
  tendsto (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)) (𝓝[Ioi 0] 0) (𝓝 0) :=
begin
  have A : tendsto (λx, (P_aux n).eval x) (𝓝[Ioi 0] 0) (𝓝 ((P_aux n).eval 0)) :=
  (P_aux n).continuous_within_at,
  have B : tendsto (λx, exp (-x⁻¹) / x^(2 * n)) (𝓝[Ioi 0] 0) (𝓝 0),
  { convert (tendsto_pow_mul_exp_neg_at_top_nhds_0 (2 * n)).comp tendsto_inv_zero_at_top,
    ext x,
    field_simp },
  convert A.mul B;
  simp [mul_div_assoc]
end

/-- Deduce from the limiting behavior at `0` of its derivative and general differentiability
extension theorems that the auxiliary function `f_aux n` is differentiable at `0`,
with derivative `0`. -/
lemma f_aux_deriv_zero (n : ℕ) : has_deriv_at (f_aux n) 0 0 :=
begin
  -- we check separately differentiability on the left and on the right
  have A : has_deriv_within_at (f_aux n) (0 : ℝ) (Iic 0) 0,
  { apply (has_deriv_at_const (0 : ℝ) (0 : ℝ)).has_deriv_within_at.congr,
    { assume y hy,
      simp at hy,
      simp [f_aux, hy] },
    { simp [f_aux, le_refl] } },
  have B : has_deriv_within_at (f_aux n) (0 : ℝ) (Ici 0) 0,
  { have diff : differentiable_on ℝ (f_aux n) (Ioi 0) :=
      λx hx, (f_aux_deriv_pos n x hx).differentiable_at.differentiable_within_at,
    -- next line is the nontrivial bit of this proof, appealing to differentiability
    -- extension results.
    apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff _ self_mem_nhds_within,
    { refine (f_aux_limit (n+1)).congr' _,
      apply mem_sets_of_superset self_mem_nhds_within (λx hx, _),
      simp [(f_aux_deriv_pos n x hx).deriv] },
    { have : f_aux n 0 = 0, by simp [f_aux, le_refl],
      simp only [continuous_within_at, this],
      refine (f_aux_limit n).congr' _,
      apply mem_sets_of_superset self_mem_nhds_within (λx hx, _),
      have : ¬(x ≤ 0), by simpa using hx,
      simp [f_aux, this] } },
  simpa using A.union B,
end

/-- At every point, the auxiliary function `f_aux n` has a derivative which is
equal to `f_aux (n+1)`. -/
lemma f_aux_has_deriv_at (n : ℕ) (x : ℝ) : has_deriv_at (f_aux n) (f_aux (n+1) x) x :=
begin
  -- check separately the result for `x < 0`, where it is trivial, for `x > 0`, where it is done
  -- in `f_aux_deriv_pos`, and for `x = 0`, done in
  -- `f_aux_deriv_zero`.
  rcases lt_trichotomy x 0 with hx|hx|hx,
  { have : f_aux (n+1) x = 0, by simp [f_aux, le_of_lt hx],
    rw this,
    apply (has_deriv_at_const x (0 : ℝ)).congr_of_eventually_eq,
    filter_upwards [gt_mem_nhds hx],
    assume y hy,
    simp [f_aux, hy.le] },
  { have : f_aux (n + 1) 0 = 0, by simp [f_aux, le_refl],
    rw [hx, this],
    exact f_aux_deriv_zero n },
  { have : f_aux (n+1) x = (P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n+1)),
      by simp [f_aux, not_le_of_gt hx],
    rw this,
    exact f_aux_deriv_pos n x hx },
end

/-- The successive derivatives of the auxiliary function `f_aux 0` are the
functions `f_aux n`, by induction. -/
lemma f_aux_iterated_deriv (n : ℕ) : iterated_deriv n (f_aux 0) = f_aux n :=
begin
  induction n with n IH,
  { simp },
  { simp [iterated_deriv_succ, IH],
    ext x,
    exact (f_aux_has_deriv_at n x).deriv }
end

/-- The function `exp_neg_inv_glue` is smooth. -/
protected theorem times_cont_diff {n} : times_cont_diff ℝ n exp_neg_inv_glue :=
begin
  rw ← f_aux_zero_eq,
  apply times_cont_diff_of_differentiable_iterated_deriv (λ m hm, _),
  rw f_aux_iterated_deriv m,
  exact λ x, (f_aux_has_deriv_at m x).differentiable_at
end

/-- The function `exp_neg_inv_glue` vanishes on `(-∞, 0]`. -/
lemma zero_of_nonpos {x : ℝ} (hx : x ≤ 0) : exp_neg_inv_glue x = 0 :=
by simp [exp_neg_inv_glue, hx]

/-- The function `exp_neg_inv_glue` is positive on `(0, +∞)`. -/
lemma pos_of_pos {x : ℝ} (hx : 0 < x) : 0 < exp_neg_inv_glue x :=
by simp [exp_neg_inv_glue, not_le.2 hx, exp_pos]

/-- The function exp_neg_inv_glue` is nonnegative. -/
lemma nonneg (x : ℝ) : 0 ≤ exp_neg_inv_glue x :=
begin
  cases le_or_gt x 0,
  { exact ge_of_eq (zero_of_nonpos h) },
  { exact le_of_lt (pos_of_pos h) }
end

end exp_neg_inv_glue

/-- An infinitely smooth function `f : ℝ → ℝ` such that `f x = 0` for `x ≤ 0`,
`f x = 1` for `1 ≤ x`, and `0 < f x < 1` for `0 < x < 1`. -/
def real.smooth_transition (x : ℝ) : ℝ :=
exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x))

namespace real

namespace smooth_transition

variables {x : ℝ}

open exp_neg_inv_glue

lemma pos_denom (x) : 0 < exp_neg_inv_glue x + exp_neg_inv_glue (1 - x) :=
((@zero_lt_one ℝ _ _).lt_or_lt x).elim
  (λ hx, add_pos_of_pos_of_nonneg (pos_of_pos hx) (nonneg _))
  (λ hx, add_pos_of_nonneg_of_pos (nonneg _) (pos_of_pos $ sub_pos.2 hx))

lemma one_of_one_le (h : 1 ≤ x) : smooth_transition x = 1 :=
(div_eq_one_iff_eq $ (pos_denom x).ne').2 $ by rw [zero_of_nonpos (sub_nonpos.2 h), add_zero]

lemma zero_of_nonpos (h : x ≤ 0) : smooth_transition x = 0 :=
by rw [smooth_transition, zero_of_nonpos h, zero_div]

lemma le_one (x : ℝ) : smooth_transition x ≤ 1 :=
(div_le_one (pos_denom x)).2 $ le_add_of_nonneg_right (nonneg _)

lemma nonneg (x : ℝ) : 0 ≤ smooth_transition x :=
div_nonneg (exp_neg_inv_glue.nonneg _) (pos_denom x).le

lemma lt_one_of_lt_one (h : x < 1) : smooth_transition x < 1 :=
(div_lt_one $ pos_denom x).2 $ lt_add_of_pos_right _ $ pos_of_pos $ sub_pos.2 h

lemma pos_of_pos (h : 0 < x) : 0 < smooth_transition x :=
div_pos (exp_neg_inv_glue.pos_of_pos h) (pos_denom x)

protected lemma times_cont_diff {n} : times_cont_diff ℝ n smooth_transition :=
exp_neg_inv_glue.times_cont_diff.div
  (exp_neg_inv_glue.times_cont_diff.add $ exp_neg_inv_glue.times_cont_diff.comp $
    times_cont_diff_const.sub times_cont_diff_id) $
  λ x, (pos_denom x).ne'

protected lemma times_cont_diff_at {x n} : times_cont_diff_at ℝ n smooth_transition x :=
smooth_transition.times_cont_diff.times_cont_diff_at

end smooth_transition

end real

variable {E : Type*}

/-- `f : times_cont_diff_bump_of_inner c`, where `c` is a point in an inner product space, is a
bundled smooth function such that

- `f` is equal to `1` in `metric.closed_ball c f.r`;
- `support f = metric.ball c f.R`;
- `0 ≤ f x ≤ 1` for all `x`.

The structure `times_cont_diff_bump_of_inner` contains the data required to construct the function:
real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through
`coe_fn`. -/
structure times_cont_diff_bump_of_inner (c : E) :=
(r R : ℝ)
(r_pos : 0 < r)
(r_lt_R : r < R)

namespace times_cont_diff_bump_of_inner

lemma R_pos {c : E} (f : times_cont_diff_bump_of_inner c) : 0 < f.R := f.r_pos.trans f.r_lt_R

instance (c : E) : inhabited (times_cont_diff_bump_of_inner c) := ⟨⟨1, 2, zero_lt_one, one_lt_two⟩⟩

variables [inner_product_space ℝ E] {c : E} (f : times_cont_diff_bump_of_inner c) {x : E}

/-- The function defined by `f : times_cont_diff_bump_of_inner c`. Use automatic coercion to
function instead. -/
def to_fun (f : times_cont_diff_bump_of_inner c) : E → ℝ :=
λ x, real.smooth_transition ((f.R - dist x c) / (f.R - f.r))

instance : has_coe_to_fun (times_cont_diff_bump_of_inner c) := ⟨_, to_fun⟩

open real (smooth_transition) real.smooth_transition metric

lemma one_of_mem_closed_ball (hx : x ∈ closed_ball c f.r) :
  f x = 1 :=
one_of_one_le $ (one_le_div (sub_pos.2 f.r_lt_R)).2 $ sub_le_sub_left hx _

lemma nonneg : 0 ≤ f x := nonneg _

lemma le_one : f x ≤ 1 := le_one _

lemma pos_of_mem_ball (hx : x ∈ ball c f.R) : 0 < f x :=
pos_of_pos $ div_pos (sub_pos.2 hx) (sub_pos.2 f.r_lt_R)

lemma lt_one_of_lt_dist (h : f.r < dist x c) : f x < 1 :=
lt_one_of_lt_one $ (div_lt_one (sub_pos.2 f.r_lt_R)).2 $ sub_lt_sub_left h _

lemma zero_of_le_dist (hx : f.R ≤ dist x c) : f x = 0 :=
zero_of_nonpos $ div_nonpos_of_nonpos_of_nonneg (sub_nonpos.2 hx) (sub_nonneg.2 f.r_lt_R.le)

lemma support_eq : support ⇑f = metric.ball c f.R :=
begin
  ext x,
  suffices : f x ≠ 0 ↔ dist x c < f.R, by simpa [mem_support],
  cases lt_or_le (dist x c) f.R with hx hx,
  { simp [hx, (f.pos_of_mem_ball hx).ne'] },
  { simp [hx.not_lt, f.zero_of_le_dist hx] }
end

lemma eventually_eq_one_of_mem_ball (h : x ∈ ball c f.r) :
  f =ᶠ[𝓝 x] 1 :=
((is_open_lt (continuous_id.dist continuous_const) continuous_const).eventually_mem h).mono $
  λ z hz, f.one_of_mem_closed_ball (le_of_lt hz)

lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 :=
f.eventually_eq_one_of_mem_ball (mem_ball_self f.r_pos)

protected lemma times_cont_diff_at {n} :
  times_cont_diff_at ℝ n f x :=
begin
  rcases em (x = c) with rfl|hx,
  { refine times_cont_diff_at.congr_of_eventually_eq _ f.eventually_eq_one,
    rw pi.one_def,
    exact times_cont_diff_at_const },
  { exact real.smooth_transition.times_cont_diff_at.comp x
      (times_cont_diff_at.div_const $ times_cont_diff_at_const.sub $
        times_cont_diff_at_id.dist times_cont_diff_at_const hx) }
end

protected lemma times_cont_diff {n} :
  times_cont_diff ℝ n f :=
times_cont_diff_iff_times_cont_diff_at.2 $ λ y, f.times_cont_diff_at

protected lemma times_cont_diff_within_at {s n} :
  times_cont_diff_within_at ℝ n f s x :=
f.times_cont_diff_at.times_cont_diff_within_at

end times_cont_diff_bump_of_inner

/-- `f : times_cont_diff_bump c`, where `c` is a point in a finite dimensional real vector space, is
a bundled smooth function such that

  - `f` is equal to `1` in `euclidean.closed_ball c f.r`;
  - `support f = euclidean.ball c f.R`;
  - `0 ≤ f x ≤ 1` for all `x`.

The structure `times_cont_diff_bump` contains the data required to construct the function: real
numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through `coe_fn`.-/
structure times_cont_diff_bump [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] (c : E)
  extends times_cont_diff_bump_of_inner (to_euclidean c)

namespace times_cont_diff_bump

variables [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {c x : E}
  (f : times_cont_diff_bump c)

/-- The function defined by `f : times_cont_diff_bump c`. Use automatic coercion to function
instead. -/
def to_fun (f : times_cont_diff_bump c) : E → ℝ := f.to_times_cont_diff_bump_of_inner ∘ to_euclidean

instance : has_coe_to_fun (times_cont_diff_bump c) :=
⟨λ f, E → ℝ, to_fun⟩

instance (c : E) : inhabited (times_cont_diff_bump c) := ⟨⟨default _⟩⟩

lemma R_pos : 0 < f.R := f.to_times_cont_diff_bump_of_inner.R_pos

lemma coe_eq_comp : ⇑f = f.to_times_cont_diff_bump_of_inner ∘ to_euclidean := rfl

lemma one_of_mem_closed_ball (hx : x ∈ euclidean.closed_ball c f.r) :
  f x = 1 :=
f.to_times_cont_diff_bump_of_inner.one_of_mem_closed_ball hx

lemma nonneg : 0 ≤ f x := f.to_times_cont_diff_bump_of_inner.nonneg

lemma le_one : f x ≤ 1 := f.to_times_cont_diff_bump_of_inner.le_one

lemma pos_of_mem_ball (hx : x ∈ euclidean.ball c f.R) : 0 < f x :=
f.to_times_cont_diff_bump_of_inner.pos_of_mem_ball hx

lemma lt_one_of_lt_dist (h : f.r < euclidean.dist x c) : f x < 1 :=
f.to_times_cont_diff_bump_of_inner.lt_one_of_lt_dist h

lemma zero_of_le_dist (hx : f.R ≤ euclidean.dist x c) : f x = 0 :=
f.to_times_cont_diff_bump_of_inner.zero_of_le_dist hx

lemma support_eq : support ⇑f = euclidean.ball c f.R :=
by rw [euclidean.ball_eq_preimage, ← f.to_times_cont_diff_bump_of_inner.support_eq,
  ← support_comp_eq_preimage, coe_eq_comp]

lemma closure_support_eq : closure (support f) = euclidean.closed_ball c f.R :=
by rw [f.support_eq, euclidean.closure_ball _ f.R_pos]

lemma compact_closure_support : is_compact (closure (support f)) :=
by { rw f.closure_support_eq, exact euclidean.compact_ball }

lemma eventually_eq_one_of_mem_ball (h : x ∈ euclidean.ball c f.r) :
  f =ᶠ[𝓝 x] 1 :=
to_euclidean.continuous_at (f.to_times_cont_diff_bump_of_inner.eventually_eq_one_of_mem_ball h)

lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 :=
f.eventually_eq_one_of_mem_ball $ euclidean.mem_ball_self f.r_pos

protected lemma times_cont_diff {n} :
  times_cont_diff ℝ n f :=
f.to_times_cont_diff_bump_of_inner.times_cont_diff.comp (to_euclidean : E ≃L[ℝ] _).times_cont_diff

protected lemma times_cont_diff_at {n} :
  times_cont_diff_at ℝ n f x :=
f.times_cont_diff.times_cont_diff_at

protected lemma times_cont_diff_within_at {s n} :
  times_cont_diff_within_at ℝ n f s x :=
f.times_cont_diff_at.times_cont_diff_within_at

lemma exists_closure_support_subset {s : set E} (hs : s ∈ 𝓝 c) :
  ∃ f : times_cont_diff_bump c, closure (support f) ⊆ s :=
let ⟨R, h0, hR⟩ := euclidean.nhds_basis_closed_ball.mem_iff.1 hs
in ⟨⟨⟨R / 2, R, half_pos h0, half_lt_self h0⟩⟩, by rwa closure_support_eq⟩

lemma exists_closure_subset {R : ℝ} (hR : 0 < R)
  {s : set E} (hs : is_closed s) (hsR : s ⊆ euclidean.ball c R) :
  ∃ f : times_cont_diff_bump c, f.R = R ∧ s ⊆ euclidean.ball c f.r :=
begin
  rcases euclidean.exists_pos_lt_subset_ball hR hs hsR with ⟨r, hr, hsr⟩,
  exact ⟨⟨⟨r, R, hr.1, hr.2⟩⟩, rfl, hsr⟩
end

end times_cont_diff_bump

open finite_dimensional metric

/-- If `E` is a finite dimensional normed space over `ℝ`, then for any point `x : E` and its
neighborhood `s` there exists an infinitely smooth function with the following properties:

* `f y = 1` in a neighborhood of `x`;
* `f y = 0` outside of `s`;
*  moreover, `closure (support f) ⊆ s` and `closure (support f)` is a compact set;
* `f y ∈ [0, 1]` for all `y`.

This lemma is a simple wrapper around lemmas about bundled smooth bump functions, see
`times_cont_diff_bump`. -/
lemma exists_times_cont_diff_bump_function_of_mem_nhds [normed_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E] {x : E} {s : set E} (hs : s ∈ 𝓝 x) :
  ∃ f : E → ℝ, f =ᶠ[𝓝 x] 1 ∧ (∀ y, f y ∈ Icc (0 : ℝ) 1) ∧ times_cont_diff ℝ ⊤ f ∧
    is_compact (closure $ support f) ∧ closure (support f) ⊆ s :=
let ⟨f, hf⟩ := times_cont_diff_bump.exists_closure_support_subset hs in
⟨f, f.eventually_eq_one, λ y, ⟨f.nonneg, f.le_one⟩, f.times_cont_diff,
  f.compact_closure_support, hf⟩


/-
Copyright (c) 2020 Google LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Wong

! This file was ported from Lean 3 source module data.list.palindrome
! leanprover-community/mathlib commit 00f4ab49e7d5139216e0b3daad15fffa504897ab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Basic

/-!
# Palindromes

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

This module defines *palindromes*, lists which are equal to their reverse.

The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction
principle. Also provided are conversions to and from other equivalent definitions.

## References

* [Pierre Castéran, *On palindromes*][casteran]

[casteran]: https://www.labri.fr/perso/casteran/CoqArt/inductive-prop-chap/palindrome.html

## Tags

palindrome, reverse, induction
-/

variable {α β : Type _}

namespace List

#print List.Palindrome /-
/-- `palindrome l` asserts that `l` is a palindrome. This is defined inductively:

* The empty list is a palindrome;
* A list with one element is a palindrome;
* Adding the same element to both ends of a palindrome results in a bigger palindrome.
-/
inductive Palindrome : List α → Prop
  | nil : palindrome []
  | singleton : ∀ x, palindrome [x]
  | cons_concat : ∀ (x) {l}, palindrome l → palindrome (x :: (l ++ [x]))
#align list.palindrome List.Palindrome
-/

namespace Palindrome

variable {l : List α}

#print List.Palindrome.reverse_eq /-
theorem reverse_eq {l : List α} (p : Palindrome l) : reverse l = l :=
  Palindrome.rec_on p rfl (fun _ => rfl) fun x l p h => by simp [h]
#align list.palindrome.reverse_eq List.Palindrome.reverse_eq
-/

#print List.Palindrome.of_reverse_eq /-
theorem of_reverse_eq {l : List α} : reverse l = l → Palindrome l :=
  by
  refine' bidirectional_rec_on l (fun _ => palindrome.nil) (fun a _ => palindrome.singleton a) _
  intro x l y hp hr
  rw [reverse_cons, reverse_append] at hr
  rw [head_eq_of_cons_eq hr]
  have : palindrome l := hp (append_inj_left' (tail_eq_of_cons_eq hr) rfl)
  exact palindrome.cons_concat x this
#align list.palindrome.of_reverse_eq List.Palindrome.of_reverse_eq
-/

#print List.Palindrome.iff_reverse_eq /-
theorem iff_reverse_eq {l : List α} : Palindrome l ↔ reverse l = l :=
  Iff.intro reverse_eq of_reverse_eq
#align list.palindrome.iff_reverse_eq List.Palindrome.iff_reverse_eq
-/

#print List.Palindrome.append_reverse /-
theorem append_reverse (l : List α) : Palindrome (l ++ reverse l) :=
  by
  apply of_reverse_eq
  rw [reverse_append, reverse_reverse]
#align list.palindrome.append_reverse List.Palindrome.append_reverse
-/

/- warning: list.palindrome.map -> List.Palindrome.map is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {l : List.{u1} α} (f : α -> β), (List.Palindrome.{u1} α l) -> (List.Palindrome.{u2} β (List.map.{u1, u2} α β f l))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {l : List.{u2} α} (f : α -> β), (List.Palindrome.{u2} α l) -> (List.Palindrome.{u1} β (List.map.{u2, u1} α β f l))
Case conversion may be inaccurate. Consider using '#align list.palindrome.map List.Palindrome.mapₓ'. -/
protected theorem map (f : α → β) (p : Palindrome l) : Palindrome (map f l) :=
  of_reverse_eq <| by rw [← map_reverse, p.reverse_eq]
#align list.palindrome.map List.Palindrome.map

instance [DecidableEq α] (l : List α) : Decidable (Palindrome l) :=
  decidable_of_iff' _ iff_reverse_eq

end Palindrome

end List


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.instances.irrational
import topology.instances.rat
import topology.alexandroff

/-!
# Additional lemmas about the topology on rational numbers

The structure of a metric space on `ℚ` (`rat.metric_space`) is introduced elsewhere, induced from
`ℝ`. In this file we prove some properties of this topological space and its one-point
compactification.

## Main statements

- `rat.totally_disconnected_space`: `ℚ` is a totally disconnected space;

- `rat.not_countably_generated_nhds_infty_alexandroff`: the filter of neighbourhoods of infinity in
  `alexandroff ℚ` is not countably generated.

## Notation

- `ℚ∞` is used as a local notation for `alexandroff ℚ`
-/

open set metric filter topological_space
open_locale topological_space alexandroff
local notation `ℚ∞` := alexandroff ℚ

namespace rat

variables {p q : ℚ} {s t : set ℚ}

lemma interior_compact_eq_empty (hs : is_compact s) :
  interior s = ∅ :=
dense_embedding_coe_real.to_dense_inducing.interior_compact_eq_empty dense_irrational hs

lemma dense_compl_compact (hs : is_compact s) : dense sᶜ :=
interior_eq_empty_iff_dense_compl.1 (interior_compact_eq_empty hs)

instance cocompact_inf_nhds_ne_bot : ne_bot (cocompact ℚ ⊓ 𝓝 p) :=
begin
  refine (has_basis_cocompact.inf (nhds_basis_opens _)).ne_bot_iff.2 _,
  rintro ⟨s, o⟩ ⟨hs, hpo, ho⟩, rw inter_comm,
  exact (dense_compl_compact hs).inter_open_nonempty _ ho ⟨p, hpo⟩
end

lemma not_countably_generated_cocompact : ¬is_countably_generated (cocompact ℚ) :=
begin
  introI H,
  rcases exists_seq_tendsto (cocompact ℚ ⊓ 𝓝 0) with ⟨x, hx⟩,
  rw tendsto_inf at hx, rcases hx with ⟨hxc, hx0⟩,
  obtain ⟨n, hn⟩ : ∃ n : ℕ, x n ∉ insert (0 : ℚ) (range x),
    from (hxc.eventually hx0.is_compact_insert_range.compl_mem_cocompact).exists,
  exact hn (or.inr ⟨n, rfl⟩)
end

lemma not_countably_generated_nhds_infty_alexandroff :
  ¬is_countably_generated (𝓝 (∞ : ℚ∞)) :=
begin
  introI,
  have : is_countably_generated (comap (coe : ℚ → ℚ∞) (𝓝 ∞)), by apply_instance,
  rw [alexandroff.comap_coe_nhds_infty, coclosed_compact_eq_cocompact] at this,
  exact not_countably_generated_cocompact this
end

lemma not_first_countable_topology_alexandroff :
  ¬first_countable_topology ℚ∞ :=
by { introI, exact not_countably_generated_nhds_infty_alexandroff infer_instance }

lemma not_second_countable_topology_alexandroff :
  ¬second_countable_topology ℚ∞ :=
by { introI, exact not_first_countable_topology_alexandroff infer_instance }

instance : totally_disconnected_space ℚ :=
begin
  refine ⟨λ s hsu hs x hx y hy, _⟩, clear hsu,
  by_contra' H : x ≠ y,
  wlog hlt : x < y := H.lt_or_lt using [x y, y x],
  rcases exists_irrational_btwn (rat.cast_lt.2 hlt) with ⟨z, hz, hxz, hzy⟩,
  have := hs.image coe continuous_coe_real.continuous_on,
  rw [is_preconnected_iff_ord_connected] at this,
  have : z ∈ coe '' s := this.out (mem_image_of_mem _ hx) (mem_image_of_mem _ hy) ⟨hxz.le, hzy.le⟩,
  exact hz (image_subset_range _ _ this)
end

end rat


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

import topology.algebra.group.basic
import logic.function.iterate

/-!
# Flows and invariant sets

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

This file defines a flow on a topological space `α` by a topological
monoid `τ` as a continuous monoid-act of `τ` on `α`. Anticipating the
cases where `τ` is one of `ℕ`, `ℤ`, `ℝ⁺`, or `ℝ`, we use additive
notation for the monoids, though the definition does not require
commutativity.

A subset `s` of `α` is invariant under a family of maps `ϕₜ : α → α`
if `ϕₜ s ⊆ s` for all `t`. In many cases `ϕ` will be a flow on
`α`. For the cases where `ϕ` is a flow by an ordered (additive,
commutative) monoid, we additionally define forward invariance, where
`t` ranges over those elements which are nonnegative.

Additionally, we define such constructions as the restriction of a
flow onto an invariant subset, and the time-reveral of a flow by a
group.
-/

open set function filter

/-!
### Invariant sets
-/

section invariant

variables {τ : Type*} {α : Type*}

/-- A set `s ⊆ α` is invariant under `ϕ : τ → α → α` if
    `ϕ t s ⊆ s` for all `t` in `τ`. -/
def is_invariant (ϕ : τ → α → α) (s : set α): Prop := ∀ t, maps_to (ϕ t) s s

variables (ϕ : τ → α → α) (s : set α)

lemma is_invariant_iff_image : is_invariant ϕ s ↔ ∀ t, ϕ t '' s ⊆ s :=
by simp_rw [is_invariant, maps_to']

/-- A set `s ⊆ α` is forward-invariant under `ϕ : τ → α → α` if
    `ϕ t s ⊆ s` for all `t ≥ 0`. -/
def is_fw_invariant [preorder τ] [has_zero τ] (ϕ : τ → α → α) (s : set α): Prop :=
∀ ⦃t⦄, 0 ≤ t → maps_to (ϕ t) s s

lemma is_invariant.is_fw_invariant [preorder τ] [has_zero τ] {ϕ : τ → α → α} {s : set α}
  (h : is_invariant ϕ s) : is_fw_invariant ϕ s :=
λ t ht, h t

/-- If `τ` is a `canonically_ordered_add_monoid` (e.g., `ℕ` or `ℝ≥0`), then the notions
`is_fw_invariant` and `is_invariant` are equivalent. -/
lemma is_fw_invariant.is_invariant [canonically_ordered_add_monoid τ] {ϕ : τ → α → α} {s : set α}
  (h : is_fw_invariant ϕ s) : is_invariant ϕ s :=
λ t, h (zero_le t)

/-- If `τ` is a `canonically_ordered_add_monoid` (e.g., `ℕ` or `ℝ≥0`), then the notions
`is_fw_invariant` and `is_invariant` are equivalent. -/
lemma is_fw_invariant_iff_is_invariant [canonically_ordered_add_monoid τ]
  {ϕ : τ → α → α} {s : set α} :
  is_fw_invariant ϕ s ↔ is_invariant ϕ s :=
⟨is_fw_invariant.is_invariant, is_invariant.is_fw_invariant⟩

end invariant

/-!
### Flows
-/

/-- A flow on a topological space `α` by an a additive topological
    monoid `τ` is a continuous monoid action of `τ` on `α`.-/
structure flow
  (τ : Type*) [topological_space τ] [add_monoid τ] [has_continuous_add τ]
  (α : Type*) [topological_space α] :=
(to_fun    : τ → α → α)
(cont'     : continuous (uncurry to_fun))
(map_add'  : ∀ t₁ t₂ x, to_fun (t₁ + t₂) x = to_fun t₁ (to_fun t₂ x))
(map_zero' : ∀ x, to_fun 0 x = x)

namespace flow

variables
{τ : Type*} [add_monoid τ] [topological_space τ] [has_continuous_add τ]
{α : Type*} [topological_space α]
(ϕ : flow τ α)

instance : inhabited (flow τ α) :=
⟨{ to_fun    := λ _ x, x,
   cont'     := continuous_snd,
   map_add'  := λ _ _ _, rfl,
   map_zero' := λ _, rfl }⟩

instance : has_coe_to_fun (flow τ α) (λ _, τ → α → α) := ⟨flow.to_fun⟩

@[ext]

@[continuity]
protected lemma continuous {β : Type*} [topological_space β]
  {t : β → τ} (ht : continuous t) {f : β → α} (hf : continuous f) :
  continuous (λ x, ϕ (t x) (f x)) :=
ϕ.cont'.comp (ht.prod_mk hf)

alias flow.continuous ← _root_.continuous.flow

lemma map_add (t₁ t₂ : τ) (x : α) : ϕ (t₁ + t₂) x = ϕ t₁ (ϕ t₂ x) :=
ϕ.map_add' _ _ _

@[simp] lemma map_zero : ϕ 0 = id := funext ϕ.map_zero'

lemma map_zero_apply (x : α) : ϕ 0 x = x := ϕ.map_zero' x

/-- Iterations of a continuous function from a topological space `α`
    to itself defines a semiflow by `ℕ` on `α`. -/
def from_iter {g : α → α} (h : continuous g) : flow ℕ α :=
{ to_fun    := λ n x, g^[n] x,
  cont'     := continuous_uncurry_of_discrete_topology_left (continuous.iterate h),
  map_add'  := iterate_add_apply _,
  map_zero' := λ x, rfl }

/-- Restriction of a flow onto an invariant set. -/
def restrict {s : set α} (h : is_invariant ϕ s) : flow τ ↥s :=
{ to_fun    := λ t, (h t).restrict _ _ _,
  cont'     := (ϕ.continuous continuous_fst continuous_subtype_coe.snd').subtype_mk _,
  map_add'  := λ _ _ _, subtype.ext (map_add _ _ _ _),
  map_zero' := λ _, subtype.ext (map_zero_apply _ _)}

end flow

namespace flow

variables
{τ : Type*} [add_comm_group τ] [topological_space τ] [topological_add_group τ]
{α : Type*} [topological_space α]
(ϕ : flow τ α)

lemma is_invariant_iff_image_eq (s : set α) :
  is_invariant ϕ s ↔ ∀ t, ϕ t '' s = s :=
(is_invariant_iff_image _ _).trans (iff.intro
  (λ h t, subset.antisymm (h t) (λ _ hx, ⟨_, h (-t) ⟨_, hx, rfl⟩, by simp [← map_add]⟩))
  (λ h t, by rw h t))

/-- The time-reversal of a flow `ϕ` by a (commutative, additive) group
    is defined `ϕ.reverse t x = ϕ (-t) x`. -/
def reverse : flow τ α :=
{ to_fun    := λ t, ϕ (-t),
  cont'     := ϕ.continuous continuous_fst.neg continuous_snd,
  map_add'  := λ _ _ _, by rw [neg_add, map_add],
  map_zero' := λ _, by rw [neg_zero, map_zero_apply] }

/-- The map `ϕ t` as a homeomorphism. -/
def to_homeomorph (t : τ) : α ≃ₜ α :=
{ to_fun := ϕ t,
  inv_fun := ϕ (-t),
  left_inv := λ x, by rw [← map_add, neg_add_self, map_zero_apply],
  right_inv := λ x, by rw [← map_add, add_neg_self, map_zero_apply] }

lemma image_eq_preimage (t : τ) (s : set α) : ϕ t '' s = ϕ (-t) ⁻¹' s :=
(ϕ.to_homeomorph t).to_equiv.image_eq_preimage s

end flow


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

namespace Cpdt
namespace Chapter2

inductive Binop where
  | plus : Binop
  | times : Binop

inductive Exp where
  | const : Nat → Exp
  | binop : Binop → Exp → Exp → Exp

namespace Binop

def denote : Binop → (Nat → Nat → Nat)
  | plus => Nat.add
  | times => Nat.mul

theorem denote_plus : denote plus = Nat.add := by rfl
theorem denote_times : denote times = Nat.mul := by rfl

end Binop

namespace Exp

def denote : Exp → Nat
  | const n => n
  | binop op l r => op.denote l.denote r.denote

theorem denote_const (n : Nat) : denote (const n) = n := by rfl
theorem denote_binop (op : Binop) (l r : Exp) : denote (binop op l r) = op.denote l.denote r.denote := by rfl

end Exp

inductive Instr where
  | iConst : Nat → Instr
  | iBinop : Binop → Instr

abbrev Prog := List Instr
abbrev Stack := List Nat

namespace Instr

def denote : Instr → Stack → Option Stack
  | iConst n , s => some (n :: s)
  | iBinop op, arg1 :: arg2 :: rest => some ((op.denote arg1 arg2) :: rest)
  | iBinop op, _ => none

theorem denote_iConst (n : Nat) (s : Stack) : denote (iConst n) s = some (n :: s) := by rfl
theorem denote_iBinop_2args (b : Binop) (s : Stack) (arg1 arg2 : Nat) : denote (iBinop op) (arg1 :: arg2 :: s) = some (op.denote arg1 arg2 :: s) := by rfl
theorem denote_iBinop_1arg (b : Binop) (arg : Nat) : denote (iBinop op) [arg] = none := by rfl
theorem denote_iBinop_nil (b : Binop) (arg : Nat) : denote (iBinop op) [] = none := by rfl

end Instr

namespace Prog

def denote : Prog → Stack → Option Stack
  | [], s => some s
  | i :: p, s =>
    match i.denote s with
    | some res => denote p res
    | none => none

theorem denote_nil (s : Stack) : denote [] s = some s := by rfl
theorem denote_iConst (s : Stack) (p : Prog) (n : Nat) : denote ((.iConst n) :: p) s = denote p (n :: s) := by rfl
theorem denote_iBinop_2args (s : Stack) (p : Prog) (op : Binop) (arg1 arg2 : Nat) : denote (.iBinop op :: p) (arg1 :: arg2 :: s) = denote p (op.denote arg1 arg2 :: s) := by rfl
theorem denote_iBinop_1args (p : Prog) (op : Binop) (arg : Nat) : denote (.iBinop op :: p) [arg] = none := by rfl
theorem denote_iBinop_nil (p : Prog) (op : Binop) : denote (.iBinop op :: p) [] = none := by rfl

end Prog

namespace Exp

def compile : Exp → Prog
  | const n => [.iConst n]
  | binop b l r => compile r ++ compile l ++ [.iBinop b]

theorem compile_const (n : Nat) : compile (const n) = [.iConst n] := by rfl
theorem compile_binop (op : Binop) (l r : Exp) : compile (binop op l r) = compile r ++ compile l ++ [.iBinop op] := by rfl

end Exp

theorem compile_correct_help : ∀ (e : Exp) (p : Prog) (s : Stack), Prog.denote (Exp.compile e ++ p) s = Prog.denote p (Exp.denote e :: s) := by
  intro e p s
  induction e generalizing p s with
  | const n =>
    rw [Exp.compile_const]
    rw [Exp.denote_const]
    simp
    rw [Prog.denote_iConst]
  | binop b l r lih rih =>
    rw [Exp.compile_binop]
    rw [Exp.denote_binop]
    rw [List.append_assoc (Exp.compile r)]
    rw [List.append_assoc (Exp.compile r)]
    rw [rih]
    rw [List.append_assoc]
    rw [lih]
    simp
    rw [Prog.denote_iBinop_2args]

theorem compile_correct : ∀ (e : Exp), Prog.denote (Exp.compile e) [] = some [Exp.denote e] := by
  intro e
  rw [←List.append_nil (Exp.compile e)]
  rw [compile_correct_help]
  rw [Prog.denote_nil]

end Chapter2
end Cpdt


/-
Copyright (c) 2019 Patrick Massot All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Simon Hudon

A tactic pushing negations into an expression
-/

import logic.basic

open tactic expr

namespace push_neg
section

universe u
variable  {α : Sort u}
variables (p q : Prop)
variable  (s : α → Prop)

local attribute [instance, priority 10] classical.prop_decidable
theorem not_not_eq : (¬ ¬ p) = p := propext not_not
theorem not_and_eq : (¬ (p ∧ q)) = (p → ¬ q) := propext not_and
theorem not_or_eq : (¬ (p ∨ q)) = (¬ p ∧ ¬ q) := propext not_or_distrib
theorem not_forall_eq : (¬ ∀ x, s x) = (∃ x, ¬ s x) := propext not_forall
theorem not_exists_eq : (¬ ∃ x, s x) = (∀ x, ¬ s x) := propext not_exists
theorem not_implies_eq : (¬ (p → q)) = (p ∧ ¬ q) := propext not_imp

theorem classical.implies_iff_not_or : (p → q) ↔ (¬ p ∨ q) := imp_iff_not_or

theorem not_eq (a b : α) : (¬ a = b) ↔ (a ≠ b) := iff.rfl

variable  {β : Type u}
variable [linear_order β]
theorem not_le_eq (a b : β) : (¬ (a ≤ b)) = (b < a) := propext not_le
theorem not_lt_eq (a b : β) : (¬ (a < b)) = (b ≤ a) := propext not_lt
end

meta def whnf_reducible (e : expr) : tactic expr := whnf e reducible

private meta def transform_negation_step (e : expr) :
  tactic (option (expr × expr)) :=
do e ← whnf_reducible e,
   match e with
   | `(¬ %%ne) :=
      (do ne ← whnf_reducible ne,
      match ne with
      | `(¬ %%a)      := do pr ← mk_app ``not_not_eq [a],
                            return (some (a, pr))
      | `(%%a ∧ %%b)  := do pr ← mk_app ``not_and_eq [a, b],
                            return (some (`((%%a : Prop) → ¬ %%b), pr))
      | `(%%a ∨ %%b)  := do pr ← mk_app ``not_or_eq [a, b],
                            return (some (`(¬ %%a ∧ ¬ %%b), pr))
      | `(%%a ≤ %%b)  := do e ← to_expr ``(%%b < %%a),
                            pr ← mk_app ``not_le_eq [a, b],
                            return (some (e, pr))
      | `(%%a < %%b)  := do e ← to_expr ``(%%b ≤ %%a),
                            pr ← mk_app ``not_lt_eq [a, b],
                            return (some (e, pr))
      | `(Exists %%p) := do pr ← mk_app ``not_exists_eq [p],
                            e ← match p with
                                | (lam n bi typ bo) := do
                                    body ← mk_app ``not [bo],
                                    return (pi n bi typ body)
                                | _ := tactic.fail "Unexpected failure negating ∃"
                                end,
                            return (some (e, pr))
      | (pi n bi d p) := if p.has_var then do
                            pr ← mk_app ``not_forall_eq [lam n bi d p],
                            body ← mk_app ``not [p],
                            e ←  mk_app ``Exists [lam n bi d body],
                            return (some (e, pr))
                         else do
                            pr ← mk_app ``not_implies_eq [d, p],
                            `(%%_ = %%e') ← infer_type pr,
                            return (some (e', pr))
      | _             := return none
      end)
    | _        := return none
  end

private meta def transform_negation : expr → tactic (option (expr × expr))
| e :=
do (some (e', pr)) ← transform_negation_step e | return none,
   (some (e'', pr')) ← transform_negation e' | return (some (e', pr)),
   pr'' ← mk_eq_trans pr pr',
   return (some (e'', pr''))

meta def normalize_negations (t : expr) : tactic (expr × expr) :=
do (_, e, pr) ← simplify_top_down ()
                   (λ _, λ e, do
                       oepr ← transform_negation e,
                       match oepr with
                       | (some (e', pr)) := return ((), e', pr)
                       | none            := do pr ← mk_eq_refl e, return ((), e, pr)
                       end)
                   t { eta := ff },
   return (e, pr)

meta def push_neg_at_hyp (h : name) : tactic unit :=
do H ← get_local h,
   t ← infer_type H,
   (e, pr) ← normalize_negations t,
   replace_hyp H e pr,
   skip

meta def push_neg_at_goal : tactic unit :=
do H ← target,
   (e, pr) ← normalize_negations H,
   replace_target e pr
end push_neg

open interactive (parse loc.ns loc.wildcard)
open interactive.types (location texpr)
open lean.parser (tk ident many) interactive.loc
local postfix `?`:9001 := optional
local postfix *:9001 := many
open push_neg

/--
Push negations in the goal of some assumption.

For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variables names are conserved.

This tactic pushes negations inside expressions. For instance, given an assumption
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```

(the pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).
Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every assumption and the goal using `push_neg at *` or at selected assumptions and the goal
using say `push_neg at h h' ⊢` as usual.
-/
meta def tactic.interactive.push_neg : parse location → tactic unit
| (loc.ns loc_l) :=
  loc_l.mmap'
    (λ l, match l with
          | some h := do push_neg_at_hyp h,
                          try $ interactive.simp_core { eta := ff } failed tt
                                 [simp_arg_type.expr ``(push_neg.not_eq)] []
                                 (interactive.loc.ns [some h])
          | none   := do push_neg_at_goal,
                          try `[simp only [push_neg.not_eq] { eta := ff }]
          end)
| loc.wildcard := do
    push_neg_at_goal,
    local_context >>= mmap' (λ h, push_neg_at_hyp (local_pp_name h)) ,
    try `[simp only [push_neg.not_eq] at * { eta := ff }]

add_tactic_doc
{ name       := "push_neg",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.push_neg],
  tags       := ["logic"] }

lemma imp_of_not_imp_not (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
λ h hP, classical.by_contradiction (λ h', h h' hP)

/-- Matches either an identifier "h" or a pair of identifiers "h with k" -/
meta def name_with_opt : lean.parser (name × option name) :=
prod.mk <$> ident <*> (some <$> (tk "with" >> ident) <|> return none)

/--
Transforms the goal into its contrapositive.

* `contrapose`     turns a goal `P → Q` into `¬ Q → ¬ P`
* `contrapose!`    turns a goal `P → Q` into `¬ Q → ¬ P` and pushes negations inside `P` and `Q`
  using `push_neg`
* `contrapose h`   first reverts the local assumption `h`, and then uses `contrapose` and `intro h`
* `contrapose! h`  first reverts the local assumption `h`, and then uses `contrapose!` and `intro h`
* `contrapose h with new_h` uses the name `new_h` for the introduced hypothesis
-/
meta def tactic.interactive.contrapose (push : parse (tk "!" )?) :
  parse name_with_opt? → tactic unit
| (some (h, h')) := get_local h >>= revert >> tactic.interactive.contrapose none >>
  intro (h'.get_or_else h) >> skip
| none :=
  do `(%%P → %%Q) ← target | fail
    "The goal is not an implication, and you didn't specify an assumption",
  cp ← mk_mapp ``imp_of_not_imp_not [P, Q] <|> fail
    "contrapose only applies to nondependent arrows between props",
  apply cp,
  when push.is_some $ try (tactic.interactive.push_neg (loc.ns [none]))

add_tactic_doc
{ name       := "contrapose",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.contrapose],
  tags       := ["logic"] }


import data.real.basic

def T := ℝ

variables (a b c : ℝ)

theorem easy_thing : (a^2 - b^2 = (a+b)*(a-b)) :=
begin
  rw mul_sub,
  rw add_mul,
  rw add_mul,
  rw sub_add_eq_sub_sub,
  rw mul_comm a b,
  rw add_sub_assoc,
  rw sub_self,
  rw add_zero,
  rw sq,
  rw sq,
end

theorem easier_thing : (a^2 - b^2 = (a+b)*(a-b)) :=
begin
  ring,
end

#check easy_thing
#check easier_thing

-- An example of how to use library_search
lemma foo : (a^2 = a*a) := by library_search


import Mathlib

/-!
# Jet Spaces

These consist of the value of a function at a point, and the value of its gradient at that point. Smooth functions are functions on jet spaces.
-/

noncomputable example : Field ℝ := inferInstance

namespace Jet

universe u

/-- Notation ℝ^n etc -/
instance : HPow (Type u) ℕ (Type u) := ⟨fun k n ↦ Vector k n⟩

structure Jet (n : ℕ) where
  value : ℝ
  gradient : ℝ ^ n

instance  {n : ℕ } : Add  (ℝ ^ n) := ⟨fun v₁ v₂ =>
  Vector.map₂ (· + ·) v₁ v₂⟩

#check Vector.map₂

instance addJets {n: ℕ} : Add (Jet n) :=
    ⟨fun j₁ j₂ => ⟨j₁.value + j₂.value, j₁.gradient + j₂.gradient⟩⟩

instance scMul {n : ℕ } : SMul ℝ  (ℝ ^ n) :=
  ⟨fun c v => v.map (c * ·)⟩

instance scMulJets {n : ℕ } : SMul ℝ (Jet n) :=
  ⟨fun c j => ⟨c * j.value, c • j.gradient⟩⟩

def Vector.dot {n: ℕ}(v₁ v₂ : ℝ ^ n) : ℝ :=
  (Vector.map₂ (· * ·) v₁ v₂).toList.sum

instance liebnitz {n: ℕ} : Mul (Jet n) :=
  ⟨fun j₁ j₂ => ⟨j₁.value * j₂.value, j₁.value • j₂.gradient + j₂.value • j₁.gradient⟩⟩

/-- Should be replaced by an actual definition eventually -/
opaque hasGradAt {n: ℕ} (f : ℝ ^ n → ℝ)(x : ℝ ^n) : Prop

/-- A function `ℝ^n → ℝ` with its gradient, the commented out condition should be added-/
structure SmoothFunction (n : ℕ) where
  asFunc : ℝ ^ n → ℝ
  grad : ℝ ^ n  → ℝ ^ n
  --hasGradAt : ∀ x, hasGradAt jetMap x

instance : CoeFun (SmoothFunction n) (fun _ => ℝ^n → ℝ) where
  coe := SmoothFunction.asFunc

/-- Should be proved as a theorem -/
axiom gradient_determined {n: ℕ} (f g : SmoothFunction n) :
    f.asFunc = g.asFunc → f = g

def zeroVector {n : ℕ} : ℝ ^ n := match n with
  | 0 => Vector.nil
  | n + 1 => Vector.cons 0 (zeroVector : ℝ ^ n)

instance {n: ℕ} : Zero (ℝ ^ n) := ⟨zeroVector⟩

def consVector {n : ℕ} (c : ℝ) : ℝ ^ n := match n with
  | 0 => Vector.nil
  | n + 1 => Vector.cons c (zeroVector : ℝ ^ n)

def Jet.const (n : ℕ) (c : ℝ) : Jet n :=
  ⟨c, zeroVector⟩

def SmoothFunction.const (n : ℕ) (c : ℝ) : SmoothFunction n :=
  ⟨fun _ => c, fun _ => 0⟩

def Vector.coord (i n : ℕ) : (i < n) →  ℝ ^ n :=
  fun h =>
  match i, n, h with
  | 0, k + 1, _ =>
    Vector.cons 1 (zeroVector : ℝ ^ k)
  | i + 1, k + 1, pf =>
     let tail : ℝ ^ k := Vector.coord i k (Nat.le_of_succ_le_succ pf)
     Vector.cons 0 tail

/-- The coordinate functions -/

def SmoothFunction.coord (i n : ℕ) (h : i < n) : SmoothFunction n :=
  ⟨fun v : Vector ℝ n => v.get ⟨i, h⟩, fun _ => 0⟩

-- instance : Coe  ℝ  (ℝ ^ 1) := ⟨fun c => Vector.cons c Vector.nil⟩
/- instance (l : List ℝ) (n : outParam ℕ)
         (h : outParam (l.length = n) := by rfl)
    : CoeDep (List ℝ) l (ℝ^n) where
  coe := ⟨l, h⟩ -/

instance : Coe  (ℝ ^ 1) ℝ  := ⟨fun v => v.get ⟨0, Nat.zero_lt_succ 0⟩⟩

/-- Composition with a smooth function `ℝ → ℝ` with chain rule for derivative -/

def SmoothFunction.comp {n: ℕ} (g : SmoothFunction 1) (f : SmoothFunction n)  : SmoothFunction n :=
  ⟨fun v => g.asFunc ⟨[f.asFunc v], rfl⟩, fun v =>
    let g' : ℝ := g.grad (⟨[f.asFunc v], rfl⟩ )
    let f' := f.grad v
    g' •  f'⟩

infix:65 " ∘ " => SmoothFunction.comp

def addVec {n : ℕ} (v1 : ℝ^n) : ℝ :=
  v1.toList.sum


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

! This file was ported from Lean 3 source module measure_theory.function.continuous_map_dense
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Regular
import Mathbin.MeasureTheory.Function.SimpleFuncDenseLp
import Mathbin.Topology.UrysohnsLemma

/-!
# Approximation in Lᵖ by continuous functions

This file proves that bounded continuous functions are dense in `Lp E p μ`, for `1 ≤ p < ∞`, if the
domain `α` of the functions is a normal topological space and the measure `μ` is weakly regular.

The result is presented in several versions:
* `measure_theory.Lp.bounded_continuous_function_dense`: The subgroup
  `measure_theory.Lp.bounded_continuous_function` of `Lp E p μ`, the additive subgroup of
  `Lp E p μ` consisting of equivalence classes containing a continuous representative, is dense in
  `Lp E p μ`.
* `bounded_continuous_function.to_Lp_dense_range`: For finite-measure `μ`, the continuous linear
  map `bounded_continuous_function.to_Lp p μ 𝕜` from `α →ᵇ E` to `Lp E p μ` has dense range.
* `continuous_map.to_Lp_dense_range`: For compact `α` and finite-measure `μ`, the continuous linear
  map `continuous_map.to_Lp p μ 𝕜` from `C(α, E)` to `Lp E p μ` has dense range.

Note that for `p = ∞` this result is not true:  the characteristic function of the set `[0, ∞)` in
`ℝ` cannot be continuously approximated in `L∞`.

The proof is in three steps.  First, since simple functions are dense in `Lp`, it suffices to prove
the result for a scalar multiple of a characteristic function of a measurable set `s`. Secondly,
since the measure `μ` is weakly regular, the set `s` can be approximated above by an open set and
below by a closed set.  Finally, since the domain `α` is normal, we use Urysohn's lemma to find a
continuous function interpolating between these two sets.

## Related results

Are you looking for a result on "directional" approximation (above or below with respect to an
order) of functions whose codomain is `ℝ≥0∞` or `ℝ`, by semicontinuous functions?  See the
Vitali-Carathéodory theorem, in the file `measure_theory.vitali_caratheodory`.

-/

open ENNReal NNReal Topology BoundedContinuousFunction

open MeasureTheory TopologicalSpace ContinuousMap

variable {α : Type _} [MeasurableSpace α] [TopologicalSpace α] [NormalSpace α] [BorelSpace α]

variable (E : Type _) [NormedAddCommGroup E] [SecondCountableTopologyEither α E]

variable {p : ℝ≥0∞} [_i : Fact (1 ≤ p)] (hp : p ≠ ∞) (μ : Measure α)

include _i hp

namespace MeasureTheory.lp

variable [NormedSpace ℝ E]

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (u «expr ⊇ » s) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (F «expr ⊆ » s) -/
/-- A function in `Lp` can be approximated in `Lp` by continuous functions. -/
theorem boundedContinuousFunction_dense [μ.WeaklyRegular] :
    (boundedContinuousFunction E p μ).topologicalClosure = ⊤ :=
  by
  have hp₀ : 0 < p := lt_of_lt_of_le zero_lt_one _i.elim
  have hp₀' : 0 ≤ 1 / p.to_real := div_nonneg zero_le_one ENNReal.toReal_nonneg
  have hp₀'' : 0 < p.to_real := by
    simpa [← ENNReal.toReal_lt_toReal ENNReal.zero_ne_top hp] using hp₀
  -- It suffices to prove that scalar multiples of the indicator function of a finite-measure
  -- measurable set can be approximated by continuous functions
  suffices
    ∀ (c : E) {s : Set α} (hs : MeasurableSet s) (hμs : μ s < ⊤),
      (Lp.simple_func.indicator_const p hs hμs.Ne c : Lp E p μ) ∈
        (BoundedContinuousFunction E p μ).topologicalClosure
    by
    rw [AddSubgroup.eq_top_iff']
    refine' Lp.induction hp _ _ _ _
    · exact this
    · exact fun f g hf hg hfg' => AddSubgroup.add_mem _
    · exact AddSubgroup.isClosed_topologicalClosure _
  -- Let `s` be a finite-measure measurable set, let's approximate `c` times its indicator function
  intro c s hs hsμ
  refine' mem_closure_iff_frequently.mpr _
  rw [metric.nhds_basis_closed_ball.frequently_iff]
  intro ε hε
  -- A little bit of pre-emptive work, to find `η : ℝ≥0` which will be a margin small enough for
  -- our purposes
  obtain ⟨η, hη_pos, hη_le⟩ : ∃ η, 0 < η ∧ (↑(‖bit0 ‖c‖‖₊ * (2 * η) ^ (1 / p.to_real)) : ℝ) ≤ ε :=
    by
    have : Filter.Tendsto (fun x : ℝ≥0 => ‖bit0 ‖c‖‖₊ * (2 * x) ^ (1 / p.to_real)) (𝓝 0) (𝓝 0) :=
      by
      have : Filter.Tendsto (fun x : ℝ≥0 => 2 * x) (𝓝 0) (𝓝 (2 * 0)) :=
        filter.tendsto_id.const_mul 2
      convert((NNReal.continuousAt_rpow_const (Or.inr hp₀')).Tendsto.comp this).const_mul _
      simp [hp₀''.ne']
    let ε' : ℝ≥0 := ⟨ε, hε.le⟩
    have hε' : 0 < ε' := by exact_mod_cast hε
    obtain ⟨δ, hδ, hδε'⟩ :=
      nnreal.nhds_zero_basis.eventually_iff.mp (eventually_le_of_tendsto_lt hε' this)
    obtain ⟨η, hη, hηδ⟩ := exists_between hδ
    refine' ⟨η, hη, _⟩
    exact_mod_cast hδε' hηδ
  have hη_pos' : (0 : ℝ≥0∞) < η := ENNReal.coe_pos.2 hη_pos
  -- Use the regularity of the measure to `η`-approximate `s` by an open superset and a closed
  -- subset
  obtain ⟨u, su, u_open, μu⟩ : ∃ (u : _)(_ : u ⊇ s), IsOpen u ∧ μ u < μ s + ↑η :=
    by
    refine' s.exists_is_open_lt_of_lt _ _
    simpa using ENNReal.add_lt_add_left hsμ.ne hη_pos'
  obtain ⟨F, Fs, F_closed, μF⟩ : ∃ (F : _)(_ : F ⊆ s), IsClosed F ∧ μ s < μ F + ↑η :=
    hs.exists_is_closed_lt_add hsμ.ne hη_pos'.ne'
  have : Disjoint (uᶜ) F := (Fs.trans su).disjoint_compl_left
  have h_μ_sdiff : μ (u \ F) ≤ 2 * η :=
    by
    have hFμ : μ F < ⊤ := (measure_mono Fs).trans_lt hsμ
    refine' ENNReal.le_of_add_le_add_left hFμ.ne _
    have : μ u < μ F + ↑η + ↑η := μu.trans (ENNReal.add_lt_add_right ENNReal.coe_ne_top μF)
    convert this.le using 1
    · rw [add_comm, ← measure_union, Set.diff_union_of_subset (Fs.trans su)]
      exacts[disjoint_sdiff_self_left, F_closed.measurable_set]
    have : (2 : ℝ≥0∞) * η = η + η := by simpa using add_mul (1 : ℝ≥0∞) 1 η
    rw [this]
    abel
  -- Apply Urysohn's lemma to get a continuous approximation to the characteristic function of
  -- the set `s`
  obtain ⟨g, hgu, hgF, hg_range⟩ :=
    exists_continuous_zero_one_of_closed u_open.is_closed_compl F_closed this
  -- Multiply this by `c` to get a continuous approximation to the function `f`; the key point is
  -- that this is pointwise bounded by the indicator of the set `u \ F`
  have g_norm : ∀ x, ‖g x‖ = g x := fun x => by rw [Real.norm_eq_abs, abs_of_nonneg (hg_range x).1]
  have gc_bd :
    ∀ x, ‖g x • c - s.indicator (fun x => c) x‖ ≤ ‖(u \ F).indicator (fun x => bit0 ‖c‖) x‖ :=
    by
    intro x
    by_cases hu : x ∈ u
    · rw [← Set.diff_union_of_subset (Fs.trans su)] at hu
      cases' hu with hFu hF
      · refine' (norm_sub_le _ _).trans _
        refine' (add_le_add_left (norm_indicator_le_norm_self (fun x => c) x) _).trans _
        have h₀ : g x * ‖c‖ + ‖c‖ ≤ 2 * ‖c‖ := by
          nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c]
        have h₁ : (2 : ℝ) * ‖c‖ = bit0 ‖c‖ := by simpa using add_mul (1 : ℝ) 1 ‖c‖
        simp [hFu, norm_smul, h₀, ← h₁, g_norm x]
      · simp [hgF hF, Fs hF]
    · have : x ∉ s := fun h => hu (su h)
      simp [hgu hu, this]
  -- The rest is basically just `ennreal`-arithmetic
  have gc_snorm :
    snorm ((fun x => g x • c) - s.indicator fun x => c) p μ ≤
      (↑(‖bit0 ‖c‖‖₊ * (2 * η) ^ (1 / p.to_real)) : ℝ≥0∞) :=
    by
    refine' (snorm_mono_ae (Filter.eventually_of_forall gc_bd)).trans _
    rw [snorm_indicator_const (u_open.sdiff F_closed).MeasurableSet hp₀.ne' hp]
    push_cast [← ENNReal.coe_rpow_of_nonneg _ hp₀']
    exact ENNReal.mul_left_mono (ENNReal.monotone_rpow_of_nonneg hp₀' h_μ_sdiff)
  have gc_cont : Continuous fun x => g x • c := g.continuous.smul continuous_const
  have gc_mem_ℒp : mem_ℒp (fun x => g x • c) p μ :=
    by
    have : mem_ℒp ((fun x => g x • c) - s.indicator fun x => c) p μ :=
      ⟨gc_cont.ae_strongly_measurable.sub
          (strongly_measurable_const.indicator hs).AeStronglyMeasurable,
        gc_snorm.trans_lt ENNReal.coe_lt_top⟩
    simpa using this.add (mem_ℒp_indicator_const p hs c (Or.inr hsμ.ne))
  refine' ⟨gc_mem_ℒp.to_Lp _, _, _⟩
  · rw [mem_closedBall_iff_norm]
    refine' le_trans _ hη_le
    rw [simple_func.coe_indicator_const, indicator_const_Lp, ← mem_ℒp.to_Lp_sub, Lp.norm_to_Lp]
    exact ENNReal.toReal_le_coe_of_le_coe gc_snorm
  · rw [SetLike.mem_coe, mem_bounded_continuous_function_iff]
    refine' ⟨BoundedContinuousFunction.ofNormedAddCommGroup _ gc_cont ‖c‖ _, rfl⟩
    intro x
    have h₀ : g x * ‖c‖ ≤ ‖c‖ := by nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c]
    simp [norm_smul, g_norm x, h₀]
#align measure_theory.Lp.bounded_continuous_function_dense MeasureTheory.lp.boundedContinuousFunction_dense

end MeasureTheory.lp

variable (𝕜 : Type _) [NormedField 𝕜] [NormedAlgebra ℝ 𝕜] [NormedSpace 𝕜 E]

namespace BoundedContinuousFunction

open LinearMap (range)

theorem toLp_denseRange [μ.WeaklyRegular] [IsFiniteMeasure μ] :
    DenseRange ⇑(toLp p μ 𝕜 : (α →ᵇ E) →L[𝕜] lp E p μ) :=
  by
  haveI : NormedSpace ℝ E := RestrictScalars.normedSpace ℝ 𝕜 E
  rw [denseRange_iff_closure_range]
  suffices (range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ)).toAddSubgroup.topologicalClosure = ⊤ by
    exact congr_arg coe this
  simp [range_to_Lp p μ, MeasureTheory.lp.boundedContinuousFunction_dense E hp]
#align bounded_continuous_function.to_Lp_dense_range BoundedContinuousFunction.toLp_denseRange

end BoundedContinuousFunction

namespace ContinuousMap

open LinearMap (range)

theorem toLp_denseRange [CompactSpace α] [μ.WeaklyRegular] [IsFiniteMeasure μ] :
    DenseRange ⇑(toLp p μ 𝕜 : C(α, E) →L[𝕜] lp E p μ) :=
  by
  haveI : NormedSpace ℝ E := RestrictScalars.normedSpace ℝ 𝕜 E
  rw [denseRange_iff_closure_range]
  suffices (range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ)).toAddSubgroup.topologicalClosure = ⊤ by
    exact congr_arg coe this
  simp [range_to_Lp p μ, MeasureTheory.lp.boundedContinuousFunction_dense E hp]
#align continuous_map.to_Lp_dense_range ContinuousMap.toLp_denseRange

end ContinuousMap


/-
Copyright (c) 2018 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow

Sequences in topological spaces.

In this file we define sequences in topological spaces and show how they are related to
filters and the topology. In particular, we
* associate a filter with a sequence and prove equivalence of convergence of the two,
* define the sequential closure of a set and prove that it's contained in the closure,
* define a type class "sequential_space" in which closure and sequential closure agree,
* define sequential continuity and show that it coincides with continuity in sequential spaces,
* provide an instance that shows that every metric space is a sequential space.

TODO:
* There should be an instance that associates a sequential space with a first countable space.
* Sequential compactness should be handled here.
-/

import topology.basic topology.metric_space.basic
import analysis.specific_limits

open set filter

variables {α : Type*} {β : Type*}

local notation f `⟶` limit := tendsto f at_top (nhds limit)

/- Statements about sequences in general topological spaces. -/
section topological_space
variables [topological_space α] [topological_space β]

/-- A sequence converges in the sence of topological spaces iff the associated statement for filter
holds. -/
@[simp] lemma topological_space.seq_tendsto_iff {x : ℕ → α} {limit : α} :
  tendsto x at_top (nhds limit) ↔
    ∀ U : set α, limit ∈ U → is_open U → ∃ n0 : ℕ, ∀ n ≥ n0, (x n) ∈ U :=
iff.intro
  (assume ttol : tendsto x at_top (nhds limit),
    show ∀ U : set α, limit ∈ U → is_open U → ∃ n0 : ℕ, ∀ n ≥ n0, (x n) ∈ U, from
      assume U limitInU isOpenU,
      have {n | (x n) ∈ U} ∈ at_top :=
        mem_map.mp $ le_def.mp ttol U $ mem_nhds_sets isOpenU limitInU,
      show ∃ n0 : ℕ, ∀ n ≥ n0, (x n) ∈ U, from mem_at_top_sets.mp this)
  (assume xtol : ∀ U : set α, limit ∈ U → is_open U → ∃ n0 : ℕ, ∀ n ≥ n0, (x n) ∈ U,
    suffices ∀ U, is_open U → limit ∈ U → x ⁻¹' U ∈ at_top,
      from tendsto_nhds.mpr this,
    assume U isOpenU limitInU,
    suffices ∃ n0 : ℕ, ∀ n ≥ n0, (x n) ∈ U, by simp [this],
    xtol U limitInU isOpenU)

/-- The sequential closure of a subset M ⊆ α of a topological space α is
the set of all p ∈ α which arise as limit of sequences in M. -/
def sequential_closure (M : set α) : set α :=
{p | ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ M) ∧ (x ⟶ p)}

lemma subset_sequential_closure (M : set α) : M ⊆ sequential_closure M :=
assume p (_ : p ∈ M), show p ∈ sequential_closure M, from
  ⟨λ n, p, assume n, ‹p ∈ M›, tendsto_const_nhds⟩

def is_seq_closed (A : set α) : Prop := A = sequential_closure A

/-- A convenience lemma for showing that a set is sequentially closed. -/
lemma is_seq_closed_of_def {A : set α}
  (h : ∀(x : ℕ → α) (p : α), (∀ n : ℕ, x n ∈ A) → (x ⟶ p) → p ∈ A) : is_seq_closed A :=
show A = sequential_closure A, from subset.antisymm
  (subset_sequential_closure A)
  (show ∀ p, p ∈ sequential_closure A → p ∈ A, from
    (assume p ⟨x, _, _⟩, show p ∈ A, from h x p ‹∀ n : ℕ, ((x n) ∈ A)› ‹(x ⟶ p)›))

/-- The sequential closure of a set is contained in the closure of that set.
The converse is not true. -/
lemma sequential_closure_subset_closure (M : set α) : sequential_closure M ⊆ closure M :=
show ∀ p, p ∈ sequential_closure M → p ∈ closure M, from
assume p,
assume : ∃ x : ℕ → α, (∀ n : ℕ, ((x n) ∈ M)) ∧ (x ⟶ p),
let ⟨x, ⟨_, _⟩⟩ := this in
show p ∈ closure M, from
-- we have to show that p is in the closure of M
-- using mem_closure_iff, this is equivalent to proving that every open neighbourhood
-- has nonempty intersection with M, but this is witnessed by our sequence x
suffices ∀ O, is_open O → p ∈ O → O ∩ M ≠ ∅, from mem_closure_iff.mpr this,
have ∀ (U : set α), p ∈ U → is_open U → (∃ n0, ∀ n, n ≥ n0 → x n ∈ U), by rwa[←topological_space.seq_tendsto_iff],
assume O is_open_O p_in_O,
let ⟨n0, _⟩ := this O ‹p ∈ O› ‹is_open O› in
have (x n0) ∈ O, from ‹∀ n ≥ n0, x n ∈ O› n0 (show n0 ≥ n0, from le_refl n0),
have (x n0) ∈ O ∩ M, from ⟨this, ‹∀n, x n ∈ M› n0⟩,
set.ne_empty_of_mem this

/-- A set is sequentially closed if it is closed. -/
lemma is_seq_closed_of_is_closed (M : set α) (_ : is_closed M) : is_seq_closed M :=
suffices sequential_closure M ⊆ M, from
  set.eq_of_subset_of_subset (subset_sequential_closure M) this,
calc sequential_closure M ⊆ closure M : sequential_closure_subset_closure M
  ... = M : closure_eq_of_is_closed ‹is_closed M›

/-- The limit of a convergent sequence in a sequentially closed set is in that set.-/
lemma mem_of_is_seq_closed {A : set α} (_ : is_seq_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : (x ⟶ limit)) : limit ∈ A :=
have limit ∈ sequential_closure A, from
  show ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ A) ∧ (x ⟶ limit), from ⟨x, ‹∀ n, x n ∈ A›, ‹(x ⟶ limit)›⟩,
eq.subst (eq.symm ‹is_seq_closed A›) ‹limit ∈ sequential_closure A›

/-- The limit of a convergent sequence in a closed set is in that set.-/
lemma mem_of_is_closed_sequential {A : set α} (_ : is_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : x ⟶ limit) : limit ∈ A :=
mem_of_is_seq_closed (is_seq_closed_of_is_closed A ‹is_closed A›) ‹∀ n, x n ∈ A› ‹(x ⟶ limit)›

/-- A sequential space is a space in which 'sequences are enough to probe the topology'. This can be
 formalised by demanding that the sequential closure and the closure coincide. The following
 statements show that other topological properties can be deduced from sequences in sequential
 spaces. -/
class sequential_space (α : Type*) [topological_space α] : Prop :=
(sequential_closure_eq_closure : ∀ M : set α, sequential_closure M = closure M)

/-- In a sequential space, a set is closed iff it's sequentially closed. -/
lemma is_seq_closed_iff_is_closed [sequential_space α] {M : set α} :
  is_seq_closed M ↔ is_closed M :=
iff.intro
  (assume _, closure_eq_iff_is_closed.mp (eq.symm
    (calc M = sequential_closure M : by assumption
        ... = closure M            : sequential_space.sequential_closure_eq_closure M)))
  (is_seq_closed_of_is_closed M)

/-- A function between topological spaces is sequentially continuous if it commutes with limit of
 convergent sequences. -/
def sequentially_continuous (f : α → β) : Prop :=
∀ (x : ℕ → α), ∀ {limit : α}, (x ⟶ limit) → (f∘x ⟶ f limit)

/- A continuous function is sequentially continuous. -/
lemma continuous.to_sequentially_continuous {f : α → β} (_ : continuous f) :
  sequentially_continuous f :=
assume x limit (_ : x ⟶ limit),
have tendsto f (nhds limit) (nhds (f limit)), from continuous.tendsto ‹continuous f› limit,
show (f ∘ x) ⟶ (f limit), from tendsto.comp ‹(x ⟶ limit)› this

/-- In a sequential space, continuity and sequential continuity coincide. -/
lemma continuous_iff_sequentially_continuous {f : α → β} [sequential_space α] :
  continuous f ↔ sequentially_continuous f :=
iff.intro
  (assume _, ‹continuous f›.to_sequentially_continuous)
  (assume : sequentially_continuous f, show continuous f, from
    suffices h : ∀ {A : set β}, is_closed A → is_seq_closed (f ⁻¹' A), from
      continuous_iff_is_closed.mpr (assume A _, is_seq_closed_iff_is_closed.mp $ h ‹is_closed A›),
    assume A (_ : is_closed A),
      is_seq_closed_of_def $
        assume (x : ℕ → α) p (_ : ∀ n, f (x n) ∈ A) (_ : x ⟶ p),
        have (f ∘ x) ⟶ (f p), from ‹sequentially_continuous f› x ‹(x ⟶ p)›,
        show f p ∈ A, from
          mem_of_is_closed_sequential ‹is_closed A› ‹∀ n, f (x n) ∈ A› ‹(f∘x ⟶ f p)›)

end topological_space

/- Statements about sequences in metric spaces -/
namespace metric
variable [metric_space α]
variables {ε : ℝ}

-- necessary for the next instance
set_option eqn_compiler.zeta true
/-- Show that every metric space is sequential. -/
instance : sequential_space α :=
⟨show ∀ M, sequential_closure M = closure M, from assume M,
  suffices closure M ⊆ sequential_closure M,
    from set.subset.antisymm (sequential_closure_subset_closure M) this,
  assume (p : α) (_ : p ∈ closure M),
  -- we construct a sequence in α, with values in M, that converges to p
  -- the first step is to use (p ∈ closure M) ↔ "all nhds of p contain elements of M" on metric
  -- balls
  have ∀ n : ℕ, ball p ((1:ℝ)/((n+1):ℝ)) ∩ M ≠ ∅ := assume n : ℕ,
    mem_closure_iff.mp ‹p ∈ (closure M)› (ball p ((1:ℝ)/((n+1):ℝ))) (is_open_ball)
    (mem_ball_self $ one_div_pos_of_pos $ add_pos_of_nonneg_of_pos (nat.cast_nonneg n) zero_lt_one),

  -- from this, construct a "sequence of hypothesis" h, (h n) := _ ∈ {x // x ∈ ball (1/n+1) p ∩ M}
  let h := λ n : ℕ, (classical.indefinite_description _ (set.exists_mem_of_ne_empty (this n))),
  -- and the actual sequence
      x := λ n : ℕ, (h n).val in

  -- now we construct the promised sequence and show the claim
  show ∃ x : ℕ → α, (∀ n : ℕ, ((x n) ∈ M)) ∧ (x ⟶ p), from
    ⟨x, assume n,
        have (x n) ∈ ball p ((1:ℝ)/((n+1):ℝ)) ∩ M := (h n).property, this.2,
        suffices ∀ ε > 0, ∃ n0 : ℕ, ∀ n ≥ n0, dist (x n) p < ε,
          by simpa only [metric.tendsto_at_top],
        assume ε _,
        -- we apply that 1/n converges to zero to the fact that (x n) ∈ ball p ε
        have ∀ ε > 0, ∃ n0 : ℕ, ∀ n ≥ n0, dist (1 / (↑n + 1)) (0:ℝ) < ε :=
          metric.tendsto_at_top.mp tendsto_one_div_add_at_top_nhds_0_nat,
        let ⟨n0, hn0⟩ := this ε ‹ε > 0› in
        show ∃ n0 : ℕ, ∀ n ≥ n0, dist (x n) p < ε, from
          ⟨n0, assume n ngtn0,
            calc dist (x n) p < (1:ℝ)/↑(n+1) : (h n).property.1
              ... = abs ((1:ℝ)/↑(n+1)) :
                eq.symm $ abs_of_nonneg $ div_nonneg' zero_le_one $ nat.cast_nonneg _
              ... = abs ((1:ℝ)/↑(n+1) - 0) : by simp
              ... = dist ((1:ℝ)/↑(n+1)) 0 : eq.symm $ real.dist_eq ((1:ℝ)/↑(n+1)) 0
              ... < ε : hn0 n ‹n ≥ n0›⟩⟩⟩

set_option eqn_compiler.zeta false

end metric


import data.nat.basic tactic.finish
open nat
def island_rules : ℕ → ℕ → ℕ → Prop
| 0        b B :=  (B = b ∨ B = b - 1) ∧ B > 0
| (succ d) b B := island_rules d b B ∧
                ((∀ c, island_rules d b c → c = b) ↔ (∀ c, island_rules d B c → c = B))

theorem init_island {d b B} : island_rules d b B → (B = b ∨ B = b - 1) ∧ B > 0 :=
nat.rec_on d id (λ d ih, ih ∘ and.left)

theorem blue_eyed_islander : ∀ d b, b > 0 → (d + 1 ≥ b ↔ ∀ B, island_rules d b B → B = b) :=
λ d, nat.rec_on d (λ b, nat.cases_on b (λ h, absurd h (dec_trivial : ¬0 > 0)) $ λ b, nat.cases_on
b (λ h, ⟨λ h B hB, or.by_cases hB.left (λ h1, h1) (λ h1, false.elim $ (dec_trivial : ¬1 - 1 > 0) $
h1 ▸ hB.right), λ h, dec_trivial⟩) $ λ b h, ⟨λ h2, ((dec_trivial : ¬0 + 1 ≥ succ (succ
b)) h2).elim, λ hB, false.elim $ (succ_ne_self $ succ b).symm $ hB (succ b) ⟨or.inr (succ_sub_one $
succ b).symm, dec_trivial⟩⟩) $ λ d hi b hb, ⟨λ hd, or.by_cases (lt_or_eq_of_le hd) (λ h B hB, (hi
b hb).mp (le_of_succ_le_succ $ succ_le_of_lt h) B hB.left) $ λ h B hB, or.by_cases (init_island
hB.left).left (λ h, h) $ λ h, hB.right.mpr ((hi B (init_island hB.left).right).mp $
le_of_succ_le_succ $ (((nat.sub_eq_iff_eq_add $ succ_le_of_lt hb).mp h.symm).trans $ add_one B) ▸
hd) B hB.left, λ hB, by_contradiction $ λ hd, Exists.rec_on (classical.not_forall.mp $
(iff_false_left $ not_le_of_gt $ lt_of_succ_lt $ lt_of_not_ge hd).mp $ hi b hb) $ λ B hB1, have
hB2 : island_rules d b B ∧ ¬B = b := (@not_imp _ _ $ classical.prop_decidable _).mp hB1, hB2.right
$ hB B ⟨hB2.left, iff.mpr (iff_false_left $ λ h, hB2.right $ h B hB2.left) $ (iff_false_left $
not_le_of_gt $ lt_of_succ_lt_succ (((nat.sub_eq_iff_eq_add $ succ_le_of_lt hb).mp (or.resolve_left
(init_island hB2.left).left hB2.right).symm) ▸ (lt_of_not_ge hd) : succ (d + 1) < B + 1)).mp $ hi
B (init_island hB2.left).right⟩⟩