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

! This file was ported from Lean 3 source module analysis.normed_space.pointwise
! leanprover-community/mathlib commit 832a8ba8f10f11fea99367c469ff802e69a5b8ec
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Group.AddTorsor
import Mathbin.Analysis.Normed.Group.Pointwise
import Mathbin.Analysis.NormedSpace.Basic

/-!
# Properties of pointwise scalar multiplication of sets in normed spaces.

We explore the relationships between scalar multiplication of sets in vector spaces, and the norm.
Notably, we express arbitrary balls as rescaling of other balls, and we show that the
multiplication of bounded sets remain bounded.
-/

open Metric Set

open Pointwise Topology

variable {𝕜 E : Type _} [NormedField 𝕜]

section SeminormedAddCommGroup

variable [SeminormedAddCommGroup E] [NormedSpace 𝕜 E]

theorem smul_ball {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) : c • ball x r = ball (c • x) (‖c‖ * r) :=
  by
  ext y
  rw [mem_smul_set_iff_inv_smul_mem₀ hc]
  conv_lhs => rw [← inv_smul_smul₀ hc x]
  simp [← div_eq_inv_mul, div_lt_iff (norm_pos_iff.2 hc), mul_comm _ r, dist_smul₀]
#align smul_ball smul_ball

theorem smul_unit_ball {c : 𝕜} (hc : c ≠ 0) : c • ball (0 : E) (1 : ℝ) = ball (0 : E) ‖c‖ := by
  rw [smul_ball hc, smul_zero, mul_one]
#align smul_unit_ball smul_unit_ball

theorem smul_sphere' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) :
    c • sphere x r = sphere (c • x) (‖c‖ * r) :=
  by
  ext y
  rw [mem_smul_set_iff_inv_smul_mem₀ hc]
  conv_lhs => rw [← inv_smul_smul₀ hc x]
  simp only [mem_sphere, dist_smul₀, norm_inv, ← div_eq_inv_mul, div_eq_iff (norm_pos_iff.2 hc).ne',
    mul_comm r]
#align smul_sphere' smul_sphere'

theorem smul_closed_ball' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) :
    c • closedBall x r = closedBall (c • x) (‖c‖ * r) := by
  simp only [← ball_union_sphere, Set.smul_set_union, smul_ball hc, smul_sphere' hc]
#align smul_closed_ball' smul_closed_ball'

theorem Metric.Bounded.smul {s : Set E} (hs : Bounded s) (c : 𝕜) : Bounded (c • s) :=
  by
  obtain ⟨R, hR⟩ : ∃ R : ℝ, ∀ x ∈ s, ‖x‖ ≤ R := hs.exists_norm_le
  refine' bounded_iff_forall_norm_le.2 ⟨‖c‖ * R, fun z hz => _⟩
  obtain ⟨y, ys, rfl⟩ : ∃ y : E, y ∈ s ∧ c • y = z := mem_smul_set.1 hz
  calc
    ‖c • y‖ = ‖c‖ * ‖y‖ := norm_smul _ _
    _ ≤ ‖c‖ * R := mul_le_mul_of_nonneg_left (hR y ys) (norm_nonneg _)

#align metric.bounded.smul Metric.Bounded.smul

/-- If `s` is a bounded set, then for small enough `r`, the set `{x} + r • s` is contained in any
fixed neighborhood of `x`. -/
theorem eventually_singleton_add_smul_subset {x : E} {s : Set E} (hs : Bounded s) {u : Set E}
    (hu : u ∈ 𝓝 x) : ∀ᶠ r in 𝓝 (0 : 𝕜), {x} + r • s ⊆ u :=
  by
  obtain ⟨ε, εpos, hε⟩ : ∃ (ε : _)(hε : 0 < ε), closed_ball x ε ⊆ u :=
    nhds_basis_closed_ball.mem_iff.1 hu
  obtain ⟨R, Rpos, hR⟩ : ∃ R : ℝ, 0 < R ∧ s ⊆ closed_ball 0 R := hs.subset_ball_lt 0 0
  have : Metric.closedBall (0 : 𝕜) (ε / R) ∈ 𝓝 (0 : 𝕜) := closed_ball_mem_nhds _ (div_pos εpos Rpos)
  filter_upwards [this]with r hr
  simp only [image_add_left, singleton_add]
  intro y hy
  obtain ⟨z, zs, hz⟩ : ∃ z : E, z ∈ s ∧ r • z = -x + y := by simpa [mem_smul_set] using hy
  have I : ‖r • z‖ ≤ ε :=
    calc
      ‖r • z‖ = ‖r‖ * ‖z‖ := norm_smul _ _
      _ ≤ ε / R * R :=
        (mul_le_mul (mem_closedBall_zero_iff.1 hr) (mem_closedBall_zero_iff.1 (hR zs))
          (norm_nonneg _) (div_pos εpos Rpos).le)
      _ = ε := by field_simp [Rpos.ne']

  have : y = x + r • z := by simp only [hz, add_neg_cancel_left]
  apply hε
  simpa only [this, dist_eq_norm, add_sub_cancel', mem_closed_ball] using I
#align eventually_singleton_add_smul_subset eventually_singleton_add_smul_subset

variable [NormedSpace ℝ E] {x y z : E} {δ ε : ℝ}

/-- In a real normed space, the image of the unit ball under scalar multiplication by a positive
constant `r` is the ball of radius `r`. -/
theorem smul_unit_ball_of_pos {r : ℝ} (hr : 0 < r) : r • ball 0 1 = ball (0 : E) r := by
  rw [smul_unit_ball hr.ne', Real.norm_of_nonneg hr.le]
#align smul_unit_ball_of_pos smul_unit_ball_of_pos

-- This is also true for `ℚ`-normed spaces
theorem exists_dist_eq (x z : E) {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
    ∃ y, dist x y = b * dist x z ∧ dist y z = a * dist x z :=
  by
  use a • x + b • z
  nth_rw 1 [← one_smul ℝ x]
  nth_rw 4 [← one_smul ℝ z]
  simp [dist_eq_norm, ← hab, add_smul, ← smul_sub, norm_smul_of_nonneg, ha, hb]
#align exists_dist_eq exists_dist_eq

theorem exists_dist_le_le (hδ : 0 ≤ δ) (hε : 0 ≤ ε) (h : dist x z ≤ ε + δ) :
    ∃ y, dist x y ≤ δ ∧ dist y z ≤ ε :=
  by
  obtain rfl | hε' := hε.eq_or_lt
  · exact ⟨z, by rwa [zero_add] at h, (dist_self _).le⟩
  have hεδ := add_pos_of_pos_of_nonneg hε' hδ
  refine'
    (exists_dist_eq x z (div_nonneg hε <| add_nonneg hε hδ) (div_nonneg hδ <| add_nonneg hε hδ) <|
          by rw [← add_div, div_self hεδ.ne']).imp
      fun y hy => _
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε]
  rw [← div_le_one hεδ] at h
  exact ⟨mul_le_of_le_one_left hδ h, mul_le_of_le_one_left hε h⟩
#align exists_dist_le_le exists_dist_le_le

-- This is also true for `ℚ`-normed spaces
theorem exists_dist_le_lt (hδ : 0 ≤ δ) (hε : 0 < ε) (h : dist x z < ε + δ) :
    ∃ y, dist x y ≤ δ ∧ dist y z < ε :=
  by
  refine'
    (exists_dist_eq x z (div_nonneg hε.le <| add_nonneg hε.le hδ)
            (div_nonneg hδ <| add_nonneg hε.le hδ) <|
          by rw [← add_div, div_self (add_pos_of_pos_of_nonneg hε hδ).ne']).imp
      fun y hy => _
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε]
  rw [← div_lt_one (add_pos_of_pos_of_nonneg hε hδ)] at h
  exact ⟨mul_le_of_le_one_left hδ h.le, mul_lt_of_lt_one_left hε h⟩
#align exists_dist_le_lt exists_dist_le_lt

-- This is also true for `ℚ`-normed spaces
theorem exists_dist_lt_le (hδ : 0 < δ) (hε : 0 ≤ ε) (h : dist x z < ε + δ) :
    ∃ y, dist x y < δ ∧ dist y z ≤ ε :=
  by
  obtain ⟨y, yz, xy⟩ :=
    exists_dist_le_lt hε hδ (show dist z x < δ + ε by simpa only [dist_comm, add_comm] using h)
  exact ⟨y, by simp [dist_comm x y, dist_comm y z, *]⟩
#align exists_dist_lt_le exists_dist_lt_le

-- This is also true for `ℚ`-normed spaces
theorem exists_dist_lt_lt (hδ : 0 < δ) (hε : 0 < ε) (h : dist x z < ε + δ) :
    ∃ y, dist x y < δ ∧ dist y z < ε :=
  by
  refine'
    (exists_dist_eq x z (div_nonneg hε.le <| add_nonneg hε.le hδ.le)
            (div_nonneg hδ.le <| add_nonneg hε.le hδ.le) <|
          by rw [← add_div, div_self (add_pos hε hδ).ne']).imp
      fun y hy => _
  rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε]
  rw [← div_lt_one (add_pos hε hδ)] at h
  exact ⟨mul_lt_of_lt_one_left hδ h, mul_lt_of_lt_one_left hε h⟩
#align exists_dist_lt_lt exists_dist_lt_lt

-- This is also true for `ℚ`-normed spaces
theorem disjoint_ball_ball_iff (hδ : 0 < δ) (hε : 0 < ε) :
    Disjoint (ball x δ) (ball y ε) ↔ δ + ε ≤ dist x y :=
  by
  refine' ⟨fun h => le_of_not_lt fun hxy => _, ball_disjoint_ball⟩
  rw [add_comm] at hxy
  obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_lt hδ hε hxy
  rw [dist_comm] at hxz
  exact h.le_bot ⟨hxz, hzy⟩
#align disjoint_ball_ball_iff disjoint_ball_ball_iff

-- This is also true for `ℚ`-normed spaces
theorem disjoint_ball_closedBall_iff (hδ : 0 < δ) (hε : 0 ≤ ε) :
    Disjoint (ball x δ) (closedBall y ε) ↔ δ + ε ≤ dist x y :=
  by
  refine' ⟨fun h => le_of_not_lt fun hxy => _, ball_disjoint_closed_ball⟩
  rw [add_comm] at hxy
  obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_le hδ hε hxy
  rw [dist_comm] at hxz
  exact h.le_bot ⟨hxz, hzy⟩
#align disjoint_ball_closed_ball_iff disjoint_ball_closedBall_iff

-- This is also true for `ℚ`-normed spaces
theorem disjoint_closedBall_ball_iff (hδ : 0 ≤ δ) (hε : 0 < ε) :
    Disjoint (closedBall x δ) (ball y ε) ↔ δ + ε ≤ dist x y := by
  rw [disjoint_comm, disjoint_ball_closedBall_iff hε hδ, add_comm, dist_comm] <;> infer_instance
#align disjoint_closed_ball_ball_iff disjoint_closedBall_ball_iff

theorem disjoint_closedBall_closedBall_iff (hδ : 0 ≤ δ) (hε : 0 ≤ ε) :
    Disjoint (closedBall x δ) (closedBall y ε) ↔ δ + ε < dist x y :=
  by
  refine' ⟨fun h => lt_of_not_ge fun hxy => _, closed_ball_disjoint_closed_ball⟩
  rw [add_comm] at hxy
  obtain ⟨z, hxz, hzy⟩ := exists_dist_le_le hδ hε hxy
  rw [dist_comm] at hxz
  exact h.le_bot ⟨hxz, hzy⟩
#align disjoint_closed_ball_closed_ball_iff disjoint_closedBall_closedBall_iff

open Emetric ENNReal

@[simp]
theorem infEdist_thickening (hδ : 0 < δ) (s : Set E) (x : E) :
    infEdist x (thickening δ s) = infEdist x s - ENNReal.ofReal δ :=
  by
  obtain hs | hs := lt_or_le (inf_edist x s) (ENNReal.ofReal δ)
  · rw [inf_edist_zero_of_mem, tsub_eq_zero_of_le hs.le]
    exact hs
  refine' (tsub_le_iff_right.2 inf_edist_le_inf_edist_thickening_add).antisymm' _
  refine' le_sub_of_add_le_right of_real_ne_top _
  refine' le_inf_edist.2 fun z hz => le_of_forall_lt' fun r h => _
  cases r
  ·
    exact
      add_lt_top.2
        ⟨lt_top_iff_ne_top.2 <| inf_edist_ne_top ⟨z, self_subset_thickening hδ _ hz⟩,
          of_real_lt_top⟩
  have hr : 0 < ↑r - δ := by
    refine' sub_pos_of_lt _
    have := hs.trans_lt ((inf_edist_le_edist_of_mem hz).trans_lt h)
    rw [of_real_eq_coe_nnreal hδ.le, some_eq_coe] at this
    exact_mod_cast this
  rw [some_eq_coe, edist_lt_coe, ← dist_lt_coe, ← add_sub_cancel'_right δ ↑r] at h
  obtain ⟨y, hxy, hyz⟩ := exists_dist_lt_lt hr hδ h
  refine'
    (ENNReal.add_lt_add_right of_real_ne_top <|
          inf_edist_lt_iff.2 ⟨_, mem_thickening_iff.2 ⟨_, hz, hyz⟩, edist_lt_ofReal.2 hxy⟩).trans_le
      _
  rw [← of_real_add hr.le hδ.le, sub_add_cancel, of_real_coe_nnreal]
  exact le_rfl
#align inf_edist_thickening infEdist_thickening

@[simp]
theorem thickening_thickening (hε : 0 < ε) (hδ : 0 < δ) (s : Set E) :
    thickening ε (thickening δ s) = thickening (ε + δ) s :=
  (thickening_thickening_subset _ _ _).antisymm fun x =>
    by
    simp_rw [mem_thickening_iff]
    rintro ⟨z, hz, hxz⟩
    rw [add_comm] at hxz
    obtain ⟨y, hxy, hyz⟩ := exists_dist_lt_lt hε hδ hxz
    exact ⟨y, ⟨_, hz, hyz⟩, hxy⟩
#align thickening_thickening thickening_thickening

@[simp]
theorem cthickening_thickening (hε : 0 ≤ ε) (hδ : 0 < δ) (s : Set E) :
    cthickening ε (thickening δ s) = cthickening (ε + δ) s :=
  (cthickening_thickening_subset hε _ _).antisymm fun x =>
    by
    simp_rw [mem_cthickening_iff, ENNReal.ofReal_add hε hδ.le, infEdist_thickening hδ]
    exact tsub_le_iff_right.2
#align cthickening_thickening cthickening_thickening

-- Note: `interior (cthickening δ s) ≠ thickening δ s` in general
@[simp]
theorem closure_thickening (hδ : 0 < δ) (s : Set E) : closure (thickening δ s) = cthickening δ s :=
  by
  rw [← cthickening_zero, cthickening_thickening le_rfl hδ, zero_add]
  infer_instance
#align closure_thickening closure_thickening

@[simp]
theorem infEdist_cthickening (δ : ℝ) (s : Set E) (x : E) :
    infEdist x (cthickening δ s) = infEdist x s - ENNReal.ofReal δ :=
  by
  obtain hδ | hδ := le_or_lt δ 0
  · rw [cthickening_of_nonpos hδ, inf_edist_closure, of_real_of_nonpos hδ, tsub_zero]
  · rw [← closure_thickening hδ, inf_edist_closure, infEdist_thickening hδ] <;> infer_instance
#align inf_edist_cthickening infEdist_cthickening

@[simp]
theorem thickening_cthickening (hε : 0 < ε) (hδ : 0 ≤ δ) (s : Set E) :
    thickening ε (cthickening δ s) = thickening (ε + δ) s :=
  by
  obtain rfl | hδ := hδ.eq_or_lt
  · rw [cthickening_zero, thickening_closure, add_zero]
  · rw [← closure_thickening hδ, thickening_closure, thickening_thickening hε hδ] <;> infer_instance
#align thickening_cthickening thickening_cthickening

@[simp]
theorem cthickening_cthickening (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (s : Set E) :
    cthickening ε (cthickening δ s) = cthickening (ε + δ) s :=
  (cthickening_cthickening_subset hε hδ _).antisymm fun x =>
    by
    simp_rw [mem_cthickening_iff, ENNReal.ofReal_add hε hδ, infEdist_cthickening]
    exact tsub_le_iff_right.2
#align cthickening_cthickening cthickening_cthickening

@[simp]
theorem thickening_ball (hε : 0 < ε) (hδ : 0 < δ) (x : E) :
    thickening ε (ball x δ) = ball x (ε + δ) := by
  rw [← thickening_singleton, thickening_thickening hε hδ, thickening_singleton] <;> infer_instance
#align thickening_ball thickening_ball

@[simp]
theorem thickening_closedBall (hε : 0 < ε) (hδ : 0 ≤ δ) (x : E) :
    thickening ε (closedBall x δ) = ball x (ε + δ) := by
  rw [← cthickening_singleton _ hδ, thickening_cthickening hε hδ, thickening_singleton] <;>
    infer_instance
#align thickening_closed_ball thickening_closedBall

@[simp]
theorem cthickening_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (x : E) :
    cthickening ε (ball x δ) = closedBall x (ε + δ) := by
  rw [← thickening_singleton, cthickening_thickening hε hδ,
      cthickening_singleton _ (add_nonneg hε hδ.le)] <;>
    infer_instance
#align cthickening_ball cthickening_ball

@[simp]
theorem cthickening_closedBall (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (x : E) :
    cthickening ε (closedBall x δ) = closedBall x (ε + δ) := by
  rw [← cthickening_singleton _ hδ, cthickening_cthickening hε hδ,
      cthickening_singleton _ (add_nonneg hε hδ)] <;>
    infer_instance
#align cthickening_closed_ball cthickening_closedBall

theorem ball_add_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) :
    ball a ε + ball b δ = ball (a + b) (ε + δ) := by
  rw [ball_add, thickening_ball hε hδ b, Metric.vadd_ball, vadd_eq_add]
#align ball_add_ball ball_add_ball

theorem ball_sub_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) :
    ball a ε - ball b δ = ball (a - b) (ε + δ) := by
  simp_rw [sub_eq_add_neg, neg_ball, ball_add_ball hε hδ]
#align ball_sub_ball ball_sub_ball

theorem ball_add_closedBall (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) :
    ball a ε + closedBall b δ = ball (a + b) (ε + δ) := by
  rw [ball_add, thickening_closedBall hε hδ b, Metric.vadd_ball, vadd_eq_add]
#align ball_add_closed_ball ball_add_closedBall

theorem ball_sub_closedBall (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) :
    ball a ε - closedBall b δ = ball (a - b) (ε + δ) := by
  simp_rw [sub_eq_add_neg, neg_closedBall, ball_add_closedBall hε hδ]
#align ball_sub_closed_ball ball_sub_closedBall

theorem closedBall_add_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) :
    closedBall a ε + ball b δ = ball (a + b) (ε + δ) := by
  rw [add_comm, ball_add_closedBall hδ hε b, add_comm, add_comm δ]
#align closed_ball_add_ball closedBall_add_ball

theorem closedBall_sub_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) :
    closedBall a ε - ball b δ = ball (a - b) (ε + δ) := by
  simp_rw [sub_eq_add_neg, neg_ball, closedBall_add_ball hε hδ]
#align closed_ball_sub_ball closedBall_sub_ball

theorem closedBall_add_closedBall [ProperSpace E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) :
    closedBall a ε + closedBall b δ = closedBall (a + b) (ε + δ) := by
  rw [(is_compact_closed_ball _ _).add_closedBall hδ b, cthickening_closedBall hδ hε a,
    Metric.vadd_closedBall, vadd_eq_add, add_comm, add_comm δ]
#align closed_ball_add_closed_ball closedBall_add_closedBall

theorem closedBall_sub_closedBall [ProperSpace E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) :
    closedBall a ε - closedBall b δ = closedBall (a - b) (ε + δ) := by
  simp_rw [sub_eq_add_neg, neg_closedBall, closedBall_add_closedBall hε hδ]
#align closed_ball_sub_closed_ball closedBall_sub_closedBall

end SeminormedAddCommGroup

section NormedAddCommGroup

variable [NormedAddCommGroup E] [NormedSpace 𝕜 E]

theorem smul_closedBall (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) :
    c • closedBall x r = closedBall (c • x) (‖c‖ * r) :=
  by
  rcases eq_or_ne c 0 with (rfl | hc)
  · simp [hr, zero_smul_set, Set.singleton_zero, ← nonempty_closed_ball]
  · exact smul_closed_ball' hc x r
#align smul_closed_ball smul_closedBall

theorem smul_closed_unit_ball (c : 𝕜) : c • closedBall (0 : E) (1 : ℝ) = closedBall (0 : E) ‖c‖ :=
  by rw [smul_closedBall _ _ zero_le_one, smul_zero, mul_one]
#align smul_closed_unit_ball smul_closed_unit_ball

variable [NormedSpace ℝ E]

/-- In a real normed space, the image of the unit closed ball under multiplication by a nonnegative
number `r` is the closed ball of radius `r` with center at the origin. -/
theorem smul_closed_unit_ball_of_nonneg {r : ℝ} (hr : 0 ≤ r) :
    r • closedBall 0 1 = closedBall (0 : E) r := by
  rw [smul_closed_unit_ball, Real.norm_of_nonneg hr]
#align smul_closed_unit_ball_of_nonneg smul_closed_unit_ball_of_nonneg

/-- In a nontrivial real normed space, a sphere is nonempty if and only if its radius is
nonnegative. -/
@[simp]
theorem NormedSpace.sphere_nonempty [Nontrivial E] {x : E} {r : ℝ} :
    (sphere x r).Nonempty ↔ 0 ≤ r :=
  by
  obtain ⟨y, hy⟩ := exists_ne x
  refine'
    ⟨fun h => nonempty_closed_ball.1 (h.mono sphere_subset_closed_ball), fun hr =>
      ⟨r • ‖y - x‖⁻¹ • (y - x) + x, _⟩⟩
  have : ‖y - x‖ ≠ 0 := by simpa [sub_eq_zero]
  simp [norm_smul, this, Real.norm_of_nonneg hr]
#align normed_space.sphere_nonempty NormedSpace.sphere_nonempty

theorem smul_sphere [Nontrivial E] (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) :
    c • sphere x r = sphere (c • x) (‖c‖ * r) :=
  by
  rcases eq_or_ne c 0 with (rfl | hc)
  · simp [zero_smul_set, Set.singleton_zero, hr]
  · exact smul_sphere' hc x r
#align smul_sphere smul_sphere

/-- Any ball `metric.ball x r`, `0 < r` is the image of the unit ball under `λ y, x + r • y`. -/
theorem affinity_unit_ball {r : ℝ} (hr : 0 < r) (x : E) : x +ᵥ r • ball 0 1 = ball x r := by
  rw [smul_unit_ball_of_pos hr, vadd_ball_zero]
#align affinity_unit_ball affinity_unit_ball

/-- Any closed ball `metric.closed_ball x r`, `0 ≤ r` is the image of the unit closed ball under
`λ y, x + r • y`. -/
theorem affinity_unit_closedBall {r : ℝ} (hr : 0 ≤ r) (x : E) :
    x +ᵥ r • closedBall 0 1 = closedBall x r := by
  rw [smul_closed_unit_ball, Real.norm_of_nonneg hr, vadd_closedBall_zero]
#align affinity_unit_closed_ball affinity_unit_closedBall

end NormedAddCommGroup


/- Homework 3.2: Program Semantics — Hoare Logic -/

/- Download `x32_library.lean` from the "Logical Verification" homepage and put it in the same
directory as this exercise sheet. -/

import .x32_library

namespace lecture

/- Question 1: Hoare logic for Dijkstra's guarded command language -/

/- Recall the definition of GCL from exercise 3.1: -/

inductive gcl (σ : Type)
| assign : string → (σ → ℕ) → gcl
| assert : (σ → Prop) → gcl
| seq    : gcl → gcl → gcl
| choice : list gcl → gcl
| loop   : gcl → gcl

namespace gcl

variables {p p₀ p₁ p₂ : gcl state} {ps : list (gcl state)}

inductive big_step : (gcl state × state) → state → Prop
| assign {f s n} :
  big_step (assign n f, s) (s.update n (f s))
| assert {c : state → Prop} {s} (hs : c s) :
  big_step (assert c, s) s
| seq {p₁ p₂ s u} (t) (h₁ : big_step (p₁, s) t) (h₂ : big_step (p₂, t) u) :
  big_step (seq p₁ p₂, s) u
| choice {ps : list (gcl state)} {s t} (i : ℕ) (hi : i < list.length ps)
  (h : big_step (list.nth_le ps i hi, s) t) :
  big_step (choice ps, s) t
| loop_base {p s} :
  big_step (loop p, s) s
| loop_step {p s t} (u) (h₁ : big_step (p, s) u) (h₂ : big_step (loop p, u) t) :
  big_step (loop p, s) t

infix ` ⟹ `:110 := big_step

/- The definition of Hoare triples for partial correctness is unsurprising: -/

def partial_hoare (P : state → Prop) (p : gcl state) (Q : state → Prop) : Prop :=
∀s t, P s → (p, s) ⟹ t → Q t

local notation `{* ` P : 1 ` *} ` p : 1 ` {* ` Q : 1 ` *}` := partial_hoare P p Q

namespace partial_hoare

variables {P P' P₁ P₂ P₃ Q Q' : state → Prop} {n : string} {f : state → ℕ}

/- 1.1. Prove the consequence rule. -/

lemma consequence (h : {* P *} p {* Q *}) (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} p {* Q' *} :=
begin
  intros pq t pqs hpq,
  cases hpq,
  repeat{apply hq,
  apply h pq,
  apply hp},
  repeat{assumption}
end

/- 1.2. Prove the rule for `assign`. -/

lemma assign_intro (P : state → Prop) :
  {* λs:state, P (s.update n (f s)) *} assign n f {* P *} :=
begin
  intros s t ls hls,
  cases hls,
  apply ls
end

/- 1.3. Prove the rule for `assert`. -/

lemma assert_intro :
  {* λs, Q s → P s *} assert Q {* P *} :=
begin
  intros s t sl hsl,
  cases hsl,
  apply sl,
  assumption
end

/- 1.4. Prove the rule for `seq`. -/

lemma seq_intro (h₁ : {* P₁ *} p₁ {* P₂ *}) (h₂ : {* P₂ *} p₂ {* P₃ *}) :
  {* P₁ *} seq p₁ p₂ {* P₃ *} :=
begin
  intros s t ps pst,
  cases pst,
  apply h₂ s,
  apply h₁ s,
  assumption,

end
insert
/- 1.5. Prove the rule for `choice`. -/

lemma choice_intro
  (h : ∀i (hi : i < list.length ps), {* λs, P s *} list.nth_le ps i hi {* Q *}) :
  {* P *} choice ps {* Q *} :=
begin
  intros s t p pst,
  cases pst,
  apply h pst_i pst_hi s t,
  repeat{assumption}
end

/- 1.6. State and prove the rule for `loop`.

    lemma loop_intro ... :
      {* ... *} loop p {* ... *} :=
    ... -/

lemma loop_intro (h : {* P *} loop p {* Q *}) (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} loop p {* Q' *} :=
begin
  intros s t ps pst,
  cases pst,
  apply hq,
  apply h s,
  apply hp,
  repeat {assumption},
  apply hq,
  apply h s,
  apply hp,
  assumption,

end

end partial_hoare

end gcl

/- Background material from the lecture. Do not prove the `sorry`s below. -/

def program.while_inv (I : state → Prop) (c : state → Prop) (p : program) : program :=
program.while c p

open program

variables
  {c : state → Prop} {f : state → ℕ} {n : string}
  {p p₀ p₁ p₂ : program} {s s₀ s₁ s₂ t u : state}
  {P P' P₁ P₂ P₃ Q Q' : state → Prop}

def partial_hoare (P : state → Prop) (p : program) (Q : state → Prop) : Prop :=
∀s t, P s → (p, s) ⟹ t → Q t

notation `{* ` P : 1 ` *} ` p : 1 ` {* ` Q : 1 ` *}` := partial_hoare P p Q

namespace partial_hoare

lemma consequence (h : {* P *} p {* Q *}) (hp : ∀s, P' s → P s) (hq : ∀s, Q s → Q' s) :
  {* P' *} p {* Q' *} :=
sorry

lemma consequence_left (P' : state → Prop) (h : {* P *} p {* Q *}) (hp : ∀s, P' s → P s) :
  {* P' *} p {* Q *} :=
sorry

lemma consequence_right (Q : state → Prop) (h : {* P *} p {* Q *}) (hq : ∀s, Q s → Q' s) :
  {* P *} p {* Q' *} :=
sorry

lemma skip_intro :
  {* P *} skip {* P *} :=
sorry

lemma assign_intro (P : state → Prop) :
  {* λs, P (s.update n (f s)) *} assign n f {* P *} :=
sorry

lemma seq_intro (h₁ : {* P₁ *} p₁ {* P₂ *}) (h₂ : {* P₂ *} p₂ {* P₃ *}) :
  {* P₁ *} seq p₁ p₂ {* P₃ *} :=
sorry

lemma ite_intro (h₁ : {* λs, P s ∧ c s *} p₁ {* Q *}) (h₂ : {* λs, P s ∧ ¬ c s *} p₂ {* Q *}) :
  {* P *} ite c p₁ p₂ {* Q *} :=
sorry

lemma while_intro (P : state → Prop) (h₁ : {* λs, P s ∧ c s *} p {* P *}) :
  {* P *} while c p {* λs, P s ∧ ¬ c s *} :=
sorry

lemma skip_intro' (h : ∀s, P s → Q s):
  {* P *} skip {* Q *} :=
sorry

lemma assign_intro' (h : ∀s, P s → Q (s.update n (f s))):
  {* P *} assign n f {* Q *} :=
sorry

lemma seq_intro' (h₂ : {* P₂ *} p₂ {* P₃ *}) (h₁ : {* P₁ *} p₁ {* P₂ *}) :
  {* P₁ *} p₁ ;; p₂ {* P₃ *} :=
sorry

lemma while_intro_inv (I : state → Prop)
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hp : ∀s, P s → I s) (hq : ∀s, ¬ c s → I s → Q s) :
  {* P *} while c p {* Q *} :=
sorry

lemma while_inv_intro {I : state → Prop}
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hq : ∀s, ¬ c s → I s → Q s) :
  {* I *} while_inv I c p {* Q *} :=
sorry

lemma while_inv_intro' {I : state → Prop}
  (h₁ : {* λs, I s ∧ c s *} p {* I *}) (hp : ∀s, P s → I s) (hq : ∀s, ¬ c s → I s → Q s) :
  {* P *} while_inv I c p {* Q *} :=
sorry

end partial_hoare

end lecture

namespace tactic.interactive

open lecture.partial_hoare lecture tactic

meta def is_meta {elab : bool} : expr elab → bool
| (expr.mvar _ _ _) := tt
| _                 := ff

meta def vcg : tactic unit := do
  `({* %%P *} %%p {* %%Q *}) ← target
  | skip, -- do nothing if the goal is not a Hoare triple
match p with
| `(program.skip)            := applyc (if is_meta P then ``skip_intro else ``skip_intro')
| `(program.assign _ _)      := applyc (if is_meta P then ``assign_intro else ``assign_intro')
| `(program.ite _ _ _)       := do applyc ``ite_intro; vcg
| `(program.seq _ _)         := do applyc ``seq_intro'; vcg
| `(program.while_inv _ _ _) :=
  do applyc (if is_meta P then ``while_inv_intro else ``while_inv_intro'); vcg
| _                          := fail (to_fmt "cannot analyze " ++ to_fmt p)

end

end tactic.interactive

namespace lecture

open program partial_hoare

/- Question 2: Factorial -/

section FACT

/- The following WHILE program is intended to compute the factorial of `n`, leaving the result in
`r`. -/

def FACT : program :=
assign "r" (λs, 1) ;;
while (λs, s "n" ≠ 0)
( assign "r" (λs, s "r" * s "n") ;;
  assign "n" (λs, s "n" - 1) )

/- 2.1. Define the factorial function. -/

def fact : ℕ → ℕ
| 0 := 1
| (x + 1) := (x + 1) * fact (x)

#reduce fact 5

/- 2.2. Prove the correctness of `FACT`, using `vcg`. -/

lemma FACT_correct (n : ℕ) :
  {* λs, s "n" = n *} FACT {* λs, s "r" = fact n *} :=
begin
  refine while_intro_inv (λs, s "n" + s "r" = fact n) _ _ _,

  intro s,
   vcg,
   intro l,
   vcg,
   intro k,
   vcg,
   intro l,
   vcg,
   cases l,
   simp {contextual := tt},

end

end FACT

end lecture


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.constructions.prod

/-!
# Product measures

In this file we define and prove properties about finite products of measures
(and at some point, countable products of measures).

## Main definition

* `measure_theory.measure.pi`: The product of finitely many σ-finite measures.
  Given `μ : Π i : ι, measure (α i)` for `[fintype ι]` it has type `measure (Π i : ι, α i)`.

To apply Fubini along some subset of the variables, use
`measure_theory.measure.map_pi_equiv_pi_subtype_prod` to reduce to the situation of a product
of two measures: this lemma states that the bijection `equiv.pi_equiv_pi_subtype_prod p α`
between `(Π i : ι, α i)` and `(Π i : {i // p i}, α i) × (Π i : {i // ¬ p i}, α i)` maps a product
measure to a direct product of product measures, to which one can apply the usual Fubini for
direct product of measures.

## Implementation Notes

We define `measure_theory.outer_measure.pi`, the product of finitely many outer measures, as the
maximal outer measure `n` with the property that `n (pi univ s) ≤ ∏ i, m i (s i)`,
where `pi univ s` is the product of the sets `{s i | i : ι}`.

We then show that this induces a product of measures, called `measure_theory.measure.pi`.
For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
`measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
* We know that there is some ordering on `ι`, given by an element of `[encodable ι]`.
* Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
  `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
* On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
  by iterating `measure_theory.measure.prod`
* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for encodable
  `ι`.
* We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
  since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
  measure which is the maximal such outer measure), we get the same rule for
  `measure_theory.measure.pi`.

## Tags

finitary product measure

-/

noncomputable theory
open function set measure_theory.outer_measure filter measurable_space encodable
open_locale classical big_operators topological_space ennreal

universes u v

variables {ι ι' : Type*} {α : ι → Type*}

/-! We start with some measurability properties -/

/-- Boxes formed by π-systems form a π-system. -/
lemma is_pi_system.pi {C : Π i, set (set (α i))} (hC : ∀ i, is_pi_system (C i)) :
  is_pi_system (pi univ '' pi univ C) :=
begin
  rintro _ _ ⟨s₁, hs₁, rfl⟩ ⟨s₂, hs₂, rfl⟩ hst,
  rw [← pi_inter_distrib] at hst ⊢, rw [univ_pi_nonempty_iff] at hst,
  exact mem_image_of_mem _ (λ i _, hC i _ _ (hs₁ i (mem_univ i)) (hs₂ i (mem_univ i)) (hst i))
end

/-- Boxes form a π-system. -/
lemma is_pi_system_pi [Π i, measurable_space (α i)] :
  is_pi_system (pi univ '' pi univ (λ i, {s : set (α i) | measurable_set s})) :=
is_pi_system.pi (λ i, is_pi_system_measurable_set)

variables [fintype ι] [fintype ι']

/-- Boxes of countably spanning sets are countably spanning. -/
lemma is_countably_spanning.pi {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  is_countably_spanning (pi univ '' pi univ C) :=
begin
  choose s h1s h2s using hC,
  haveI := fintype.encodable ι,
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  refine ⟨λ n, pi univ (λ i, s i (e n i)), λ n, mem_image_of_mem _ (λ i _, h1s i _), _⟩,
  simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, s i (x i))),
      Union_univ_pi s, h2s, pi_univ]
end

/-- The product of generated σ-algebras is the one generated by boxes, if both generating sets
  are countably spanning. -/
lemma generate_from_pi_eq {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  @measurable_space.pi _ _ (λ i, generate_from (C i)) = generate_from (pi univ '' pi univ C) :=
begin
  haveI := fintype.encodable ι,
  apply le_antisymm,
  { refine supr_le _, intro i, rw [comap_generate_from],
    apply generate_from_le, rintro _ ⟨s, hs, rfl⟩, dsimp,
    choose t h1t h2t using hC,
    simp_rw [eval_preimage, ← h2t],
    rw [← @Union_const _ ℕ _ s],
    have : (pi univ (update (λ (i' : ι), Union (t i')) i (⋃ (i' : ℕ), s))) =
      (pi univ (λ k, ⋃ j : ℕ, @update ι (λ i', set (α i')) _ (λ i', t i' j) i s k)),
    { ext, simp_rw [mem_univ_pi], apply forall_congr, intro i',
      by_cases (i' = i), { subst h, simp }, { rw [← ne.def] at h, simp [h] }},
    rw [this, ← Union_univ_pi],
    apply measurable_set.Union,
    intro n, apply measurable_set_generate_from,
    apply mem_image_of_mem, intros j _, dsimp only,
    by_cases h: j = i, subst h, rwa [update_same], rw [update_noteq h], apply h1t },
  { apply generate_from_le, rintro _ ⟨s, hs, rfl⟩,
    rw [univ_pi_eq_Inter], apply measurable_set.Inter, intro i, apply measurable_pi_apply,
    exact measurable_set_generate_from (hs i (mem_univ i)) }
end

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
lemma generate_from_eq_pi [h : Π i, measurable_space (α i)]
  {C : Π i, set (set (α i))} (hC : ∀ i, generate_from (C i) = h i)
  (h2C : ∀ i, is_countably_spanning (C i)) :
  generate_from (pi univ '' pi univ C) = measurable_space.pi :=
by rw [← funext hC, generate_from_pi_eq h2C]

/-- The product σ-algebra is generated from boxes, i.e. `s.prod t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_pi [Π i, measurable_space (α i)] :
  generate_from (pi univ '' pi univ (λ i, { s : set (α i) | measurable_set s})) =
  measurable_space.pi :=
generate_from_eq_pi (λ i, generate_from_measurable_set) (λ i, is_countably_spanning_measurable_set)

namespace measure_theory

variables {m : Π i, outer_measure (α i)}

/-- An upper bound for the measure in a finite product space.
  It is defined to by taking the image of the set under all projections, and taking the product
  of the measures of these images.
  For measurable boxes it is equal to the correct measure. -/
@[simp] def pi_premeasure (m : Π i, outer_measure (α i)) (s : set (Π i, α i)) : ℝ≥0∞ :=
∏ i, m i (eval i '' s)

lemma pi_premeasure_pi {s : Π i, set (α i)} (hs : (pi univ s).nonempty) :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
by simp [hs]

lemma pi_premeasure_pi' [nonempty ι] {s : Π i, set (α i)} :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
begin
  cases (pi univ s).eq_empty_or_nonempty with h h,
  { rcases univ_pi_eq_empty_iff.mp h with ⟨i, hi⟩,
    have : ∃ i, m i (s i) = 0 := ⟨i, by simp [hi]⟩,
    simpa [h, finset.card_univ, zero_pow (fintype.card_pos_iff.mpr ‹_›),
      @eq_comm _ (0 : ℝ≥0∞), finset.prod_eq_zero_iff] },
  { simp [h] }
end

lemma pi_premeasure_pi_mono {s t : set (Π i, α i)} (h : s ⊆ t) :
  pi_premeasure m s ≤ pi_premeasure m t :=
finset.prod_le_prod' (λ i _, (m i).mono' (image_subset _ h))

lemma pi_premeasure_pi_eval [nonempty ι] {s : set (Π i, α i)} :
  pi_premeasure m (pi univ (λ i, eval i '' s)) = pi_premeasure m s :=
by simp [pi_premeasure_pi']

namespace outer_measure

/-- `outer_measure.pi m` is the finite product of the outer measures `{m i | i : ι}`.
  It is defined to be the maximal outer measure `n` with the property that
  `n (pi univ s) ≤ ∏ i, m i (s i)`, where `pi univ s` is the product of the sets
  `{s i | i : ι}`. -/
protected def pi (m : Π i, outer_measure (α i)) : outer_measure (Π i, α i) :=
bounded_by (pi_premeasure m)

lemma pi_pi_le (m : Π i, outer_measure (α i)) (s : Π i, set (α i)) :
  outer_measure.pi m (pi univ s) ≤ ∏ i, m i (s i) :=
by { cases (pi univ s).eq_empty_or_nonempty with h h, simp [h],
     exact (bounded_by_le _).trans_eq (pi_premeasure_pi h) }

lemma le_pi {m : Π i, outer_measure (α i)} {n : outer_measure (Π i, α i)} :
  n ≤ outer_measure.pi m ↔ ∀ (s : Π i, set (α i)), (pi univ s).nonempty →
    n (pi univ s) ≤ ∏ i, m i (s i) :=
begin
  rw [outer_measure.pi, le_bounded_by'], split,
  { intros h s hs, refine (h _ hs).trans_eq (pi_premeasure_pi hs) },
  { intros h s hs, refine le_trans (n.mono $ subset_pi_eval_image univ s) (h _ _),
    simp [univ_pi_nonempty_iff, hs] }
end

end outer_measure

namespace measure

variables [Π i, measurable_space (α i)] (μ : Π i, measure (α i))

section tprod

open list
variables {δ : Type*} {π : δ → Type*} [∀ x, measurable_space (π x)]

/-- A product of measures in `tprod α l`. -/
-- for some reason the equation compiler doesn't like this definition
protected def tprod (l : list δ) (μ : Π i, measure (π i)) : measure (tprod π l) :=
by { induction l with i l ih, exact dirac punit.star, exact (μ i).prod ih }

@[simp] lemma tprod_nil (μ : Π i, measure (π i)) : measure.tprod [] μ = dirac punit.star := rfl

@[simp] lemma tprod_cons (i : δ) (l : list δ) (μ : Π i, measure (π i)) :
  measure.tprod (i :: l) μ = (μ i).prod (measure.tprod l μ) := rfl

instance sigma_finite_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)] :
  sigma_finite (measure.tprod l μ) :=
begin
  induction l with i l ih,
  { rw [tprod_nil], apply_instance },
  { rw [tprod_cons], resetI, apply_instance }
end

lemma tprod_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)]
  (s : Π i, set (π i)) :
  measure.tprod l μ (set.tprod l s) = (l.map (λ i, (μ i) (s i))).prod :=
begin
  induction l with i l ih, { simp },
  rw [tprod_cons, set.tprod, prod_prod, map_cons, prod_cons, ih]
end

end tprod

section encodable

open list measurable_equiv
variables [encodable ι]

/-- The product measure on an encodable finite type, defined by mapping `measure.tprod` along the
  equivalence `measurable_equiv.pi_measurable_equiv_tprod`.
  The definition `measure_theory.measure.pi` should be used instead of this one. -/
def pi' : measure (Π i, α i) :=
measure.map (tprod.elim' mem_sorted_univ) (measure.tprod (sorted_univ ι) μ)

lemma pi'_pi [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) : pi' μ (pi univ s) = ∏ i, μ i (s i) :=
by rw [pi', ← measurable_equiv.pi_measurable_equiv_tprod_symm_apply, measurable_equiv.map_apply,
  measurable_equiv.pi_measurable_equiv_tprod_symm_apply, elim_preimage_pi, tprod_tprod _ μ,
  ← list.prod_to_finset, sorted_univ_to_finset]; exact sorted_univ_nodup ι

end encodable

lemma pi_caratheodory :
  measurable_space.pi ≤ (outer_measure.pi (λ i, (μ i).to_outer_measure)).caratheodory :=
begin
  refine supr_le _,
  intros i s hs,
  rw [measurable_space.comap] at hs,
  rcases hs with ⟨s, hs, rfl⟩,
  apply bounded_by_caratheodory,
  intro t,
  simp_rw [pi_premeasure],
  refine finset.prod_add_prod_le' (finset.mem_univ i) _ _ _,
  { simp [image_inter_preimage, image_diff_preimage, measure_inter_add_diff _ hs, le_refl] },
  { rintro j - hj, apply mono', apply image_subset, apply inter_subset_left },
  { rintro j - hj, apply mono', apply image_subset, apply diff_subset }
end

/-- `measure.pi μ` is the finite product of the measures `{μ i | i : ι}`.
  It is defined to be measure corresponding to `measure_theory.outer_measure.pi`. -/
@[irreducible] protected def pi : measure (Π i, α i) :=
to_measure (outer_measure.pi (λ i, (μ i).to_outer_measure)) (pi_caratheodory μ)

lemma pi_pi_aux [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) (hs : ∀ i, measurable_set (s i)) :
  measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  refine le_antisymm _ _,
  { rw [measure.pi, to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i))],
    apply outer_measure.pi_pi_le },
  { haveI : encodable ι := fintype.encodable ι,
    rw [← pi'_pi μ s],
    simp_rw [← pi'_pi μ s, measure.pi,
      to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i)), ← to_outer_measure_apply],
    suffices : (pi' μ).to_outer_measure ≤ outer_measure.pi (λ i, (μ i).to_outer_measure),
    { exact this _ },
    clear hs s,
    rw [outer_measure.le_pi],
    intros s hs,
    simp_rw [to_outer_measure_apply],
    exact (pi'_pi μ s).le }
end

variable {μ}

/-- `measure.pi μ` has finite spanning sets in rectangles of finite spanning sets. -/
def finite_spanning_sets_in.pi {C : Π i, set (set (α i))}
  (hμ : ∀ i, (μ i).finite_spanning_sets_in (C i)) :
  (measure.pi μ).finite_spanning_sets_in (pi univ '' pi univ C) :=
begin
  haveI := λ i, (hμ i).sigma_finite,
  haveI := fintype.encodable ι,
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  refine ⟨λ n, pi univ (λ i, (hμ i).set (e n i)), λ n, _, λ n, _, _⟩,
  { refine mem_image_of_mem _ (λ i _, (hμ i).set_mem _) },
  { calc measure.pi μ (pi univ (λ i, (hμ i).set (e n i)))
        ≤ measure.pi μ (pi univ (λ i, to_measurable (μ i) ((hμ i).set (e n i)))) :
      measure_mono (pi_mono $ λ i hi, subset_to_measurable _ _)
    ... = ∏ i, μ i (to_measurable (μ i) ((hμ i).set (e n i))) :
      pi_pi_aux μ _ (λ i, measurable_set_to_measurable _ _)
    ... = ∏ i, μ i ((hμ i).set (e n i)) :
      by simp only [measure_to_measurable]
    ... < ∞ : ennreal.prod_lt_top (λ i hi, ((hμ i).finite _).ne) },
  { simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, (hμ i).set (x i))),
      Union_univ_pi (λ i, (hμ i).set), (hμ _).spanning, set.pi_univ] }
end

/-- A measure on a finite product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
lemma pi_eq_generate_from {C : Π i, set (set (α i))}
  (hC : ∀ i, generate_from (C i) = _inst_3 i)
  (h2C : ∀ i, is_pi_system (C i))
  (h3C : ∀ i, (μ i).finite_spanning_sets_in (C i))
  {μν : measure (Π i, α i)}
  (h₁ : ∀ s : Π i, set (α i), (∀ i, s i ∈ C i) → μν (pi univ s) = ∏ i, μ i (s i)) :
    measure.pi μ = μν :=
begin
  have h4C : ∀ i (s : set (α i)), s ∈ C i → measurable_set s,
  { intros i s hs, rw [← hC], exact measurable_set_generate_from hs },
  refine (finite_spanning_sets_in.pi h3C).ext
    (generate_from_eq_pi hC (λ i, (h3C i).is_countably_spanning)).symm
    (is_pi_system.pi h2C) _,
  rintro _ ⟨s, hs, rfl⟩,
  rw [mem_univ_pi] at hs,
  haveI := λ i, (h3C i).sigma_finite,
  simp_rw [h₁ s hs, pi_pi_aux μ s (λ i, h4C i _ (hs i))]
end

variables [∀ i, sigma_finite (μ i)]

/-- A measure on a finite product space equals the product measure if they are equal on
  rectangles. -/
lemma pi_eq {μ' : measure (Π i, α i)}
  (h : ∀ s : Π i, set (α i), (∀ i, measurable_set (s i)) → μ' (pi univ s) = ∏ i, μ i (s i)) :
  measure.pi μ = μ' :=
pi_eq_generate_from (λ i, generate_from_measurable_set)
  (λ i, is_pi_system_measurable_set)
  (λ i, (μ i).to_finite_spanning_sets_in) h

variables (μ)

lemma pi'_eq_pi [encodable ι] : pi' μ = measure.pi μ :=
eq.symm $ pi_eq $ λ s hs, pi'_pi μ s

@[simp] lemma pi_pi (s : Π i, set (α i)) : measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  haveI : encodable ι := fintype.encodable ι,
  rw [← pi'_eq_pi, pi'_pi]
end

lemma pi_univ : measure.pi μ univ = ∏ i, μ i univ := by rw [← pi_univ, pi_pi μ]

lemma pi_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 < r) :
  measure.pi μ (metric.ball x r) = ∏ i, μ i (metric.ball (x i) r) :=
by rw [ball_pi _ hr, pi_pi]

lemma pi_closed_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 ≤ r) :
  measure.pi μ (metric.closed_ball x r) = ∏ i, μ i (metric.closed_ball (x i) r) :=
by rw [closed_ball_pi _ hr, pi_pi]

instance pi.sigma_finite : sigma_finite (measure.pi μ) :=
(finite_spanning_sets_in.pi (λ i, (μ i).to_finite_spanning_sets_in)).sigma_finite

lemma pi_of_empty {α : Type*} [is_empty α] {β : α → Type*} {m : Π a, measurable_space (β a)}
  (μ : Π a : α, measure (β a)) (x : Π a, β a := is_empty_elim) :
  measure.pi μ = dirac x :=
begin
  haveI : ∀ a, sigma_finite (μ a) := is_empty_elim,
  refine pi_eq (λ s hs, _),
  rw [fintype.prod_empty, dirac_apply_of_mem],
  exact is_empty_elim
end

lemma pi_eval_preimage_null {i : ι} {s : set (α i)} (hs : μ i s = 0) :
  measure.pi μ (eval i ⁻¹' s) = 0 :=
begin
  /- WLOG, `s` is measurable -/
  rcases exists_measurable_superset_of_null hs with ⟨t, hst, htm, hμt⟩,
  suffices : measure.pi μ (eval i ⁻¹' t) = 0,
    from measure_mono_null (preimage_mono hst) this,
  clear_dependent s,
  /- Now rewrite it as `set.pi`, and apply `pi_pi` -/
  rw [← univ_pi_update_univ, pi_pi],
  apply finset.prod_eq_zero (finset.mem_univ i),
  simp [hμt]
end

lemma pi_hyperplane (i : ι) [has_no_atoms (μ i)] (x : α i) :
  measure.pi μ {f : Π i, α i | f i = x} = 0 :=
show measure.pi μ (eval i ⁻¹' {x}) = 0,
from pi_eval_preimage_null _ (measure_singleton x)

lemma ae_eval_ne (i : ι) [has_no_atoms (μ i)] (x : α i) :
  ∀ᵐ y : Π i, α i ∂measure.pi μ, y i ≠ x :=
compl_mem_ae_iff.2 (pi_hyperplane μ i x)

variable {μ}

lemma tendsto_eval_ae_ae {i : ι} : tendsto (eval i) (measure.pi μ).ae (μ i).ae :=
λ s hs, pi_eval_preimage_null μ hs

lemma ae_pi_le_pi : (measure.pi μ).ae ≤ filter.pi (λ i, (μ i).ae) :=
le_infi $ λ i, tendsto_eval_ae_ae.le_comap

lemma ae_eq_pi {β : ι → Type*} {f f' : Π i, α i → β i} (h : ∀ i, f i =ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) =ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, funext hx

lemma ae_le_pi {β : ι → Type*} [Π i, preorder (β i)] {f f' : Π i, α i → β i}
  (h : ∀ i, f i ≤ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) ≤ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, hx

lemma ae_le_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i ≤ᵐ[μ i] t i) :
  (set.pi I s) ≤ᵐ[measure.pi μ] (set.pi I t) :=
((eventually_all_finite (finite.of_fintype I)).2
  (λ i hi, tendsto_eval_ae_ae.eventually (h i hi))).mono $
    λ x hst hx i hi, hst i hi $ hx i hi

lemma ae_eq_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i =ᵐ[μ i] t i) :
  (set.pi I s) =ᵐ[measure.pi μ] (set.pi I t) :=
(ae_le_set_pi (λ i hi, (h i hi).le)).antisymm (ae_le_set_pi (λ i hi, (h i hi).symm.le))

section intervals

variables {μ} [Π i, partial_order (α i)] [∀ i, has_no_atoms (μ i)]

lemma pi_Iio_ae_eq_pi_Iic {s : set ι} {f : Π i, α i} :
  pi s (λ i, Iio (f i)) =ᵐ[measure.pi μ] pi s (λ i, Iic (f i)) :=
ae_eq_set_pi $ λ i hi, Iio_ae_eq_Iic

lemma pi_Ioi_ae_eq_pi_Ici {s : set ι} {f : Π i, α i} :
  pi s (λ i, Ioi (f i)) =ᵐ[measure.pi μ] pi s (λ i, Ici (f i)) :=
ae_eq_set_pi $ λ i hi, Ioi_ae_eq_Ici

lemma univ_pi_Iio_ae_eq_Iic {f : Π i, α i} :
  pi univ (λ i, Iio (f i)) =ᵐ[measure.pi μ] Iic f :=
by { rw ← pi_univ_Iic, exact pi_Iio_ae_eq_pi_Iic }

lemma univ_pi_Ioi_ae_eq_Ici {f : Π i, α i} :
  pi univ (λ i, Ioi (f i)) =ᵐ[measure.pi μ] Ici f :=
by { rw ← pi_univ_Ici, exact pi_Ioi_ae_eq_pi_Ici }

lemma pi_Ioo_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioo_ae_eq_Icc

lemma univ_pi_Ioo_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioo_ae_eq_pi_Icc }

lemma pi_Ioc_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioc_ae_eq_Icc

lemma univ_pi_Ioc_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioc_ae_eq_pi_Icc }

lemma pi_Ico_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ico_ae_eq_Icc

lemma univ_pi_Ico_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ico_ae_eq_pi_Icc }

end intervals

/-- If one of the measures `μ i` has no atoms, them `measure.pi µ`
has no atoms. The instance below assumes that all `μ i` have no atoms. -/
lemma pi_has_no_atoms (i : ι) [has_no_atoms (μ i)] :
  has_no_atoms (measure.pi μ) :=
⟨λ x, flip measure_mono_null (pi_hyperplane μ i (x i)) (singleton_subset_iff.2 rfl)⟩

instance [h : nonempty ι] [∀ i, has_no_atoms (μ i)] : has_no_atoms (measure.pi μ) :=
h.elim $ λ i, pi_has_no_atoms i

instance [Π i, topological_space (α i)] [∀ i, is_locally_finite_measure (μ i)] :
  is_locally_finite_measure (measure.pi μ) :=
begin
  refine ⟨λ x, _⟩,
  choose s hxs ho hμ using λ i, (μ i).exists_is_open_measure_lt_top (x i),
  refine ⟨pi univ s, set_pi_mem_nhds finite_univ (λ i hi, is_open.mem_nhds (ho i) (hxs i)), _⟩,
  rw [pi_pi],
  exact ennreal.prod_lt_top (λ i _, (hμ i).ne)
end

variable (μ)

/-- Separating the indices into those that satisfy a predicate `p` and those that don't maps
a product measure to a product of product measures. This is useful to apply Fubini to some subset
of the variables. The converse is `measure_theory.measure.map_pi_equiv_pi_subtype_prod`. -/
lemma map_pi_equiv_pi_subtype_prod_symm (p : ι → Prop) [decidable_pred p] :
  map (equiv.pi_equiv_pi_subtype_prod p α).symm
    (measure.prod (measure.pi (λ i, μ i)) (measure.pi (λ i, μ i))) = measure.pi μ :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  have A : (equiv.pi_equiv_pi_subtype_prod p α).symm ⁻¹' (set.pi set.univ (λ (i : ι), s i)) =
    set.prod (set.pi set.univ (λ i, s i)) (set.pi set.univ (λ i, s i)),
  { ext x,
    simp only [equiv.pi_equiv_pi_subtype_prod_symm_apply, mem_prod, mem_univ_pi, mem_preimage,
      subtype.forall],
    split,
    { exact λ h, ⟨λ i hi, by simpa [dif_pos hi] using h i,
                  λ i hi, by simpa [dif_neg hi] using h i⟩ },
    { assume h i,
      by_cases hi : p i,
      { simpa only [dif_pos hi] using h.1 i hi },
      {simpa only [dif_neg hi] using h.2 i hi } } },
  rw [measure.map_apply (measurable_pi_equiv_pi_subtype_prod_symm _ p)
        (measurable_set.univ_pi_fintype hs), A,
      measure.prod_prod, pi_pi, pi_pi, ← fintype.prod_subtype_mul_prod_subtype p (λ i, μ i (s i))],
end

lemma map_pi_equiv_pi_subtype_prod (p : ι → Prop) [decidable_pred p] :
  map (equiv.pi_equiv_pi_subtype_prod p α) (measure.pi μ) =
    measure.prod (measure.pi (λ i, μ i)) (measure.pi (λ i, μ i)) :=
begin
  rw [← map_pi_equiv_pi_subtype_prod_symm μ p, measure.map_map
      (measurable_pi_equiv_pi_subtype_prod _ p) (measurable_pi_equiv_pi_subtype_prod_symm _ p)],
  simp only [equiv.self_comp_symm, map_id]
end

end measure
instance measure_space.pi [Π i, measure_space (α i)] : measure_space (Π i, α i) :=
⟨measure.pi (λ i, volume)⟩

lemma volume_pi [Π i, measure_space (α i)] :
  (volume : measure (Π i, α i)) = measure.pi (λ i, volume) :=
rfl

lemma volume_pi_pi [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  (s : Π i, set (α i)) :
  volume (pi univ s) = ∏ i, volume (s i) :=
measure.pi_pi (λ i, volume) s

lemma volume_pi_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball x r) = ∏ i, volume (metric.ball (x i) r) :=
measure.pi_ball _ _ hr

lemma volume_pi_closed_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball x r) = ∏ i, volume (metric.closed_ball (x i) r) :=
measure.pi_closed_ball _ _ hr

/-!
### Measure preserving equivalences

In this section we prove that some measurable equivalences (e.g., between `fin 1 → α` and `α` or
between `fin 2 → α` and `α × α`) preserve measure or volume. These lemmas can be used to prove that
measures of corresponding sets (images or preimages) have equal measures and functions `f ∘ e` and
`f` have equal integrals, see lemmas in the `measure_theory.measure_preserving` prefix.
-/

section measure_preserving

lemma measure_preserving_fun_unique {β : Type u} {m : measurable_space β} (μ : measure β)
  (α : Type v) [unique α] :
  measure_preserving (measurable_equiv.fun_unique α β) (measure.pi (λ a : α, μ)) μ :=
begin
  set e := measurable_equiv.fun_unique α β,
  have : pi_premeasure (λ _ : α, μ.to_outer_measure) = measure.map e.symm μ,
  { ext1 s,
    rw [pi_premeasure, fintype.prod_unique, to_outer_measure_apply, e.symm.map_apply],
    congr' 1, exact e.to_equiv.image_eq_preimage s },
  simp only [measure.pi, outer_measure.pi, this, bounded_by_measure, to_outer_measure_to_measure],
  exact ((measurable_equiv.fun_unique α β).symm.measurable.measure_preserving _).symm
end

lemma volume_preserving_fun_unique (α : Type u) (β : Type v) [unique α] [measure_space β] :
  measure_preserving (measurable_equiv.fun_unique α β) volume volume :=
measure_preserving_fun_unique volume α

lemma measure_preserving_pi_fin_two {α : fin 2 → Type u} {m : Π i, measurable_space (α i)}
  (μ : Π i, measure (α i)) [∀ i, sigma_finite (μ i)] :
  measure_preserving (measurable_equiv.pi_fin_two α) (measure.pi μ) ((μ 0).prod (μ 1)) :=
begin
  refine ⟨measurable_equiv.measurable _, (measure.prod_eq $ λ s t hs ht, _).symm⟩,
  rw [measurable_equiv.map_apply, measurable_equiv.pi_fin_two_apply, fin.preimage_apply_01_prod,
    measure.pi_pi, fin.prod_univ_two],
  refl
end

lemma volume_preserving_pi_fin_two (α : fin 2 → Type u) [Π i, measure_space (α i)]
  [∀ i, sigma_finite (volume : measure (α i))] :
  measure_preserving (measurable_equiv.pi_fin_two α) volume volume :=
measure_preserving_pi_fin_two _

lemma measure_preserving_fin_two_arrow_vec {α : Type u} {m : measurable_space α}
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi ![μ, ν]) (μ.prod ν) :=
begin
  haveI : ∀ i, sigma_finite (![μ, ν] i) := fin.forall_fin_two.2 ⟨‹_›, ‹_›⟩,
  exact measure_preserving_pi_fin_two _
end

lemma measure_preserving_fin_two_arrow {α : Type u} {m : measurable_space α}
  (μ : measure α) [sigma_finite μ] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi (λ _, μ)) (μ.prod μ) :=
by simpa only [matrix.vec_single_eq_const, matrix.vec_cons_const]
  using measure_preserving_fin_two_arrow_vec μ μ

lemma volume_preserving_fin_two_arrow (α : Type u) [measure_space α]
  [sigma_finite (volume : measure α)] :
  measure_preserving (@measurable_equiv.fin_two_arrow α _) volume volume :=
measure_preserving_fin_two_arrow volume

lemma measure_preserving_pi_empty {ι : Type u} {α : ι → Type v} [is_empty ι]
  {m : Π i, measurable_space (α i)} (μ : Π i, measure (α i)) :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit)
    (measure.pi μ) (measure.dirac ()) :=
begin
  set e := (measurable_equiv.of_unique_of_unique (Π i, α i) unit),
  refine ⟨e.measurable, _⟩,
  rw [measure.pi_of_empty, measure.map_dirac e.measurable], refl
end

lemma volume_preserving_pi_empty {ι : Type u} (α : ι → Type v) [is_empty ι]
  [Π i, measure_space (α i)] :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit) volume volume :=
measure_preserving_pi_empty (λ _, volume)

end measure_preserving

end measure_theory


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.metric_space.lipschitz
import analysis.special_functions.pow

/-!
# Hölder continuous functions

In this file we define Hölder continuity on a set and on the whole space. We also prove some basic
properties of Hölder continuous functions.

## Main definitions

* `holder_on_with`: `f : X → Y` is said to be *Hölder continuous* with constant `C : ℝ≥0` and
  exponent `r : ℝ≥0` on a set `s`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y ∈ s`;
* `holder_with`: `f : X → Y` is said to be *Hölder continuous* with constant `C : ℝ≥0` and exponent
  `r : ℝ≥0`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y : X`.

## Implementation notes

We use the type `ℝ≥0` (a.k.a. `nnreal`) for `C` because this type has coercion both to `ℝ` and
`ℝ≥0∞`, so it can be easily used both in inequalities about `dist` and `edist`. We also use `ℝ≥0`
for `r` to ensure that `d ^ r` is monotone in `d`. It might be a good idea to use
`ℝ>0` for `r` but we don't have this type in `mathlib` (yet).

## Tags

Hölder continuity, Lipschitz continuity

 -/

variables {X Y Z : Type*}

open filter set
open_locale nnreal ennreal topological_space

section emetric

variables [pseudo_emetric_space X] [pseudo_emetric_space Y] [pseudo_emetric_space Z]

/-- A function `f : X → Y` between two `pseudo_emetric_space`s is Hölder continuous with constant
`C : ℝ≥0` and exponent `r : ℝ≥0`, if `edist (f x) (f y) ≤ C * edist x y ^ r` for all `x y : X`. -/
def holder_with (C r : ℝ≥0) (f : X → Y) : Prop :=
∀ x y, edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ)

/-- A function `f : X → Y` between two `pseudo_emeteric_space`s is Hölder continuous with constant
`C : ℝ≥0` and exponent `r : ℝ≥0` on a set `s : set X`, if `edist (f x) (f y) ≤ C * edist x y ^ r`
for all `x y ∈ s`. -/
def holder_on_with (C r : ℝ≥0) (f : X → Y) (s : set X) : Prop :=
∀ (x ∈ s) (y ∈ s), edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ)

@[simp] lemma holder_on_with_empty (C r : ℝ≥0) (f : X → Y) : holder_on_with C r f ∅ :=
λ x hx, hx.elim

@[simp] lemma holder_on_with_singleton (C r : ℝ≥0) (f : X → Y) (x : X) : holder_on_with C r f {x} :=
by { rintro a (rfl : a = x) b (rfl : b = a), rw edist_self, exact zero_le _ }

lemma set.subsingleton.holder_on_with {s : set X} (hs : s.subsingleton) (C r : ℝ≥0) (f : X → Y) :
  holder_on_with C r f s :=
hs.induction_on (holder_on_with_empty C r f) (holder_on_with_singleton C r f)

lemma holder_on_with_univ {C r : ℝ≥0} {f : X → Y} :
  holder_on_with C r f univ ↔ holder_with C r f :=
by simp only [holder_on_with, holder_with, mem_univ, true_implies_iff]

@[simp] lemma holder_on_with_one {C : ℝ≥0} {f : X → Y} {s : set X} :
  holder_on_with C 1 f s ↔ lipschitz_on_with C f s :=
by simp only [holder_on_with, lipschitz_on_with, nnreal.coe_one, ennreal.rpow_one]

alias holder_on_with_one ↔ _ lipschitz_on_with.holder_on_with

@[simp] lemma holder_with_one {C : ℝ≥0} {f : X → Y} :
  holder_with C 1 f ↔ lipschitz_with C f :=
holder_on_with_univ.symm.trans $ holder_on_with_one.trans lipschitz_on_univ

alias holder_with_one ↔ _ lipschitz_with.holder_with

lemma holder_with_id : holder_with 1 1 (id : X → X) :=
lipschitz_with.id.holder_with

protected lemma holder_with.holder_on_with {C r : ℝ≥0} {f : X → Y} (h : holder_with C r f)
  (s : set X) :
  holder_on_with C r f s :=
λ x _ y _, h x y

namespace holder_on_with

variables {C r : ℝ≥0} {f : X → Y} {s t : set X}

lemma edist_le (h : holder_on_with C r f s) {x y : X} (hx : x ∈ s) (hy : y ∈ s) :
  edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ) :=
h x hx y hy

lemma edist_le_of_le (h : holder_on_with C r f s) {x y : X} (hx : x ∈ s) (hy : y ∈ s)
  {d : ℝ≥0∞} (hd : edist x y ≤ d) :
  edist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
(h.edist_le hx hy).trans (mul_le_mul_left' (ennreal.rpow_le_rpow hd r.coe_nonneg) _)

lemma comp {Cg rg : ℝ≥0} {g : Y → Z} {t : set Y} (hg : holder_on_with Cg rg g t)
  {Cf rf : ℝ≥0} {f : X → Y} (hf : holder_on_with Cf rf f s) (hst : maps_to f s t) :
  holder_on_with (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) s :=
begin
  intros x hx y hy,
  rw [ennreal.coe_mul, mul_comm rg, nnreal.coe_mul, ennreal.rpow_mul, mul_assoc,
    ← ennreal.coe_rpow_of_nonneg _ rg.coe_nonneg, ← ennreal.mul_rpow_of_nonneg _ _ rg.coe_nonneg],
  exact hg.edist_le_of_le (hst hx) (hst hy) (hf.edist_le hx hy)
end

lemma comp_holder_with {Cg rg : ℝ≥0} {g : Y → Z} {t : set Y} (hg : holder_on_with Cg rg g t)
  {Cf rf : ℝ≥0} {f : X → Y} (hf : holder_with Cf rf f) (ht : ∀ x, f x ∈ t) :
  holder_with (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) :=
holder_on_with_univ.mp $ hg.comp (hf.holder_on_with univ) (λ x _, ht x)

/-- A Hölder continuous function is uniformly continuous -/
protected lemma uniform_continuous_on (hf : holder_on_with C r f s) (h0 : 0 < r) :
  uniform_continuous_on f s :=
begin
  refine emetric.uniform_continuous_on_iff.2 (λε εpos, _),
  have : tendsto (λ d : ℝ≥0∞, (C : ℝ≥0∞) * d ^ (r : ℝ)) (𝓝 0) (𝓝 0),
    from ennreal.tendsto_const_mul_rpow_nhds_zero_of_pos ennreal.coe_ne_top h0,
  rcases ennreal.nhds_zero_basis.mem_iff.1 (this (gt_mem_nhds εpos)) with ⟨δ, δ0, H⟩,
  exact ⟨δ, δ0, λ x y hx hy h, (hf.edist_le hx hy).trans_lt (H h)⟩,
end

protected lemma continuous_on (hf : holder_on_with C r f s) (h0 : 0 < r) : continuous_on f s :=
(hf.uniform_continuous_on h0).continuous_on

protected lemma mono (hf : holder_on_with C r f s) (ht : t ⊆ s) : holder_on_with C r f t :=
λ x hx y hy, hf.edist_le (ht hx) (ht hy)

lemma ediam_image_le_of_le (hf : holder_on_with C r f s) {d : ℝ≥0∞} (hd : emetric.diam s ≤ d) :
  emetric.diam (f '' s) ≤ C * d ^ (r : ℝ) :=
emetric.diam_image_le_iff.2 $ λ x hx y hy, hf.edist_le_of_le hx hy $
  (emetric.edist_le_diam_of_mem hx hy).trans hd

lemma ediam_image_le (hf : holder_on_with C r f s) :
  emetric.diam (f '' s) ≤ C * emetric.diam s ^ (r : ℝ) :=
hf.ediam_image_le_of_le le_rfl

lemma ediam_image_le_of_subset (hf : holder_on_with C r f s) (ht : t ⊆ s) :
  emetric.diam (f '' t) ≤ C * emetric.diam t ^ (r : ℝ) :=
(hf.mono ht).ediam_image_le

lemma ediam_image_le_of_subset_of_le (hf : holder_on_with C r f s) (ht : t ⊆ s) {d : ℝ≥0∞}
  (hd : emetric.diam t ≤ d) :
  emetric.diam (f '' t) ≤ C * d ^ (r : ℝ) :=
(hf.mono ht).ediam_image_le_of_le hd

lemma ediam_image_inter_le_of_le (hf : holder_on_with C r f s) {d : ℝ≥0∞}
  (hd : emetric.diam t ≤ d) :
  emetric.diam (f '' (t ∩ s)) ≤ C * d ^ (r : ℝ) :=
hf.ediam_image_le_of_subset_of_le (inter_subset_right _ _) $
  (emetric.diam_mono $ inter_subset_left _ _).trans hd

lemma ediam_image_inter_le (hf : holder_on_with C r f s) (t : set X) :
  emetric.diam (f '' (t ∩ s)) ≤ C * emetric.diam t ^ (r : ℝ) :=
hf.ediam_image_inter_le_of_le le_rfl

end holder_on_with

namespace holder_with

variables {C r : ℝ≥0} {f : X → Y}

lemma edist_le (h : holder_with C r f) (x y : X) :
  edist (f x) (f y) ≤ C * edist x y ^ (r : ℝ) :=
h x y

lemma edist_le_of_le (h : holder_with C r f) {x y : X} {d : ℝ≥0∞} (hd : edist x y ≤ d) :
  edist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
(h.holder_on_with univ).edist_le_of_le trivial trivial hd

lemma comp {Cg rg : ℝ≥0} {g : Y → Z} (hg : holder_with Cg rg g)
  {Cf rf : ℝ≥0} {f : X → Y} (hf : holder_with Cf rf f) :
  holder_with (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) :=
(hg.holder_on_with univ).comp_holder_with hf (λ _, trivial)

lemma comp_holder_on_with {Cg rg : ℝ≥0} {g : Y → Z} (hg : holder_with Cg rg g)
  {Cf rf : ℝ≥0} {f : X → Y} {s : set X} (hf : holder_on_with Cf rf f s) :
  holder_on_with (Cg * Cf ^ (rg : ℝ)) (rg * rf) (g ∘ f) s :=
(hg.holder_on_with univ).comp hf (λ _ _, trivial)

/-- A Hölder continuous function is uniformly continuous -/
protected lemma uniform_continuous (hf : holder_with C r f) (h0 : 0 < r) : uniform_continuous f :=
uniform_continuous_on_univ.mp $ (hf.holder_on_with univ).uniform_continuous_on h0

protected lemma continuous (hf : holder_with C r f) (h0 : 0 < r) : continuous f :=
(hf.uniform_continuous h0).continuous

lemma ediam_image_le (hf : holder_with C r f) (s : set X) :
  emetric.diam (f '' s) ≤ C * emetric.diam s ^ (r : ℝ) :=
emetric.diam_image_le_iff.2 $ λ x hx y hy, hf.edist_le_of_le $ emetric.edist_le_diam_of_mem hx hy

end holder_with

end emetric

section metric

variables [pseudo_metric_space X] [pseudo_metric_space Y] {C r : ℝ≥0} {f : X → Y}

namespace holder_with

lemma nndist_le_of_le (hf : holder_with C r f) {x y : X} {d : ℝ≥0} (hd : nndist x y ≤ d) :
  nndist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
begin
  rw [← ennreal.coe_le_coe, ← edist_nndist, ennreal.coe_mul,
    ← ennreal.coe_rpow_of_nonneg _ r.coe_nonneg],
  apply hf.edist_le_of_le,
  rwa [edist_nndist, ennreal.coe_le_coe],
end

lemma nndist_le (hf : holder_with C r f) (x y : X) :
  nndist (f x) (f y) ≤ C * nndist x y ^ (r : ℝ) :=
hf.nndist_le_of_le le_rfl

lemma dist_le_of_le (hf : holder_with C r f) {x y : X} {d : ℝ} (hd : dist x y ≤ d) :
  dist (f x) (f y) ≤ C * d ^ (r : ℝ) :=
begin
  lift d to ℝ≥0 using dist_nonneg.trans hd,
  rw dist_nndist at hd ⊢,
  norm_cast at hd ⊢,
  exact hf.nndist_le_of_le hd
end

lemma dist_le (hf : holder_with C r f) (x y : X) :
  dist (f x) (f y) ≤ C * dist x y ^ (r : ℝ) :=
hf.dist_le_of_le le_rfl

end holder_with

end metric


import tactic
import tactic.induction
import data.nat.pow
import data.nat.parity
import data.nat.lattice

noncomputable theory
open_locale classical

def shift (n : ℕ) : ℕ :=
Inf {k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = n}

lemma shift_0 : shift 0 = 0 :=
begin
  simp_rw [shift, nat.Inf_eq_zero],
  right, ext n, simp, rintro h k, push_neg, split,
  { rintro rfl, contrapose! h, exact even_zero },
  { intro h₁, clear' n h, induction k with k ih,
    { cases h₁ },
    { apply ih, clear ih, change 2 * 2 ^ k = 2 * 0 at h₁,
      rwa nat.mul_right_inj (dec_trivial : 0 < 2) at h₁ }},
end

lemma shift_1 : shift 1 = 1 :=
begin
  have h : {k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = 1}.nonempty,
  { use 1, simp, use 0, dec_trivial },
  rw [shift, nat.Inf_def h, nat.find_eq_iff], dsimp, clear h,
  refine ⟨⟨odd_one, _⟩, _⟩,
  { use 0, dec_trivial },
  { push_neg, rintro n h₁ h₂ p, cases n, { simp },
    contrapose h₁, simp },
end

lemma shift_mul_2 {n : ℕ} :
  shift (n * 2) = shift n :=
begin
  generalize h : shift n = r, rw shift at h ⊢,
  by_cases h₁ : {k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = n}.nonempty,
  { have h₂ : {k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = n * 2}.nonempty,
    { rcases h₁ with ⟨k, h₁, p, h₂⟩, use [k, h₁, p + 1],
      simp [pow_succ], linarith },
    rw nat.Inf_def h₁ at h, rw nat.Inf_def h₂,
    simp_rw nat.find_eq_iff at h ⊢, clear' h₁ h₂,
    rcases h with ⟨⟨h₁, p, h₂⟩, h₃⟩, simp at *, refine ⟨⟨h₁, _⟩, _⟩,
    { use p + 1, rw [pow_succ, ←mul_assoc, mul_comm r 2, mul_assoc, mul_comm n 2],
      congr, exact h₂ },
    { rintro a h₁ h₂ b, cases b,
      { rw [pow_zero, mul_one], rintro rfl, contrapose! h₂,
        rw even, use n, rw mul_comm },
      { rw [pow_succ, ←mul_assoc, mul_comm _ 2, mul_assoc, mul_comm _ 2],
        rw nat.mul_right_inj (dec_trivial : 0 < 2), apply h₃; assumption }}},
  { have h₂ : ¬{k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = n * 2}.nonempty,
    { contrapose! h₁, cases h₁ with k h₁, use k, simp at h₁ ⊢, clear' r h,
      rcases h₁ with ⟨h₁, p, h₂⟩, use h₁, rw ←nat.odd_iff_not_even at h₁,
      rcases h₁ with ⟨k, rfl⟩, cases p,
      { exfalso, simp at h₂, replace h₂ := congr_arg (λ n, n % 2) h₂,
        contrapose! h₂, simp [nat.add_mod] },
      use p, simp [pow_succ] at h₂, linarith },
    rw set.not_nonempty_iff_eq_empty at h₂, cases r,
    { rw nat.Inf_eq_zero, simp, simp_rw ←nat.odd_iff_not_even, exact h₂ },
    have h₃ := nat.nonempty_of_Inf_eq_succ h, contradiction },
end

lemma not_even_mul_2_add_1 {n : ℕ} : ¬even (n * 2 + 1) :=
begin
  rw even, push_neg, rintro k h, replace h := congr_arg (λ n, n % 2) h,
  simp [nat.add_mod] at h, exact h,
end

lemma shift_mul_2_add_1 {n : ℕ} :
  shift (n * 2 + 1) = n * 2 + 1 :=
begin
  rw shift, have h : {k : ℕ | odd k ∧ ∃ (p : ℕ), k * 2 ^ p = n * 2 + 1}.nonempty,
  { use n * 2 + 1, simp, use [not_even_mul_2_add_1, 0], simp },
  rw [nat.Inf_def h, nat.find_eq_iff], clear h, simp,
  refine ⟨⟨not_even_mul_2_add_1, _⟩, _⟩,
  { use 0, simp },
  { rintro k h₁ h₂ p, rw ←nat.odd_iff_not_even at h₂,
    rcases h₂ with ⟨k, rfl⟩, cases p,
    { apply ne_of_lt, simp at *, exact h₁ },
    { rw pow_succ, intro h₂, replace h₂ := congr_arg (λ n, n % 2) h₂,
      simp [nat.add_mod, nat.mul_mod] at h₂, exact h₂ }},
end

lemma shift_def {n : ℕ} :
  shift n = if 1 < n ∧ n % 2 = 0 then shift (n / 2) else n :=
begin
  split_ifs,
  { cases h with h₁ h₂, rw [←nat.even_iff, even] at h₂,
    rcases h₂ with ⟨n, rfl⟩, clear h₁, simp, rw mul_comm, exact shift_mul_2 },
  { rw not_and_distrib at h, cases h,
    { cases n, { exact shift_0 },
      cases n, { exact shift_1 },
      contrapose h, push_neg, simp },
    { rw [←nat.even_iff, ←nat.odd_iff_not_even, odd] at h,
      rcases h with ⟨n, rfl⟩, rw mul_comm, exact shift_mul_2_add_1 }},
end


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Alex J. Best
-/
import measure_theory.group.arithmetic

/-!
# Pointwise set operations on `measurable_set`s

In this file we prove several versions of the following fact: if `s` is a measurable set, then so is
`a • s`. Note that the pointwise product of two measurable sets need not be measurable, so there is
no `measurable_set.mul` etc.
-/

open_locale pointwise
open set

@[to_additive]
lemma measurable_set.const_smul {G α : Type*} [group G] [mul_action G α] [measurable_space G]
  [measurable_space α] [has_measurable_smul G α] {s : set α} (hs : measurable_set s) (a : G) :
  measurable_set (a • s) :=
begin
  rw ← preimage_smul_inv,
  exact measurable_const_smul _ hs
end

lemma measurable_set.const_smul_of_ne_zero {G₀ α : Type*} [group_with_zero G₀] [mul_action G₀ α]
  [measurable_space G₀] [measurable_space α] [has_measurable_smul G₀ α] {s : set α}
  (hs : measurable_set s) {a : G₀} (ha : a ≠ 0) :
  measurable_set (a • s) :=
begin
  rw ← preimage_smul_inv₀ ha,
  exact measurable_const_smul _ hs
end

lemma measurable_set.const_smul₀ {G₀ α : Type*} [group_with_zero G₀] [has_zero α]
  [mul_action_with_zero G₀ α] [measurable_space G₀] [measurable_space α] [has_measurable_smul G₀ α]
  [measurable_singleton_class α] {s : set α} (hs : measurable_set s) (a : G₀) :
  measurable_set (a • s) :=
begin
  rcases eq_or_ne a 0 with (rfl|ha),
  exacts [(subsingleton_zero_smul_set s).measurable_set, hs.const_smul_of_ne_zero ha]
end


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

! This file was ported from Lean 3 source module topology.is_locally_homeomorph
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.LocalHomeomorph

/-!
# Local homeomorphisms

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

This file defines local homeomorphisms.

## Main definitions

* `is_locally_homeomorph`: A function `f : X → Y` satisfies `is_locally_homeomorph` if for each
  point `x : X`, the restriction of `f` to some open neighborhood `U` of `x` gives a homeomorphism
  between `U` and an open subset of `Y`.

  Note that `is_locally_homeomorph` is a global condition. This is in contrast to
  `local_homeomorph`, which is a homeomorphism between specific open subsets.
-/

open Topology

variable {X Y Z : Type _} [TopologicalSpace X] [TopologicalSpace Y] [TopologicalSpace Z] (g : Y → Z)
  (f : X → Y) (s : Set X) (t : Set Y)

#print IsLocallyHomeomorphOn /-
/-- A function `f : X → Y` satisfies `is_locally_homeomorph_on f s` if each `x ∈ s` is contained in
the source of some `e : local_homeomorph X Y` with `f = e`. -/
def IsLocallyHomeomorphOn :=
  ∀ x ∈ s, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ f = e
#align is_locally_homeomorph_on IsLocallyHomeomorphOn
-/

namespace IsLocallyHomeomorphOn

/- warning: is_locally_homeomorph_on.mk -> IsLocallyHomeomorphOn.mk is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] (f : X -> Y) (s : Set.{u1} X), (forall (x : X), (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) x s) -> (Exists.{max (succ u1) (succ u2)} (LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) (fun (e : LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) => And (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) x (LocalEquiv.source.{u1, u2} X Y (LocalHomeomorph.toLocalEquiv.{u1, u2} X Y _inst_1 _inst_2 e))) (forall (y : X), (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) y (LocalEquiv.source.{u1, u2} X Y (LocalHomeomorph.toLocalEquiv.{u1, u2} X Y _inst_1 _inst_2 e))) -> (Eq.{succ u2} Y (f y) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) (fun (_x : LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) => X -> Y) (LocalHomeomorph.hasCoeToFun.{u1, u2} X Y _inst_1 _inst_2) e y)))))) -> (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f s)
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] (f : X -> Y) (s : Set.{u2} X), (forall (x : X), (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) x s) -> (Exists.{max (succ u2) (succ u1)} (LocalHomeomorph.{u2, u1} X Y _inst_1 _inst_2) (fun (e : LocalHomeomorph.{u2, u1} X Y _inst_1 _inst_2) => And (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) x (LocalEquiv.source.{u2, u1} X Y (LocalHomeomorph.toLocalEquiv.{u2, u1} X Y _inst_1 _inst_2 e))) (forall (y : X), (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) y (LocalEquiv.source.{u2, u1} X Y (LocalHomeomorph.toLocalEquiv.{u2, u1} X Y _inst_1 _inst_2 e))) -> (Eq.{succ u1} Y (f y) (LocalHomeomorph.toFun'.{u2, u1} X Y _inst_1 _inst_2 e y)))))) -> (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f s)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_on.mk IsLocallyHomeomorphOn.mkₓ'. -/
/-- Proves that `f` satisfies `is_locally_homeomorph_on f s`. The condition `h` is weaker than the
definition of `is_locally_homeomorph_on f s`, since it only requires `e : local_homeomorph X Y` to
agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
theorem mk (h : ∀ x ∈ s, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
    IsLocallyHomeomorphOn f s := by
  intro x hx
  obtain ⟨e, hx, he⟩ := h x hx
  exact
    ⟨{ e with
        toFun := f
        map_source' := fun x hx => by rw [he x hx] <;> exact e.map_source' hx
        left_inv' := fun x hx => by rw [he x hx] <;> exact e.left_inv' hx
        right_inv' := fun y hy => by rw [he _ (e.map_target' hy)] <;> exact e.right_inv' hy
        continuous_toFun := (continuousOn_congr he).mpr e.continuous_to_fun },
      hx, rfl⟩
#align is_locally_homeomorph_on.mk IsLocallyHomeomorphOn.mk

variable {g f s t}

/- warning: is_locally_homeomorph_on.map_nhds_eq -> IsLocallyHomeomorphOn.map_nhds_eq is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y} {s : Set.{u1} X}, (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f s) -> (forall {x : X}, (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) x s) -> (Eq.{succ u2} (Filter.{u2} Y) (Filter.map.{u1, u2} X Y f (nhds.{u1} X _inst_1 x)) (nhds.{u2} Y _inst_2 (f x))))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y} {s : Set.{u2} X}, (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f s) -> (forall {x : X}, (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) x s) -> (Eq.{succ u1} (Filter.{u1} Y) (Filter.map.{u2, u1} X Y f (nhds.{u2} X _inst_1 x)) (nhds.{u1} Y _inst_2 (f x))))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_on.map_nhds_eq IsLocallyHomeomorphOn.map_nhds_eqₓ'. -/
theorem map_nhds_eq (hf : IsLocallyHomeomorphOn f s) {x : X} (hx : x ∈ s) : (𝓝 x).map f = 𝓝 (f x) :=
  let ⟨e, hx, he⟩ := hf x hx
  he.symm ▸ e.map_nhds_eq hx
#align is_locally_homeomorph_on.map_nhds_eq IsLocallyHomeomorphOn.map_nhds_eq

/- warning: is_locally_homeomorph_on.continuous_at -> IsLocallyHomeomorphOn.continuousAt is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y} {s : Set.{u1} X}, (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f s) -> (forall {x : X}, (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) x s) -> (ContinuousAt.{u1, u2} X Y _inst_1 _inst_2 f x))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y} {s : Set.{u2} X}, (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f s) -> (forall {x : X}, (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) x s) -> (ContinuousAt.{u2, u1} X Y _inst_1 _inst_2 f x))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_on.continuous_at IsLocallyHomeomorphOn.continuousAtₓ'. -/
protected theorem continuousAt (hf : IsLocallyHomeomorphOn f s) {x : X} (hx : x ∈ s) :
    ContinuousAt f x :=
  (hf.map_nhds_eq hx).le
#align is_locally_homeomorph_on.continuous_at IsLocallyHomeomorphOn.continuousAt

/- warning: is_locally_homeomorph_on.continuous_on -> IsLocallyHomeomorphOn.continuousOn is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y} {s : Set.{u1} X}, (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f s) -> (ContinuousOn.{u1, u2} X Y _inst_1 _inst_2 f s)
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y} {s : Set.{u2} X}, (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f s) -> (ContinuousOn.{u2, u1} X Y _inst_1 _inst_2 f s)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_on.continuous_on IsLocallyHomeomorphOn.continuousOnₓ'. -/
protected theorem continuousOn (hf : IsLocallyHomeomorphOn f s) : ContinuousOn f s :=
  ContinuousAt.continuousOn fun x => hf.ContinuousAt
#align is_locally_homeomorph_on.continuous_on IsLocallyHomeomorphOn.continuousOn

/- warning: is_locally_homeomorph_on.comp -> IsLocallyHomeomorphOn.comp is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] [_inst_3 : TopologicalSpace.{u3} Z] {g : Y -> Z} {f : X -> Y} {s : Set.{u1} X} {t : Set.{u2} Y}, (IsLocallyHomeomorphOn.{u2, u3} Y Z _inst_2 _inst_3 g t) -> (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f s) -> (Set.MapsTo.{u1, u2} X Y f s t) -> (IsLocallyHomeomorphOn.{u1, u3} X Z _inst_1 _inst_3 (Function.comp.{succ u1, succ u2, succ u3} X Y Z g f) s)
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u3}} {Z : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u3} Y] [_inst_3 : TopologicalSpace.{u2} Z] {g : Y -> Z} {f : X -> Y} {s : Set.{u1} X} {t : Set.{u3} Y}, (IsLocallyHomeomorphOn.{u3, u2} Y Z _inst_2 _inst_3 g t) -> (IsLocallyHomeomorphOn.{u1, u3} X Y _inst_1 _inst_2 f s) -> (Set.MapsTo.{u1, u3} X Y f s t) -> (IsLocallyHomeomorphOn.{u1, u2} X Z _inst_1 _inst_3 (Function.comp.{succ u1, succ u3, succ u2} X Y Z g f) s)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_on.comp IsLocallyHomeomorphOn.compₓ'. -/
protected theorem comp (hg : IsLocallyHomeomorphOn g t) (hf : IsLocallyHomeomorphOn f s)
    (h : Set.MapsTo f s t) : IsLocallyHomeomorphOn (g ∘ f) s :=
  by
  intro x hx
  obtain ⟨eg, hxg, rfl⟩ := hg (f x) (h hx)
  obtain ⟨ef, hxf, rfl⟩ := hf x hx
  exact ⟨ef.trans eg, ⟨hxf, hxg⟩, rfl⟩
#align is_locally_homeomorph_on.comp IsLocallyHomeomorphOn.comp

end IsLocallyHomeomorphOn

#print IsLocallyHomeomorph /-
/-- A function `f : X → Y` satisfies `is_locally_homeomorph f` if each `x : x` is contained in
  the source of some `e : local_homeomorph X Y` with `f = e`. -/
def IsLocallyHomeomorph :=
  ∀ x : X, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ f = e
#align is_locally_homeomorph IsLocallyHomeomorph
-/

variable {f}

/- warning: is_locally_homeomorph_iff_is_locally_homeomorph_on_univ -> isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y}, Iff (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f (Set.univ.{u1} X))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y}, Iff (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f) (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f (Set.univ.{u2} X))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph_iff_is_locally_homeomorph_on_univ isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univₓ'. -/
theorem isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ :
    IsLocallyHomeomorph f ↔ IsLocallyHomeomorphOn f Set.univ := by
  simp only [IsLocallyHomeomorph, IsLocallyHomeomorphOn, Set.mem_univ, forall_true_left]
#align is_locally_homeomorph_iff_is_locally_homeomorph_on_univ isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ

/- warning: is_locally_homeomorph.is_locally_homeomorph_on -> IsLocallyHomeomorph.isLocallyHomeomorphOn is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) -> (IsLocallyHomeomorphOn.{u1, u2} X Y _inst_1 _inst_2 f (Set.univ.{u1} X))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f) -> (IsLocallyHomeomorphOn.{u2, u1} X Y _inst_1 _inst_2 f (Set.univ.{u2} X))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.is_locally_homeomorph_on IsLocallyHomeomorph.isLocallyHomeomorphOnₓ'. -/
protected theorem IsLocallyHomeomorph.isLocallyHomeomorphOn (hf : IsLocallyHomeomorph f) :
    IsLocallyHomeomorphOn f Set.univ :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mp hf
#align is_locally_homeomorph.is_locally_homeomorph_on IsLocallyHomeomorph.isLocallyHomeomorphOn

variable (f)

namespace IsLocallyHomeomorph

/- warning: is_locally_homeomorph.mk -> IsLocallyHomeomorph.mk is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] (f : X -> Y), (forall (x : X), Exists.{max (succ u1) (succ u2)} (LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) (fun (e : LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) => And (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) x (LocalEquiv.source.{u1, u2} X Y (LocalHomeomorph.toLocalEquiv.{u1, u2} X Y _inst_1 _inst_2 e))) (forall (y : X), (Membership.Mem.{u1, u1} X (Set.{u1} X) (Set.hasMem.{u1} X) y (LocalEquiv.source.{u1, u2} X Y (LocalHomeomorph.toLocalEquiv.{u1, u2} X Y _inst_1 _inst_2 e))) -> (Eq.{succ u2} Y (f y) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) (fun (_x : LocalHomeomorph.{u1, u2} X Y _inst_1 _inst_2) => X -> Y) (LocalHomeomorph.hasCoeToFun.{u1, u2} X Y _inst_1 _inst_2) e y))))) -> (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f)
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] (f : X -> Y), (forall (x : X), Exists.{max (succ u2) (succ u1)} (LocalHomeomorph.{u2, u1} X Y _inst_1 _inst_2) (fun (e : LocalHomeomorph.{u2, u1} X Y _inst_1 _inst_2) => And (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) x (LocalEquiv.source.{u2, u1} X Y (LocalHomeomorph.toLocalEquiv.{u2, u1} X Y _inst_1 _inst_2 e))) (forall (y : X), (Membership.mem.{u2, u2} X (Set.{u2} X) (Set.instMembershipSet.{u2} X) y (LocalEquiv.source.{u2, u1} X Y (LocalHomeomorph.toLocalEquiv.{u2, u1} X Y _inst_1 _inst_2 e))) -> (Eq.{succ u1} Y (f y) (LocalHomeomorph.toFun'.{u2, u1} X Y _inst_1 _inst_2 e y))))) -> (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.mk IsLocallyHomeomorph.mkₓ'. -/
/-- Proves that `f` satisfies `is_locally_homeomorph f`. The condition `h` is weaker than the
definition of `is_locally_homeomorph f`, since it only requires `e : local_homeomorph X Y` to
agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
theorem mk (h : ∀ x : X, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
    IsLocallyHomeomorph f :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mpr
    (IsLocallyHomeomorphOn.mk f Set.univ fun x hx => h x)
#align is_locally_homeomorph.mk IsLocallyHomeomorph.mk

variable {g f}

/- warning: is_locally_homeomorph.map_nhds_eq -> IsLocallyHomeomorph.map_nhds_eq is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) -> (forall (x : X), Eq.{succ u2} (Filter.{u2} Y) (Filter.map.{u1, u2} X Y f (nhds.{u1} X _inst_1 x)) (nhds.{u2} Y _inst_2 (f x)))
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f) -> (forall (x : X), Eq.{succ u1} (Filter.{u1} Y) (Filter.map.{u2, u1} X Y f (nhds.{u2} X _inst_1 x)) (nhds.{u1} Y _inst_2 (f x)))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.map_nhds_eq IsLocallyHomeomorph.map_nhds_eqₓ'. -/
theorem map_nhds_eq (hf : IsLocallyHomeomorph f) (x : X) : (𝓝 x).map f = 𝓝 (f x) :=
  hf.IsLocallyHomeomorphOn.map_nhds_eq (Set.mem_univ x)
#align is_locally_homeomorph.map_nhds_eq IsLocallyHomeomorph.map_nhds_eq

/- warning: is_locally_homeomorph.continuous -> IsLocallyHomeomorph.continuous is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) -> (Continuous.{u1, u2} X Y _inst_1 _inst_2 f)
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f) -> (Continuous.{u2, u1} X Y _inst_1 _inst_2 f)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.continuous IsLocallyHomeomorph.continuousₓ'. -/
protected theorem continuous (hf : IsLocallyHomeomorph f) : Continuous f :=
  continuous_iff_continuousOn_univ.mpr hf.IsLocallyHomeomorphOn.ContinuousOn
#align is_locally_homeomorph.continuous IsLocallyHomeomorph.continuous

/- warning: is_locally_homeomorph.is_open_map -> IsLocallyHomeomorph.isOpenMap is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) -> (IsOpenMap.{u1, u2} X Y _inst_1 _inst_2 f)
but is expected to have type
  forall {X : Type.{u2}} {Y : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : TopologicalSpace.{u1} Y] {f : X -> Y}, (IsLocallyHomeomorph.{u2, u1} X Y _inst_1 _inst_2 f) -> (IsOpenMap.{u2, u1} X Y _inst_1 _inst_2 f)
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.is_open_map IsLocallyHomeomorph.isOpenMapₓ'. -/
protected theorem isOpenMap (hf : IsLocallyHomeomorph f) : IsOpenMap f :=
  IsOpenMap.of_nhds_le fun x => ge_of_eq (hf.map_nhds_eq x)
#align is_locally_homeomorph.is_open_map IsLocallyHomeomorph.isOpenMap

/- warning: is_locally_homeomorph.comp -> IsLocallyHomeomorph.comp is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} {Z : Type.{u3}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u2} Y] [_inst_3 : TopologicalSpace.{u3} Z] {g : Y -> Z} {f : X -> Y}, (IsLocallyHomeomorph.{u2, u3} Y Z _inst_2 _inst_3 g) -> (IsLocallyHomeomorph.{u1, u2} X Y _inst_1 _inst_2 f) -> (IsLocallyHomeomorph.{u1, u3} X Z _inst_1 _inst_3 (Function.comp.{succ u1, succ u2, succ u3} X Y Z g f))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u3}} {Z : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : TopologicalSpace.{u3} Y] [_inst_3 : TopologicalSpace.{u2} Z] {g : Y -> Z} {f : X -> Y}, (IsLocallyHomeomorph.{u3, u2} Y Z _inst_2 _inst_3 g) -> (IsLocallyHomeomorph.{u1, u3} X Y _inst_1 _inst_2 f) -> (IsLocallyHomeomorph.{u1, u2} X Z _inst_1 _inst_3 (Function.comp.{succ u1, succ u3, succ u2} X Y Z g f))
Case conversion may be inaccurate. Consider using '#align is_locally_homeomorph.comp IsLocallyHomeomorph.compₓ'. -/
protected theorem comp (hg : IsLocallyHomeomorph g) (hf : IsLocallyHomeomorph f) :
    IsLocallyHomeomorph (g ∘ f) :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mpr
    (hg.IsLocallyHomeomorphOn.comp hf.IsLocallyHomeomorphOn (Set.univ.mapsTo_univ f))
#align is_locally_homeomorph.comp IsLocallyHomeomorph.comp

end IsLocallyHomeomorph


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Yury Kudryashov
-/
import measure_theory.measure.measure_space

/-! # Mutually singular measures

Two measures `μ`, `ν` are said to be mutually singular (`measure_theory.measure.mutually_singular`,
localized notation `μ ⊥ₘ ν`) if there exists a measurable set `s` such that `μ s = 0` and
`ν sᶜ = 0`. The measurability of `s` is an unnecessary assumption (see
`measure_theory.measure.mutually_singular.mk`) but we keep it because this way `rcases (h : μ ⊥ₘ ν)`
gives us a measurable set and usually it is easy to prove measurability.

In this file we define the predicate `measure_theory.measure.mutually_singular` and prove basic
facts about it.

## Tags

measure, mutually singular
-/

open set
open_locale measure_theory nnreal ennreal

namespace measure_theory

namespace measure

variables {α : Type*} {m0 : measurable_space α} {μ μ₁ μ₂ ν ν₁ ν₂ : measure α}

/-- Two measures `μ`, `ν` are said to be mutually singular if there exists a measurable set `s`
such that `μ s = 0` and `ν sᶜ = 0`. -/
def mutually_singular {m0 : measurable_space α} (μ ν : measure α) : Prop :=
∃ (s : set α), measurable_set s ∧ μ s = 0 ∧ ν sᶜ = 0

localized "infix ` ⊥ₘ `:60 := measure_theory.measure.mutually_singular" in measure_theory

namespace mutually_singular

lemma mk {s t : set α} (hs : μ s = 0) (ht : ν t = 0) (hst : univ ⊆ s ∪ t) :
  mutually_singular μ ν :=
begin
  use [to_measurable μ s, measurable_set_to_measurable _ _, (measure_to_measurable _).trans hs],
  refine measure_mono_null (λ x hx, (hst trivial).resolve_left $ λ hxs, hx _) ht,
  exact subset_to_measurable _ _ hxs
end

@[simp] lemma zero_right : μ ⊥ₘ 0 := ⟨∅, measurable_set.empty, measure_empty, rfl⟩

@[symm] lemma symm (h : ν ⊥ₘ μ) : μ ⊥ₘ ν :=
let ⟨i, hi, his, hit⟩ := h in ⟨iᶜ, hi.compl, hit, (compl_compl i).symm ▸ his⟩

lemma comm : μ ⊥ₘ ν ↔ ν ⊥ₘ μ := ⟨λ h, h.symm, λ h, h.symm⟩

@[simp] lemma zero_left : 0 ⊥ₘ μ := zero_right.symm

lemma mono_ac (h : μ₁ ⊥ₘ ν₁) (hμ : μ₂ ≪ μ₁) (hν : ν₂ ≪ ν₁) : μ₂ ⊥ₘ ν₂ :=
let ⟨s, hs, h₁, h₂⟩ := h in ⟨s, hs, hμ h₁, hν h₂⟩

lemma mono (h : μ₁ ⊥ₘ ν₁) (hμ : μ₂ ≤ μ₁) (hν : ν₂ ≤ ν₁) : μ₂ ⊥ₘ ν₂ :=
h.mono_ac hμ.absolutely_continuous hν.absolutely_continuous

@[simp] lemma sum_left {ι : Type*} [encodable ι] {μ : ι → measure α} :
  (sum μ) ⊥ₘ ν ↔ ∀ i, μ i ⊥ₘ ν :=
begin
  refine ⟨λ h i, h.mono (le_sum _ _) le_rfl, λ H, _⟩,
  choose s hsm hsμ hsν using H,
  refine ⟨⋂ i, s i, measurable_set.Inter hsm, _, _⟩,
  { rw [sum_apply _ (measurable_set.Inter hsm), ennreal.tsum_eq_zero],
    exact λ i, measure_mono_null (Inter_subset _ _) (hsμ i) },
  { rwa [compl_Inter, measure_Union_null_iff], }
end

@[simp] lemma sum_right {ι : Type*} [encodable ι] {ν : ι → measure α} :
  μ ⊥ₘ sum ν ↔ ∀ i, μ ⊥ₘ ν i :=
comm.trans $ sum_left.trans $ forall_congr $ λ i, comm

@[simp] lemma add_left_iff : μ₁ + μ₂ ⊥ₘ ν ↔ μ₁ ⊥ₘ ν ∧ μ₂ ⊥ₘ ν :=
by rw [← sum_cond, sum_left, bool.forall_bool, cond, cond, and.comm]

@[simp] lemma add_right_iff : μ ⊥ₘ ν₁ + ν₂ ↔ μ ⊥ₘ ν₁ ∧ μ ⊥ₘ ν₂ :=
comm.trans $ add_left_iff.trans $ and_congr comm comm

lemma add_left (h₁ : ν₁ ⊥ₘ μ) (h₂ : ν₂ ⊥ₘ μ) : ν₁ + ν₂ ⊥ₘ μ :=
add_left_iff.2 ⟨h₁, h₂⟩

lemma add_right (h₁ : μ ⊥ₘ ν₁) (h₂ : μ ⊥ₘ ν₂) : μ ⊥ₘ ν₁ + ν₂ :=
add_right_iff.2 ⟨h₁, h₂⟩

lemma smul (r : ℝ≥0∞) (h : ν ⊥ₘ μ) : r • ν ⊥ₘ μ :=
h.mono_ac (absolutely_continuous.rfl.smul r) absolutely_continuous.rfl

lemma smul_nnreal (r : ℝ≥0) (h : ν ⊥ₘ μ) : r • ν ⊥ₘ μ := h.smul r

end mutually_singular

end measure

end measure_theory


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen

! This file was ported from Lean 3 source module linear_algebra.matrix.to_linear_equiv
! leanprover-community/mathlib commit c8ab806ef73c20cab1d87b5157e43a82c205f28e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.Nondegenerate
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse
import Mathbin.LinearAlgebra.Matrix.ToLin
import Mathbin.RingTheory.Localization.FractionRing
import Mathbin.RingTheory.Localization.Integer

/-!
# Matrices and linear equivalences

This file gives the map `matrix.to_linear_equiv` from matrices with invertible determinant,
to linear equivs.

## Main definitions

 * `matrix.to_linear_equiv`: a matrix with an invertible determinant forms a linear equiv

## Main results

 * `matrix.exists_mul_vec_eq_zero_iff`: `M` maps some `v ≠ 0` to zero iff `det M = 0`

## Tags

matrix, linear_equiv, determinant, inverse

-/

namespace Matrix

open LinearMap

variable {R M : Type _} [CommRing R] [AddCommGroup M] [Module R M]

variable {n : Type _} [Fintype n]

section ToLinearEquiv'

variable [DecidableEq n]

/-- An invertible matrix yields a linear equivalence from the free module to itself.

See `matrix.to_linear_equiv` for the same map on arbitrary modules.
-/
def toLinearEquiv' (P : Matrix n n R) (h : Invertible P) : (n → R) ≃ₗ[R] n → R :=
  { P.toLin' with
    invFun := (⅟ P).toLin'
    left_inv := fun v =>
      show ((⅟ P).toLin'.comp P.toLin') v = v by
        rw [← Matrix.toLin'_mul, P.inv_of_mul_self, Matrix.toLin'_one, LinearMap.id_apply]
    right_inv := fun v =>
      show (P.toLin'.comp (⅟ P).toLin') v = v by
        rw [← Matrix.toLin'_mul, P.mul_inv_of_self, Matrix.toLin'_one, LinearMap.id_apply] }
#align matrix.to_linear_equiv' Matrix.toLinearEquiv'

@[simp]
theorem toLinearEquiv'_apply (P : Matrix n n R) (h : Invertible P) :
    (↑(P.toLinearEquiv' h) : Module.End R (n → R)) = P.toLin' :=
  rfl
#align matrix.to_linear_equiv'_apply Matrix.toLinearEquiv'_apply

@[simp]
theorem toLinearEquiv'_symm_apply (P : Matrix n n R) (h : Invertible P) :
    (↑(P.toLinearEquiv' h).symm : Module.End R (n → R)) = P⁻¹.toLin' :=
  show (⅟ P).toLin' = _ from congr_arg _ P.invOf_eq_nonsing_inv
#align matrix.to_linear_equiv'_symm_apply Matrix.toLinearEquiv'_symm_apply

end ToLinearEquiv'

section ToLinearEquiv

variable (b : Basis n R M)

include b

/-- Given `hA : is_unit A.det` and `b : basis R b`, `A.to_linear_equiv b hA` is
the `linear_equiv` arising from `to_lin b b A`.

See `matrix.to_linear_equiv'` for this result on `n → R`.
-/
@[simps apply]
noncomputable def toLinearEquiv [DecidableEq n] (A : Matrix n n R) (hA : IsUnit A.det) :
    M ≃ₗ[R] M := by
  refine'
        { to_lin b b A with
          toFun := to_lin b b A
          invFun := to_lin b b A⁻¹
          left_inv := fun x => _
          right_inv := fun x => _ } <;>
      rw [← LinearMap.comp_apply] <;>
    simp only [← Matrix.toLin_mul b b b, Matrix.nonsing_inv_mul _ hA, Matrix.mul_nonsing_inv _ hA,
      to_lin_one, LinearMap.id_apply]
#align matrix.to_linear_equiv Matrix.toLinearEquiv

theorem ker_toLin_eq_bot [DecidableEq n] (A : Matrix n n R) (hA : IsUnit A.det) :
    (toLin b b A).ker = ⊥ :=
  ker_eq_bot.mpr (toLinearEquiv b A hA).Injective
#align matrix.ker_to_lin_eq_bot Matrix.ker_toLin_eq_bot

theorem range_toLin_eq_top [DecidableEq n] (A : Matrix n n R) (hA : IsUnit A.det) :
    (toLin b b A).range = ⊤ :=
  range_eq_top.mpr (toLinearEquiv b A hA).Surjective
#align matrix.range_to_lin_eq_top Matrix.range_toLin_eq_top

end ToLinearEquiv

section Nondegenerate

open Matrix

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ≠ » 0) -/
/-- This holds for all integral domains (see `matrix.exists_mul_vec_eq_zero_iff`),
not just fields, but it's easier to prove it for the field of fractions first. -/
theorem exists_mulVec_eq_zero_iff_aux {K : Type _} [DecidableEq n] [Field K] {M : Matrix n n K} :
    (∃ (v : _)(_ : v ≠ 0), M.mulVec v = 0) ↔ M.det = 0 :=
  by
  constructor
  · rintro ⟨v, hv, mul_eq⟩
    contrapose! hv
    exact eq_zero_of_mul_vec_eq_zero hv mul_eq
  · contrapose!
    intro h
    have : Function.Injective M.to_lin' := by
      simpa only [← LinearMap.ker_eq_bot, ker_to_lin'_eq_bot_iff, not_imp_not] using h
    have :
      M ⬝
          LinearMap.toMatrix'
            ((LinearEquiv.ofInjectiveEndo M.to_lin' this).symm : (n → K) →ₗ[K] n → K) =
        1 :=
      by
      refine' matrix.to_lin'.injective (LinearMap.ext fun v => _)
      rw [Matrix.toLin'_mul, Matrix.toLin'_one, Matrix.toLin'_toMatrix', LinearMap.comp_apply]
      exact (LinearEquiv.ofInjectiveEndo M.to_lin' this).apply_symm_apply v
    exact Matrix.det_ne_zero_of_right_inverse this
#align matrix.exists_mul_vec_eq_zero_iff_aux Matrix.exists_mulVec_eq_zero_iff_aux

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ≠ » 0) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ≠ » 0) -/
theorem exists_mulVec_eq_zero_iff' {A : Type _} (K : Type _) [DecidableEq n] [CommRing A]
    [Nontrivial A] [Field K] [Algebra A K] [IsFractionRing A K] {M : Matrix n n A} :
    (∃ (v : _)(_ : v ≠ 0), M.mulVec v = 0) ↔ M.det = 0 :=
  by
  have : (∃ (v : _)(_ : v ≠ 0), mul_vec ((algebraMap A K).mapMatrix M) v = 0) ↔ _ :=
    exists_mul_vec_eq_zero_iff_aux
  rw [← RingHom.map_det, IsFractionRing.to_map_eq_zero_iff] at this
  refine' Iff.trans _ this; constructor <;> rintro ⟨v, hv, mul_eq⟩
  · refine' ⟨fun i => algebraMap _ _ (v i), mt (fun h => funext fun i => _) hv, _⟩
    · exact is_fraction_ring.to_map_eq_zero_iff.mp (congr_fun h i)
    · ext i
      refine' (RingHom.map_mulVec _ _ _ i).symm.trans _
      rw [mul_eq, Pi.zero_apply, RingHom.map_zero, Pi.zero_apply]
  · letI := Classical.decEq K
    obtain ⟨⟨b, hb⟩, ba_eq⟩ :=
      IsLocalization.exist_integer_multiples_of_finset (nonZeroDivisors A) (finset.univ.image v)
    choose f hf using ba_eq
    refine'
      ⟨fun i => f _ (finset.mem_image.mpr ⟨i, Finset.mem_univ i, rfl⟩),
        mt (fun h => funext fun i => _) hv, _⟩
    · have := congr_arg (algebraMap A K) (congr_fun h i)
      rw [hf, Subtype.coe_mk, Pi.zero_apply, RingHom.map_zero, Algebra.smul_def, mul_eq_zero,
        IsFractionRing.to_map_eq_zero_iff] at this
      exact this.resolve_left (nonZeroDivisors.ne_zero hb)
    · ext i
      refine' IsFractionRing.injective A K _
      calc
        algebraMap A K (M.mul_vec (fun i : n => f (v i) _) i) =
            ((algebraMap A K).mapMatrix M).mulVec (algebraMap _ K b • v) i :=
          _
        _ = 0 := _
        _ = algebraMap A K 0 := (RingHom.map_zero _).symm

      ·
        simp_rw [RingHom.map_mulVec, mul_vec, dot_product, Function.comp_apply, hf, Subtype.coe_mk,
          RingHom.mapMatrix_apply, Pi.smul_apply, smul_eq_mul, Algebra.smul_def]
      · rw [mul_vec_smul, mul_eq, Pi.smul_apply, Pi.zero_apply, smul_zero]
#align matrix.exists_mul_vec_eq_zero_iff' Matrix.exists_mulVec_eq_zero_iff'

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ≠ » 0) -/
theorem exists_mulVec_eq_zero_iff {A : Type _} [DecidableEq n] [CommRing A] [IsDomain A]
    {M : Matrix n n A} : (∃ (v : _)(_ : v ≠ 0), M.mulVec v = 0) ↔ M.det = 0 :=
  exists_mulVec_eq_zero_iff' (FractionRing A)
#align matrix.exists_mul_vec_eq_zero_iff Matrix.exists_mulVec_eq_zero_iff

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (v «expr ≠ » 0) -/
theorem exists_vecMul_eq_zero_iff {A : Type _} [DecidableEq n] [CommRing A] [IsDomain A]
    {M : Matrix n n A} : (∃ (v : _)(_ : v ≠ 0), M.vecMul v = 0) ↔ M.det = 0 := by
  simpa only [← M.det_transpose, ← mul_vec_transpose] using exists_mul_vec_eq_zero_iff
#align matrix.exists_vec_mul_eq_zero_iff Matrix.exists_vecMul_eq_zero_iff

theorem nondegenerate_iff_det_ne_zero {A : Type _} [DecidableEq n] [CommRing A] [IsDomain A]
    {M : Matrix n n A} : Nondegenerate M ↔ M.det ≠ 0 :=
  by
  refine' Iff.trans _ (not_iff_not.mpr exists_vec_mul_eq_zero_iff)
  simp only [not_exists]
  constructor
  · intro hM v hv hMv
    obtain ⟨w, hwMv⟩ := hM.exists_not_ortho_of_ne_zero hv
    simpa only [dot_product_mul_vec, hMv, zero_dot_product] using hwMv
  · intro h v hv
    refine' not_imp_not.mp (h v) (funext fun i => _)
    simpa only [dot_product_mul_vec, dot_product_single, mul_one] using hv (Pi.single i 1)
#align matrix.nondegenerate_iff_det_ne_zero Matrix.nondegenerate_iff_det_ne_zero

alias nondegenerate_iff_det_ne_zero ↔ nondegenerate.det_ne_zero nondegenerate.of_det_ne_zero
#align matrix.nondegenerate.det_ne_zero Matrix.Nondegenerate.det_ne_zero
#align matrix.nondegenerate.of_det_ne_zero Matrix.Nondegenerate.of_det_ne_zero

end Nondegenerate

end Matrix