/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.special_functions.pow
import measure_theory.constructions.borel_space
import measure_theory.measure.lebesgue
import topology.metric_space.holder
import topology.metric_space.metric_separated

/-!
# 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_locale nnreal ennreal topology big_operators

open emetric set function filter encodable finite_dimensional topological_space

noncomputable theory

variables {ι X Y : Type*} [emetric_space X] [emetric_space Y]

namespace measure_theory

namespace outer_measure

/-!
### 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 is_metric (μ : outer_measure X) : Prop :=
∀ (s t : set X), is_metric_separated s t → μ (s ∪ t) = μ s + μ t

namespace is_metric

variables {μ : outer_measure X}

/-- A metric outer measure is additive on a finite set of pairwise metric separated sets. -/
lemma finset_Union_of_pairwise_separated (hm : is_metric μ) {I : finset ι} {s : ι → set X}
  (hI : ∀ (i ∈ I) (j ∈ I), i ≠ j → is_metric_separated (s i) (s j)) :
  μ (⋃ i ∈ I, s i) = ∑ i in I, μ (s i) :=
begin
  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 [λ i hi j hj hij, (hI i (or.inr hi) j (or.inr hj) hij),
    is_metric_separated.finset_Union_right
      (λ j hj, hI i (or.inl rfl) j (or.inr hj) (ne_of_mem_of_not_mem hj hiI).symm)]
end

/-- 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`. -/
lemma borel_le_caratheodory (hm : is_metric μ) :
  borel X ≤ μ.caratheodory :=
begin
  rw [borel_eq_generate_from_is_closed],
  refine measurable_space.generate_from_le (λ t ht, μ.is_caratheodory_iff_le.2 $ λ s, _),
  set S : ℕ → set X := λ n, {x ∈ s | (↑n)⁻¹ ≤ inf_edist x t},
  have n0 : ∀ {n : ℕ}, (n⁻¹ : ℝ≥0∞) ≠ 0, from λ n, ennreal.inv_ne_zero.2 (ennreal.nat_ne_top _),
  have Ssep : ∀ n, is_metric_separated (S n) t,
    from λ n, ⟨n⁻¹, n0, λ x hx y hy, hx.2.trans $ inf_edist_le_edist_of_mem hy⟩,
  have Ssep' : ∀ n, is_metric_separated (S n) (s ∩ t),
    from λ n, (Ssep n).mono subset.rfl (inter_subset_right _ _),
  have S_sub : ∀ n, S n ⊆ s \ t,
    from λ n, subset_inter (inter_subset_left _ _) (Ssep n).subset_compl_right,
  have hSs : ∀ n, μ (s ∩ t) + μ (S n) ≤ μ s, from λ 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,
  { 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_supr
  ... ≤ μ s : supr_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), from λ 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))) ≠ ∞,
    from ⟨by simpa using this 0, by simpa using this 1⟩,
  refine λ r, ne_top_of_le_ne_top htop _,
  rw [← Union_S, ennreal.tsum_eq_supr_nat, supr_le_iff],
  intro n,
  rw [← hm.finset_Union_of_pairwise_separated],
  { exact μ.mono (Union_subset $ λ i, Union_subset $ λ hi x hx, mem_Union.2 ⟨_, hx.1⟩) },
  suffices : ∀ i  j, i < j → is_metric_separated (S (2 * i + 1 + r)) (s \ S (2 * j + r)),
    from λ i _ j _ hij, hij.lt_or_lt.elim
      (λ h, (this i j h).mono (inter_subset_left _ _) (λ x hx, ⟨hx.1.1, hx.2⟩))
      (λ h, (this j i h).symm.mono  (λ x hx, ⟨hx.1.1, hx.2⟩) (inter_subset_left _ _)),
  intros 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, λ x hx y hy, _⟩,
  have : inf_edist y t < (↑(2 * j + r))⁻¹, from not_le.1 (λ 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, from 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]
end

lemma le_caratheodory [measurable_space X] [borel_space X] (hm : is_metric μ) :
  ‹measurable_space X› ≤ μ.caratheodory :=
by { rw @borel_space.measurable_eq X _ _, exact hm.borel_le_caratheodory }

end is_metric

/-!
### 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 mk_metric'.pre (m : set X → ℝ≥0∞) (r : ℝ≥0∞) :
  outer_measure X :=
bounded_by $ extend (λ s (hs : diam s ≤ r), m s)

/-- 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 mk_metric' (m : set X → ℝ≥0∞) :
  outer_measure X :=
⨆ r > 0, mk_metric'.pre m r

/-- 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 mk_metric (m : ℝ≥0∞ → ℝ≥0∞) : outer_measure X :=
mk_metric' (λ s, m (diam s))

namespace mk_metric'

variables {m : set X → ℝ≥0∞} {r : ℝ≥0∞} {μ : outer_measure X} {s : set X}

lemma le_pre : μ ≤ pre m r ↔ ∀ s : set X, diam s ≤ r → μ s ≤ m s :=
by simp only [pre, le_bounded_by, extend, le_infi_iff]

lemma pre_le (hs : diam s ≤ r) : pre m r s ≤ m s :=
(bounded_by_le _).trans $ infi_le _ hs

lemma mono_pre (m : set X → ℝ≥0∞) {r r' : ℝ≥0∞} (h : r ≤ r') :
  pre m r' ≤ pre m r :=
le_pre.2 $ λ s hs, pre_le (hs.trans h)

lemma mono_pre_nat (m : set X → ℝ≥0∞) :
  monotone (λ k : ℕ, pre m k⁻¹) :=
λ k l h, le_pre.2 $ λ s hs, pre_le (hs.trans $ by simpa)

lemma tendsto_pre (m : set X → ℝ≥0∞) (s : set X) :
  tendsto (λ r, pre m r s) (𝓝[>] 0) (𝓝 $ mk_metric' m s) :=
begin
  rw [← map_coe_Ioi_at_bot, tendsto_map'_iff],
  simp only [mk_metric', outer_measure.supr_apply, supr_subtype'],
  exact tendsto_at_bot_supr (λ r r' hr, mono_pre _ hr _)
end

lemma tendsto_pre_nat (m : set X → ℝ≥0∞) (s : set X) :
  tendsto (λ n : ℕ, pre m n⁻¹ s) at_top (𝓝 $ mk_metric' m s) :=
begin
  refine (tendsto_pre m s).comp (tendsto_inf.2 ⟨ennreal.tendsto_inv_nat_nhds_zero, _⟩),
  refine tendsto_principal.2 (eventually_of_forall $ λ n, _),
  simp
end

lemma eq_supr_nat (m : set X → ℝ≥0∞) :
  mk_metric' m = ⨆ n : ℕ, mk_metric'.pre m n⁻¹ :=
begin
  ext1 s,
  rw supr_apply,
  refine tendsto_nhds_unique (mk_metric'.tendsto_pre_nat m s)
    (tendsto_at_top_supr $ λ k l hkl, mk_metric'.mono_pre_nat m hkl s)
end

/-- `measure_theory.outer_measure.mk_metric'.pre m r` is a trimmed measure provided that
`m (closure s) = m s` for any set `s`. -/
lemma trim_pre [measurable_space X] [opens_measurable_space X]
  (m : set X → ℝ≥0∞) (hcl : ∀ s, m (closure s) = m s) (r : ℝ≥0∞) :
  (pre m r).trim = pre m r :=
begin
  refine le_antisymm (le_pre.2 $ λ s hs, _) (le_trim _),
  rw trim_eq_infi,
  refine (infi_le_of_le (closure s) $ infi_le_of_le subset_closure $
    infi_le_of_le measurable_set_closure ((pre_le _).trans_eq (hcl _))),
  rwa diam_closure
end

end mk_metric'

/-- An outer measure constructed using `outer_measure.mk_metric'` is a metric outer measure. -/
lemma mk_metric'_is_metric (m : set X → ℝ≥0∞) :
  (mk_metric' m).is_metric :=
begin
  rintros s t ⟨r, r0, hr⟩,
  refine tendsto_nhds_unique_of_eventually_eq
    (mk_metric'.tendsto_pre _ _)
    ((mk_metric'.tendsto_pre _ _).add (mk_metric'.tendsto_pre _ _)) _,
  rw [← pos_iff_ne_zero] at r0,
  filter_upwards [Ioo_mem_nhds_within_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, from εr.trans_le ((hr x hxs y hyt).trans $ edist_le_diam_of_mem hxu hyu),
  exact infi_eq_top.2 (λ h, (this.not_le h).elim)
end

/-- 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₂`. -/
lemma mk_metric_mono_smul {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} {c : ℝ≥0∞} (hc : c ≠ ∞) (h0 : c ≠ 0)
  (hle : m₁ ≤ᶠ[𝓝[≥] 0] c • m₂) :
  (mk_metric m₁ : outer_measure X) ≤ c • mk_metric m₂ :=
begin
  classical,
  rcases (mem_nhds_within_Ici_iff_exists_Ico_subset' zero_lt_one).1 hle with ⟨r, hr0, hr⟩,
  refine λ 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_nhds_within_Ioi ⟨le_rfl, hr0⟩) (λ r' hr', _)),
  simp only [mem_set_of_eq, mk_metric'.pre, ring_hom.id_apply],
  rw [←smul_eq_mul, ← smul_apply, smul_bounded_by hc],
  refine le_bounded_by.2 (λ t, (bounded_by_le _).trans _) _,
  simp only [smul_eq_mul, pi.smul_apply, extend, infi_eq_if],
  split_ifs with ht ht,
  { apply hr,
    exact ⟨zero_le _, ht.trans_lt hr'.2⟩ },
  { simp [h0] }
end

/-- 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₂`-/
lemma mk_metric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
  (mk_metric m₁ : outer_measure X) ≤ mk_metric m₂ :=
by { convert mk_metric_mono_smul ennreal.one_ne_top one_ne_zero _; simp * }

lemma isometry_comap_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : isometry f)
  (H : monotone m ∨ surjective f) :
  comap f (mk_metric m) = mk_metric m :=
begin
  simp only [mk_metric, mk_metric', mk_metric'.pre, induced_outer_measure, comap_supr],
  refine surjective_id.supr_congr id (λ ε, surjective_id.supr_congr id $ λ hε, _),
  rw comap_bounded_by _ (H.imp (λ h_mono, _) id),
  { congr' with s : 1,
    apply extend_congr,
    { simp [hf.ediam_image] },
    { intros, simp [hf.injective.subsingleton_image_iff, hf.ediam_image] } },
  { assume s t hst,
    simp only [extend, le_infi_iff],
    assume ht,
    apply le_trans _ (h_mono (diam_mono hst)),
    simp only [(diam_mono hst).trans ht, le_refl, cinfi_pos] }
end

lemma isometry_map_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : isometry f)
  (H : monotone m ∨ surjective f) :
  map f (mk_metric m) = restrict (range f) (mk_metric m) :=
by rw [← isometry_comap_mk_metric _ hf H, map_comap]

lemma isometry_equiv_comap_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
  comap f (mk_metric m) = mk_metric m :=
isometry_comap_mk_metric _ f.isometry (or.inr f.surjective)

lemma isometry_equiv_map_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
  map f (mk_metric m) = mk_metric m :=
by rw [← isometry_equiv_comap_mk_metric _ f, map_comap_of_surjective f.surjective]

lemma trim_mk_metric [measurable_space X] [borel_space X] (m : ℝ≥0∞ → ℝ≥0∞) :
  (mk_metric m : outer_measure X).trim = mk_metric m :=
begin
  simp only [mk_metric, mk_metric'.eq_supr_nat, trim_supr],
  congr' 1 with n : 1,
  refine mk_metric'.trim_pre _ (λ s, _) _,
  simp
end

lemma le_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (μ : outer_measure X)
  (r : ℝ≥0∞) (h0 : 0 < r) (hr : ∀ s, diam s ≤ r → μ s ≤ m (diam s)) :
  μ ≤ mk_metric m :=
le_supr₂_of_le r h0 $ mk_metric'.le_pre.2 $ λ s hs, hr _ hs

end outer_measure

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

variables [measurable_space X] [borel_space 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 mk_metric' (m : set X → ℝ≥0∞) : measure X :=
(outer_measure.mk_metric' m).to_measure (outer_measure.mk_metric'_is_metric _).le_caratheodory

/-- 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 mk_metric (m : ℝ≥0∞ → ℝ≥0∞) : measure X :=
(outer_measure.mk_metric m).to_measure (outer_measure.mk_metric'_is_metric _).le_caratheodory

@[simp] lemma mk_metric'_to_outer_measure (m : set X → ℝ≥0∞) :
  (mk_metric' m).to_outer_measure = (outer_measure.mk_metric' m).trim :=
rfl

@[simp] lemma mk_metric_to_outer_measure (m : ℝ≥0∞ → ℝ≥0∞) :
  (mk_metric m : measure X).to_outer_measure = outer_measure.mk_metric m :=
outer_measure.trim_mk_metric m

end measure

lemma outer_measure.coe_mk_metric [measurable_space X] [borel_space X] (m : ℝ≥0∞ → ℝ≥0∞) :
  ⇑(outer_measure.mk_metric m : outer_measure X) = measure.mk_metric m :=
by rw [← measure.mk_metric_to_outer_measure, coe_to_outer_measure]

namespace measure

variables [measurable_space X] [borel_space 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₂`. -/
lemma mk_metric_mono_smul {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} {c : ℝ≥0∞} (hc : c ≠ ∞) (h0 : c ≠ 0)
  (hle : m₁ ≤ᶠ[𝓝[≥] 0] c • m₂) :
  (mk_metric m₁ : measure X) ≤ c • mk_metric m₂ :=
begin
  intros 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
end

/-- 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₂`-/
lemma mk_metric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
  (mk_metric m₁ : measure X) ≤ mk_metric m₂ :=
by { convert mk_metric_mono_smul ennreal.one_ne_top one_ne_zero _; simp * }

/-- A formula for `measure_theory.measure.mk_metric`. -/
lemma mk_metric_apply (m : ℝ≥0∞ → ℝ≥0∞) (s : set X) :
  mk_metric 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)) :=
begin
  -- We mostly unfold the definitions but we need to switch the order of `∑'` and `⨅`
  classical,
  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 (λ r, r) (λ r, supr_congr_Prop iff.rfl $ λ hr,
    surjective_id.infi_congr _ $ λ t, infi_congr_Prop iff.rfl $ λ ht, _),
  dsimp,
  by_cases htr : ∀ n, diam (t n) ≤ r,
  { rw [infi_eq_if, if_pos htr],
    congr' 1 with n : 1,
    simp only [infi_eq_if, htr n, id, if_true, supr_and'] },
  { rw [infi_eq_if, if_neg htr],
    push_neg at htr, rcases htr with ⟨n, hn⟩,
    refine ennreal.tsum_eq_top_of_eq_top ⟨n, _⟩,
    rw [supr_eq_if, if_pos, infi_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⟩ }
end

lemma le_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (μ : measure X) (ε : ℝ≥0∞) (h₀ : 0 < ε)
  (h : ∀ s : set X, diam s ≤ ε → μ s ≤ m (diam s)) :
  μ ≤ mk_metric m :=
begin
  rw [← to_outer_measure_le, mk_metric_to_outer_measure],
  exact outer_measure.le_mk_metric m μ.to_outer_measure ε h₀ h
end

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

/-- 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. -/
lemma mk_metric_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∞) :
  mk_metric m s ≤ liminf (λ 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

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

/-- Hausdorff measure on an (e)metric space. -/
def hausdorff_measure (d : ℝ) : measure X := mk_metric (λ r, r ^ d)

localized "notation (name := hausdorff_measure)
  `μH[` d `]` := measure_theory.measure.hausdorff_measure d" in measure_theory

lemma le_hausdorff_measure (d : ℝ) (μ : measure X) (ε : ℝ≥0∞) (h₀ : 0 < ε)
  (h : ∀ s : set X, diam s ≤ ε → μ s ≤ diam s ^ d) :
  μ ≤ μH[d] :=
le_mk_metric _ μ ε h₀ h

/-- A formula for `μH[d] s`. -/
lemma hausdorff_measure_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 :=
mk_metric_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. -/
lemma hausdorff_measure_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 (λ n, ∑' i, diam (t n i) ^ d) l :=
mk_metric_le_liminf_tsum s r hr t ht hst _

/-- 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. -/
lemma hausdorff_measure_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 (λ n, ∑ i, diam (t n i) ^ d) l :=
mk_metric_le_liminf_sum s r hr t ht hst _

/-- If `d₁ < d₂`, then for any set `s` we have either `μH[d₂] s = 0`, or `μH[d₁] s = ∞`. -/
lemma hausdorff_measure_zero_or_top {d₁ d₂ : ℝ} (h : d₁ < d₂) (s : set X) :
  μH[d₂] s = 0 ∨ μH[d₁] s = ∞ :=
begin
  by_contra' H,
  suffices : ∀ (c : ℝ≥0), c ≠ 0 → μH[d₂] s ≤ c * μH[d₁] s,
  { 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)) },
  intros 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∞),
  { 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_nhds_within_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 }
end

/-- Hausdorff measure `μH[d] s` is monotone in `d`. -/
lemma hausdorff_measure_mono {d₁ d₂ : ℝ} (h : d₁ ≤ d₂) (s : set X) : μH[d₂] s ≤ μH[d₁] s :=
begin
  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 }
end

variables (X)
lemma no_atoms_hausdorff {d : ℝ} (hd : 0 < d) : has_no_atoms (hausdorff_measure d : measure X) :=
begin
  refine ⟨λ x, _⟩,
  rw [← nonpos_iff_eq_zero, hausdorff_measure_apply],
  refine supr₂_le (λ ε ε0, infi₂_le_of_le (λ n, {x}) _ $ infi_le_of_le (λ n, _) _),
  { exact subset_Union (λ n, {x} : ℕ → set X) 0 },
  { simp only [emetric.diam_singleton, zero_le] },
  { simp [hd] }
end
variables {X}

@[simp] lemma hausdorff_measure_zero_singleton (x : X) : μH[0] ({x} : set X) = 1 :=
begin
  apply le_antisymm,
  { let r : ℕ → ℝ≥0∞ := λ _, 0,
    let t : ℕ → unit → set X := λ n _, {x},
    have ht : ∀ᶠ n in at_top, ∀ i, diam (t n i) ≤ r n,
      by simp only [implies_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 : ℝ),
    { apply le_trans this _,
      convert le_supr₂ (1 : ℝ≥0∞) zero_lt_one,
      refl },
    simp only [ennreal.rpow_zero, le_infi_iff],
    assume 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, csupr_pos]
    ... ≤ ∑' n, ⨆ (h : (t n).nonempty), 1 : ennreal.le_tsum _ }
end

lemma one_le_hausdorff_measure_zero_of_nonempty {s : set X} (h : s.nonempty) :
  1 ≤ μH[0] s :=
begin
  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)
end

lemma hausdorff_measure_le_one_of_subsingleton
  {s : set X} (hs : s.subsingleton) {d : ℝ} (hd : 0 ≤ d) :
  μH[d] s ≤ 1 :=
begin
  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] } }
end

end measure

open_locale measure_theory
open measure

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

/-- In the space `ι → ℝ`, Hausdorff measure coincides exactly with Lebesgue measure. -/
@[simp] theorem hausdorff_measure_pi_real {ι : Type*} [fintype ι] :
  (μH[fintype.card ι] : measure (ι → ℝ)) = volume :=
begin
  classical,
  -- it suffices to check that the two measures coincide on products of rational intervals
  refine (pi_eq_generate_from (λ i, real.borel_eq_generate_from_Ioo_rat.symm)
    (λ i, real.is_pi_system_Ioo_rat) (λ i, real.finite_spanning_sets_in_Ioo_rat _)
    _).symm,
  simp only [mem_Union, mem_singleton_iff],
  -- fix such a product `s` of rational intervals, of the form `Π (a i, b i)`.
  intros s hs,
  choose a b H using hs,
  obtain rfl : s = λ i, Ioo (a i) (b i), from funext (λ i, (H i).2), replace H := λ i, (H i).1,
  apply le_antisymm _,
  -- first check that `volume s ≤ μH s`
  { have Hle : volume ≤ (μH[fintype.card ι] : measure (ι → ℝ)),
    { refine le_hausdorff_measure _ _ ∞ ennreal.coe_lt_top (λ s _, _),
      rw [ennreal.rpow_nat_cast],
      exact real.volume_pi_le_diam_pow s },
    rw [← volume_pi_pi (λ 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 := λ i, by simpa only [sub_nonneg, rat.cast_le] using (H i).le,
  let γ := λ (n : ℕ), (Π (i : ι), fin ⌈((b i : ℝ) - a i) * n⌉₊),
  let t : Π (n : ℕ), γ n → set (ι → ℝ) :=
    λ n f, set.pi univ (λ i, Icc (a i + f i / n) (a i + (f i + 1) / n)),
  have A : tendsto (λ (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,
  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
    assume f,
    apply diam_pi_le_of_le (λ b, _),
    simp only [real.ediam_Icc, add_div, ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), le_refl,
      add_sub_add_left_eq_sub, add_sub_cancel', ennreal.of_real_one, ennreal.of_real_coe_nat] },
  have C : ∀ᶠ n in at_top, set.pi univ (λ (i : ι), Ioo (a i : ℝ) (b i)) ⊆ ⋃ (i : γ n), t n i,
  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
    have npos : (0 : ℝ) < n := nat.cast_pos.2 hn,
    assume 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 := λ i, ⟨⌊(x i - a i) * n⌋₊,
    begin
      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 }
    end⟩,
    refine ⟨f, λ i, ⟨_, _⟩⟩,
    { calc (a i : ℝ) + ⌊(x i - a i) * n⌋₊ / n
      ≤ (a i : ℝ) + ((x i - a i) * n) / n :
          begin
            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),
          end
      ... = 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 (λ (i : ι), Ioo (a i : ℝ) (b i)))
    ≤ liminf (λ (n : ℕ), ∑ (i : γ n), diam (t n i) ^ ↑(fintype.card ι)) at_top :
      hausdorff_measure_le_liminf_sum _ (set.pi univ (λ i, Ioo (a i : ℝ) (b i)))
        (λ (n : ℕ), 1/(n : ℝ≥0∞)) A t B C
  ... ≤ liminf (λ (n : ℕ), ∑ (i : γ n), (1/n) ^ (fintype.card ι)) at_top :
    begin
      refine liminf_le_liminf _ (by is_bounded_default),
      filter_upwards [B] with _ hn,
      apply finset.sum_le_sum (λ i _, _),
      rw ennreal.rpow_nat_cast,
      exact pow_le_pow_of_le_left' (hn i) _,
    end
  ... = liminf (λ (n : ℕ), ∏ (i : ι), (⌈((b i : ℝ) - a i) * n⌉₊ : ℝ≥0∞) / n) at_top :
  begin
    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]
  end
  ... = ∏ (i : ι), volume (Ioo (a i : ℝ) (b i)) :
  begin
    simp only [real.volume_Ioo],
    apply tendsto.liminf_eq,
    refine ennreal.tendsto_finset_prod_of_ne_top _ (λ i hi, _) (λ i hi, _),
    { apply tendsto.congr' _ ((ennreal.continuous_of_real.tendsto _).comp
        ((tendsto_nat_ceil_mul_div_at_top (I i)).comp tendsto_coe_nat_at_top_at_top)),
      apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
      simp only [ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), comp_app,
        ennreal.of_real_coe_nat] },
    { simp only [ennreal.of_real_ne_top, ne.def, not_false_iff] }
  end
end

end measure_theory

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

open_locale measure_theory
open measure_theory measure_theory.measure

variables [measurable_space X] [borel_space X] [measurable_space Y] [borel_space Y]

namespace holder_on_with

variables {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`. -/
lemma hausdorff_measure_image_le (h : holder_on_with C r f s) (hr : 0 < r) {d : ℝ} (hd : 0 ≤ d) :
  μH[d] (f '' s) ≤ C ^ d * μH[r * d] s :=
begin
  -- 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, mul_zero, image_empty] },
    have : f '' s = {f x},
    { have : (f '' s).subsingleton, by simpa [diam_eq_zero_iff] using h.ediam_image_le,
      exact (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, 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_supr, ennreal.mul_infi_of_ne hCd0 hCd,
      ← ennreal.tsum_mul_left],
    refine supr_le (λ R, supr_le $ λ hR, _),
    have : tendsto (λ d : ℝ≥0∞, (C : ℝ≥0∞) * d ^ (r : ℝ)) (𝓝 0) (𝓝 0),
      from 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_supr₂_of_le δ δ0 (infi₂_mono' $ λ t hst, ⟨λ n, f '' (t n ∩ s), _, infi_mono' $ λ htδ,
      ⟨λ 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 (λ n, _),
      simp only [supr_le_iff, nonempty_image_iff],
      assume hft,
      simp only [nonempty.mono ((t n).inter_subset_left s) hft, csupr_pos],
      rw [ennreal.rpow_mul, ← ennreal.mul_rpow_of_nonneg _ _ hd],
      exact ennreal.rpow_le_rpow (h.ediam_image_inter_le _) hd } }
end

end holder_on_with

namespace lipschitz_on_with

variables {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`. -/
lemma hausdorff_measure_image_le (h : lipschitz_on_with 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

end lipschitz_on_with

namespace lipschitz_with

variables {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`.-/
lemma hausdorff_measure_image_le (h : lipschitz_with K f) {d : ℝ} (hd : 0 ≤ d) (s : set X) :
  μH[d] (f '' s) ≤ K ^ d * μH[d] s :=
(h.lipschitz_on_with s).hausdorff_measure_image_le hd

end lipschitz_with

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

namespace antilipschitz_with

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

lemma hausdorff_measure_preimage_le (hf : antilipschitz_with K f) (hd : 0 ≤ d) (s : set Y) :
  μH[d] (f ⁻¹' s) ≤ K ^ d * μH[d] s :=
begin
  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},
    { haveI : subsingleton X := hf.subsingleton,
      have : (f ⁻¹' s).subsingleton, from 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, 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_supr, ennreal.mul_infi_of_ne hKd0 hKd,
    ← ennreal.tsum_mul_left],
  refine supr₂_le (λ ε ε0, _),
  refine le_supr₂_of_le (ε / K) (by simp [ε0.ne']) _,
  refine le_infi₂ (λ t hst, le_infi $ λ htε, _),
  replace hst : f ⁻¹' s ⊆ _ := preimage_mono hst, rw preimage_Union at hst,
  refine infi₂_le_of_le _ hst (infi_le_of_le (λ n, _) _),
  { exact (hf.ediam_preimage_le _).trans (ennreal.mul_le_of_le_div' $ htε n) },
  { refine ennreal.tsum_le_tsum (λ n, supr_le_iff.2 (λ hft, _)),
    simp only [nonempty_of_nonempty_preimage hft, csupr_pos],
    rw [← ennreal.mul_rpow_of_nonneg _ _ hd],
    exact ennreal.rpow_le_rpow (hf.ediam_preimage_le _) hd }
end

lemma le_hausdorff_measure_image (hf : antilipschitz_with 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.hausdorff_measure_preimage_le hd (f '' s)

end antilipschitz_with

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

namespace isometry

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

lemma hausdorff_measure_image (hf : isometry f) (hd : 0 ≤ d ∨ surjective f) (s : set X) :
  μH[d] (f '' s) = μH[d] s :=
begin
  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 λ hd x y hxy, ennreal.rpow_le_rpow hxy hd
end

lemma hausdorff_measure_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]

lemma map_hausdorff_measure (hf : isometry f) (hd : 0 ≤ d ∨ surjective f) :
  measure.map f μH[d] = (μH[d]).restrict (range f) :=
begin
  ext1 s hs,
  rw [map_apply hf.continuous.measurable hs, restrict_apply hs, hf.hausdorff_measure_preimage hd]
end

end isometry

namespace isometry_equiv

@[simp] lemma hausdorff_measure_image (e : X ≃ᵢ Y) (d : ℝ) (s : set X) :
  μH[d] (e '' s) = μH[d] s :=
e.isometry.hausdorff_measure_image (or.inr e.surjective) s

@[simp] lemma hausdorff_measure_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]

end isometry_equiv


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison, Adam Topaz
-/

import category_theory.skeletal
import tactic.linarith
import data.fintype.sort
import order.category.NonemptyFinLinOrd

/-! # The simplex category

We construct a skeletal model of the simplex category, with objects `ℕ` and the
morphism `n ⟶ m` being the monotone maps from `fin (n+1)` to `fin (m+1)`.

We show that this category is equivalent to `NonemptyFinLinOrd`.

## Remarks

The definitions `simplex_category` and `simplex_category.hom` are marked as irreducible.

We provide the following functions to work with these objects:
1. `simplex_category.mk` creates an object of `simplex_category` out of a natural number.
  Use the notation `[n]` in the `simplicial` locale.
2. `simplex_category.len` gives the "length" of an object of `simplex_category`, as a natural.
3. `simplex_category.hom.mk` makes a morphism out of a monotone map between `fin`'s.
4. `simplex_category.hom.to_order_hom` gives the underlying monotone map associated to a
  term of `simplex_category.hom`.

-/

universes u v

open category_theory

/-- The simplex category:
* objects are natural numbers `n : ℕ`
* morphisms from `n` to `m` are monotone functions `fin (n+1) → fin (m+1)`
-/
@[derive inhabited, irreducible]
def simplex_category := ulift.{u} ℕ

namespace simplex_category

section
local attribute [semireducible] simplex_category

-- TODO: Make `mk` irreducible.
/-- Interpet a natural number as an object of the simplex category. -/
def mk (n : ℕ) : simplex_category.{u} := ulift.up n

localized "notation `[`n`]` := simplex_category.mk n" in simplicial

-- TODO: Make `len` irreducible.
/-- The length of an object of `simplex_category`. -/
def len (n : simplex_category.{u}) : ℕ := n.down

@[ext] lemma ext (a b : simplex_category.{u}) : a.len = b.len → a = b := ulift.ext a b
@[simp] lemma len_mk (n : ℕ) : [n].len = n := rfl
@[simp] lemma mk_len (n : simplex_category.{u}) : [n.len] = n := by {cases n, refl}

/-- Morphisms in the simplex_category. -/
@[irreducible, nolint has_inhabited_instance]
protected def hom (a b : simplex_category.{u}) : Type u :=
ulift (fin (a.len + 1) →o fin (b.len + 1))

namespace hom

local attribute [semireducible] simplex_category.hom

/-- Make a moprhism in `simplex_category` from a monotone map of fin's. -/
def mk {a b : simplex_category.{u}} (f : fin (a.len + 1) →o fin (b.len + 1)) :
  simplex_category.hom a b :=
ulift.up f

/-- Recover the monotone map from a morphism in the simplex category. -/
def to_order_hom {a b : simplex_category.{u}} (f : simplex_category.hom a b) :
  fin (a.len + 1) →o fin (b.len + 1) :=
ulift.down f

@[ext] lemma ext {a b : simplex_category.{u}} (f g : simplex_category.hom a b) :
  f.to_order_hom = g.to_order_hom → f = g := ulift.ext _ _

@[simp] lemma mk_to_order_hom {a b : simplex_category.{u}}
  (f : simplex_category.hom a b) : mk (f.to_order_hom) = f :=
by {cases f, refl}

@[simp] lemma to_order_hom_mk {a b : simplex_category.{u}}
  (f : fin (a.len + 1) →o fin (b.len + 1)) : (mk f).to_order_hom = f :=
by simp [to_order_hom, mk]

lemma mk_to_order_hom_apply {a b : simplex_category.{u}}
  (f : fin (a.len + 1) →o fin (b.len + 1)) (i : fin (a.len + 1)) :
  (mk f).to_order_hom i = f i := rfl

/-- Identity morphisms of `simplex_category`. -/
@[simp]
def id (a : simplex_category.{u}) :
  simplex_category.hom a a :=
mk order_hom.id

/-- Composition of morphisms of `simplex_category`. -/
@[simp]
def comp {a b c : simplex_category.{u}} (f : simplex_category.hom b c)
  (g : simplex_category.hom a b) : simplex_category.hom a c :=
mk $ f.to_order_hom.comp g.to_order_hom

end hom

@[simps]
instance small_category : small_category.{u} simplex_category :=
{ hom := λ n m, simplex_category.hom n m,
  id := λ m, simplex_category.hom.id _,
  comp := λ _ _ _ f g, simplex_category.hom.comp g f, }

/-- The constant morphism from [0]. -/
def const (x : simplex_category.{u}) (i : fin (x.len+1)) : [0] ⟶ x :=
  hom.mk $ ⟨λ _, i, by tauto⟩

@[simp]
lemma const_comp (x y : simplex_category.{u}) (i : fin (x.len + 1)) (f : x ⟶ y) :
  const x i ≫ f = const y (f.to_order_hom i) := rfl

/--
Make a morphism `[n] ⟶ [m]` from a monotone map between fin's.
This is useful for constructing morphisms beetween `[n]` directly
without identifying `n` with `[n].len`.
-/
@[simp]
def mk_hom {n m : ℕ} (f : (fin (n+1)) →o (fin (m+1))) : [n] ⟶ [m] :=
simplex_category.hom.mk f

lemma hom_zero_zero (f : [0] ⟶ [0]) : f = 𝟙 _ :=
by { ext : 2, dsimp, apply subsingleton.elim }

end

open_locale simplicial

section generators
/-!
## Generating maps for the simplex category

TODO: prove that the simplex category is equivalent to
one given by the following generators and relations.
-/

/-- The `i`-th face map from `[n]` to `[n+1]` -/
def δ {n} (i : fin (n+2)) : [n] ⟶ [n+1] :=
mk_hom (fin.succ_above i).to_order_hom

/-- The `i`-th degeneracy map from `[n+1]` to `[n]` -/
def σ {n} (i : fin (n+1)) : [n+1] ⟶ [n] := mk_hom
{ to_fun := fin.pred_above i,
  monotone' := fin.pred_above_right_monotone i }

/-- The generic case of the first simplicial identity -/
lemma δ_comp_δ {n} {i j : fin (n+2)} (H : i ≤ j) :
  δ i ≫ δ j.succ = δ j ≫ δ i.cast_succ :=
begin
  ext k,
  dsimp [δ, fin.succ_above],
  simp only [order_embedding.to_order_hom_coe,
    order_embedding.coe_of_strict_mono,
    function.comp_app,
    simplex_category.hom.to_order_hom_mk,
    order_hom.comp_coe],
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  rcases k with ⟨k, _⟩,
  split_ifs; { simp at *; linarith },
end

/-- The special case of the first simplicial identity -/
lemma δ_comp_δ_self {n} {i : fin (n+2)} : δ i ≫ δ i.cast_succ = δ i ≫ δ i.succ :=
(δ_comp_δ (le_refl i)).symm

/-- The second simplicial identity -/
lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) :
  δ i.cast_succ ≫ σ j.succ = σ j ≫ δ i :=
begin
  ext k,
  suffices : ite (j.succ.cast_succ < ite (k < i) k.cast_succ k.succ)
    (ite (k < i) (k:ℕ) (k + 1) - 1) (ite (k < i) k (k + 1)) =
      ite ((if h : (j:ℕ) < k
        then k.pred (by { rintro rfl, exact nat.not_lt_zero _ h })
        else k.cast_lt (by { cases j, cases k, simp only [len_mk], linarith })).cast_succ < i)
          (ite (j.cast_succ < k) (k - 1) k) (ite (j.cast_succ < k) (k - 1) k + 1),
  { dsimp [δ, σ, fin.succ_above, fin.pred_above],
    simpa [fin.pred_above] with push_cast },
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  rcases k with ⟨k, _⟩,
  simp only [subtype.mk_le_mk, fin.cast_succ_mk] at H,
  dsimp, simp only [if_congr, subtype.mk_lt_mk, dif_ctx_congr],
  split_ifs,
  -- Most of the goals can now be handled by `linarith`,
  -- but we have to deal with two of them by hand.
  swap 8,
  { exact (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) ‹_›)).symm, },
  swap 7,
  { have : k ≤ i := nat.le_of_pred_lt ‹_›, linarith, },
  -- Hope for the best from `linarith`:
  all_goals { try { refl <|> simp at * }; linarith, },
end

/-- The first part of the third simplicial identity -/
lemma δ_comp_σ_self {n} {i : fin (n+1)} :
  δ i.cast_succ ≫ σ i = 𝟙 [n] :=
begin
  ext j,
  suffices : ite (fin.cast_succ i < ite (j < i) (fin.cast_succ j) j.succ)
    (ite (j < i) (j:ℕ) (j + 1) - 1) (ite (j < i) j (j + 1)) = j,
  { dsimp [δ, σ, fin.succ_above, fin.pred_above], simpa [fin.pred_above] with push_cast },
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  dsimp, simp only [if_congr, subtype.mk_lt_mk],
  split_ifs; { simp at *; linarith, },
end

/-- The second part of the third simplicial identity -/
lemma δ_comp_σ_succ {n} {i : fin (n+1)} :
  δ i.succ ≫ σ i = 𝟙 [n] :=
begin
  ext j,
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  dsimp [δ, σ, fin.succ_above, fin.pred_above],
  simp [fin.pred_above] with push_cast,
  split_ifs; { simp at *; linarith, },
end

/-- The fourth simplicial identity -/
lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) :
  δ i.succ ≫ σ j.cast_succ = σ j ≫ δ i :=
begin
  ext k,
  dsimp [δ, σ, fin.succ_above, fin.pred_above],
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  rcases k with ⟨k, _⟩,
  simp only [subtype.mk_lt_mk, fin.cast_succ_mk] at H,
  suffices : ite (_ < ite (k < i + 1) _ _) _ _ =
    ite _ (ite (j < k) (k - 1) k) (ite (j < k) (k - 1) k + 1),
  { simpa [apply_dite fin.cast_succ, fin.pred_above] with push_cast, },
  split_ifs,
  -- Most of the goals can now be handled by `linarith`,
  -- but we have to deal with three of them by hand.
  swap 2,
  { simp only [subtype.mk_lt_mk] at h_1,
    simp only [not_lt] at h_2,
    simp only [self_eq_add_right, one_ne_zero],
    exact lt_irrefl (k - 1) (lt_of_lt_of_le
      (nat.pred_lt (ne_of_lt (lt_of_le_of_lt (zero_le _) h_1)).symm)
      (le_trans (nat.le_of_lt_succ h) h_2)) },
  swap 4,
  { simp only [subtype.mk_lt_mk] at h_1,
    simp only [not_lt] at h,
    simp only [nat.add_succ_sub_one, add_zero],
    exfalso,
    exact lt_irrefl _ (lt_of_le_of_lt (nat.le_pred_of_lt (nat.lt_of_succ_le h)) h_3), },
  swap 4,
  { simp only [subtype.mk_lt_mk] at h_1,
    simp only [not_lt] at h_3,
    simp only [nat.add_succ_sub_one, add_zero],
    exact (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) h_2)).symm, },
  -- Hope for the best from `linarith`:
  all_goals { simp at h_1 h_2 ⊢; linarith, },
end

local attribute [simp] fin.pred_mk

/-- The fifth simplicial identity -/
lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) :
  σ i.cast_succ ≫ σ j = σ j.succ ≫ σ i :=
begin
  ext k,
  dsimp [σ, fin.pred_above],
  rcases i with ⟨i, _⟩,
  rcases j with ⟨j, _⟩,
  rcases k with ⟨k, _⟩,
  simp only [subtype.mk_le_mk] at H,
  -- At this point `simp with push_cast` makes good progress, but neither `simp?` nor `squeeze_simp`
  -- return usable sets of lemmas.
  -- To avoid using a non-terminal simp, we make a `suffices` statement indicating the shape
  -- of the goal we're looking for, and then use `simpa with push_cast`.
  -- I'm not sure this is actually much more robust that a non-terminal simp.
  suffices : ite (_ < dite (i < k) _ _) _ _ =
    ite (_ < dite (j + 1 < k) _ _) _ _,
  { simpa [fin.pred_above] with push_cast, },
  split_ifs,
  -- `split_ifs` created 12 goals.
  -- Most of them are dealt with `by simp at *; linarith`,
  -- but we pull out two harder ones to do by hand.
  swap 3,
  { simp only [not_lt] at h_2,
    exact false.elim
    (lt_irrefl (k - 1)
      (lt_of_lt_of_le (nat.pred_lt (id (ne_of_lt (lt_of_le_of_lt (zero_le i) h)).symm))
        (le_trans h_2 (nat.succ_le_of_lt h_1)))) },
  swap 3,
  { simp only [subtype.mk_lt_mk, not_lt] at h_1,
    exact false.elim
    (lt_irrefl j (lt_of_lt_of_le (nat.pred_lt_pred (nat.succ_ne_zero j) h_2) h_1)) },
  -- Deal with the rest automatically.
  all_goals { simp at *; linarith, },
end

end generators

section skeleton

/-- The functor that exhibits `simplex_category` as skeleton
of `NonemptyFinLinOrd` -/
@[simps obj map]
def skeletal_functor : simplex_category.{u} ⥤ NonemptyFinLinOrd.{v} :=
{ obj := λ a, NonemptyFinLinOrd.of $ ulift (fin (a.len + 1)),
  map := λ a b f,
    ⟨λ i, ulift.up (f.to_order_hom i.down), λ i j h, f.to_order_hom.monotone h⟩,
  map_id' := λ a, by { ext, simp, },
  map_comp' := λ a b c f g, by { ext, simp, }, }

lemma skeletal : skeletal simplex_category.{u} :=
λ X Y ⟨I⟩,
begin
  suffices : fintype.card (fin (X.len+1)) = fintype.card (fin (Y.len+1)),
  { ext, simpa },
  { apply fintype.card_congr,
    refine equiv.ulift.symm.trans (((skeletal_functor ⋙ forget _).map_iso I).to_equiv.trans _),
    apply equiv.ulift }
end

namespace skeletal_functor

instance : full skeletal_functor.{u v} :=
{ preimage := λ a b f, simplex_category.hom.mk ⟨λ i, (f (ulift.up i)).down, λ i j h, f.monotone h⟩,
  witness' := by { intros m n f, dsimp at *, ext1 ⟨i⟩, ext1, ext1, cases x, simp, } }

instance : faithful skeletal_functor.{u v} :=
{ map_injective' := λ m n f g h,
  begin
    ext1, ext1, ext1 i, apply ulift.up.inj,
    change (skeletal_functor.map f) ⟨i⟩ = (skeletal_functor.map g) ⟨i⟩,
    rw h,
  end }

instance : ess_surj skeletal_functor.{u v} :=
{ mem_ess_image := λ X, ⟨mk (fintype.card X - 1 : ℕ), ⟨begin
    have aux : fintype.card X = fintype.card X - 1 + 1,
    { exact (nat.succ_pred_eq_of_pos $ fintype.card_pos_iff.mpr ⟨⊥⟩).symm, },
    let f := mono_equiv_of_fin X aux,
    have hf := (finset.univ.order_emb_of_fin aux).strict_mono,
    refine
    { hom := ⟨λ i, f i.down, _⟩,
      inv := ⟨λ i, ⟨f.symm i⟩, _⟩,
      hom_inv_id' := _,
      inv_hom_id' := _ },
    { rintro ⟨i⟩ ⟨j⟩ h, show f i ≤ f j, exact hf.monotone h, },
    { intros i j h, show f.symm i ≤ f.symm j, rw ← hf.le_iff_le,
      show f (f.symm i) ≤ f (f.symm j), simpa only [order_iso.apply_symm_apply], },
    { ext1, ext1 ⟨i⟩, ext1, exact f.symm_apply_apply i },
    { ext1, ext1 i, exact f.apply_symm_apply i },
  end⟩⟩, }

noncomputable instance is_equivalence : is_equivalence skeletal_functor.{u v} :=
equivalence.of_fully_faithfully_ess_surj skeletal_functor

end skeletal_functor

/-- The equivalence that exhibits `simplex_category` as skeleton
of `NonemptyFinLinOrd` -/
noncomputable def skeletal_equivalence : simplex_category.{u} ≌ NonemptyFinLinOrd.{v} :=
functor.as_equivalence skeletal_functor

end skeleton

/--
`simplex_category` is a skeleton of `NonemptyFinLinOrd`.
-/
noncomputable
def is_skeleton_of : is_skeleton_of NonemptyFinLinOrd simplex_category skeletal_functor.{u v} :=
{ skel := skeletal,
  eqv := skeletal_functor.is_equivalence }

/-- The truncated simplex category. -/
@[derive small_category]
def truncated (n : ℕ) := {a : simplex_category.{u} // a.len ≤ n}

namespace truncated

instance {n} : inhabited (truncated n) := ⟨⟨[0],by simp⟩⟩

/--
The fully faithful inclusion of the truncated simplex category into the usual
simplex category.
-/
@[derive [full, faithful]]
def inclusion {n : ℕ} : simplex_category.truncated.{u} n ⥤ simplex_category.{u} :=
full_subcategory_inclusion _

end truncated

section concrete

instance : concrete_category.{0} simplex_category.{u} :=
{ forget :=
  { obj := λ i, fin (i.len + 1),
    map := λ i j f, f.to_order_hom },
  forget_faithful := {} }

end concrete

section epi_mono

/-- A morphism in `simplex_category` is a monomorphism precisely when it is an injective function
-/
theorem mono_iff_injective {n m : simplex_category.{u}} {f : n ⟶ m} :
  mono f ↔ function.injective f.to_order_hom :=
begin
  split,
  { introsI m x y h,
    have H : const n x ≫ f = const n y ≫ f,
    { dsimp, rw h },
    change (n.const x).to_order_hom 0 = (n.const y).to_order_hom 0,
    rw cancel_mono f at H,
    rw H },
  { exact concrete_category.mono_of_injective f }
end

/-- A morphism in `simplex_category` is an epimorphism if and only if it is a surjective function
-/
lemma epi_iff_surjective {n m : simplex_category.{u}} {f: n ⟶ m} :
  epi f ↔ function.surjective f.to_order_hom :=
begin
  split,
  { introsI hyp_f_epi x,
    by_contra' h_ab,
    -- The proof is by contradiction: assume f is not surjective,
    -- then introduce two non-equal auxiliary functions equalizing f, and get a contradiction.
    -- First we define the two auxiliary functions.
    set chi_1 : m ⟶ [1] := hom.mk ⟨λ u, if u ≤ x then 0 else 1, begin
      intros a b h,
      dsimp only [],
      split_ifs with h1 h2 h3,
      any_goals { exact le_rfl },
      { exact bot_le },
      { exact false.elim (h1 (le_trans h h3)) }
    end ⟩,
    set chi_2 : m ⟶ [1] := hom.mk ⟨λ u, if u < x then 0 else 1, begin
      intros a b h,
      dsimp only [],
      split_ifs with h1 h2 h3,
      any_goals { exact le_rfl },
      { exact bot_le },
      { exact false.elim (h1 (lt_of_le_of_lt h h3)) }
    end ⟩,
    -- The two auxiliary functions equalize f
    have f_comp_chi_i : f ≫ chi_1 = f ≫ chi_2,
    { dsimp,
      ext,
      simp [le_iff_lt_or_eq, h_ab x_1] },
    -- We now just have to show the two auxiliary functions are not equal.
    rw category_theory.cancel_epi f at f_comp_chi_i, rename f_comp_chi_i eq_chi_i,
    apply_fun (λ e, e.to_order_hom x) at eq_chi_i,
    suffices : (0 : fin 2) = 1, by exact bot_ne_top this,
    simpa using eq_chi_i },
  { exact concrete_category.epi_of_surjective f }
end

/-- A monomorphism in `simplex_category` must increase lengths-/
lemma len_le_of_mono {x y : simplex_category.{u}} {f : x ⟶ y} :
  mono f → (x.len ≤ y.len) :=
begin
  intro hyp_f_mono,
  have f_inj : function.injective f.to_order_hom.to_fun,
  { exact mono_iff_injective.elim_left (hyp_f_mono) },
  simpa using fintype.card_le_of_injective f.to_order_hom.to_fun f_inj,
end

/-- An epimorphism in `simplex_category` must decrease lengths-/
lemma len_le_of_epi {x y : simplex_category.{u}} {f : x ⟶ y} :
  epi f → y.len ≤ x.len :=
begin
  intro hyp_f_epi,
  have f_surj : function.surjective f.to_order_hom.to_fun,
  { exact epi_iff_surjective.elim_left (hyp_f_epi) },
  simpa using fintype.card_le_of_surjective f.to_order_hom.to_fun f_surj,
end

lemma le_of_epi {n m : ℕ} {f : [n] ⟶ [m]} : epi f → (m ≤ n) :=
len_le_of_epi

end epi_mono

end simplex_category


/-
 Description : Formalization of islanders problem for two people.
 Copyright   : (c) Daniel Selsam, 2018
 License     : GPL-3
-/

import .util .knows .problem

theorem islanders_n2 : islanders 2 :=

assume everyone_sees :
  ∀ (d₁ d₂ : day) (p₁ p₂ : person), p₂ ≠ p₁ → common_knowledge (is_marked p₂ → knows d₂ p₁ (is_marked p₂)) d₁
                                            ∧ common_knowledge (¬ is_marked p₂ → knows d₂ p₁ (¬ is_marked p₂)) d₁,

assume oracle :
  ∀ (d : day) (p : person) (k : ℕ), common_knowledge (knows (d+1) p (reduce_or (list.map is_marked (list.range 2)))) (d+1+k),

assume nobody_leaves :
  ∀ (d : day) (p : person), d+1 < 2 → common_knowledge (¬ knows (d+1) p (is_marked p)) (d+2),

have H1 : knows 1 1 (¬ is_marked 1 → knows 1 0 (is_marked 0 ∨ is_marked 1)), from
  knows_lam 1 1 1 [] (λ _, oracle 0 0 0 [1]),

have H2 : knows 1 1 (¬ is_marked 1 → knows 1 0 (¬ is_marked 1)), from
  and.right (everyone_sees 1 1 0 1 (ne.symm nat.zero_ne_one)) [1],

have H3 : knows 1 1 (¬ is_marked 1) → knows 1 1 (knows 1 0 (is_marked 0)), from
  assume h1 : knows 1 1 (¬ is_marked 1),
  show knows 1 1 (knows 1 0 (is_marked 0)), from
  have h2 : knows 1 1 (knows 1 0 (is_marked 0 ∨ is_marked 1)), from knows_mp 0 1 1 1 [] [] H1 h1,
  have h3 : knows 1 1 (knows 1 0 (¬ is_marked 1)), from knows_mp 0 1 1 1 [] [] H2 h1,
  knows_cancel_or 0 _ _ _ [1] [] h2 h3,

have H4 : knows 2 1 (¬ is_marked 1 → knows 1 0 (is_marked 0)), from
  knows_persists 0 1 1 [] (knows_lam 0 1 1 [] H3),

have H5 : knows 2 1 (¬ knows 1 0 (is_marked 0)), from
  nobody_leaves 0 0 (nat.lt_succ_self 1) [1],

show knows 2 1 (is_marked 1), from
  knows_dneg 0 _ _ [] (knows_cancel_imp 0 0 _ _ [] [] H4 H5)


import measure_theory.interval_integral
import measure_theory.integration
import topology.basic

import picard_lindelof.domain

open set measure_theory topological_space interval_integral

variables {E : Type*}
    [normed_field E] [normed_space ℝ E] [second_countable_topology E]
    [measurable_space E] [linear_order E] [complete_space E] [borel_space E]

lemma temp.norm_integral_le_integral_norm_Ioc_of_le
{a b : α} {f : α → E} {μ : measure α} (h : a ≤ b)
: ∥∫ x in a..b, f x ∂μ∥ ≤ ∫ x in a..b, ∥f x∥ ∂μ :=
begin
    rw [integral_of_le h, integral_of_le h],
    have hle := @norm_integral_le_integral_norm_Ioc α E _ _ _ _ _ _ _ _ a b f μ,
    rw [integral_of_le h, max_eq_right h, min_eq_left h] at hle,
    exact hle,
end

--TODO: Move.
lemma temp.norm_integral_le_of_norm_le_const_ae {a b : α} {C : ℝ} {f : α → E}
  (h : filter.eventually (λ x, x ∈ Ioc (min a b) (max a b) → ∥f x∥ ≤ C) volume.ae) :
  ∥∫ x in a..b, f x∥ ≤ C * abs (b.val - a.val) :=
begin
  rw [norm_integral_eq_norm_integral_Ioc],
  have hrw : ∀ {a b : α}, volume (Ioc a b) = ennreal.of_real (b.1 - a.1) := λ a b, α.volume_Ioc,
  convert norm_set_integral_le_of_norm_le_const_ae'' _ is_measurable_Ioc h,
  { have hmax : (max a b).val = max a.val b.val := by unfold max; split_ifs; refl,
    have hmin : (min a b).val = min a.val b.val := by unfold min; split_ifs; refl,
    rw [hrw, hmax, hmin, max_sub_min_eq_abs, ennreal.to_real_of_real (abs_nonneg _)], },
  { simp only [hrw, ennreal.of_real_lt_top], }
end

lemma temp.norm_integral_le_of_norm_le_const {a b : α} {C : ℝ} {f : α → E}
  (h : ∀ x ∈ Ioc (min a b) (max a b), ∥f x∥ ≤ C) :
  ∥∫ x in a..b, f x∥ ≤ C * abs (b.val - a.val) :=
temp.norm_integral_le_of_norm_le_const_ae (filter.eventually_of_forall h)

-- TODO: Move
variables {α : Type*} [measurable_space α]
variables {μ : measure α}

#check has_finite_integral_iff_of_real
#check @ennreal.exists_inv_nat_lt
#check @measure_theory.integral_eq_zero_of_ae
#print normed_space
#check le_integral

lemma integral_eq_zero_iff_of_nonneg_ae' {f : α → E} (hf : 0 ≤ᵐ[μ] f) (hfi : integrable f μ) :
  ∫ x, f x ∂μ = 0 ↔ f =ᵐ[μ] 0 :=
begin
  split,
  { intros h,
    have : ∀n:ℕ, ∀ᵐ a ∂μ, f a < n⁻¹,
    { intros n, rw [ae_iff, ←le_zero_iff_eq],
      simp only [not_lt],
      sorry, },
    refine (ae_all_iff.2 this).mono (λ a ha, _),
    by_contradiction h, sorry, },
  { intros h, convert integral_eq_zero_of_ae h, },
end

-- @[simp] lemma lintegral_eq_zero_iff {f : α → ennreal} (hf : measurable f) :
--   ∫⁻ a, f a ∂μ = 0 ↔ (f =ᵐ[μ] 0) :=
-- begin
--   refine iff.intro (assume h, _) (assume h, _),
--   { have : ∀n:ℕ, ∀ᵐ a ∂μ, f a < n⁻¹,
--     { assume n,
--       rw [ae_iff, ← le_zero_iff_eq, ← @ennreal.zero_div n⁻¹,
--         ennreal.le_div_iff_mul_le, mul_comm],
--       simp only [not_lt],
--       -- TODO: why `rw ← h` fails with "not an equality or an iff"?
--       exacts [h ▸ mul_meas_ge_le_lintegral hf n⁻¹,
--         or.inl (ennreal.inv_ne_zero.2 ennreal.coe_nat_ne_top),
--         or.inr ennreal.zero_ne_top] },
--     refine (ae_all_iff.2 this).mono (λ a ha, _),
--     by_contradiction h,
--     rcases ennreal.exists_inv_nat_lt h with ⟨n, hn⟩,
--     exact (lt_irrefl _ $ lt_trans hn $ ha n).elim },
--   { calc ∫⁻ a, f a ∂μ = ∫⁻ a, 0 ∂μ : lintegral_congr_ae h
--       ... = 0 : lintegral_zero }
-- end

--integral_eq_zero_iff_of_nonneg_ae

lemma integral_eq_zero_iff_of_le_of_nonneg_ae' {f : ℝ → E} {a b : ℝ} (hab : a ≤ b)
  (hf : 0 ≤ᵐ[volume.restrict (Ioc a b)] f) (hfi : interval_integrable f volume a b) :
  ∫ x in a..b, f x = 0 ↔ f =ᵐ[volume.restrict (Ioc a b)] 0 :=
by rw [integral_of_le hab, integral_eq_zero_iff_of_nonneg_ae' hf hfi.1]

-- lemma temp.integral_mono_ae {f g : α → E} (a b : α)
-- (hf : interval_integrable f volume a b) (hg : interval_integrable g volume a b) (h : f ≤ᵐ[volume] g)
-- : ∫ t in a..b, f t ≤ ∫ t in a..b, g t := sorry

-- lemma temp.integral_mono {f g : α → E} (a b : α)
-- (hf : interval_integrable f volume a b) (hg : interval_integrable g volume a b) (h : f ≤ g)
-- : ∫ t in a..b, f t ≤ ∫ t in a..b, g t := sorry


inductive zfc : Type
| empty  : zfc
| insert : zfc → zfc → zfc

instance : has_emptyc zfc := ⟨zfc.empty⟩
instance : has_insert zfc zfc := ⟨zfc.insert⟩

instance : has_zero zfc := ⟨{}⟩
instance : has_one zfc := ⟨{0}⟩

def succ (a : zfc) : zfc := has_insert.insert a a

def zfc_add : zfc → zfc → zfc
| m 0 := m
| m (zfc.insert n p) := succ (zfc_add m n)

instance : has_add zfc := ⟨zfc_add⟩

inductive member : zfc → zfc → Prop
| left {a b c : zfc} : member a c → member a (has_insert.insert b c)
| right {a b : zfc} : member a (has_insert.insert a b)

instance : has_mem zfc zfc := ⟨member⟩
instance : has_subset zfc := ⟨(λ a b:zfc, (∀ z:zfc, z ∈ a → z ∈ b))⟩

axiom member.ext (a b : zfc) : (∀ x, x ∈ a ↔ x ∈ b) ↔ a=b

export zfc
export member

definition A : zfc := {1,2,3,4,5}

theorem M1F_Sheet01_Q05a_is_true : (1:zfc) ∈ A :=
begin
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05b_is_false: ({1}:zfc) ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05c_is_true: ({1}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05d_is_true: ({1,2}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    left, left, left, left, right,
    left, left, left, right
end

theorem M1F_Sheet01_Q05e_is_true: ({1,2,1}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    left, left, left, left, right,
    left, left, left, right,
    left, left, left, left, right
end

theorem M1F_Sheet01_Q05f_is_false: ({1,1}:zfc) ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05g_is_false: A ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3,
    cases a_4,
    cases a_5
end

theorem M1F_Sheet01_Q05h_is_true: A ⊇ A :=
begin
    intro h,
    exact id
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Johannes Hölzl
-/
import order.conditionally_complete_lattice
import logic.function.iterate
import order.rel_iso

/-!
# Order continuity

We say that a function is *left order continuous* if it sends all least upper bounds
to least upper bounds. The order dual notion is called *right order continuity*.

For monotone functions `ℝ → ℝ` these notions correspond to the usual left and right continuity.

We prove some basic lemmas (`map_sup`, `map_Sup` etc) and prove that an `rel_iso` is both left
and right order continuous.
-/

universes u v w x

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

open set function

/-!
### Definitions
-/

/-- A function `f` between preorders is left order continuous if it preserves all suprema.  We
define it using `is_lub` instead of `Sup` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def left_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_lub s x → is_lub (f '' s) (f x)

/-- A function `f` between preorders is right order continuous if it preserves all infima.  We
define it using `is_glb` instead of `Inf` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def right_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_glb s x → is_glb (f '' s) (f x)

namespace left_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : left_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual (hf : left_ord_continuous f) :
  @right_ord_continuous (order_dual α) (order_dual β) _ _ f := hf

lemma map_is_greatest (hf : left_ord_continuous f) {s : set α} {x : α} (h : is_greatest s x):
  is_greatest (f '' s) (f x) :=
⟨mem_image_of_mem f h.1, (hf h.is_lub).1⟩

lemma comp (hg : left_ord_continuous g) (hf : left_ord_continuous f) :
  left_ord_continuous (g ∘ f) :=
λ s x h, by simpa only [image_image] using hg (hf h)

protected lemma iterate {f : α → α} (hf : left_ord_continuous f) (n : ℕ) :
  left_ord_continuous (f^[n]) :=
nat.rec_on n (left_ord_continuous.id α) $ λ n ihn, ihn.comp hf

end preorder

section semilattice_sup

variables [semilattice_sup α] [semilattice_sup β] {f : α → β}

lemma map_sup (hf : left_ord_continuous f) (x y : α) :
  f (x ⊔ y) = f x ⊔ f y :=
(hf is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

lemma le_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
by simp only [← sup_eq_right, ← hf.map_sup, h.eq_iff]

lemma lt_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
by simp only [lt_iff_le_not_le, hf.le_iff h]

variable (f)

/-- Convert an injective left order continuous function to an order embedding. -/
def to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_sup

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Sup' (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = Sup (f '' s) :=
(hf $ is_lub_Sup s).Sup_eq.symm

lemma map_Sup (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = ⨆ x ∈ s, f x :=
by rw [hf.map_Sup', Sup_image]

lemma map_supr (hf : left_ord_continuous f) (g : ι → α) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_Sup', ← range_comp]

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cSup (hf : left_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_above s) :
  f (Sup s) = Sup (f '' s) :=
((hf $ is_lub_cSup sne sbdd).cSup_eq $ sne.image f).symm

lemma map_csupr (hf : left_ord_continuous f) {g : ι → α} (hg : bdd_above (range g)) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_cSup (range_nonempty _) hg, ← range_comp]

end conditionally_complete_lattice

end left_ord_continuous

namespace right_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : right_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual (hf : right_ord_continuous f) :
  @left_ord_continuous (order_dual α) (order_dual β) _ _ f := hf

lemma map_is_least (hf : right_ord_continuous f) {s : set α} {x : α} (h : is_least s x):
  is_least (f '' s) (f x) :=
hf.order_dual.map_is_greatest h

lemma mono (hf : right_ord_continuous f) : monotone f :=
hf.order_dual.mono.order_dual

lemma comp (hg : right_ord_continuous g) (hf : right_ord_continuous f) :
  right_ord_continuous (g ∘ f) :=
hg.order_dual.comp hf.order_dual

protected lemma iterate {f : α → α} (hf : right_ord_continuous f) (n : ℕ) :
  right_ord_continuous (f^[n]) :=
hf.order_dual.iterate n

end preorder

section semilattice_inf

variables [semilattice_inf α] [semilattice_inf β] {f : α → β}

lemma map_inf (hf : right_ord_continuous f) (x y : α) :
  f (x ⊓ y) = f x ⊓ f y :=
hf.order_dual.map_sup x y

lemma le_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
hf.order_dual.le_iff h

lemma lt_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
hf.order_dual.lt_iff h

variable (f)

/-- Convert an injective left order continuous function to a `order_embedding`. -/
def to_order_embedding (hf : right_ord_continuous f) (h : injective f) : α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : right_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_inf

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Inf' (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_Sup' s

lemma map_Inf (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = ⨅ x ∈ s, f x :=
hf.order_dual.map_Sup s

lemma map_infi (hf : right_ord_continuous f) (g : ι → α) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_supr g

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cInf (hf : right_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_below s) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_cSup sne sbdd

lemma map_cinfi (hf : right_ord_continuous f) {g : ι → α} (hg : bdd_below (range g)) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_csupr hg

end conditionally_complete_lattice

end right_ord_continuous

namespace order_iso

section preorder

variables [preorder α] [preorder β] (e : α ≃o β)
  {s : set α} {x : α}

protected lemma left_ord_continuous : left_ord_continuous e :=
λ s x hx,
⟨monotone.mem_upper_bounds_image (λ x y, e.map_rel_iff.2) hx.1,
  λ y hy, e.rel_symm_apply.1 $ (is_lub_le_iff hx).2 $ λ x' hx', e.rel_symm_apply.2 $ hy $
    mem_image_of_mem _ hx'⟩

protected lemma right_ord_continuous : right_ord_continuous e :=
order_iso.left_ord_continuous e.dual

end preorder

end order_iso


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

! This file was ported from Lean 3 source module group_theory.divisible
! leanprover-community/mathlib commit b6da1a0b3e7cd83b1f744c49ce48ef8c6307d2f6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Subgroup.Pointwise
import Mathbin.GroupTheory.QuotientGroup
import Mathbin.Algebra.Group.Pi

/-!
# Divisible Group and rootable group

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

In this file, we define a divisible add monoid and a rootable monoid with some basic properties.

## Main definition

* `divisible_by A α`: An additive monoid `A` is said to be divisible by `α` iff for all `n ≠ 0 ∈ α`
  and `y ∈ A`, there is an `x ∈ A` such that `n • x = y`. In this file, we adopt a constructive
  approach, i.e. we ask for an explicit `div : A → α → A` function such that `div a 0 = 0` and
  `n • div a n = a` for all `n ≠ 0 ∈ α`.
* `rootable_by A α`: A monoid `A` is said to be rootable by `α` iff for all `n ≠ 0 ∈ α` and `y ∈ A`,
  there is an `x ∈ A` such that `x^n = y`. In this file, we adopt a constructive approach, i.e. we
  ask for an explicit `root : A → α → A` function such that `root a 0 = 1` and `(root a n)ⁿ = a` for
  all `n ≠ 0 ∈ α`.

## Main results

For additive monoids and groups:

* `divisible_by_of_smul_right_surj` : the constructive definition of divisiblity is implied by
  the condition that `n • x = a` has solutions for all `n ≠ 0` and `a ∈ A`.
* `smul_right_surj_of_divisible_by` : the constructive definition of divisiblity implies
  the condition that `n • x = a` has solutions for all `n ≠ 0` and `a ∈ A`.
* `prod.divisible_by` : `A × B` is divisible for any two divisible additive monoids.
* `pi.divisible_by` : any product of divisble additive monoids is divisible.
* `add_group.divisible_by_int_of_divisible_by_nat` : for additive groups, int divisiblity is implied
  by nat divisiblity.
* `add_group.divisible_by_nat_of_divisible_by_int` : for additive groups, nat divisiblity is implied
  by int divisiblity.
* `add_comm_group.divisible_by_int_of_smul_top_eq_top`: the constructive definition of divisiblity
  is implied by the condition that `n • A = A` for all `n ≠ 0`.
* `add_comm_group.smul_top_eq_top_of_divisible_by_int`: the constructive definition of divisiblity
  implies the condition that `n • A = A` for all `n ≠ 0`.
* `divisible_by_int_of_char_zero` : any field of characteristic zero is divisible.
* `quotient_add_group.divisible_by` : quotient group of divisible group is divisible.
* `function.surjective.divisible_by` : if `A` is divisible and `A →+ B` is surjective, then `B`
  is divisible.

and their multiplicative counterparts:

* `rootable_by_of_pow_left_surj` : the constructive definition of rootablity is implied by the
  condition that `xⁿ = y` has solutions for all `n ≠ 0` and `a ∈ A`.
* `pow_left_surj_of_rootable_by` : the constructive definition of rootablity implies the
  condition that `xⁿ = y` has solutions for all `n ≠ 0` and `a ∈ A`.
* `prod.rootable_by` : any product of two rootable monoids is rootable.
* `pi.rootable_by` : any product of rootable monoids is rootable.
* `group.rootable_by_int_of_rootable_by_nat` : in groups, int rootablity is implied by nat
  rootablity.
* `group.rootable_by_nat_of_rootable_by_int` : in groups, nat rootablity is implied by int
  rootablity.
* `quotient_group.rootable_by` : quotient group of rootable group is rootable.
* `function.surjective.rootable_by` : if `A` is rootable and `A →* B` is surjective, then `B` is
  rootable.

TODO: Show that divisibility implies injectivity in the category of `AddCommGroup`.
-/

open Pointwise

section AddMonoid

variable (A α : Type _) [AddMonoid A] [SMul α A] [Zero α]

#print DivisibleBy /-
/--
An `add_monoid A` is `α`-divisible iff `n • x = a` has a solution for all `n ≠ 0 ∈ α` and `a ∈ A`.
Here we adopt a constructive approach where we ask an explicit `div : A → α → A` function such that
* `div a 0 = 0` for all `a ∈ A`
* `n • div a n = a` for all `n ≠ 0 ∈ α` and `a ∈ A`.
-/
class DivisibleBy where
  div : A → α → A
  div_zero : ∀ a, div a 0 = 0
  div_cancel : ∀ {n : α} (a : A), n ≠ 0 → n • div a n = a
#align divisible_by DivisibleBy
-/

end AddMonoid

section Monoid

variable (A α : Type _) [Monoid A] [Pow A α] [Zero α]

#print RootableBy /-
/-- A `monoid A` is `α`-rootable iff `xⁿ = a` has a solution for all `n ≠ 0 ∈ α` and `a ∈ A`.
Here we adopt a constructive approach where we ask an explicit `root : A → α → A` function such that
* `root a 0 = 1` for all `a ∈ A`
* `(root a n)ⁿ = a` for all `n ≠ 0 ∈ α` and `a ∈ A`.
-/
@[to_additive]
class RootableBy where
  root : A → α → A
  root_zero : ∀ a, root a 0 = 1
  root_cancel : ∀ {n : α} (a : A), n ≠ 0 → root a n ^ n = a
#align rootable_by RootableBy
#align divisible_by DivisibleBy
-/

/- warning: pow_left_surj_of_rootable_by -> pow_left_surj_of_rootableBy is a dubious translation:
lean 3 declaration is
  forall (A : Type.{u1}) (α : Type.{u2}) [_inst_1 : Monoid.{u1} A] [_inst_2 : Pow.{u1, u2} A α] [_inst_3 : Zero.{u2} α] [_inst_4 : RootableBy.{u1, u2} A α _inst_1 _inst_2 _inst_3] {n : α}, (Ne.{succ u2} α n (OfNat.ofNat.{u2} α 0 (OfNat.mk.{u2} α 0 (Zero.zero.{u2} α _inst_3)))) -> (Function.Surjective.{succ u1, succ u1} A A (fun (a : A) => HPow.hPow.{u1, u2, u1} A α A (instHPow.{u1, u2} A α _inst_2) a n))
but is expected to have type
  forall (A : Type.{u2}) (α : Type.{u1}) [_inst_1 : Monoid.{u2} A] [_inst_2 : Pow.{u2, u1} A α] [_inst_3 : Zero.{u1} α] [_inst_4 : RootableBy.{u2, u1} A α _inst_1 _inst_2 _inst_3] {n : α}, (Ne.{succ u1} α n (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_3))) -> (Function.Surjective.{succ u2, succ u2} A A (fun (a : A) => HPow.hPow.{u2, u1, u2} A α A (instHPow.{u2, u1} A α _inst_2) a n))
Case conversion may be inaccurate. Consider using '#align pow_left_surj_of_rootable_by pow_left_surj_of_rootableByₓ'. -/
@[to_additive smul_right_surj_of_divisibleBy]
theorem pow_left_surj_of_rootableBy [RootableBy A α] {n : α} (hn : n ≠ 0) :
    Function.Surjective (fun a => pow a n : A → A) := fun x =>
  ⟨RootableBy.root x n, RootableBy.root_cancel _ hn⟩
#align pow_left_surj_of_rootable_by pow_left_surj_of_rootableBy
#align smul_right_surj_of_divisible_by smul_right_surj_of_divisibleBy

#print rootableByOfPowLeftSurj /-
/--
A `monoid A` is `α`-rootable iff the `pow _ n` function is surjective, i.e. the constructive version
implies the textbook approach.
-/
@[to_additive divisibleByOfSMulRightSurj
      "An `add_monoid A` is `α`-divisible iff `n • _` is a surjective function, i.e. the constructive\nversion implies the textbook approach."]
noncomputable def rootableByOfPowLeftSurj
    (H : ∀ {n : α}, n ≠ 0 → Function.Surjective (fun a => a ^ n : A → A)) : RootableBy A α
    where
  root a n := @dite _ (n = 0) (Classical.dec _) (fun _ => (1 : A)) fun hn => (H hn a).some
  root_zero _ := by classical exact dif_pos rfl
  root_cancel n a hn := by
    classical
      rw [dif_neg hn]
      exact (H hn a).choose_spec
#align rootable_by_of_pow_left_surj rootableByOfPowLeftSurj
#align divisible_by_of_smul_right_surj divisibleByOfSMulRightSurj
-/

section Pi

variable {ι β : Type _} (B : ι → Type _) [∀ i : ι, Pow (B i) β]

variable [Zero β] [∀ i : ι, Monoid (B i)] [∀ i, RootableBy (B i) β]

#print Pi.rootableBy /-
@[to_additive]
instance Pi.rootableBy : RootableBy (∀ i, B i) β
    where
  root x n i := RootableBy.root (x i) n
  root_zero x := funext fun i => RootableBy.root_zero _
  root_cancel n x hn := funext fun i => RootableBy.root_cancel _ hn
#align pi.rootable_by Pi.rootableBy
#align pi.divisible_by Pi.divisibleBy
-/

end Pi

section Prod

variable {β B B' : Type _} [Pow B β] [Pow B' β]

variable [Zero β] [Monoid B] [Monoid B'] [RootableBy B β] [RootableBy B' β]

/- warning: prod.rootable_by -> Prod.rootableBy is a dubious translation:
lean 3 declaration is
  forall {β : Type.{u1}} {B : Type.{u2}} {B' : Type.{u3}} [_inst_4 : Pow.{u2, u1} B β] [_inst_5 : Pow.{u3, u1} B' β] [_inst_6 : Zero.{u1} β] [_inst_7 : Monoid.{u2} B] [_inst_8 : Monoid.{u3} B'] [_inst_9 : RootableBy.{u2, u1} B β _inst_7 _inst_4 _inst_6] [_inst_10 : RootableBy.{u3, u1} B' β _inst_8 _inst_5 _inst_6], RootableBy.{max u2 u3, u1} (Prod.{u2, u3} B B') β (Prod.monoid.{u2, u3} B B' _inst_7 _inst_8) (Prod.pow.{u1, u2, u3} β B B' _inst_4 _inst_5) _inst_6
but is expected to have type
  forall {β : Type.{u1}} {B : Type.{u2}} {B' : Type.{u3}} [_inst_4 : Pow.{u2, u1} B β] [_inst_5 : Pow.{u3, u1} B' β] [_inst_6 : Zero.{u1} β] [_inst_7 : Monoid.{u2} B] [_inst_8 : Monoid.{u3} B'] [_inst_9 : RootableBy.{u2, u1} B β _inst_7 _inst_4 _inst_6] [_inst_10 : RootableBy.{u3, u1} B' β _inst_8 _inst_5 _inst_6], RootableBy.{max u3 u2, u1} (Prod.{u2, u3} B B') β (Prod.instMonoidProd.{u2, u3} B B' _inst_7 _inst_8) (Prod.pow.{u1, u2, u3} β B B' _inst_4 _inst_5) _inst_6
Case conversion may be inaccurate. Consider using '#align prod.rootable_by Prod.rootableByₓ'. -/
@[to_additive]
instance Prod.rootableBy : RootableBy (B × B') β
    where
  root p n := (RootableBy.root p.1 n, RootableBy.root p.2 n)
  root_zero p := Prod.ext (RootableBy.root_zero _) (RootableBy.root_zero _)
  root_cancel n p hn := Prod.ext (RootableBy.root_cancel _ hn) (RootableBy.root_cancel _ hn)
#align prod.rootable_by Prod.rootableBy
#align prod.divisible_by Prod.divisibleBy

end Prod

end Monoid

namespace AddCommGroup

variable (A : Type _) [AddCommGroup A]

/- warning: add_comm_group.smul_top_eq_top_of_divisible_by_int -> AddCommGroup.smul_top_eq_top_of_divisibleBy_int is a dubious translation:
lean 3 declaration is
  forall (A : Type.{u1}) [_inst_1 : AddCommGroup.{u1} A] [_inst_2 : DivisibleBy.{u1, 0} A Int (SubNegMonoid.toAddMonoid.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (SubNegMonoid.SMulInt.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) Int.hasZero] {n : Int}, (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{succ u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (SMul.smul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MulAction.toHasSmul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MonoidWithZero.toMonoid.{0} Int (Semiring.toMonoidWithZero.{0} Int Int.semiring)) (AddSubgroup.pointwiseMulAction.{0, u1} Int A (AddCommGroup.toAddGroup.{u1} A _inst_1) (MonoidWithZero.toMonoid.{0} Int (Semiring.toMonoidWithZero.{0} Int Int.semiring)) (Module.toDistribMulAction.{0, u1} Int A Int.semiring (AddCommGroup.toAddCommMonoid.{u1} A _inst_1) (AddCommGroup.intModule.{u1} A _inst_1)))) n (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.hasTop.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)))) (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.hasTop.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))))
but is expected to have type
  forall (A : Type.{u1}) [_inst_1 : AddCommGroup.{u1} A] [_inst_2 : DivisibleBy.{u1, 0} A Int (SubNegMonoid.toAddMonoid.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (SubNegMonoid.SMulInt.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (CommMonoidWithZero.toZero.{0} Int (CancelCommMonoidWithZero.toCommMonoidWithZero.{0} Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))))] {n : Int}, (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{succ u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (HSMul.hSMul.{0, u1, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (instHSMul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MulAction.toSMul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) Int.instMonoidInt (AddSubgroup.pointwiseMulAction.{0, u1} Int A (AddCommGroup.toAddGroup.{u1} A _inst_1) Int.instMonoidInt (Module.toDistribMulAction.{0, u1} Int A (Ring.toSemiring.{0} Int (CommRing.toRing.{0} Int Int.instCommRingInt)) (AddCommGroup.toAddCommMonoid.{u1} A _inst_1) (AddCommGroup.intModule.{u1} A _inst_1))))) n (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.instTopAddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)))) (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.instTopAddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))))
Case conversion may be inaccurate. Consider using '#align add_comm_group.smul_top_eq_top_of_divisible_by_int AddCommGroup.smul_top_eq_top_of_divisibleBy_intₓ'. -/
theorem smul_top_eq_top_of_divisibleBy_int [DivisibleBy A ℤ] {n : ℤ} (hn : n ≠ 0) :
    n • (⊤ : AddSubgroup A) = ⊤ :=
  AddSubgroup.map_top_of_surjective _ fun a => ⟨DivisibleBy.div a n, DivisibleBy.div_cancel _ hn⟩
#align add_comm_group.smul_top_eq_top_of_divisible_by_int AddCommGroup.smul_top_eq_top_of_divisibleBy_int

/- warning: add_comm_group.divisible_by_int_of_smul_top_eq_top -> AddCommGroup.divisibleByIntOfSmulTopEqTop is a dubious translation:
lean 3 declaration is
  forall (A : Type.{u1}) [_inst_1 : AddCommGroup.{u1} A], (forall {n : Int}, (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{succ u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (SMul.smul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MulAction.toHasSmul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MonoidWithZero.toMonoid.{0} Int (Semiring.toMonoidWithZero.{0} Int Int.semiring)) (AddSubgroup.pointwiseMulAction.{0, u1} Int A (AddCommGroup.toAddGroup.{u1} A _inst_1) (MonoidWithZero.toMonoid.{0} Int (Semiring.toMonoidWithZero.{0} Int Int.semiring)) (Module.toDistribMulAction.{0, u1} Int A Int.semiring (AddCommGroup.toAddCommMonoid.{u1} A _inst_1) (AddCommGroup.intModule.{u1} A _inst_1)))) n (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.hasTop.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)))) (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.hasTop.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))))) -> (DivisibleBy.{u1, 0} A Int (SubNegMonoid.toAddMonoid.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (SubNegMonoid.SMulInt.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) Int.hasZero)
but is expected to have type
  forall (A : Type.{u1}) [_inst_1 : AddCommGroup.{u1} A], (forall {n : Int}, (Ne.{1} Int n (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{succ u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (HSMul.hSMul.{0, u1, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (instHSMul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (MulAction.toSMul.{0, u1} Int (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) Int.instMonoidInt (AddSubgroup.pointwiseMulAction.{0, u1} Int A (AddCommGroup.toAddGroup.{u1} A _inst_1) Int.instMonoidInt (Module.toDistribMulAction.{0, u1} Int A (Ring.toSemiring.{0} Int (CommRing.toRing.{0} Int Int.instCommRingInt)) (AddCommGroup.toAddCommMonoid.{u1} A _inst_1) (AddCommGroup.intModule.{u1} A _inst_1))))) n (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.instTopAddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)))) (Top.top.{u1} (AddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1)) (AddSubgroup.instTopAddSubgroup.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))))) -> (DivisibleBy.{u1, 0} A Int (SubNegMonoid.toAddMonoid.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (SubNegMonoid.SMulInt.{u1} A (AddGroup.toSubNegMonoid.{u1} A (AddCommGroup.toAddGroup.{u1} A _inst_1))) (CommMonoidWithZero.toZero.{0} Int (CancelCommMonoidWithZero.toCommMonoidWithZero.{0} Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing))))))
Case conversion may be inaccurate. Consider using '#align add_comm_group.divisible_by_int_of_smul_top_eq_top AddCommGroup.divisibleByIntOfSmulTopEqTopₓ'. -/
/-- If for all `n ≠ 0 ∈ ℤ`, `n • A = A`, then `A` is divisible.
-/
noncomputable def divisibleByIntOfSmulTopEqTop
    (H : ∀ {n : ℤ} (hn : n ≠ 0), n • (⊤ : AddSubgroup A) = ⊤) : DivisibleBy A ℤ
    where
  div a n :=
    if hn : n = 0 then 0 else show a ∈ n • (⊤ : AddSubgroup A) by rw [H hn] <;> trivial.some
  div_zero a := dif_pos rfl
  div_cancel n a hn := by
    rw [dif_neg hn]
    generalize_proofs h1
    exact h1.some_spec.2
#align add_comm_group.divisible_by_int_of_smul_top_eq_top AddCommGroup.divisibleByIntOfSmulTopEqTop

end AddCommGroup

/- warning: divisible_by_int_of_char_zero -> divisibleByIntOfCharZero is a dubious translation:
lean 3 declaration is
  forall {𝕜 : Type.{u1}} [_inst_1 : DivisionRing.{u1} 𝕜] [_inst_2 : CharZero.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1))))], DivisibleBy.{u1, 0} 𝕜 Int (AddMonoidWithOne.toAddMonoid.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1))))) (SubNegMonoid.SMulInt.{u1} 𝕜 (AddGroup.toSubNegMonoid.{u1} 𝕜 (AddGroupWithOne.toAddGroup.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1)))))) Int.hasZero
but is expected to have type
  forall {𝕜 : Type.{u1}} [_inst_1 : DivisionRing.{u1} 𝕜] [_inst_2 : CharZero.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (Ring.toAddGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1)))], DivisibleBy.{u1, 0} 𝕜 Int (AddMonoidWithOne.toAddMonoid.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (Ring.toAddGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1)))) (SubNegMonoid.SMulInt.{u1} 𝕜 (AddGroup.toSubNegMonoid.{u1} 𝕜 (AddGroupWithOne.toAddGroup.{u1} 𝕜 (Ring.toAddGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 _inst_1))))) (CommMonoidWithZero.toZero.{0} Int (CancelCommMonoidWithZero.toCommMonoidWithZero.{0} Int (IsDomain.toCancelCommMonoidWithZero.{0} Int Int.instCommSemiringInt (LinearOrderedRing.isDomain.{0} Int (LinearOrderedCommRing.toLinearOrderedRing.{0} Int Int.linearOrderedCommRing)))))
Case conversion may be inaccurate. Consider using '#align divisible_by_int_of_char_zero divisibleByIntOfCharZeroₓ'. -/
instance (priority := 100) divisibleByIntOfCharZero {𝕜} [DivisionRing 𝕜] [CharZero 𝕜] :
    DivisibleBy 𝕜 ℤ where
  div q n := q / n
  div_zero q := by norm_num
  div_cancel n q hn := by
    rw [zsmul_eq_mul, (Int.cast_commute n _).Eq, div_mul_cancel q (int.cast_ne_zero.mpr hn)]
#align divisible_by_int_of_char_zero divisibleByIntOfCharZero

namespace Group

variable (A : Type _) [Group A]

#print Group.rootableByIntOfRootableByNat /-
/-- A group is `ℤ`-rootable if it is `ℕ`-rootable.
-/
@[to_additive AddGroup.divisibleByIntOfDivisibleByNat
      "An additive group is `ℤ`-divisible if it is `ℕ`-divisible."]
def rootableByIntOfRootableByNat [RootableBy A ℕ] : RootableBy A ℤ
    where
  root a z :=
    match z with
    | (n : ℕ) => RootableBy.root a n
    | -[n+1] => (RootableBy.root a (n + 1))⁻¹
  root_zero a := RootableBy.root_zero a
  root_cancel n a hn := by
    induction n
    · change RootableBy.root a _ ^ _ = a
      norm_num
      rw [RootableBy.root_cancel]
      rw [Int.ofNat_eq_coe] at hn
      exact_mod_cast hn
    · change (RootableBy.root a _)⁻¹ ^ _ = a
      norm_num
      rw [RootableBy.root_cancel]
      norm_num
#align group.rootable_by_int_of_rootable_by_nat Group.rootableByIntOfRootableByNat
#align add_group.divisible_by_int_of_divisible_by_nat AddGroup.divisibleByIntOfDivisibleByNat
-/

#print Group.rootableByNatOfRootableByInt /-
/-- A group is `ℕ`-rootable if it is `ℤ`-rootable
-/
@[to_additive AddGroup.divisibleByNatOfDivisibleByInt
      "An additive group is `ℕ`-divisible if it `ℤ`-divisible."]
def rootableByNatOfRootableByInt [RootableBy A ℤ] : RootableBy A ℕ
    where
  root a n := RootableBy.root a (n : ℤ)
  root_zero a := RootableBy.root_zero a
  root_cancel n a hn :=
    by
    have := RootableBy.root_cancel a (show (n : ℤ) ≠ 0 by exact_mod_cast hn)
    norm_num at this
    exact this
#align group.rootable_by_nat_of_rootable_by_int Group.rootableByNatOfRootableByInt
#align add_group.divisible_by_nat_of_divisible_by_int AddGroup.divisibleByNatOfDivisibleByInt
-/

end Group

section Hom

variable {α A B : Type _}

variable [Zero α] [Monoid A] [Monoid B] [Pow A α] [Pow B α] [RootableBy A α]

variable (f : A → B)

/--
If `f : A → B` is a surjective homomorphism and `A` is `α`-rootable, then `B` is also `α`-rootable.
-/
@[to_additive
      "If `f : A → B` is a surjective homomorphism and\n`A` is `α`-divisible, then `B` is also `α`-divisible."]
noncomputable def Function.Surjective.rootableBy (hf : Function.Surjective f)
    (hpow : ∀ (a : A) (n : α), f (a ^ n) = f a ^ n) : RootableBy B α :=
  rootableByOfPowLeftSurj _ _ fun n hn x =>
    let ⟨y, hy⟩ := hf x
    ⟨f <| RootableBy.root y n,
      (by rw [← hpow (RootableBy.root y n) n, RootableBy.root_cancel _ hn, hy] : _ ^ _ = x)⟩
#align function.surjective.rootable_by Function.Surjective.rootableByₓ
#align function.surjective.divisible_by Function.Surjective.divisibleByₓ

/- warning: rootable_by.surjective_pow -> RootableBy.surjective_pow is a dubious translation:
lean 3 declaration is
  forall (A : Type.{u1}) (α : Type.{u2}) [_inst_7 : Monoid.{u1} A] [_inst_8 : Pow.{u1, u2} A α] [_inst_9 : Zero.{u2} α] [_inst_10 : RootableBy.{u1, u2} A α _inst_7 _inst_8 _inst_9] {n : α}, (Ne.{succ u2} α n (OfNat.ofNat.{u2} α 0 (OfNat.mk.{u2} α 0 (Zero.zero.{u2} α _inst_9)))) -> (Function.Surjective.{succ u1, succ u1} A A (fun (a : A) => HPow.hPow.{u1, u2, u1} A α A (instHPow.{u1, u2} A α _inst_8) a n))
but is expected to have type
  forall (A : Type.{u2}) (α : Type.{u1}) [_inst_7 : Monoid.{u2} A] [_inst_8 : Pow.{u2, u1} A α] [_inst_9 : Zero.{u1} α] [_inst_10 : RootableBy.{u2, u1} A α _inst_7 _inst_8 _inst_9] {n : α}, (Ne.{succ u1} α n (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_9))) -> (Function.Surjective.{succ u2, succ u2} A A (fun (a : A) => HPow.hPow.{u2, u1, u2} A α A (instHPow.{u2, u1} A α _inst_8) a n))
Case conversion may be inaccurate. Consider using '#align rootable_by.surjective_pow RootableBy.surjective_powₓ'. -/
@[to_additive DivisibleBy.surjective_smul]
theorem RootableBy.surjective_pow (A α : Type _) [Monoid A] [Pow A α] [Zero α] [RootableBy A α]
    {n : α} (hn : n ≠ 0) : Function.Surjective fun a : A => a ^ n := fun a =>
  ⟨RootableBy.root a n, RootableBy.root_cancel a hn⟩
#align rootable_by.surjective_pow RootableBy.surjective_pow
#align divisible_by.surjective_smul DivisibleBy.surjective_smul

end Hom

section Quotient

variable (α : Type _) {A : Type _} [CommGroup A] (B : Subgroup A)

#print QuotientGroup.rootableBy /-
/-- Any quotient group of a rootable group is rootable. -/
@[to_additive QuotientAddGroup.divisibleBy "Any quotient group of a divisible group is divisible"]
noncomputable instance QuotientGroup.rootableBy [RootableBy A ℕ] : RootableBy (A ⧸ B) ℕ :=
  QuotientGroup.mk_surjective.RootableBy _ fun _ _ => rfl
#align quotient_group.rootable_by QuotientGroup.rootableBy
#align quotient_add_group.divisible_by QuotientAddGroup.divisibleBy
-/

end Quotient