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

! This file was ported from Lean 3 source module measure_theory.measure.hausdorff
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.MeasureTheory.Constructions.BorelSpace
import Mathbin.MeasureTheory.Measure.Lebesgue
import Mathbin.Topology.MetricSpace.Holder
import Mathbin.Topology.MetricSpace.MetricSeparated

/-!
# Hausdorff measure and metric (outer) measures

In this file we define the `d`-dimensional Hausdorff measure on an (extended) metric space `X` and
the Hausdorff dimension of a set in an (extended) metric space. Let `μ d δ` be the maximal outer
measure such that `μ d δ s ≤ (emetric.diam s) ^ d` for every set of diameter less than `δ`. Then
the Hausdorff measure `μH[d] s` of `s` is defined as `⨆ δ > 0, μ d δ s`. By Caratheodory theorem
`measure_theory.outer_measure.is_metric.borel_le_caratheodory`, this is a Borel measure on `X`.

The value of `μH[d]`, `d > 0`, on a set `s` (measurable or not) is given by
```
μH[d] s = ⨆ (r : ℝ≥0∞) (hr : 0 < r), ⨅ (t : ℕ → set X) (hts : s ⊆ ⋃ n, t n)
    (ht : ∀ n, emetric.diam (t n) ≤ r), ∑' n, emetric.diam (t n) ^ d
```

For every set `s` for any `d < d'` we have either `μH[d] s = ∞` or `μH[d'] s = 0`, see
`measure_theory.measure.hausdorff_measure_zero_or_top`. In
`topology.metric_space.hausdorff_dimension` we use this fact to define the Hausdorff dimension
`dimH` of a set in an (extended) metric space.

We also define two generalizations of the Hausdorff measure. In one generalization (see
`measure_theory.measure.mk_metric`) we take any function `m (diam s)` instead of `(diam s) ^ d`. In
an even more general definition (see `measure_theory.measure.mk_metric'`) we use any function
of `m : set X → ℝ≥0∞`. Some authors start with a partial function `m` defined only on some sets
`s : set X` (e.g., only on balls or only on measurable sets). This is equivalent to our definition
applied to `measure_theory.extend m`.

We also define a predicate `measure_theory.outer_measure.is_metric` which says that an outer measure
is additive on metric separated pairs of sets: `μ (s ∪ t) = μ s + μ t` provided that
`⨅ (x ∈ s) (y ∈ t), edist x y ≠ 0`. This is the property required for the Caratheodory theorem
`measure_theory.outer_measure.is_metric.borel_le_caratheodory`, so we prove this theorem for any
metric outer measure, then prove that outer measures constructed using `mk_metric'` are metric outer
measures.

## Main definitions

* `measure_theory.outer_measure.is_metric`: an outer measure `μ` is called *metric* if
  `μ (s ∪ t) = μ s + μ t` for any two metric separated sets `s` and `t`. A metric outer measure in a
  Borel extended metric space is guaranteed to satisfy the Caratheodory condition, see
  `measure_theory.outer_measure.is_metric.borel_le_caratheodory`.
* `measure_theory.outer_measure.mk_metric'` and its particular case
  `measure_theory.outer_measure.mk_metric`: a construction of an outer measure that is guaranteed to
  be metric. Both constructions are generalizations of the Hausdorff measure. The same measures
  interpreted as Borel measures are called `measure_theory.measure.mk_metric'` and
  `measure_theory.measure.mk_metric`.
* `measure_theory.measure.hausdorff_measure` a.k.a. `μH[d]`: the `d`-dimensional Hausdorff measure.
  There are many definitions of the Hausdorff measure that differ from each other by a
  multiplicative constant. We put
  `μH[d] s = ⨆ r > 0, ⨅ (t : ℕ → set X) (hts : s ⊆ ⋃ n, t n) (ht : ∀ n, emetric.diam (t n) ≤ r),
    ∑' n, ⨆ (ht : ¬set.subsingleton (t n)), (emetric.diam (t n)) ^ d`,
  see `measure_theory.measure.hausdorff_measure_apply'`. In the most interesting case `0 < d` one
  can omit the `⨆ (ht : ¬set.subsingleton (t n))` part.

## Main statements

### Basic properties

* `measure_theory.outer_measure.is_metric.borel_le_caratheodory`: if `μ` is a metric outer measure
  on an extended metric space `X` (that is, it is additive on pairs of metric separated sets), then
  every Borel set is Caratheodory measurable (hence, `μ` defines an actual
  `measure_theory.measure`). See also `measure_theory.measure.mk_metric`.
* `measure_theory.measure.hausdorff_measure_mono`: `μH[d] s` is an antitone function
  of `d`.
* `measure_theory.measure.hausdorff_measure_zero_or_top`: if `d₁ < d₂`, then for any `s`, either
  `μH[d₂] s = 0` or `μH[d₁] s = ∞`. Together with the previous lemma, this means that `μH[d] s` is
  equal to infinity on some ray `(-∞, D)` and is equal to zero on `(D, +∞)`, where `D` is a possibly
  infinite number called the *Hausdorff dimension* of `s`; `μH[D] s` can be zero, infinity, or
  anything in between.
* `measure_theory.measure.no_atoms_hausdorff`: Hausdorff measure has no atoms.

### Hausdorff measure in `ℝⁿ`

* `measure_theory.hausdorff_measure_pi_real`: for a nonempty `ι`, `μH[card ι]` on `ι → ℝ` equals
  Lebesgue measure.

## Notations

We use the following notation localized in `measure_theory`.

- `μH[d]` : `measure_theory.measure.hausdorff_measure d`

## Implementation notes

There are a few similar constructions called the `d`-dimensional Hausdorff measure. E.g., some
sources only allow coverings by balls and use `r ^ d` instead of `(diam s) ^ d`. While these
construction lead to different Hausdorff measures, they lead to the same notion of the Hausdorff
dimension.

## TODO

* prove that `1`-dimensional Hausdorff measure on `ℝ` equals `volume`;
* prove a similar statement for `ℝ × ℝ`.

## References

* [Herbert Federer, Geometric Measure Theory, Chapter 2.10][Federer1996]

## Tags

Hausdorff measure, measure, metric measure
-/

open NNReal ENNReal Topology BigOperators

open Emetric Set Function Filter Encodable FiniteDimensional TopologicalSpace

noncomputable section

variable {ι X Y : Type _} [EMetricSpace X] [EMetricSpace Y]

namespace MeasureTheory

namespace OuterMeasure

/-!
### Metric outer measures

In this section we define metric outer measures and prove Caratheodory theorem: a metric outer
measure has the Caratheodory property.
-/

/-- We say that an outer measure `μ` in an (e)metric space is *metric* if `μ (s ∪ t) = μ s + μ t`
for any two metric separated sets `s`, `t`. -/
def IsMetric (μ : OuterMeasure X) : Prop :=
  ∀ s t : Set X, IsMetricSeparated s t → μ (s ∪ t) = μ s + μ t
#align measure_theory.outer_measure.is_metric MeasureTheory.OuterMeasure.IsMetric

namespace IsMetric

variable {μ : OuterMeasure X}

/-- A metric outer measure is additive on a finite set of pairwise metric separated sets. -/
theorem finset_unionᵢ_of_pairwise_separated (hm : IsMetric μ) {I : Finset ι} {s : ι → Set X}
    (hI : ∀ i ∈ I, ∀ j ∈ I, i ≠ j → IsMetricSeparated (s i) (s j)) :
    μ (⋃ i ∈ I, s i) = ∑ i in I, μ (s i) := by
  classical
    induction' I using Finset.induction_on with i I hiI ihI hI
    · simp
    simp only [Finset.mem_insert] at hI
    rw [Finset.set_bunionᵢ_insert, hm, ihI, Finset.sum_insert hiI]
    exacts[fun i hi j hj hij => hI i (Or.inr hi) j (Or.inr hj) hij,
      IsMetricSeparated.finset_unionᵢ_right fun j hj =>
        hI i (Or.inl rfl) j (Or.inr hj) (ne_of_mem_of_not_mem hj hiI).symm]
#align measure_theory.outer_measure.is_metric.finset_Union_of_pairwise_separated MeasureTheory.OuterMeasure.IsMetric.finset_unionᵢ_of_pairwise_separated

/-- Caratheodory theorem. If `m` is a metric outer measure, then every Borel measurable set `t` is
Caratheodory measurable: for any (not necessarily measurable) set `s` we have
`μ (s ∩ t) + μ (s \ t) = μ s`. -/
theorem borel_le_caratheodory (hm : IsMetric μ) : borel X ≤ μ.caratheodory :=
  by
  rw [borel_eq_generateFrom_isClosed]
  refine' MeasurableSpace.generateFrom_le fun t ht => μ.is_caratheodory_iff_le.2 fun s => _
  set S : ℕ → Set X := fun n => { x ∈ s | (↑n)⁻¹ ≤ inf_edist x t }
  have n0 : ∀ {n : ℕ}, (n⁻¹ : ℝ≥0∞) ≠ 0 := fun n => ENNReal.inv_ne_zero.2 (ENNReal.nat_ne_top _)
  have Ssep : ∀ n, IsMetricSeparated (S n) t := fun n =>
    ⟨n⁻¹, n0, fun x hx y hy => hx.2.trans <| inf_edist_le_edist_of_mem hy⟩
  have Ssep' : ∀ n, IsMetricSeparated (S n) (s ∩ t) := fun n =>
    (Ssep n).mono subset.rfl (inter_subset_right _ _)
  have S_sub : ∀ n, S n ⊆ s \ t := fun n =>
    subset_inter (inter_subset_left _ _) (Ssep n).subset_compl_right
  have hSs : ∀ n, μ (s ∩ t) + μ (S n) ≤ μ s := fun n =>
    calc
      μ (s ∩ t) + μ (S n) = μ (s ∩ t ∪ S n) := Eq.symm <| hm _ _ <| (Ssep' n).symm
      _ ≤ μ (s ∩ t ∪ s \ t) := by
        mono*
        exact le_rfl
      _ = μ s := by rw [inter_union_diff]

  have Union_S : (⋃ n, S n) = s \ t :=
    by
    refine' subset.antisymm (Union_subset S_sub) _
    rintro x ⟨hxs, hxt⟩
    rw [mem_iff_inf_edist_zero_of_closed ht] at hxt
    rcases ENNReal.exists_inv_nat_lt hxt with ⟨n, hn⟩
    exact mem_Union.2 ⟨n, hxs, hn.le⟩
  /- Now we have `∀ n, μ (s ∩ t) + μ (S n) ≤ μ s` and we need to prove
    `μ (s ∩ t) + μ (⋃ n, S n) ≤ μ s`. We can't pass to the limit because
    `μ` is only an outer measure. -/
  by_cases htop : μ (s \ t) = ∞
  · rw [htop, add_top, ← htop]
    exact μ.mono (diff_subset _ _)
  suffices : μ (⋃ n, S n) ≤ ⨆ n, μ (S n)
  calc
    μ (s ∩ t) + μ (s \ t) = μ (s ∩ t) + μ (⋃ n, S n) := by rw [Union_S]
    _ ≤ μ (s ∩ t) + ⨆ n, μ (S n) := (add_le_add le_rfl this)
    _ = ⨆ n, μ (s ∩ t) + μ (S n) := ENNReal.add_supᵢ
    _ ≤ μ s := supᵢ_le hSs

  /- It suffices to show that `∑' k, μ (S (k + 1) \ S k) ≠ ∞`. Indeed, if we have this,
    then for all `N` we have `μ (⋃ n, S n) ≤ μ (S N) + ∑' k, m (S (N + k + 1) \ S (N + k))`
    and the second term tends to zero, see `outer_measure.Union_nat_of_monotone_of_tsum_ne_top`
    for details. -/
  have : ∀ n, S n ⊆ S (n + 1) := fun n x hx =>
    ⟨hx.1, le_trans (ENNReal.inv_le_inv.2 <| Nat.cast_le.2 n.le_succ) hx.2⟩
  refine' (μ.Union_nat_of_monotone_of_tsum_ne_top this _).le
  clear this
  /- While the sets `S (k + 1) \ S k` are not pairwise metric separated, the sets in each
    subsequence `S (2 * k + 1) \ S (2 * k)` and `S (2 * k + 2) \ S (2 * k)` are metric separated,
    so `m` is additive on each of those sequences. -/
  rw [← tsum_even_add_odd ENNReal.summable ENNReal.summable, ENNReal.add_ne_top]
  suffices : ∀ a, (∑' k : ℕ, μ (S (2 * k + 1 + a) \ S (2 * k + a))) ≠ ∞
  exact ⟨by simpa using this 0, by simpa using this 1⟩
  refine' fun r => ne_top_of_le_ne_top htop _
  rw [← Union_S, ENNReal.tsum_eq_supᵢ_nat, supᵢ_le_iff]
  intro n
  rw [← hm.finset_Union_of_pairwise_separated]
  · exact μ.mono (Union_subset fun i => Union_subset fun hi x hx => mem_Union.2 ⟨_, hx.1⟩)
  suffices : ∀ i j, i < j → IsMetricSeparated (S (2 * i + 1 + r)) (s \ S (2 * j + r))
  exact fun i _ j _ hij =>
    hij.lt_or_lt.elim
      (fun h => (this i j h).mono (inter_subset_left _ _) fun x hx => ⟨hx.1.1, hx.2⟩) fun h =>
      (this j i h).symm.mono (fun x hx => ⟨hx.1.1, hx.2⟩) (inter_subset_left _ _)
  intro i j hj
  have A : ((↑(2 * j + r))⁻¹ : ℝ≥0∞) < (↑(2 * i + 1 + r))⁻¹ :=
    by
    rw [ENNReal.inv_lt_inv, Nat.cast_lt]
    linarith
  refine' ⟨(↑(2 * i + 1 + r))⁻¹ - (↑(2 * j + r))⁻¹, by simpa using A, fun x hx y hy => _⟩
  have : inf_edist y t < (↑(2 * j + r))⁻¹ := not_le.1 fun hle => hy.2 ⟨hy.1, hle⟩
  rcases inf_edist_lt_iff.mp this with ⟨z, hzt, hyz⟩
  have hxz : (↑(2 * i + 1 + r))⁻¹ ≤ edist x z := le_inf_edist.1 hx.2 _ hzt
  apply ENNReal.le_of_add_le_add_right hyz.ne_top
  refine' le_trans _ (edist_triangle _ _ _)
  refine' (add_le_add le_rfl hyz.le).trans (Eq.trans_le _ hxz)
  rw [tsub_add_cancel_of_le A.le]
#align measure_theory.outer_measure.is_metric.borel_le_caratheodory MeasureTheory.OuterMeasure.IsMetric.borel_le_caratheodory

theorem le_caratheodory [MeasurableSpace X] [BorelSpace X] (hm : IsMetric μ) :
    ‹MeasurableSpace X› ≤ μ.caratheodory :=
  by
  rw [@BorelSpace.measurable_eq X _ _]
  exact hm.borel_le_caratheodory
#align measure_theory.outer_measure.is_metric.le_caratheodory MeasureTheory.OuterMeasure.IsMetric.le_caratheodory

end IsMetric

/-!
### Constructors of metric outer measures

In this section we provide constructors `measure_theory.outer_measure.mk_metric'` and
`measure_theory.outer_measure.mk_metric` and prove that these outer measures are metric outer
measures. We also prove basic lemmas about `map`/`comap` of these measures.
-/

/-- Auxiliary definition for `outer_measure.mk_metric'`: given a function on sets
`m : set X → ℝ≥0∞`, returns the maximal outer measure `μ` such that `μ s ≤ m s`
for any set `s` of diameter at most `r`.-/
def MkMetric'.pre (m : Set X → ℝ≥0∞) (r : ℝ≥0∞) : OuterMeasure X :=
  boundedBy <| extend fun s (hs : diam s ≤ r) => m s
#align measure_theory.outer_measure.mk_metric'.pre MeasureTheory.OuterMeasure.MkMetric'.pre

/-- Given a function `m : set X → ℝ≥0∞`, `mk_metric' m` is the supremum of `mk_metric'.pre m r`
over `r > 0`. Equivalently, it is the limit of `mk_metric'.pre m r` as `r` tends to zero from
the right. -/
def mkMetric' (m : Set X → ℝ≥0∞) : OuterMeasure X :=
  ⨆ r > 0, MkMetric'.pre m r
#align measure_theory.outer_measure.mk_metric' MeasureTheory.OuterMeasure.mkMetric'

/-- Given a function `m : ℝ≥0∞ → ℝ≥0∞` and `r > 0`, let `μ r` be the maximal outer measure such that
`μ s ≤ m (emetric.diam s)` whenever `emetric.diam s < r`. Then
`mk_metric m = ⨆ r > 0, μ r`. -/
def mkMetric (m : ℝ≥0∞ → ℝ≥0∞) : OuterMeasure X :=
  mkMetric' fun s => m (diam s)
#align measure_theory.outer_measure.mk_metric MeasureTheory.OuterMeasure.mkMetric

namespace MkMetric'

variable {m : Set X → ℝ≥0∞} {r : ℝ≥0∞} {μ : OuterMeasure X} {s : Set X}

theorem le_pre : μ ≤ pre m r ↔ ∀ s : Set X, diam s ≤ r → μ s ≤ m s := by
  simp only [pre, le_bounded_by, extend, le_infᵢ_iff]
#align measure_theory.outer_measure.mk_metric'.le_pre MeasureTheory.OuterMeasure.mkMetric'.le_pre

theorem pre_le (hs : diam s ≤ r) : pre m r s ≤ m s :=
  (boundedBy_le _).trans <| infᵢ_le _ hs
#align measure_theory.outer_measure.mk_metric'.pre_le MeasureTheory.OuterMeasure.mkMetric'.pre_le

theorem mono_pre (m : Set X → ℝ≥0∞) {r r' : ℝ≥0∞} (h : r ≤ r') : pre m r' ≤ pre m r :=
  le_pre.2 fun s hs => pre_le (hs.trans h)
#align measure_theory.outer_measure.mk_metric'.mono_pre MeasureTheory.OuterMeasure.mkMetric'.mono_pre

theorem mono_pre_nat (m : Set X → ℝ≥0∞) : Monotone fun k : ℕ => pre m k⁻¹ := fun k l h =>
  le_pre.2 fun s hs => pre_le (hs.trans <| by simpa)
#align measure_theory.outer_measure.mk_metric'.mono_pre_nat MeasureTheory.OuterMeasure.mkMetric'.mono_pre_nat

theorem tendsto_pre (m : Set X → ℝ≥0∞) (s : Set X) :
    Tendsto (fun r => pre m r s) (𝓝[>] 0) (𝓝 <| mkMetric' m s) :=
  by
  rw [← map_coe_Ioi_atBot, tendsto_map'_iff]
  simp only [mk_metric', outer_measure.supr_apply, supᵢ_subtype']
  exact tendsto_atBot_supᵢ fun r r' hr => mono_pre _ hr _
#align measure_theory.outer_measure.mk_metric'.tendsto_pre MeasureTheory.OuterMeasure.mkMetric'.tendsto_pre

theorem tendsto_pre_nat (m : Set X → ℝ≥0∞) (s : Set X) :
    Tendsto (fun n : ℕ => pre m n⁻¹ s) atTop (𝓝 <| mkMetric' m s) :=
  by
  refine' (tendsto_pre m s).comp (tendsto_inf.2 ⟨ENNReal.tendsto_inv_nat_nhds_zero, _⟩)
  refine' tendsto_principal.2 (eventually_of_forall fun n => _)
  simp
#align measure_theory.outer_measure.mk_metric'.tendsto_pre_nat MeasureTheory.OuterMeasure.mkMetric'.tendsto_pre_nat

theorem eq_supᵢ_nat (m : Set X → ℝ≥0∞) : mkMetric' m = ⨆ n : ℕ, MkMetric'.pre m n⁻¹ :=
  by
  ext1 s
  rw [supᵢ_apply]
  refine'
    tendsto_nhds_unique (mk_metric'.tendsto_pre_nat m s)
      (tendsto_atTop_supᵢ fun k l hkl => mk_metric'.mono_pre_nat m hkl s)
#align measure_theory.outer_measure.mk_metric'.eq_supr_nat MeasureTheory.OuterMeasure.mkMetric'.eq_supᵢ_nat

/-- `measure_theory.outer_measure.mk_metric'.pre m r` is a trimmed measure provided that
`m (closure s) = m s` for any set `s`. -/
theorem trim_pre [MeasurableSpace X] [OpensMeasurableSpace X] (m : Set X → ℝ≥0∞)
    (hcl : ∀ s, m (closure s) = m s) (r : ℝ≥0∞) : (pre m r).trim = pre m r :=
  by
  refine' le_antisymm (le_pre.2 fun s hs => _) (le_trim _)
  rw [trim_eq_infi]
  refine'
    infᵢ_le_of_le (closure s) <|
      infᵢ_le_of_le subset_closure <|
        infᵢ_le_of_le measurableSet_closure ((pre_le _).trans_eq (hcl _))
  rwa [diam_closure]
#align measure_theory.outer_measure.mk_metric'.trim_pre MeasureTheory.OuterMeasure.mkMetric'.trim_pre

end MkMetric'

/-- An outer measure constructed using `outer_measure.mk_metric'` is a metric outer measure. -/
theorem mkMetric'_isMetric (m : Set X → ℝ≥0∞) : (mkMetric' m).IsMetric :=
  by
  rintro s t ⟨r, r0, hr⟩
  refine'
    tendsto_nhds_unique_of_eventuallyEq (mk_metric'.tendsto_pre _ _)
      ((mk_metric'.tendsto_pre _ _).add (mk_metric'.tendsto_pre _ _)) _
  rw [← pos_iff_ne_zero] at r0
  filter_upwards [Ioo_mem_nhdsWithin_Ioi ⟨le_rfl, r0⟩]
  rintro ε ⟨ε0, εr⟩
  refine' bounded_by_union_of_top_of_nonempty_inter _
  rintro u ⟨x, hxs, hxu⟩ ⟨y, hyt, hyu⟩
  have : ε < diam u := εr.trans_le ((hr x hxs y hyt).trans <| edist_le_diam_of_mem hxu hyu)
  exact infᵢ_eq_top.2 fun h => (this.not_le h).elim
#align measure_theory.outer_measure.mk_metric'_is_metric MeasureTheory.OuterMeasure.mkMetric'_isMetric

/-- If `c ∉ {0, ∞}` and `m₁ d ≤ c * m₂ d` for `d < ε` for some `ε > 0`
(we use `≤ᶠ[𝓝[≥] 0]` to state this), then `mk_metric m₁ hm₁ ≤ c • mk_metric m₂ hm₂`. -/
theorem mkMetric_mono_smul {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} {c : ℝ≥0∞} (hc : c ≠ ∞) (h0 : c ≠ 0)
    (hle : m₁ ≤ᶠ[𝓝[≥] 0] c • m₂) : (mkMetric m₁ : OuterMeasure X) ≤ c • mkMetric m₂ := by
  classical
    rcases(mem_nhdsWithin_Ici_iff_exists_Ico_subset' zero_lt_one).1 hle with ⟨r, hr0, hr⟩
    refine' fun s =>
      le_of_tendsto_of_tendsto (mk_metric'.tendsto_pre _ s)
        (ENNReal.Tendsto.const_mul (mk_metric'.tendsto_pre _ s) (Or.inr hc))
        (mem_of_superset (Ioo_mem_nhdsWithin_Ioi ⟨le_rfl, hr0⟩) fun r' hr' => _)
    simp only [mem_set_of_eq, mk_metric'.pre, RingHom.id_apply]
    rw [← smul_eq_mul, ← smul_apply, smul_bounded_by hc]
    refine' le_bounded_by.2 (fun t => (bounded_by_le _).trans _) _
    simp only [smul_eq_mul, Pi.smul_apply, extend, infᵢ_eq_if]
    split_ifs with ht ht
    · apply hr
      exact ⟨zero_le _, ht.trans_lt hr'.2⟩
    · simp [h0]
#align measure_theory.outer_measure.mk_metric_mono_smul MeasureTheory.OuterMeasure.mkMetric_mono_smul

/-- If `m₁ d ≤ m₂ d` for `d < ε` for some `ε > 0` (we use `≤ᶠ[𝓝[≥] 0]` to state this), then
`mk_metric m₁ hm₁ ≤ mk_metric m₂ hm₂`-/
theorem mkMetric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
    (mkMetric m₁ : OuterMeasure X) ≤ mkMetric m₂ := by
  convert mk_metric_mono_smul ENNReal.one_ne_top one_ne_zero _ <;> simp [*]
#align measure_theory.outer_measure.mk_metric_mono MeasureTheory.OuterMeasure.mkMetric_mono

theorem isometry_comap_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : Isometry f)
    (H : Monotone m ∨ Surjective f) : comap f (mkMetric m) = mkMetric m :=
  by
  simp only [mk_metric, mk_metric', mk_metric'.pre, induced_outer_measure, comap_supr]
  refine' surjective_id.supr_congr id fun ε => surjective_id.supr_congr id fun hε => _
  rw [comap_bounded_by _ (H.imp (fun h_mono => _) id)]
  · congr with s : 1
    apply extend_congr
    · simp [hf.ediam_image]
    · intros
      simp [hf.injective.subsingleton_image_iff, hf.ediam_image]
  · intro s t hst
    simp only [extend, le_infᵢ_iff]
    intro ht
    apply le_trans _ (h_mono (diam_mono hst))
    simp only [(diam_mono hst).trans ht, le_refl, cinfᵢ_pos]
#align measure_theory.outer_measure.isometry_comap_mk_metric MeasureTheory.OuterMeasure.isometry_comap_mkMetric

theorem isometry_map_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : Isometry f)
    (H : Monotone m ∨ Surjective f) : map f (mkMetric m) = restrict (range f) (mkMetric m) := by
  rw [← isometry_comap_mk_metric _ hf H, map_comap]
#align measure_theory.outer_measure.isometry_map_mk_metric MeasureTheory.OuterMeasure.isometry_map_mkMetric

theorem isometryEquiv_comap_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
    comap f (mkMetric m) = mkMetric m :=
  isometry_comap_mkMetric _ f.Isometry (Or.inr f.Surjective)
#align measure_theory.outer_measure.isometry_equiv_comap_mk_metric MeasureTheory.OuterMeasure.isometryEquiv_comap_mkMetric

theorem isometryEquiv_map_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
    map f (mkMetric m) = mkMetric m := by
  rw [← isometry_equiv_comap_mk_metric _ f, map_comap_of_surjective f.surjective]
#align measure_theory.outer_measure.isometry_equiv_map_mk_metric MeasureTheory.OuterMeasure.isometryEquiv_map_mkMetric

theorem trim_mkMetric [MeasurableSpace X] [BorelSpace X] (m : ℝ≥0∞ → ℝ≥0∞) :
    (mkMetric m : OuterMeasure X).trim = mkMetric m :=
  by
  simp only [mk_metric, mk_metric'.eq_supr_nat, trim_supr]
  congr 1 with n : 1
  refine' mk_metric'.trim_pre _ (fun s => _) _
  simp
#align measure_theory.outer_measure.trim_mk_metric MeasureTheory.OuterMeasure.trim_mkMetric

theorem le_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) (μ : OuterMeasure X) (r : ℝ≥0∞) (h0 : 0 < r)
    (hr : ∀ s, diam s ≤ r → μ s ≤ m (diam s)) : μ ≤ mkMetric m :=
  le_supᵢ₂_of_le r h0 <| mkMetric'.le_pre.2 fun s hs => hr _ hs
#align measure_theory.outer_measure.le_mk_metric MeasureTheory.OuterMeasure.le_mkMetric

end OuterMeasure

/-!
### Metric measures

In this section we use `measure_theory.outer_measure.to_measure` and theorems about
`measure_theory.outer_measure.mk_metric'`/`measure_theory.outer_measure.mk_metric` to define
`measure_theory.measure.mk_metric'`/`measure_theory.measure.mk_metric`. We also restate some lemmas
about metric outer measures for metric measures.
-/

namespace Measure

variable [MeasurableSpace X] [BorelSpace X]

/-- Given a function `m : set X → ℝ≥0∞`, `mk_metric' m` is the supremum of `μ r`
over `r > 0`, where `μ r` is the maximal outer measure `μ` such that `μ s ≤ m s`
for all `s`. While each `μ r` is an *outer* measure, the supremum is a measure. -/
def mkMetric' (m : Set X → ℝ≥0∞) : Measure X :=
  (OuterMeasure.mkMetric' m).toMeasure (OuterMeasure.mkMetric'_isMetric _).le_caratheodory
#align measure_theory.measure.mk_metric' MeasureTheory.Measure.mkMetric'

/-- Given a function `m : ℝ≥0∞ → ℝ≥0∞`, `mk_metric m` is the supremum of `μ r` over `r > 0`, where
`μ r` is the maximal outer measure `μ` such that `μ s ≤ m s` for all sets `s` that contain at least
two points. While each `mk_metric'.pre` is an *outer* measure, the supremum is a measure. -/
def mkMetric (m : ℝ≥0∞ → ℝ≥0∞) : Measure X :=
  (OuterMeasure.mkMetric m).toMeasure (OuterMeasure.mkMetric'_isMetric _).le_caratheodory
#align measure_theory.measure.mk_metric MeasureTheory.Measure.mkMetric

@[simp]
theorem mkMetric'_toOuterMeasure (m : Set X → ℝ≥0∞) :
    (mkMetric' m).toOuterMeasure = (OuterMeasure.mkMetric' m).trim :=
  rfl
#align measure_theory.measure.mk_metric'_to_outer_measure MeasureTheory.Measure.mkMetric'_toOuterMeasure

@[simp]
theorem mkMetric_toOuterMeasure (m : ℝ≥0∞ → ℝ≥0∞) :
    (mkMetric m : Measure X).toOuterMeasure = OuterMeasure.mkMetric m :=
  OuterMeasure.trim_mkMetric m
#align measure_theory.measure.mk_metric_to_outer_measure MeasureTheory.Measure.mkMetric_toOuterMeasure

end Measure

theorem OuterMeasure.coe_mkMetric [MeasurableSpace X] [BorelSpace X] (m : ℝ≥0∞ → ℝ≥0∞) :
    ⇑(OuterMeasure.mkMetric m : OuterMeasure X) = Measure.mkMetric m := by
  rw [← measure.mk_metric_to_outer_measure, coe_to_outer_measure]
#align measure_theory.outer_measure.coe_mk_metric MeasureTheory.OuterMeasure.coe_mkMetric

namespace Measure

variable [MeasurableSpace X] [BorelSpace X]

/-- If `c ∉ {0, ∞}` and `m₁ d ≤ c * m₂ d` for `d < ε` for some `ε > 0`
(we use `≤ᶠ[𝓝[≥] 0]` to state this), then `mk_metric m₁ hm₁ ≤ c • mk_metric m₂ hm₂`. -/
theorem mkMetric_mono_smul {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} {c : ℝ≥0∞} (hc : c ≠ ∞) (h0 : c ≠ 0)
    (hle : m₁ ≤ᶠ[𝓝[≥] 0] c • m₂) : (mkMetric m₁ : Measure X) ≤ c • mkMetric m₂ :=
  by
  intro s hs
  rw [← outer_measure.coe_mk_metric, coe_smul, ← outer_measure.coe_mk_metric]
  exact outer_measure.mk_metric_mono_smul hc h0 hle s
#align measure_theory.measure.mk_metric_mono_smul MeasureTheory.Measure.mkMetric_mono_smul

/-- If `m₁ d ≤ m₂ d` for `d < ε` for some `ε > 0` (we use `≤ᶠ[𝓝[≥] 0]` to state this), then
`mk_metric m₁ hm₁ ≤ mk_metric m₂ hm₂`-/
theorem mkMetric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
    (mkMetric m₁ : Measure X) ≤ mkMetric m₂ := by
  convert mk_metric_mono_smul ENNReal.one_ne_top one_ne_zero _ <;> simp [*]
#align measure_theory.measure.mk_metric_mono MeasureTheory.Measure.mkMetric_mono

/-- A formula for `measure_theory.measure.mk_metric`. -/
theorem mkMetric_apply (m : ℝ≥0∞ → ℝ≥0∞) (s : Set X) :
    mkMetric m s =
      ⨆ (r : ℝ≥0∞) (hr : 0 < r),
        ⨅ (t : ℕ → Set X) (h : s ⊆ unionᵢ t) (h' : ∀ n, diam (t n) ≤ r),
          ∑' n, ⨆ h : (t n).Nonempty, m (diam (t n)) :=
  by
  classical
    -- We mostly unfold the definitions but we need to switch the order of `∑'` and `⨅`
    simp only [← outer_measure.coe_mk_metric, outer_measure.mk_metric, outer_measure.mk_metric',
      outer_measure.supr_apply, outer_measure.mk_metric'.pre, outer_measure.bounded_by_apply,
      extend]
    refine'
      surjective_id.supr_congr (fun r => r) fun r =>
        supᵢ_congr_Prop Iff.rfl fun hr =>
          surjective_id.infi_congr _ fun t => infᵢ_congr_Prop Iff.rfl fun ht => _
    dsimp
    by_cases htr : ∀ n, diam (t n) ≤ r
    · rw [infᵢ_eq_if, if_pos htr]
      congr 1 with n : 1
      simp only [infᵢ_eq_if, htr n, id, if_true, supᵢ_and']
    · rw [infᵢ_eq_if, if_neg htr]
      push_neg  at htr
      rcases htr with ⟨n, hn⟩
      refine' ENNReal.tsum_eq_top_of_eq_top ⟨n, _⟩
      rw [supᵢ_eq_if, if_pos, infᵢ_eq_if, if_neg]
      exact hn.not_le
      rcases diam_pos_iff.1 ((zero_le r).trans_lt hn) with ⟨x, hx, -⟩
      exact ⟨x, hx⟩
#align measure_theory.measure.mk_metric_apply MeasureTheory.Measure.mkMetric_apply

theorem le_mkMetric (m : ℝ≥0∞ → ℝ≥0∞) (μ : Measure X) (ε : ℝ≥0∞) (h₀ : 0 < ε)
    (h : ∀ s : Set X, diam s ≤ ε → μ s ≤ m (diam s)) : μ ≤ mkMetric m :=
  by
  rw [← to_outer_measure_le, mk_metric_to_outer_measure]
  exact outer_measure.le_mk_metric m μ.to_outer_measure ε h₀ h
#align measure_theory.measure.le_mk_metric MeasureTheory.Measure.le_mkMetric

/-- To bound the Hausdorff measure (or, more generally, for a measure defined using
`measure_theory.measure.mk_metric`) of a set, one may use coverings with maximum diameter tending to
`0`, indexed by any sequence of countable types. -/
theorem mkMetric_le_liminf_tsum {β : Type _} {ι : β → Type _} [∀ n, Countable (ι n)] (s : Set X)
    {l : Filter β} (r : β → ℝ≥0∞) (hr : Tendsto r l (𝓝 0)) (t : ∀ n : β, ι n → Set X)
    (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) (m : ℝ≥0∞ → ℝ≥0∞) :
    mkMetric m s ≤ liminf (fun n => ∑' i, m (diam (t n i))) l :=
  by
  haveI : ∀ n, Encodable (ι n) := fun n => Encodable.ofCountable _
  simp only [mk_metric_apply]
  refine' supᵢ₂_le fun ε hε => _
  refine' le_of_forall_le_of_dense fun c hc => _
  rcases((frequently_lt_of_liminf_lt (by infer_param) hc).and_eventually
        ((hr.eventually (gt_mem_nhds hε)).And (ht.and hst))).exists with
    ⟨n, hn, hrn, htn, hstn⟩
  set u : ℕ → Set X := fun j => ⋃ b ∈ decode₂ (ι n) j, t n b
  refine' infᵢ₂_le_of_le u (by rwa [Union_decode₂]) _
  refine' infᵢ_le_of_le (fun j => _) _
  · rw [EMetric.diam_unionᵢ_mem_option]
    exact supᵢ₂_le fun _ _ => (htn _).trans hrn.le
  ·
    calc
      (∑' j : ℕ, ⨆ h : (u j).Nonempty, m (diam (u j))) = _ :=
        tsum_unionᵢ_decode₂ (fun t : Set X => ⨆ h : t.Nonempty, m (diam t)) (by simp) _
      _ ≤ ∑' i : ι n, m (diam (t n i)) := (ENNReal.tsum_le_tsum fun b => supᵢ_le fun htb => le_rfl)
      _ ≤ c := hn.le

#align measure_theory.measure.mk_metric_le_liminf_tsum MeasureTheory.Measure.mkMetric_le_liminf_tsum

/-- To bound the Hausdorff measure (or, more generally, for a measure defined using
`measure_theory.measure.mk_metric`) of a set, one may use coverings with maximum diameter tending to
`0`, indexed by any sequence of finite types. -/
theorem mkMetric_le_liminf_sum {β : Type _} {ι : β → Type _} [hι : ∀ n, Fintype (ι n)] (s : Set X)
    {l : Filter β} (r : β → ℝ≥0∞) (hr : Tendsto r l (𝓝 0)) (t : ∀ n : β, ι n → Set X)
    (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) (m : ℝ≥0∞ → ℝ≥0∞) :
    mkMetric m s ≤ liminf (fun n => ∑ i, m (diam (t n i))) l := by
  simpa only [tsum_fintype] using mk_metric_le_liminf_tsum s r hr t ht hst m
#align measure_theory.measure.mk_metric_le_liminf_sum MeasureTheory.Measure.mkMetric_le_liminf_sum

/-!
### Hausdorff measure and Hausdorff dimension
-/

/-- Hausdorff measure on an (e)metric space. -/
def hausdorffMeasure (d : ℝ) : Measure X :=
  mkMetric fun r => r ^ d
#align measure_theory.measure.hausdorff_measure MeasureTheory.Measure.hausdorffMeasure

-- mathport name: hausdorff_measure
scoped[MeasureTheory] notation "μH[" d "]" => MeasureTheory.Measure.hausdorffMeasure d

theorem le_hausdorffMeasure (d : ℝ) (μ : Measure X) (ε : ℝ≥0∞) (h₀ : 0 < ε)
    (h : ∀ s : Set X, diam s ≤ ε → μ s ≤ diam s ^ d) : μ ≤ μH[d] :=
  le_mkMetric _ μ ε h₀ h
#align measure_theory.measure.le_hausdorff_measure MeasureTheory.Measure.le_hausdorffMeasure

/-- A formula for `μH[d] s`. -/
theorem hausdorffMeasure_apply (d : ℝ) (s : Set X) :
    μH[d] s =
      ⨆ (r : ℝ≥0∞) (hr : 0 < r),
        ⨅ (t : ℕ → Set X) (hts : s ⊆ ⋃ n, t n) (ht : ∀ n, diam (t n) ≤ r),
          ∑' n, ⨆ h : (t n).Nonempty, diam (t n) ^ d :=
  mkMetric_apply _ _
#align measure_theory.measure.hausdorff_measure_apply MeasureTheory.Measure.hausdorffMeasure_apply

/-- To bound the Hausdorff measure of a set, one may use coverings with maximum diameter tending
to `0`, indexed by any sequence of countable types. -/
theorem hausdorffMeasure_le_liminf_tsum {β : Type _} {ι : β → Type _} [hι : ∀ n, Countable (ι n)]
    (d : ℝ) (s : Set X) {l : Filter β} (r : β → ℝ≥0∞) (hr : Tendsto r l (𝓝 0))
    (t : ∀ n : β, ι n → Set X) (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n)
    (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) : μH[d] s ≤ liminf (fun n => ∑' i, diam (t n i) ^ d) l :=
  mkMetric_le_liminf_tsum s r hr t ht hst _
#align measure_theory.measure.hausdorff_measure_le_liminf_tsum MeasureTheory.Measure.hausdorffMeasure_le_liminf_tsum

/-- To bound the Hausdorff measure of a set, one may use coverings with maximum diameter tending
to `0`, indexed by any sequence of finite types. -/
theorem hausdorffMeasure_le_liminf_sum {β : Type _} {ι : β → Type _} [hι : ∀ n, Fintype (ι n)]
    (d : ℝ) (s : Set X) {l : Filter β} (r : β → ℝ≥0∞) (hr : Tendsto r l (𝓝 0))
    (t : ∀ n : β, ι n → Set X) (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n)
    (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) : μH[d] s ≤ liminf (fun n => ∑ i, diam (t n i) ^ d) l :=
  mkMetric_le_liminf_sum s r hr t ht hst _
#align measure_theory.measure.hausdorff_measure_le_liminf_sum MeasureTheory.Measure.hausdorffMeasure_le_liminf_sum

/-- If `d₁ < d₂`, then for any set `s` we have either `μH[d₂] s = 0`, or `μH[d₁] s = ∞`. -/
theorem hausdorffMeasure_zero_or_top {d₁ d₂ : ℝ} (h : d₁ < d₂) (s : Set X) :
    μH[d₂] s = 0 ∨ μH[d₁] s = ∞ := by
  by_contra' H
  suffices ∀ c : ℝ≥0, c ≠ 0 → μH[d₂] s ≤ c * μH[d₁] s
    by
    rcases ENNReal.exists_nnreal_pos_mul_lt H.2 H.1 with ⟨c, hc0, hc⟩
    exact hc.not_le (this c (pos_iff_ne_zero.1 hc0))
  intro c hc
  refine' le_iff'.1 (mk_metric_mono_smul ENNReal.coe_ne_top (by exact_mod_cast hc) _) s
  have : 0 < (c ^ (d₂ - d₁)⁻¹ : ℝ≥0∞) :=
    by
    rw [ENNReal.coe_rpow_of_ne_zero hc, pos_iff_ne_zero, Ne.def, ENNReal.coe_eq_zero,
      NNReal.rpow_eq_zero_iff]
    exact mt And.left hc
  filter_upwards [Ico_mem_nhdsWithin_Ici ⟨le_rfl, this⟩]
  rintro r ⟨hr₀, hrc⟩
  lift r to ℝ≥0 using ne_top_of_lt hrc
  rw [Pi.smul_apply, smul_eq_mul, ←
    ENNReal.div_le_iff_le_mul (Or.inr ENNReal.coe_ne_top) (Or.inr <| mt ENNReal.coe_eq_zero.1 hc)]
  rcases eq_or_ne r 0 with (rfl | hr₀)
  · rcases lt_or_le 0 d₂ with (h₂ | h₂)
    · simp only [h₂, ENNReal.zero_rpow_of_pos, zero_le, ENNReal.zero_div, ENNReal.coe_zero]
    ·
      simp only [h.trans_le h₂, ENNReal.div_top, zero_le, ENNReal.zero_rpow_of_neg,
        ENNReal.coe_zero]
  · have : (r : ℝ≥0∞) ≠ 0 := by simpa only [ENNReal.coe_eq_zero, Ne.def] using hr₀
    rw [← ENNReal.rpow_sub _ _ this ENNReal.coe_ne_top]
    refine' (ENNReal.rpow_lt_rpow hrc (sub_pos.2 h)).le.trans _
    rw [← ENNReal.rpow_mul, inv_mul_cancel (sub_pos.2 h).ne', ENNReal.rpow_one]
    exact le_rfl
#align measure_theory.measure.hausdorff_measure_zero_or_top MeasureTheory.Measure.hausdorffMeasure_zero_or_top

/-- Hausdorff measure `μH[d] s` is monotone in `d`. -/
theorem hausdorffMeasure_mono {d₁ d₂ : ℝ} (h : d₁ ≤ d₂) (s : Set X) : μH[d₂] s ≤ μH[d₁] s :=
  by
  rcases h.eq_or_lt with (rfl | h); · exact le_rfl
  cases' hausdorff_measure_zero_or_top h s with hs hs
  · rw [hs]
    exact zero_le _
  · rw [hs]
    exact le_top
#align measure_theory.measure.hausdorff_measure_mono MeasureTheory.Measure.hausdorffMeasure_mono

variable (X)

theorem noAtomsHausdorff {d : ℝ} (hd : 0 < d) : HasNoAtoms (hausdorffMeasure d : Measure X) :=
  by
  refine' ⟨fun x => _⟩
  rw [← nonpos_iff_eq_zero, hausdorff_measure_apply]
  refine' supᵢ₂_le fun ε ε0 => infᵢ₂_le_of_le (fun n => {x}) _ <| infᵢ_le_of_le (fun n => _) _
  · exact subset_Union (fun n => {x} : ℕ → Set X) 0
  · simp only [EMetric.diam_singleton, zero_le]
  · simp [hd]
#align measure_theory.measure.no_atoms_hausdorff MeasureTheory.Measure.noAtomsHausdorff

variable {X}

@[simp]
theorem hausdorffMeasure_zero_singleton (x : X) : μH[0] ({x} : Set X) = 1 :=
  by
  apply le_antisymm
  · let r : ℕ → ℝ≥0∞ := fun _ => 0
    let t : ℕ → Unit → Set X := fun n _ => {x}
    have ht : ∀ᶠ n in at_top, ∀ i, diam (t n i) ≤ r n := by
      simp only [imp_true_iff, eq_self_iff_true, diam_singleton, eventually_at_top,
        nonpos_iff_eq_zero, exists_const]
    simpa [liminf_const] using hausdorff_measure_le_liminf_sum 0 {x} r tendsto_const_nhds t ht
  · rw [hausdorff_measure_apply]
    suffices
      (1 : ℝ≥0∞) ≤
        ⨅ (t : ℕ → Set X) (hts : {x} ⊆ ⋃ n, t n) (ht : ∀ n, diam (t n) ≤ 1),
          ∑' n, ⨆ h : (t n).Nonempty, diam (t n) ^ (0 : ℝ)
      by
      apply le_trans this _
      convert le_supᵢ₂ (1 : ℝ≥0∞) zero_lt_one
      rfl
    simp only [ENNReal.rpow_zero, le_infᵢ_iff]
    intro t hst h't
    rcases mem_Union.1 (hst (mem_singleton x)) with ⟨m, hm⟩
    have A : (t m).Nonempty := ⟨x, hm⟩
    calc
      (1 : ℝ≥0∞) = ⨆ h : (t m).Nonempty, 1 := by simp only [A, csupᵢ_pos]
      _ ≤ ∑' n, ⨆ h : (t n).Nonempty, 1 := ENNReal.le_tsum _

#align measure_theory.measure.hausdorff_measure_zero_singleton MeasureTheory.Measure.hausdorffMeasure_zero_singleton

theorem one_le_hausdorffMeasure_zero_of_nonempty {s : Set X} (h : s.Nonempty) : 1 ≤ μH[0] s :=
  by
  rcases h with ⟨x, hx⟩
  calc
    (1 : ℝ≥0∞) = μH[0] ({x} : Set X) := (hausdorff_measure_zero_singleton x).symm
    _ ≤ μH[0] s := measure_mono (singleton_subset_iff.2 hx)

#align measure_theory.measure.one_le_hausdorff_measure_zero_of_nonempty MeasureTheory.Measure.one_le_hausdorffMeasure_zero_of_nonempty

theorem hausdorffMeasure_le_one_of_subsingleton {s : Set X} (hs : s.Subsingleton) {d : ℝ}
    (hd : 0 ≤ d) : μH[d] s ≤ 1 :=
  by
  rcases eq_empty_or_nonempty s with (rfl | ⟨x, hx⟩)
  · simp only [measure_empty, zero_le]
  · rw [(subsingleton_iff_singleton hx).1 hs]
    rcases eq_or_lt_of_le hd with (rfl | dpos)
    · simp only [le_refl, hausdorff_measure_zero_singleton]
    · haveI := no_atoms_hausdorff X dpos
      simp only [zero_le, measure_singleton]
#align measure_theory.measure.hausdorff_measure_le_one_of_subsingleton MeasureTheory.Measure.hausdorffMeasure_le_one_of_subsingleton

end Measure

open MeasureTheory

open Measure

/-!
### Hausdorff measure and Lebesgue measure
-/

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic filter.is_bounded_default -/
/-- In the space `ι → ℝ`, Hausdorff measure coincides exactly with Lebesgue measure. -/
@[simp]
theorem hausdorffMeasure_pi_real {ι : Type _} [Fintype ι] :
    (μH[Fintype.card ι] : Measure (ι → ℝ)) = volume := by
  classical
    -- it suffices to check that the two measures coincide on products of rational intervals
    refine'
      (pi_eq_generateFrom (fun i => real.borel_eq_generate_from_Ioo_rat.symm)
          (fun i => Real.isPiSystem_Ioo_rat) (fun i => Real.finiteSpanningSetsInIooRat _) _).symm
    simp only [mem_Union, mem_singleton_iff]
    -- fix such a product `s` of rational intervals, of the form `Π (a i, b i)`.
    intro s hs
    choose a b H using hs
    obtain rfl : s = fun i => Ioo (a i) (b i)
    exact funext fun i => (H i).2
    replace H := fun i => (H i).1
    apply le_antisymm _
    -- first check that `volume s ≤ μH s`
    · have Hle : volume ≤ (μH[Fintype.card ι] : Measure (ι → ℝ)) :=
        by
        refine' le_hausdorff_measure _ _ ∞ ENNReal.coe_lt_top fun s _ => _
        rw [ENNReal.rpow_nat_cast]
        exact Real.volume_pi_le_diam_pow s
      rw [← volume_pi_pi fun i => Ioo (a i : ℝ) (b i)]
      exact measure.le_iff'.1 Hle _
    /- For the other inequality `μH s ≤ volume s`, we use a covering of `s` by sets of small diameter
      `1/n`, namely cubes with left-most point of the form `a i + f i / n` with `f i` ranging between
      `0` and `⌈(b i - a i) * n⌉`. Their number is asymptotic to `n^d * Π (b i - a i)`. -/
    have I : ∀ i, 0 ≤ (b i : ℝ) - a i := fun i => by
      simpa only [sub_nonneg, Rat.cast_le] using (H i).le
    let γ := fun n : ℕ => ∀ i : ι, Fin ⌈((b i : ℝ) - a i) * n⌉₊
    let t : ∀ n : ℕ, γ n → Set (ι → ℝ) := fun n f =>
      Set.pi univ fun i => Icc (a i + f i / n) (a i + (f i + 1) / n)
    have A : tendsto (fun n : ℕ => 1 / (n : ℝ≥0∞)) at_top (𝓝 0) := by
      simp only [one_div, ENNReal.tendsto_inv_nat_nhds_zero]
    have B : ∀ᶠ n in at_top, ∀ i : γ n, diam (t n i) ≤ 1 / n :=
      by
      apply eventually_at_top.2 ⟨1, fun n hn => _⟩
      intro f
      apply diam_pi_le_of_le fun b => _
      simp only [Real.ediam_Icc, add_div, ENNReal.ofReal_div_of_pos (nat.cast_pos.mpr hn), le_refl,
        add_sub_add_left_eq_sub, add_sub_cancel', ENNReal.ofReal_one, ENNReal.ofReal_coe_nat]
    have C : ∀ᶠ n in at_top, (Set.pi univ fun i : ι => Ioo (a i : ℝ) (b i)) ⊆ ⋃ i : γ n, t n i :=
      by
      apply eventually_at_top.2 ⟨1, fun n hn => _⟩
      have npos : (0 : ℝ) < n := Nat.cast_pos.2 hn
      intro x hx
      simp only [mem_Ioo, mem_univ_pi] at hx
      simp only [mem_Union, mem_Ioo, mem_univ_pi, coe_coe]
      let f : γ n := fun i =>
        ⟨⌊(x i - a i) * n⌋₊, by
          apply Nat.floor_lt_ceil_of_lt_of_pos
          · refine' (mul_lt_mul_right npos).2 _
            simp only [(hx i).right, sub_lt_sub_iff_right]
          · refine' mul_pos _ npos
            simpa only [Rat.cast_lt, sub_pos] using H i⟩
      refine' ⟨f, fun i => ⟨_, _⟩⟩
      ·
        calc
          (a i : ℝ) + ⌊(x i - a i) * n⌋₊ / n ≤ (a i : ℝ) + (x i - a i) * n / n :=
            by
            refine' add_le_add le_rfl ((div_le_div_right npos).2 _)
            exact Nat.floor_le (mul_nonneg (sub_nonneg.2 (hx i).1.le) npos.le)
          _ = x i := by field_simp [npos.ne']

      ·
        calc
          x i = (a i : ℝ) + (x i - a i) * n / n := by field_simp [npos.ne']
          _ ≤ (a i : ℝ) + (⌊(x i - a i) * n⌋₊ + 1) / n :=
            add_le_add le_rfl ((div_le_div_right npos).2 (Nat.lt_floor_add_one _).le)

    calc
      μH[Fintype.card ι] (Set.pi univ fun i : ι => Ioo (a i : ℝ) (b i)) ≤
          liminf (fun n : ℕ => ∑ i : γ n, diam (t n i) ^ ↑(Fintype.card ι)) at_top :=
        hausdorff_measure_le_liminf_sum _ (Set.pi univ fun i => Ioo (a i : ℝ) (b i))
          (fun n : ℕ => 1 / (n : ℝ≥0∞)) A t B C
      _ ≤ liminf (fun n : ℕ => ∑ i : γ n, (1 / n) ^ Fintype.card ι) at_top :=
        by
        refine'
          liminf_le_liminf _
            (by
              run_tac
                is_bounded_default)
        filter_upwards [B]with _ hn
        apply Finset.sum_le_sum fun i _ => _
        rw [ENNReal.rpow_nat_cast]
        exact pow_le_pow_of_le_left' (hn i) _
      _ = liminf (fun n : ℕ => ∏ i : ι, (⌈((b i : ℝ) - a i) * n⌉₊ : ℝ≥0∞) / n) at_top := by
        simp only [Finset.card_univ, Nat.cast_prod, one_mul, Fintype.card_fin, Finset.sum_const,
          nsmul_eq_mul, Fintype.card_pi, div_eq_mul_inv, Finset.prod_mul_distrib, Finset.prod_const]
      _ = ∏ i : ι, volume (Ioo (a i : ℝ) (b i)) :=
        by
        simp only [Real.volume_Ioo]
        apply tendsto.liminf_eq
        refine' ENNReal.tendsto_finset_prod_of_ne_top _ (fun i hi => _) fun i hi => _
        · apply
            tendsto.congr' _
              ((ennreal.continuous_of_real.tendsto _).comp
                ((tendsto_nat_ceil_mul_div_atTop (I i)).comp tendsto_nat_cast_atTop_atTop))
          apply eventually_at_top.2 ⟨1, fun n hn => _⟩
          simp only [ENNReal.ofReal_div_of_pos (nat.cast_pos.mpr hn), comp_app,
            ENNReal.ofReal_coe_nat]
        · simp only [ENNReal.ofReal_ne_top, Ne.def, not_false_iff]

#align measure_theory.hausdorff_measure_pi_real MeasureTheory.hausdorffMeasure_pi_real

end MeasureTheory

/-!
### Hausdorff measure, Hausdorff dimension, and Hölder or Lipschitz continuous maps
-/

open MeasureTheory

open MeasureTheory MeasureTheory.Measure

variable [MeasurableSpace X] [BorelSpace X] [MeasurableSpace Y] [BorelSpace Y]

namespace HolderOnWith

variable {C r : ℝ≥0} {f : X → Y} {s t : Set X}

/-- If `f : X → Y` is Hölder continuous on `s` with a positive exponent `r`, then
`μH[d] (f '' s) ≤ C ^ d * μH[r * d] s`. -/
theorem hausdorffMeasure_image_le (h : HolderOnWith C r f s) (hr : 0 < r) {d : ℝ} (hd : 0 ≤ d) :
    μH[d] (f '' s) ≤ C ^ d * μH[r * d] s :=
  by
  -- We start with the trivial case `C = 0`
  rcases(zero_le C).eq_or_lt with (rfl | hC0)
  · rcases eq_empty_or_nonempty s with (rfl | ⟨x, hx⟩)
    · simp only [measure_empty, nonpos_iff_eq_zero, MulZeroClass.mul_zero, image_empty]
    have : f '' s = {f x} :=
      haveI : (f '' s).Subsingleton := by simpa [diam_eq_zero_iff] using h.ediam_image_le
      (subsingleton_iff_singleton (mem_image_of_mem f hx)).1 this
    rw [this]
    rcases eq_or_lt_of_le hd with (rfl | h'd)
    · simp only [ENNReal.rpow_zero, one_mul, MulZeroClass.mul_zero]
      rw [hausdorff_measure_zero_singleton]
      exact one_le_hausdorff_measure_zero_of_nonempty ⟨x, hx⟩
    · haveI := no_atoms_hausdorff Y h'd
      simp only [zero_le, measure_singleton]
  -- Now assume `C ≠ 0`
  · have hCd0 : (C : ℝ≥0∞) ^ d ≠ 0 := by simp [hC0.ne']
    have hCd : (C : ℝ≥0∞) ^ d ≠ ∞ := by simp [hd]
    simp only [hausdorff_measure_apply, ENNReal.mul_supᵢ, ENNReal.mul_infᵢ_of_ne hCd0 hCd, ←
      ENNReal.tsum_mul_left]
    refine' supᵢ_le fun R => supᵢ_le fun hR => _
    have : tendsto (fun d : ℝ≥0∞ => (C : ℝ≥0∞) * d ^ (r : ℝ)) (𝓝 0) (𝓝 0) :=
      ENNReal.tendsto_const_mul_rpow_nhds_zero_of_pos ENNReal.coe_ne_top hr
    rcases ennreal.nhds_zero_basis_Iic.eventually_iff.1 (this.eventually (gt_mem_nhds hR)) with
      ⟨δ, δ0, H⟩
    refine'
      le_supᵢ₂_of_le δ δ0
        (infᵢ₂_mono' fun t hst =>
          ⟨fun n => f '' (t n ∩ s), _,
            infᵢ_mono' fun htδ =>
              ⟨fun n => (h.ediam_image_inter_le (t n)).trans (H (htδ n)).le, _⟩⟩)
    · rw [← image_Union, ← Union_inter]
      exact image_subset _ (subset_inter hst subset.rfl)
    · apply ENNReal.tsum_le_tsum fun n => _
      simp only [supᵢ_le_iff, nonempty_image_iff]
      intro hft
      simp only [nonempty.mono ((t n).inter_subset_left s) hft, csupᵢ_pos]
      rw [ENNReal.rpow_mul, ← ENNReal.mul_rpow_of_nonneg _ _ hd]
      exact ENNReal.rpow_le_rpow (h.ediam_image_inter_le _) hd
#align holder_on_with.hausdorff_measure_image_le HolderOnWith.hausdorffMeasure_image_le

end HolderOnWith

namespace LipschitzOnWith

variable {K : ℝ≥0} {f : X → Y} {s t : Set X}

/-- If `f : X → Y` is `K`-Lipschitz on `s`, then `μH[d] (f '' s) ≤ K ^ d * μH[d] s`. -/
theorem hausdorffMeasure_image_le (h : LipschitzOnWith K f s) {d : ℝ} (hd : 0 ≤ d) :
    μH[d] (f '' s) ≤ K ^ d * μH[d] s := by
  simpa only [NNReal.coe_one, one_mul] using
    h.holder_on_with.hausdorff_measure_image_le zero_lt_one hd
#align lipschitz_on_with.hausdorff_measure_image_le LipschitzOnWith.hausdorffMeasure_image_le

end LipschitzOnWith

namespace LipschitzWith

variable {K : ℝ≥0} {f : X → Y}

/-- If `f` is a `K`-Lipschitz map, then it increases the Hausdorff `d`-measures of sets at most
by the factor of `K ^ d`.-/
theorem hausdorffMeasure_image_le (h : LipschitzWith K f) {d : ℝ} (hd : 0 ≤ d) (s : Set X) :
    μH[d] (f '' s) ≤ K ^ d * μH[d] s :=
  (h.LipschitzOnWith s).hausdorffMeasure_image_le hd
#align lipschitz_with.hausdorff_measure_image_le LipschitzWith.hausdorffMeasure_image_le

end LipschitzWith

/-!
### Antilipschitz maps do not decrease Hausdorff measures and dimension
-/

namespace AntilipschitzWith

variable {f : X → Y} {K : ℝ≥0} {d : ℝ}

theorem hausdorffMeasure_preimage_le (hf : AntilipschitzWith K f) (hd : 0 ≤ d) (s : Set Y) :
    μH[d] (f ⁻¹' s) ≤ K ^ d * μH[d] s :=
  by
  rcases eq_or_ne K 0 with (rfl | h0)
  · rcases eq_empty_or_nonempty (f ⁻¹' s) with (hs | ⟨x, hx⟩)
    · simp only [hs, measure_empty, zero_le]
    have : f ⁻¹' s = {x} := by
      haveI : Subsingleton X := hf.subsingleton
      have : (f ⁻¹' s).Subsingleton := subsingleton_univ.anti (subset_univ _)
      exact (subsingleton_iff_singleton hx).1 this
    rw [this]
    rcases eq_or_lt_of_le hd with (rfl | h'd)
    · simp only [ENNReal.rpow_zero, one_mul, MulZeroClass.mul_zero]
      rw [hausdorff_measure_zero_singleton]
      exact one_le_hausdorff_measure_zero_of_nonempty ⟨f x, hx⟩
    · haveI := no_atoms_hausdorff X h'd
      simp only [zero_le, measure_singleton]
  have hKd0 : (K : ℝ≥0∞) ^ d ≠ 0 := by simp [h0]
  have hKd : (K : ℝ≥0∞) ^ d ≠ ∞ := by simp [hd]
  simp only [hausdorff_measure_apply, ENNReal.mul_supᵢ, ENNReal.mul_infᵢ_of_ne hKd0 hKd, ←
    ENNReal.tsum_mul_left]
  refine' supᵢ₂_le fun ε ε0 => _
  refine' le_supᵢ₂_of_le (ε / K) (by simp [ε0.ne']) _
  refine' le_infᵢ₂ fun t hst => le_infᵢ fun htε => _
  replace hst : f ⁻¹' s ⊆ _ := preimage_mono hst
  rw [preimage_Union] at hst
  refine' infᵢ₂_le_of_le _ hst (infᵢ_le_of_le (fun n => _) _)
  · exact (hf.ediam_preimage_le _).trans (ENNReal.mul_le_of_le_div' <| htε n)
  · refine' ENNReal.tsum_le_tsum fun n => supᵢ_le_iff.2 fun hft => _
    simp only [nonempty_of_nonempty_preimage hft, csupᵢ_pos]
    rw [← ENNReal.mul_rpow_of_nonneg _ _ hd]
    exact ENNReal.rpow_le_rpow (hf.ediam_preimage_le _) hd
#align antilipschitz_with.hausdorff_measure_preimage_le AntilipschitzWith.hausdorffMeasure_preimage_le

theorem le_hausdorffMeasure_image (hf : AntilipschitzWith K f) (hd : 0 ≤ d) (s : Set X) :
    μH[d] s ≤ K ^ d * μH[d] (f '' s) :=
  calc
    μH[d] s ≤ μH[d] (f ⁻¹' (f '' s)) := measure_mono (subset_preimage_image _ _)
    _ ≤ K ^ d * μH[d] (f '' s) := hf.hausdorffMeasure_preimage_le hd (f '' s)

#align antilipschitz_with.le_hausdorff_measure_image AntilipschitzWith.le_hausdorffMeasure_image

end AntilipschitzWith

/-!
### Isometries preserve the Hausdorff measure and Hausdorff dimension
-/

namespace Isometry

variable {f : X → Y} {d : ℝ}

theorem hausdorffMeasure_image (hf : Isometry f) (hd : 0 ≤ d ∨ Surjective f) (s : Set X) :
    μH[d] (f '' s) = μH[d] s :=
  by
  simp only [hausdorff_measure, ← outer_measure.coe_mk_metric, ← outer_measure.comap_apply]
  rw [outer_measure.isometry_comap_mk_metric _ hf (hd.imp_left _)]
  exact fun hd x y hxy => ENNReal.rpow_le_rpow hxy hd
#align isometry.hausdorff_measure_image Isometry.hausdorffMeasure_image

theorem hausdorffMeasure_preimage (hf : Isometry f) (hd : 0 ≤ d ∨ Surjective f) (s : Set Y) :
    μH[d] (f ⁻¹' s) = μH[d] (s ∩ range f) := by
  rw [← hf.hausdorff_measure_image hd, image_preimage_eq_inter_range]
#align isometry.hausdorff_measure_preimage Isometry.hausdorffMeasure_preimage

theorem map_hausdorffMeasure (hf : Isometry f) (hd : 0 ≤ d ∨ Surjective f) :
    Measure.map f μH[d] = μH[d].restrict (range f) :=
  by
  ext1 s hs
  rw [map_apply hf.continuous.measurable hs, restrict_apply hs, hf.hausdorff_measure_preimage hd]
#align isometry.map_hausdorff_measure Isometry.map_hausdorffMeasure

end Isometry

namespace IsometryEquiv

@[simp]
theorem hausdorffMeasure_image (e : X ≃ᵢ Y) (d : ℝ) (s : Set X) : μH[d] (e '' s) = μH[d] s :=
  e.Isometry.hausdorffMeasure_image (Or.inr e.Surjective) s
#align isometry_equiv.hausdorff_measure_image IsometryEquiv.hausdorffMeasure_image

@[simp]
theorem hausdorffMeasure_preimage (e : X ≃ᵢ Y) (d : ℝ) (s : Set Y) : μH[d] (e ⁻¹' s) = μH[d] s := by
  rw [← e.image_symm, e.symm.hausdorff_measure_image]
#align isometry_equiv.hausdorff_measure_preimage IsometryEquiv.hausdorffMeasure_preimage

end IsometryEquiv


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

import analysis.special_functions.trigonometric.arctan
import measure_theory.constructions.borel_space

/-!
# Measurability of arctan

-/

namespace real

@[measurability] lemma measurable_arctan : measurable arctan := continuous_arctan.measurable

end real

section real_composition
open real
variables {α : Type*} {m : measurable_space α} {f : α → ℝ} (hf : measurable f)

@[measurability] lemma measurable.arctan : measurable (λ x, arctan (f x)) :=
measurable_arctan.comp hf

end real_composition


/- Combinatorics on lists. Copied from mathlib. -/

namespace list
universes u v
variables {α : Type u} {β : Type v}
inductive perm : list α → list α → Prop
|nil {}: perm [] []
|skip {x : α} {l₁ l₂ : list α} : perm l₁ l₂ → perm (x :: l₁) (x :: l₂)
|swap {x y : α} {l : list α} : perm (y::x::l) (x::y::l)
|trans {l₁ l₂ l₃ : list α} : perm l₁ l₂ → perm l₂ l₃ → perm l₁ l₃
open perm
infix ~ := perm

@[refl] protected theorem perm.refl : ∀ (l : list α), l ~ l
|[] := perm.nil
|(h::t) := skip $ perm.refl t

@[symm] protected theorem perm.symm : ∀ {l₁ l₂ : list α}, l₁ ~ l₂ → l₂ ~ l₁
:= λ l₁ l₂ p, perm.rec_on p (perm.nil) (λ x l₁ l₂ p q, skip q) (λ x y l, swap) (λ l₁ l₂ l₃ p₁₂ p₂₃ p₂₁ p₃₂, trans p₃₂ p₂₁)

attribute [trans] perm.trans

local infix ` ◾ ` :30 := perm.trans
/- ...etc etc -/
end list

namespace perm
open nat
inductive fin : ℕ → Type
| zero {n} : fin (succ n)
| succ {n} : fin n → fin (succ n)

def fin_0_absurd {C : Type} : fin 0 → C :=
λ z, @fin.rec_on (λ n f, nat.rec_on n C (λ _ _, unit)) 0 z (λ x,⟨⟩) (λ x y g, ⟨⟩)

def fin.comp : Π {n m : ℕ}, fin n → fin m → ordering
|(succ n) (succ m) (fin.zero) (fin.zero) := ordering.eq
|(succ n) (succ m) (fin.succ x) (fin.zero) := ordering.gt
|(succ n) (succ m) (fin.zero) (fin.succ y) := ordering.lt
|(succ n) (succ m) (fin.succ x) (fin.succ y) := fin.comp x y

def fin.inj : Π {n : ℕ}, fin n → fin (succ n)
|(succ n) (fin.zero) := fin.zero
|(succ n) (fin.succ x) := fin.succ (fin.inj x)

universes u
inductive vec (α : Type u) : ℕ → Type u
|zero {} : vec 0
|cons {n} : α → vec n → vec (succ n)

def vec.popn {α : Type u} : Π {n:ℕ} (i:fin (succ n)), vec α (succ n) → α × vec α ( n)
|n (fin.zero) (vec.cons h t) := ⟨h,t⟩
|(succ n) (fin.succ i) (vec.cons h t) :=
    let ⟨a,t'⟩ := vec.popn i t in
    ⟨a, vec.cons h t'⟩

inductive perm : ℕ → ℕ → Type
| first {n} :  perm 0 n
| pick {r n} : fin (succ n) → perm r n →  perm (succ r) (succ n)

infix ` ↪ `:40 := perm

def perm.id : Π {r}, r ↪ r
|0 := perm.first
|(succ r) := perm.pick (fin.zero) (perm.id)

def perm.empty_motive : ℕ → ℕ → Type
|0 n := unit
|(succ r) (succ n) := unit
|_ _ := empty

def perm.absurd : Π {r}, (succ r) ↪ 0 → empty
:= λ r π, @perm.rec_on (λ r n π, perm.empty_motive r n) (succ r) (0) π (λ n, ⟨⟩) (λ r n x y z, ⟨⟩)

def perm.inj : Π {r n}, r ↪ n → r ↪ (succ n)
|_ _ (perm.first) := perm.first
|_ _ (perm.pick i π) := perm.pick (fin.inj i) (perm.inj π)

def perm.inj_at : Π {r n}, r ↪ n → fin (succ n) → r ↪ (succ n)
|_ _ (perm.first) _ := perm.first
|_ _ (perm.pick i π) (fin.zero) := perm.pick (fin.succ i) (perm.inj_at π fin.zero)
|_ _ (perm.pick (fin.zero) π) (fin.succ x) := perm.pick (fin.zero) (perm.inj_at π x)
|_ _ (perm.pick (fin.succ y) π) (fin.succ x) :=

-- def perm.get : Π {r n}, r ↪ n → fin r → fin n
-- --|r n (perm.first) z :=
-- |r n (perm.pick i π) (fin.zero) := i
-- |r n (perm.pick i π) (fin.succ x) :=
--     let j := perm.get π x in
--     match fin.comp i j with
--     |ordering.lt := fin.in

def perm.pop :Π {r n}, (succ r) ↪ (succ n) → fin (succ r) → fin (succ n) × r ↪ (succ n)
|r n (perm.pick i π) (fin.zero)  := ⟨i, perm.inj π⟩
|(succ r) (succ n) (perm.pick (fin.zero) π) (fin.succ x) :=

def perm.comp : Π {a b c}, a ↪ b → b ↪ c → a ↪ c
|0 _ _ _ _ := perm.first
|(succ a) 0 c π (perm.first) := empty.rec_on _ $ perm.absurd π
|(succ a) (succ b) 0 π₁ π₂ := empty.rec_on _ $ perm.absurd π₂
|(succ a) (succ b) (succ c) (perm.pick i₁ π₁) (perm.pick i₂ π₂) := _

def action {α : Type*} : Π {r n : ℕ}, perm r n → vec α n → vec α r
|_ _ (perm.first) v := vec.zero
|_ _ (perm.pick i π) v :=
    let ⟨a,t'⟩ := vec.popn i v in
    vec.cons a (action π t')

end perm

#check fin
universes u

structure iso (n m : ℕ) :=
(f : fin n → fin m)
(g : fin m → fin n)
(fg := f ∘ g = id)
(gf := g ∘ f = id)

def iso_inv {X} {Y} : iso X Y → iso Y X := λ ⟨f,g,fg,gf⟩, ⟨g,f,gf,fg⟩

infix ` ↭ `: 40 := iso
instance {X} {Y} : has_coe_to_fun (X ↭ Y) := ⟨λ F, fin X → fin Y, λ F, F.f⟩

postfix `⁻¹ ` := iso_inv

structure inj (r n : ℕ) : Type :=
(f : fin r → fin n)
(is_inj : ∀ x y, f x = f y → x = y)

infix ` ↪ `:40 := inj
instance {n r} : has_coe_to_fun (r ↪ n) := ⟨λ F, fin r → fin n, λ F, F.f⟩

def permuatation (r n : ℕ) := inj r n

def same_image {r} {n} : (r ↪ n) → (r ↪ n) → Prop :=
λ π₁ π₂, ∃ σ: r ↭ r, π₁ ∘ σ = π₂

/- something like; quotient inj by ordering? -/
def combination (r n : ℕ) := @quot (r ↪ n) same_image

inductive permuatation_concrete (r n : ℕ) :=


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.monic
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u w

namespace Mathlib

/-!
# Polynomials

Lemmas for the interaction between polynomials and ∑ and ∏.

## Main results

- `nat_degree_prod_of_monic` : the degree of a product of monic polynomials is the product of
    degrees. We prove this only for [comm_semiring R],
    but it ought to be true for [semiring R] and list.prod.
- `nat_degree_prod` : for polynomials over an integral domain,
    the degree of the product is the sum of degrees
- `leading_coeff_prod` : for polynomials over an integral domain,
    the leading coefficient is the product of leading coefficients
- `prod_X_sub_C_coeff_card_pred` carries most of the content for computing
    the second coefficient of the characteristic polynomial.
-/

namespace polynomial

theorem nat_degree_prod_le {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R]
    (f : ι → polynomial R) :
    nat_degree (finset.prod s fun (i : ι) => f i) ≤ finset.sum s fun (i : ι) => nat_degree (f i) :=
  sorry

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients, provided that this product is nonzero.

See `leading_coeff_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
theorem leading_coeff_prod' {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R]
    (f : ι → polynomial R) (h : (finset.prod s fun (i : ι) => leading_coeff (f i)) ≠ 0) :
    leading_coeff (finset.prod s fun (i : ι) => f i) =
        finset.prod s fun (i : ι) => leading_coeff (f i) :=
  sorry

/--
The degree of a product of polynomials is equal to
the product of the degrees, provided that the product of leading coefficients is nonzero.

See `nat_degree_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
theorem nat_degree_prod' {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R]
    (f : ι → polynomial R) (h : (finset.prod s fun (i : ι) => leading_coeff (f i)) ≠ 0) :
    nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) :=
  sorry

theorem nat_degree_prod_of_monic {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R]
    (f : ι → polynomial R) [nontrivial R] (h : ∀ (i : ι), i ∈ s → monic (f i)) :
    nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) :=
  sorry

theorem coeff_zero_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_semiring R]
    (f : ι → polynomial R) :
    coeff (finset.prod s fun (i : ι) => f i) 0 = finset.prod s fun (i : ι) => coeff (f i) 0 :=
  sorry

-- Eventually this can be generalized with Vieta's formulas

-- plus the connection between roots and factorization.

theorem prod_X_sub_C_next_coeff {R : Type u} {ι : Type w} [comm_ring R] [nontrivial R]
    {s : finset ι} (f : ι → R) :
    next_coeff (finset.prod s fun (i : ι) => X - coe_fn C (f i)) =
        -finset.sum s fun (i : ι) => f i :=
  sorry

theorem prod_X_sub_C_coeff_card_pred {R : Type u} {ι : Type w} [comm_ring R] [nontrivial R]
    (s : finset ι) (f : ι → R) (hs : 0 < finset.card s) :
    coeff (finset.prod s fun (i : ι) => X - coe_fn C (f i)) (finset.card s - 1) =
        -finset.sum s fun (i : ι) => f i :=
  sorry

theorem nat_degree_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_ring R] [no_zero_divisors R]
    (f : ι → polynomial R) [nontrivial R] (h : ∀ (i : ι), i ∈ s → f i ≠ 0) :
    nat_degree (finset.prod s fun (i : ι) => f i) = finset.sum s fun (i : ι) => nat_degree (f i) :=
  sorry

theorem leading_coeff_prod {R : Type u} {ι : Type w} (s : finset ι) [comm_ring R]
    [no_zero_divisors R] (f : ι → polynomial R) :
    leading_coeff (finset.prod s fun (i : ι) => f i) =
        finset.prod s fun (i : ι) => leading_coeff (f i) :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import algebra.module.pi
import algebra.module.prod
import algebra.order.monoid.prod
import algebra.order.pi
import data.set.pointwise.smul
import tactic.positivity

/-!
# Ordered scalar product

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

In this file we define

* `ordered_smul R M` : an ordered additive commutative monoid `M` is an `ordered_smul`
  over an `ordered_semiring` `R` if the scalar product respects the order relation on the
  monoid and on the ring. There is a correspondence between this structure and convex cones,
  which is proven in `analysis/convex/cone.lean`.

## Implementation notes

* We choose to define `ordered_smul` as a `Prop`-valued mixin, so that it can be
  used for actions, modules, and algebras
  (the axioms for an "ordered algebra" are exactly that the algebra is ordered as a module).
* To get ordered modules and ordered vector spaces, it suffices to replace the
  `order_add_comm_monoid` and the `ordered_semiring` as desired.

## References

* https://en.wikipedia.org/wiki/Ordered_module

## Tags

ordered module, ordered scalar, ordered smul, ordered action, ordered vector space
-/

open_locale pointwise

/--
The ordered scalar product property is when an ordered additive commutative monoid
with a partial order has a scalar multiplication which is compatible with the order.
-/
@[protect_proj]
class ordered_smul (R M : Type*)
  [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] : Prop :=
(smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, a < b → 0 < c → c • a < c • b)
(lt_of_smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, c • a < c • b → 0 < c → a < b)

variables {ι 𝕜 R M N : Type*}

namespace order_dual

instance [has_zero R] [add_zero_class M] [h : smul_with_zero R M] : smul_with_zero R Mᵒᵈ :=
{ zero_smul := λ m, order_dual.rec (zero_smul _) m,
  smul_zero := λ r, order_dual.rec smul_zero r,
  ..order_dual.has_smul }

instance [monoid R] [mul_action R M] : mul_action R Mᵒᵈ :=
{ one_smul := λ m, order_dual.rec (one_smul _) m,
  mul_smul := λ r, order_dual.rec mul_smul r,
  ..order_dual.has_smul }

instance [monoid_with_zero R] [add_monoid M] [mul_action_with_zero R M] :
  mul_action_with_zero R Mᵒᵈ :=
{ ..order_dual.mul_action, ..order_dual.smul_with_zero }

instance [monoid_with_zero R] [add_monoid M] [distrib_mul_action R M] :
  distrib_mul_action R Mᵒᵈ :=
{ smul_add := λ k a, order_dual.rec (λ a' b, order_dual.rec (smul_add _ _) b) a,
  smul_zero := λ r, order_dual.rec (@smul_zero _ M _ _) r }

instance [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M]
  [ordered_smul R M] :
  ordered_smul R Mᵒᵈ :=
{ smul_lt_smul_of_pos := λ a b, @ordered_smul.smul_lt_smul_of_pos R M _ _ _ _ b a,
  lt_of_smul_lt_smul_of_pos := λ a b,
    @ordered_smul.lt_of_smul_lt_smul_of_pos R M _ _ _ _ b a }

end order_dual

section ordered_smul
variables [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M]
  {s : set M} {a b : M} {c : R}

lemma smul_lt_smul_of_pos : a < b → 0 < c → c • a < c • b := ordered_smul.smul_lt_smul_of_pos

lemma smul_le_smul_of_nonneg (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c • a ≤ c • b :=
begin
  rcases h₁.eq_or_lt with rfl|hab,
  { refl },
  { rcases h₂.eq_or_lt with rfl|hc,
    { rw [zero_smul, zero_smul] },
    { exact (smul_lt_smul_of_pos hab hc).le } }
end

lemma smul_nonneg (hc : 0 ≤ c) (ha : 0 ≤ a) : 0 ≤ c • a :=
calc (0 : M) = c • (0 : M) : (smul_zero c).symm
         ... ≤ c • a : smul_le_smul_of_nonneg ha hc

lemma smul_nonpos_of_nonneg_of_nonpos (hc : 0 ≤ c) (ha : a ≤ 0) : c • a ≤ 0 :=
@smul_nonneg R Mᵒᵈ _ _ _ _ _ _ hc ha

lemma eq_of_smul_eq_smul_of_pos_of_le (h₁ : c • a = c • b) (hc : 0 < c) (hle : a ≤ b) :
  a = b :=
hle.lt_or_eq.resolve_left $ λ hlt, (smul_lt_smul_of_pos hlt hc).ne h₁

lemma lt_of_smul_lt_smul_of_nonneg (h : c • a < c • b) (hc : 0 ≤ c) : a < b :=
hc.eq_or_lt.elim (λ hc, false.elim $ lt_irrefl (0:M) $ by rwa [← hc, zero_smul, zero_smul] at h)
  (ordered_smul.lt_of_smul_lt_smul_of_pos h)

lemma smul_lt_smul_iff_of_pos (hc : 0 < c) : c • a < c • b ↔ a < b :=
⟨λ h, lt_of_smul_lt_smul_of_nonneg h hc.le, λ h, smul_lt_smul_of_pos h hc⟩

lemma smul_pos_iff_of_pos (hc : 0 < c) : 0 < c • a ↔ 0 < a :=
calc 0 < c • a ↔ c • 0 < c • a : by rw smul_zero
           ... ↔ 0 < a         : smul_lt_smul_iff_of_pos hc

alias smul_pos_iff_of_pos ↔ _ smul_pos

lemma monotone_smul_left (hc : 0 ≤ c) : monotone (has_smul.smul c : M → M) :=
λ a b h, smul_le_smul_of_nonneg h hc

lemma strict_mono_smul_left (hc : 0 < c) : strict_mono (has_smul.smul c : M → M) :=
λ a b h, smul_lt_smul_of_pos h hc

lemma smul_lower_bounds_subset_lower_bounds_smul (hc : 0 ≤ c) :
  c • lower_bounds s ⊆ lower_bounds (c • s) :=
(monotone_smul_left hc).image_lower_bounds_subset_lower_bounds_image

lemma smul_upper_bounds_subset_upper_bounds_smul (hc : 0 ≤ c) :
  c • upper_bounds s ⊆ upper_bounds (c • s) :=
(monotone_smul_left hc).image_upper_bounds_subset_upper_bounds_image

lemma bdd_below.smul_of_nonneg (hs : bdd_below s) (hc : 0 ≤ c) : bdd_below (c • s) :=
(monotone_smul_left hc).map_bdd_below hs

lemma bdd_above.smul_of_nonneg (hs : bdd_above s) (hc : 0 ≤ c) : bdd_above (c • s) :=
(monotone_smul_left hc).map_bdd_above hs

end ordered_smul

/-- To prove that a linear ordered monoid is an ordered module, it suffices to verify only the first
axiom of `ordered_smul`. -/
lemma ordered_smul.mk'' [ordered_semiring 𝕜] [linear_ordered_add_comm_monoid M] [smul_with_zero 𝕜 M]
  (h : ∀ ⦃c : 𝕜⦄, 0 < c → strict_mono (λ a : M, c • a)) :
  ordered_smul 𝕜 M :=
{ smul_lt_smul_of_pos := λ a b c hab hc, h hc hab,
  lt_of_smul_lt_smul_of_pos := λ a b c hab hc, (h hc).lt_iff_lt.1 hab }

instance nat.ordered_smul [linear_ordered_cancel_add_comm_monoid M] : ordered_smul ℕ M :=
ordered_smul.mk'' $ λ n hn a b hab, begin
  cases n,
  { cases hn },
  induction n with n ih,
  { simp only [one_nsmul, hab], },
  { simp only [succ_nsmul _ n.succ, add_lt_add hab (ih n.succ_pos)] }
end

instance int.ordered_smul [linear_ordered_add_comm_group M] : ordered_smul ℤ M :=
ordered_smul.mk'' $ λ n hn, begin
  cases n,
  { simp only [int.of_nat_eq_coe, int.coe_nat_pos, coe_nat_zsmul] at ⊢ hn,
    exact strict_mono_smul_left hn },
  { cases (int.neg_succ_not_pos _).1 hn }
end

-- TODO: `linear_ordered_field M → ordered_smul ℚ M`

instance linear_ordered_semiring.to_ordered_smul {R : Type*} [linear_ordered_semiring R] :
  ordered_smul R R :=
ordered_smul.mk'' $ λ c, strict_mono_mul_left_of_pos

section linear_ordered_semifield
variables [linear_ordered_semifield 𝕜] [ordered_add_comm_monoid M] [ordered_add_comm_monoid N]
  [mul_action_with_zero 𝕜 M] [mul_action_with_zero 𝕜 N]

/-- To prove that a vector space over a linear ordered field is ordered, it suffices to verify only
the first axiom of `ordered_smul`. -/
lemma ordered_smul.mk' (h : ∀ ⦃a b : M⦄ ⦃c : 𝕜⦄, a < b → 0 < c → c • a ≤ c • b) :
  ordered_smul 𝕜 M :=
begin
  have hlt' : ∀ ⦃a b : M⦄ ⦃c : 𝕜⦄, a < b → 0 < c → c • a < c • b,
  { refine λ a b c hab hc, (h hab hc).lt_of_ne _,
    rw [ne.def, hc.ne'.is_unit.smul_left_cancel],
    exact hab.ne },
  refine { smul_lt_smul_of_pos := hlt', .. },
  intros a b c hab hc,
  obtain ⟨c, rfl⟩ := hc.ne'.is_unit,
  rw [← inv_smul_smul c a, ← inv_smul_smul c b],
  refine hlt' hab (pos_of_mul_pos_right _ hc.le),
  simp only [c.mul_inv, zero_lt_one]
end

instance [ordered_smul 𝕜 M] [ordered_smul 𝕜 N] : ordered_smul 𝕜 (M × N) :=
ordered_smul.mk' $ λ a b c h hc,
  ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩

instance pi.ordered_smul {M : ι → Type*} [Π i, ordered_add_comm_monoid (M i)]
  [Π i, mul_action_with_zero 𝕜 (M i)] [∀ i, ordered_smul 𝕜 (M i)] :
  ordered_smul 𝕜 (Π i, M i) :=
ordered_smul.mk' $ λ v u c h hc i, smul_le_smul_of_nonneg (h.le i) hc.le

/- Sometimes Lean fails to apply the dependent version to non-dependent functions, so we define
another instance. -/
instance pi.ordered_smul' [ordered_smul 𝕜 M] : ordered_smul 𝕜 (ι → M) := pi.ordered_smul

/- Sometimes Lean fails to unify the module with the scalars, so we define another instance. -/
instance pi.ordered_smul'' : ordered_smul 𝕜 (ι → 𝕜) := @pi.ordered_smul' ι 𝕜 𝕜 _ _ _ _

variables [ordered_smul 𝕜 M] {s : set M} {a b : M} {c : 𝕜}

lemma smul_le_smul_iff_of_pos (hc : 0 < c) : c • a ≤ c • b ↔ a ≤ b :=
⟨λ h, inv_smul_smul₀ hc.ne' a ▸ inv_smul_smul₀ hc.ne' b ▸
  smul_le_smul_of_nonneg h (inv_nonneg.2 hc.le),
  λ h, smul_le_smul_of_nonneg h hc.le⟩

lemma inv_smul_le_iff (h : 0 < c) : c⁻¹ • a ≤ b ↔ a ≤ c • b :=
by { rw [←smul_le_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance }

lemma inv_smul_lt_iff (h : 0 < c) : c⁻¹ • a < b ↔ a < c • b :=
by { rw [←smul_lt_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance }

lemma le_inv_smul_iff (h : 0 < c) : a ≤ c⁻¹ • b ↔ c • a ≤ b :=
by { rw [←smul_le_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance }

lemma lt_inv_smul_iff (h : 0 < c) : a < c⁻¹ • b ↔ c • a < b :=
by { rw [←smul_lt_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance }

variables (M)

/-- Left scalar multiplication as an order isomorphism. -/
@[simps] def order_iso.smul_left (hc : 0 < c) : M ≃o M :=
{ to_fun := λ b, c • b,
  inv_fun := λ b, c⁻¹ • b,
  left_inv := inv_smul_smul₀ hc.ne',
  right_inv := smul_inv_smul₀ hc.ne',
  map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_pos hc }

variables {M}

@[simp] lemma lower_bounds_smul_of_pos (hc : 0 < c) : lower_bounds (c • s) = c • lower_bounds s :=
(order_iso.smul_left _ hc).lower_bounds_image

@[simp] lemma upper_bounds_smul_of_pos (hc : 0 < c) : upper_bounds (c • s) = c • upper_bounds s :=
(order_iso.smul_left _ hc).upper_bounds_image

@[simp] lemma bdd_below_smul_iff_of_pos (hc : 0 < c) : bdd_below (c • s) ↔ bdd_below s :=
(order_iso.smul_left _ hc).bdd_below_image

@[simp] lemma bdd_above_smul_iff_of_pos (hc : 0 < c) : bdd_above (c • s) ↔ bdd_above s :=
(order_iso.smul_left _ hc).bdd_above_image

end linear_ordered_semifield

namespace tactic
section ordered_smul
variables [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M]
  {a : R} {b : M}

private lemma smul_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a • b :=
smul_nonneg ha.le hb

private lemma smul_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a • b :=
smul_nonneg ha hb.le

end ordered_smul

section no_zero_smul_divisors
variables [has_zero R] [has_zero M] [has_smul R M] [no_zero_smul_divisors R M] {a : R} {b : M}

private lemma smul_ne_zero_of_pos_of_ne_zero [preorder R] (ha : 0 < a) (hb : b ≠ 0) : a • b ≠ 0 :=
smul_ne_zero ha.ne' hb

private lemma smul_ne_zero_of_ne_zero_of_pos [preorder M] (ha : a ≠ 0) (hb : 0 < b) : a • b ≠ 0 :=
smul_ne_zero ha hb.ne'

end no_zero_smul_divisors

open positivity

/-- Extension for the `positivity` tactic: scalar multiplication is nonnegative/positive/nonzero if
both sides are. -/
@[positivity]
meta def positivity_smul : expr → tactic strictness
| e@`(%%a • %%b) := do
  strictness_a ← core a,
  strictness_b ← core b,
  match strictness_a, strictness_b with
  | positive pa, positive pb := positive <$> mk_app ``smul_pos [pa, pb]
  | positive pa, nonnegative pb := nonnegative <$> mk_app ``smul_nonneg_of_pos_of_nonneg [pa, pb]
  | nonnegative pa, positive pb := nonnegative <$> mk_app ``smul_nonneg_of_nonneg_of_pos [pa, pb]
  | nonnegative pa, nonnegative pb := nonnegative <$> mk_app ``smul_nonneg [pa, pb]
  | positive pa, nonzero pb := nonzero <$> to_expr ``(smul_ne_zero_of_pos_of_ne_zero %%pa %%pb)
  | nonzero pa, positive pb := nonzero <$> to_expr ``(smul_ne_zero_of_ne_zero_of_pos %%pa %%pb)
  | nonzero pa, nonzero pb := nonzero <$> to_expr ``(smul_ne_zero %%pa %%pb)
  | sa@_, sb@ _ := positivity_fail e a b sa sb
  end
| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a • b`"

end tactic


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import order.basic
import algebra.algebra.basic
import tactic.derive_fintype

/-!
# Sign function

This file defines the sign function for types with zero and a decidable less-than relation, and
proves some basic theorems about it.
-/

/-- The type of signs. -/
@[derive [decidable_eq, inhabited, fintype]]
inductive sign_type
| zero | neg | pos

namespace sign_type

instance : has_zero sign_type := ⟨zero⟩
instance : has_one  sign_type := ⟨pos⟩

instance : has_neg sign_type :=
⟨λ s, match s with
| neg  := pos
| zero := zero
| pos  := neg
end⟩

@[simp] lemma zero_eq_zero   : zero = 0 := rfl
@[simp] lemma neg_eq_neg_one : neg = -1 := rfl
@[simp] lemma pos_eq_one     : pos = 1  := rfl

/-- The multiplication on `sign_type`. -/
def mul : sign_type → sign_type → sign_type
| neg neg  := pos
| neg zero := zero
| neg pos  := neg
| zero _   := zero
| pos h    := h

instance : has_mul sign_type := ⟨mul⟩

/-- The less-than relation on signs. -/
inductive le : sign_type → sign_type → Prop
| of_neg (a) : le neg a
| zero       : le zero zero
| of_pos (a) : le a pos

instance : has_le sign_type := ⟨le⟩

instance : decidable_rel le :=
λ a b, by cases a; cases b; exact is_false (by rintro ⟨⟩) <|> exact is_true (by constructor)

/- We can define a `field` instance on `sign_type`, but it's not mathematically sensible,
so we only define the `comm_group_with_zero`. -/
instance : comm_group_with_zero sign_type :=
{ zero            := 0,
  one             := 1,
  mul             := (*),
  inv             := id,
  mul_zero        := λ a, by cases a; refl,
  zero_mul        := λ a, by cases a; refl,
  mul_one         := λ a, by cases a; refl,
  one_mul         := λ a, by cases a; refl,
  mul_inv_cancel  := λ a ha,  by cases a; trivial,
  mul_comm        := λ a b,   by casesm* _; refl,
  mul_assoc       := λ a b c, by casesm* _; refl,
  exists_pair_ne  := ⟨0, 1,   by rintro ⟨⟩⟩,
  inv_zero        := rfl }

instance : linear_order sign_type :=
{ le           := (≤),
  le_refl      := λ a, by cases a; constructor,
  le_total     := λ a b, by casesm* _; dec_trivial,
  le_antisymm  := λ a b ha hb, by casesm* _; refl,
  le_trans     := λ a b c hab hbc, by casesm* _; constructor,
  decidable_le := le.decidable_rel }

instance : has_distrib_neg sign_type :=
{ neg_neg := λ x, by cases x; refl,
  neg_mul := λ x y, by casesm* _; refl,
  mul_neg := λ x y, by casesm* _; refl,
..sign_type.has_neg }

/-- `sign_type` is equivalent to `fin 3`. -/
def fin3_equiv : sign_type ≃* fin 3 :=
{ to_fun :=  λ a, a.rec_on 0 (-1) 1,
  inv_fun := λ a, match a with
    | ⟨0, h⟩   := 0
    | ⟨1, h⟩   := 1
    | ⟨2, h⟩   := -1
    | ⟨n+3, h⟩ := (h.not_le le_add_self).elim
  end,
  left_inv :=  λ a, by cases a; refl,
  right_inv := λ a, match a with
    | ⟨0, h⟩   := rfl
    | ⟨1, h⟩   := rfl
    | ⟨2, h⟩   := rfl
    | ⟨n+3, h⟩ := (h.not_le le_add_self).elim
  end,
  map_mul' := λ x y, by casesm* _; refl }

section cast

variables {α : Type*} [has_zero α] [has_one α] [has_neg α]

/-- Turn a `sign_type` into zero, one, or minus one. This is a coercion instance, but note it is
only a `has_coe_t` instance: see note [use has_coe_t]. -/
def cast : sign_type → α
| zero :=  0
| pos  :=  1
| neg  := -1

instance : has_coe_t sign_type α := ⟨cast⟩

@[simp] lemma cast_eq_coe (a : sign_type) : (cast a : α) = a := rfl

@[simp] lemma coe_zero : ↑(0 : sign_type) = (0 : α) := rfl
@[simp] lemma coe_one  : ↑(1 : sign_type) = (1 : α) := rfl
@[simp] lemma coe_neg_one : ↑(-1 : sign_type) = (-1 : α) := rfl

end cast

/-- `sign_type.cast` as a `mul_with_zero_hom`. -/
@[simps] def cast_hom {α} [mul_zero_one_class α] [has_distrib_neg α] : sign_type →*₀ α :=
{ to_fun    := cast,
  map_zero' := rfl,
  map_one'  := rfl,
  map_mul'  := λ x y, by cases x; cases y; simp }

end sign_type

variables {α : Type*}

open sign_type

section preorder

variables [has_zero α] [preorder α] [decidable_rel ((<) : α → α → Prop)] {a : α}

/-- The sign of an element is 1 if it's positive, -1 if negative, 0 otherwise. -/
def sign : α →o sign_type :=
⟨λ a, if 0 < a then 1 else if a < 0 then -1 else 0,
 λ a b h, begin
  dsimp,
  split_ifs with h₁ h₂ h₃ h₄ _ _ h₂ h₃; try {constructor},
  { cases lt_irrefl 0 (h₁.trans $ h.trans_lt h₃) },
  { cases h₂ (h₁.trans_le h) },
  { cases h₄ (h.trans_lt h₃) }
  end⟩

lemma sign_apply : sign a = ite (0 < a) 1 (ite (a < 0) (-1) 0) := rfl

@[simp] lemma sign_zero : sign (0 : α) = 0 := by simp [sign_apply]
@[simp] lemma sign_pos (ha : 0 < a) : sign a = 1 := by rwa [sign_apply, if_pos]
@[simp] lemma sign_neg (ha : a < 0) : sign a = -1 := by rwa [sign_apply, if_neg $ asymm ha, if_pos]

end preorder

section linear_order

variables [has_zero α] [linear_order α] {a : α}

@[simp] lemma sign_eq_zero_iff : sign a = 0 ↔ a = 0 :=
begin
  refine ⟨λ h, _, λ h, h.symm ▸ sign_zero⟩,
  rw [sign_apply] at h,
  split_ifs at h; cases h,
  exact (le_of_not_lt h_1).eq_of_not_lt h_2
end

lemma sign_ne_zero : sign a ≠ 0 ↔ a ≠ 0 :=
sign_eq_zero_iff.not

end linear_order

section linear_ordered_ring

variables [linear_ordered_ring α] {a b : α}

/- I'm not sure why this is necessary, see https://leanprover.zulipchat.com/#narrow/stream/
113488-general/topic/type.20class.20inference.20issues/near/276937942 -/
local attribute [instance] linear_ordered_ring.decidable_lt

/-- `sign` as a `monoid_with_zero_hom` for a nontrivial ordered semiring. Note that linearity
is required; consider ℂ with the order `z ≤ w` iff they have the same imaginary part and
`z - w ≤ 0` in the reals; then `1 + i` and `1 - i` are incomparable to zero, and thus we have:
`0 * 0 = sign (1 + i) * sign (1 - i) ≠ sign 2 = 1`. (`complex.ordered_comm_ring`) -/
def sign_hom : α →*₀ sign_type :=
{ to_fun := sign,
  map_zero' := sign_zero,
  map_one' := sign_pos zero_lt_one,
  map_mul' := λ x y, by
    rcases lt_trichotomy x 0 with hx | hx | hx; rcases lt_trichotomy y 0 with hy | hy | hy;
    simp only [sign_zero, mul_zero, zero_mul, sign_pos, sign_neg, hx, hy, mul_one, neg_one_mul,
               neg_neg, one_mul, mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, neg_zero',
               mul_neg_of_pos_of_neg, mul_pos] }

end linear_ordered_ring


-- Las_clases_de_equivalencia_recubren_el_conjunto.lean
-- Las clases de equivalencia recubren el conjunto
-- José A. Alonso Jiménez
-- Sevilla, 6 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Este ejercicio es el 7º de una serie, que comenzó con el [ejercicio
-- del 30 de septiembre](https://bit.ly/2YfsvBZ), cuyo objetivo es
-- demostrar que el tipo de las particiones de un conjunto `X` es
-- isomorfo al tipo de las relaciones de equivalencia sobre `X`.
--
-- El ejercicio consiste en demostrar que si R es una relación de
-- equivalencia en A, entonces las clases de equivalencia de R recubren
-- a A.
-- ---------------------------------------------------------------------

import tactic

variable {A : Type}
variable (R : A → A → Prop)

def clase (a : A) :=
  {b : A | R b a}

def clases : (A → A → Prop) → set (set A) :=
  λ R, {B : set A | ∃ x : A, B = clase R x}

-- Se usarán los dos siguientes lemas auxiliares
lemma pertenece_clase_syss
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
by refl

lemma pertenece_clase_propia
  {R : A → A → Prop}
  (hR: equivalence R)
  (a : A)
  : a ∈ clase R a :=
(pertenece_clase_syss R).mpr (hR.1 a)

-- 1ª demostración,
example
  (hR: equivalence R)
  : ∀ a, ∃ X ∈ clases R, a ∈ X :=
begin
  intro a,
  use clase R a,
  split,
  { unfold clases,
    dsimp,
    use a, },
  { exact pertenece_clase_propia hR a, },
end

-- 2ª demostración,
lemma clases_recubren
  (hR: equivalence R)
  : ∀ a, ∃ X ∈ clases R, a ∈ X :=
begin
  intro a,
  use clase R a,
  split,
  { use a, },
  { exact hR.1 a, },
end