import data.list.range
import data.list.join

@[reducible]
def fibonacci : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n+2) := fibonacci n + fibonacci (n+1)

open nat list
---
@[reducible]
def fib_sum (n : ℕ) : ℕ :=
((range n).map fibonacci).sum

@[reducible]
def fib_odd_sum (n : ℕ) : ℕ :=
((range n).map (λ m, fibonacci (2*m + 1))).sum

@[reducible]
def fib_even_sum (n : ℕ) : ℕ :=
((range n).map (λ m, fibonacci (2*m))).sum
---
theorem fib_odd_sum_eq : ∀ (n : ℕ),
  fib_odd_sum n = fibonacci (2*n)
| 0 := rfl
| (n+1) := by rw [fib_odd_sum,
  sum_range_succ,
  ←fib_odd_sum,
  fib_odd_sum_eq,
  mul_add,
  mul_one,
  fibonacci]
---
theorem fib_even_sum_eq : ∀ {n : ℕ} (h : n > 0),
  fib_even_sum n + 1 = fibonacci (2*n - 1)
| 0 h := (gt_irrefl 0 h).elim
| 1 _ := rfl
| (n+2) _ :=
have H : fib_even_sum (n+1) + 1 = fibonacci (2*(n+1) - 1) :=
  fib_even_sum_eq (succ_pos n),
begin
  rw [fib_even_sum,
    sum_range_succ,
    ←fib_even_sum,
    add_right_comm,
    H,
    mul_add,
    mul_one,
    mul_add],
  change fibonacci (2*n + 1) + fibonacci (2*n + 1 + 1) =
    fibonacci (2*n + 1 + 2),
  rw [←fibonacci],
end
---
theorem fib_sum_eq : ∀ (n : ℕ),
  fib_sum n + 1 = fibonacci (n+1)
| 0 := rfl
| (n+1) :=
begin
  rw [fibonacci,
    ←fib_sum_eq n],
  simp [range_succ, fib_sum,
    add_left_comm, add_comm],
end

inductive bee : Type
| queen : bee
| worker : bee
| drone : bee

open bee list

instance : has_repr bee :=
⟨λ s, match s with
| queen := "Q"
| worker := "W"
| drone := "D"
end⟩
---
namespace bee

def parents : bee → list bee
| queen := [queen, drone]
| worker := [queen, drone]
| drone := [queen]

def ancestors (b : bee) : ℕ → list bee
| 0 := [b]
| (n+1) := ((ancestors n).map parents).join
---
def tree_json : bee → ℕ → string
| b 0 := "{\"name\":\"" ++ repr b ++ "\"}"
| b (n+1) := "{\"name\":\"" ++ repr b ++ "\",\"children\":[" ++
  string.intercalate "," (b.parents.map (λ p, p.tree_json n)) ++ "]}"
---
lemma drone_ancestors_concat : ∀ (n : ℕ),
  drone.ancestors (n+2) = drone.ancestors (n+1) ++ drone.ancestors n
| 0 := rfl
| (n+1) := begin
  change ((ancestors _ (n+2)).map _).join = _,
  conv { to_lhs,
    rw [drone_ancestors_concat n,
      map_append,
      join_append], },
  refl,
end
---
theorem drone_ancestors_length_eq_fib_succ : ∀ (n : ℕ),
  (drone.ancestors n).length = fibonacci (n+1)
| 0 := rfl
| 1 := rfl
| (n+2) := begin
  rw [drone_ancestors_concat,
    length_append,
    drone_ancestors_length_eq_fib_succ n,
    drone_ancestors_length_eq_fib_succ (n+1),
    add_comm],
  refl,
end

end bee
---
inductive car : Type
| rabbit : car
| cadillac : car

open car list nat

instance : has_repr car :=
⟨λ s, match s with
| rabbit := "R"
| cadillac := "C"
end⟩
---
namespace car

@[reducible]
def size : car → ℕ
| rabbit := 1
| cadillac := 2

@[reducible]
def sum_size (cs : list car) : ℕ :=
(cs.map size).sum

lemma sum_size_cons (c : car) (cs : list car) :
  sum_size (c :: cs) = sum_size cs + c.size :=
by simp only [sum_size, sum_cons, map, add_comm]
---
@[reducible]
def packings : ℕ → list (list car)
| 0 := [[]]
| 1 := [[rabbit]]
| (n+2) := (packings (n+1)).map (cons rabbit) ++
  (packings n).map (cons cadillac)
---
theorem num_packings_eq_fib : ∀ (n : ℕ),
  (packings n).length = fibonacci (n+1)
| 0 := rfl
| 1 := rfl
| (n+2) :=
begin
  simp [packings, fibonacci, add_left_comm, add_comm],
  rw [num_packings_eq_fib n,
    num_packings_eq_fib (n+1),
    add_left_comm,
    add_right_inj,
    fibonacci],
end
---
theorem packings_size : ∀ {n : ℕ} {cs : list car} (h : cs ∈ packings n),
  sum_size cs = n
| 0 cs h :=
begin
  rw mem_singleton.1 h,
  refl,
end
| 1 cs h :=
begin
  rw mem_singleton.1 h,
  refl,
end
| (n+2) cs h :=
begin
  simp [packings] at h,
  rcases h with ⟨cs', h₁, h₂⟩ | ⟨cs', h₁, h₂⟩,
  all_goals { rw [←h₂,
    sum_size_cons,
    size,
    packings_size h₁], },
end
---
lemma car_size_ne_zero (c : car) : size c ≠ 0 :=
by cases c; contradiction

lemma sum_size_zero : ∀ {cs : list car} (h : sum_size cs = 0),
  cs = []
| [] _ := rfl
| (c::cs) h :=
begin
  exfalso,
  rw [sum_size_cons,
      add_eq_zero_iff] at h,
  exact car_size_ne_zero c h.2,
end
---
lemma sum_size_one : ∀ {cs : list car} (h : sum_size cs = 1),
  cs = [rabbit]
| [] h := by contradiction
| (rabbit::cs) h :=
begin
  rw [sum_size_cons] at h,
  simp,
  exact sum_size_zero (succ.inj h),
end
| (cadillac::cs) h :=
begin
  rw [sum_size_cons] at h,
  have : sum_size cs + 1 = 0 := succ.inj h,
  contradiction,
end
---
theorem all_packings : ∀ {n : ℕ} {cs : list car} (h : sum_size cs = n),
  cs ∈ packings n
| 0 cs h := by simp [packings, sum_size_zero h]
| 1 cs h := by simp [packings, sum_size_one h]
| (n+2) [] h := by contradiction
| (n+2) (rabbit::cs) h :=
begin
  rw [sum_size_cons,
    add_left_inj 1] at h,
  simp [packings, all_packings, h],
end
| (n+2) (cadillac::cs) h :=
begin
  rw [sum_size_cons,
    add_left_inj 2] at h,
  simp [packings, all_packings, h],
end

end car


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import analysis.inner_product_space.projection
import linear_algebra.orientation

/-!
# Orientations of real inner product spaces.

This file provides definitions and proves lemmas about orientations of real inner product spaces.

## Main definitions

* `orientation.fin_orthonormal_basis` is an orthonormal basis, indexed by `fin n`, with the given
orientation.

-/

noncomputable theory

variables {E : Type*} [inner_product_space ℝ E]
variables {ι : Type*} [fintype ι] [decidable_eq ι]

open finite_dimensional

/-- `basis.adjust_to_orientation`, applied to an orthonormal basis, produces an orthonormal
basis. -/
lemma orthonormal.orthonormal_adjust_to_orientation [nonempty ι] {e : basis ι ℝ E}
  (h : orthonormal ℝ e) (x : orientation ℝ E ι) : orthonormal ℝ (e.adjust_to_orientation x) :=
h.orthonormal_of_forall_eq_or_eq_neg (e.adjust_to_orientation_apply_eq_or_eq_neg x)

/-- An orthonormal basis, indexed by `fin n`, with the given orientation. -/
protected def orientation.fin_orthonormal_basis {n : ℕ} (hn : 0 < n) (h : finrank ℝ E = n)
  (x : orientation ℝ E (fin n)) : basis (fin n) ℝ E :=
begin
  haveI := fin.pos_iff_nonempty.1 hn,
  haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E),
  exact (fin_orthonormal_basis h).adjust_to_orientation x
end

/-- `orientation.fin_orthonormal_basis` is orthonormal. -/
protected lemma orientation.fin_orthonormal_basis_orthonormal {n : ℕ} (hn : 0 < n)
  (h : finrank ℝ E = n) (x : orientation ℝ E (fin n)) :
  orthonormal ℝ (x.fin_orthonormal_basis hn h) :=
begin
  haveI := fin.pos_iff_nonempty.1 hn,
  haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E),
  exact (fin_orthonormal_basis_orthonormal h).orthonormal_adjust_to_orientation _
end

/-- `orientation.fin_orthonormal_basis` gives a basis with the required orientation. -/
@[simp] lemma orientation.fin_orthonormal_basis_orientation {n : ℕ} (hn : 0 < n)
  (h : finrank ℝ E = n) (x : orientation ℝ E (fin n)) :
  (x.fin_orthonormal_basis hn h).orientation = x :=
begin
  haveI := fin.pos_iff_nonempty.1 hn,
  exact basis.orientation_adjust_to_orientation _ _
end


import data.real.basic data.real.sqrt tactic.fin_cases

namespace loh

lemma real_sq_nonneg (x : ℝ) : 0 ≤ x ^ 2 := sq_nonneg x

lemma no_nat_half : ¬ ∃ (n : ℕ), 2 * n = 1 :=
begin
  rintro ⟨n,hn⟩,
  cases n; cases hn
end

lemma int_domain : ∀ (n m : ℤ), n * m = 0 → n = 0 ∨ m = 0 :=
  λ n m h, int.eq_zero_or_eq_zero_of_mul_eq_zero h

section root_set

variables {u : ℝ} (hu : u > 0)
include hu

def root_set := { x : ℝ | x ^ 2 = u }
noncomputable def pos_root : root_set hu :=
  ⟨real.sqrt u, real.sq_sqrt (le_of_lt hu)⟩
noncomputable def neg_root : root_set hu :=
  ⟨- real.sqrt u, by { change _ ^ 2  = _, rw[neg_sq, real.sq_sqrt (le_of_lt hu)] } ⟩

lemma coe_pos_root : ((pos_root hu) : ℝ) = real.sqrt u := rfl
lemma coe_neg_root : ((neg_root hu) : ℝ) = - real.sqrt u := rfl

lemma pos_root_pos : (pos_root hu : ℝ) > 0 := real.sqrt_pos.mpr hu
lemma neg_root_neg : ¬ ((neg_root hu : ℝ) > 0) :=
  not_lt_of_gt (neg_neg_of_pos (pos_root_pos hu))

lemma sq_pos_root : (pos_root hu : ℝ) ^ 2 = u := (pos_root hu).property
lemma sq_neg_root : (neg_root hu : ℝ) ^ 2 = u := (neg_root hu).property

noncomputable def root_set_to : root_set hu → fin 2 := λ u, ite ((u : ℝ) > 0) 0 1
noncomputable def root_set_of : fin 2 → root_set hu := λ i, ite (i = 0) (pos_root hu) (neg_root hu)

lemma coe_root_set_of : ∀ (i : fin 2), ((root_set_of hu i) : ℝ) = ite (i = 0) (real.sqrt u) (- real.sqrt u) :=
begin
  intro i, dsimp[root_set_of], split_ifs; refl
end

lemma root_set_els : ∀ (x : root_set hu), x = (pos_root hu) ∨ x = (neg_root hu) :=
begin
  rintro ⟨x, hx : x ^ 2 = u⟩,
  let v := real.sqrt u,
  rw[← sub_eq_zero, ← (real.sq_sqrt (le_of_lt hu))] at hx,
  have : x ^ 2 - v ^ 2 = (x - v) * (x - (- v)) := by ring,
  rw[this] at hx,
  replace hx := eq_zero_or_eq_zero_of_mul_eq_zero hx,
  rw[sub_eq_zero, sub_eq_zero] at hx,
  cases hx with hx hx,
  { left , ext, change x = _, rw[coe_pos_root], exact hx },
  { right, ext, change x = _, rw[coe_neg_root], exact hx }
end

noncomputable def root_set.equiv : (root_set hu) ≃ (fin 2) := {
  to_fun := root_set_to hu,
  inv_fun := root_set_of hu,
  left_inv := begin
    intro x,
    cases root_set_els hu x with hp hn,
    { rw[hp], dsimp[root_set_to], rw[if_pos (pos_root_pos hu)], refl },
    { rw[hn], dsimp[root_set_to], rw[if_neg (neg_root_neg hu)], refl }
  end,
  right_inv := begin
    intro i,
    dsimp[root_set_of],
    split_ifs,
    { dsimp[root_set_to], rw[h, if_pos (pos_root_pos hu)] },
    { dsimp[root_set_to], rw[if_neg (neg_root_neg hu)],
      fin_cases i; trivial,
    }
  end
}
end root_set

example (x : ℝ) (h : 0 ≤ x) : (abs x) = x := by library_search

noncomputable def abs_cases (x : ℝ) : { u : ℝ // 0 ≤ u ∧ (abs x) = u ∧ (x = u ∨ x = -u) } :=
begin
  use (abs x), split, exact (abs_nonneg x), split, refl,
  by_cases h : x ≥ 0,
  {left, rw[abs_eq_self.mpr h]},
  {right, rw[abs_eq_neg_self.mpr (le_of_not_ge h), neg_neg] }
end

lemma tri_ineq (x y : ℝ) : abs (x + y) ≤ (abs x) + (abs y) := sorry

def conv_to (x : ℕ → ℝ) (a : ℝ) : Prop :=
  ∀ (ε : ℝ) (hε : ε > 0), ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → (abs (x n - a) < ε)

section jective

variables {X Y : Type*} (f : X → Y)

def inj (f : X → Y) := ∀ x₀ x₁ : X, f x₀ = f x₁ → x₀ = x₁

def surj (f : X → Y) := ∀ y : Y, ∃ x : X, f x = y

def bij (f : X → Y) := (inj f) ∧ (surj f)

lemma inj_of_bij {f : X → Y} (h : bij f) : inj f := h.1

lemma surj_of_bij {f : X → Y} (h : bij f) : surj f := h.2

lemma bij_of_inj_of_surj {f : X → Y} (hi : inj f) (hs : surj f) : bij f := ⟨hi, hs⟩

end jective

end loh


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

! This file was ported from Lean 3 source module topology.fiber_bundle.is_homeomorphic_trivial_bundle
! leanprover-community/mathlib commit be2c24f56783935652cefffb4bfca7e4b25d167e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Homeomorph

/-!
# Maps equivariantly-homeomorphic to projection in a product

This file contains the definition `IsHomeomorphicTrivialFiberBundle F p`, a Prop saying that a
map `p : Z → B` between topological spaces is a "trivial fiber bundle" in the sense that there
exists a homeomorphism `h : Z ≃ₜ B × F` such that `proj x = (h x).1`.  This is an abstraction which
is occasionally convenient in showing that a map is open, a quotient map, etc.

This material was formerly linked to the main definition of fiber bundles, but after a series of
refactors, there is no longer a direct connection.
-/

variable {B : Type _} (F : Type _) {Z : Type _} [TopologicalSpace B] [TopologicalSpace F]
  [TopologicalSpace Z]

/-- A trivial fiber bundle with fiber `F` over a base `B` is a space `Z`
projecting on `B` for which there exists a homeomorphism to `B × F` that sends `proj`
to `prod.fst`. -/
def IsHomeomorphicTrivialFiberBundle (proj : Z → B) : Prop :=
  ∃ e : Z ≃ₜ B × F, ∀ x, (e x).1 = proj x
#align is_homeomorphic_trivial_fiber_bundle IsHomeomorphicTrivialFiberBundle

namespace IsHomeomorphicTrivialFiberBundle

variable {F} {proj : Z → B}

protected theorem proj_eq (h : IsHomeomorphicTrivialFiberBundle F proj) :
    ∃ e : Z ≃ₜ B × F, proj = Prod.fst ∘ e :=
  ⟨h.choose, (funext h.choose_spec).symm⟩
#align is_homeomorphic_trivial_fiber_bundle.proj_eq IsHomeomorphicTrivialFiberBundle.proj_eq

/-- The projection from a trivial fiber bundle to its base is surjective. -/
protected theorem surjective_proj [Nonempty F] (h : IsHomeomorphicTrivialFiberBundle F proj) :
    Function.Surjective proj := by
  obtain ⟨e, rfl⟩ := h.proj_eq
  exact Prod.fst_surjective.comp e.surjective
#align is_homeomorphic_trivial_fiber_bundle.surjective_proj IsHomeomorphicTrivialFiberBundle.surjective_proj

/-- The projection from a trivial fiber bundle to its base is continuous. -/
protected theorem continuous_proj (h : IsHomeomorphicTrivialFiberBundle F proj) : Continuous proj :=
  by obtain ⟨e, rfl⟩ := h.proj_eq; exact continuous_fst.comp e.continuous
#align is_homeomorphic_trivial_fiber_bundle.continuous_proj IsHomeomorphicTrivialFiberBundle.continuous_proj

/-- The projection from a trivial fiber bundle to its base is open. -/
protected theorem isOpenMap_proj (h : IsHomeomorphicTrivialFiberBundle F proj) : IsOpenMap proj :=
  by obtain ⟨e, rfl⟩ := h.proj_eq; exact isOpenMap_fst.comp e.isOpenMap
#align is_homeomorphic_trivial_fiber_bundle.is_open_map_proj IsHomeomorphicTrivialFiberBundle.isOpenMap_proj

/-- The projection from a trivial fiber bundle to its base is open. -/
protected theorem quotientMap_proj [Nonempty F] (h : IsHomeomorphicTrivialFiberBundle F proj) :
    QuotientMap proj :=
  h.isOpenMap_proj.to_quotientMap h.continuous_proj h.surjective_proj
#align is_homeomorphic_trivial_fiber_bundle.quotient_map_proj IsHomeomorphicTrivialFiberBundle.quotientMap_proj

end IsHomeomorphicTrivialFiberBundle

/-- The first projection in a product is a trivial fiber bundle. -/
theorem isHomeomorphicTrivialFiberBundle_fst :
    IsHomeomorphicTrivialFiberBundle F (Prod.fst : B × F → B) :=
  ⟨Homeomorph.refl _, fun _x => rfl⟩
#align is_homeomorphic_trivial_fiber_bundle_fst isHomeomorphicTrivialFiberBundle_fst

/-- The second projection in a product is a trivial fiber bundle. -/
theorem isHomeomorphicTrivialFiberBundle_snd :
    IsHomeomorphicTrivialFiberBundle F (Prod.snd : F × B → B) :=
  ⟨Homeomorph.prodComm _ _, fun _x => rfl⟩
#align is_homeomorphic_trivial_fiber_bundle_snd isHomeomorphicTrivialFiberBundle_snd


import group_theory.group_action group_theory.coset
import hp.tactic.hp_interactive

namespace examples

section
variables {G H I : Type} [group G] [group H] [group I]
variables {f : G → H} {g : H → I}

def is_hom (f : G → H) := ∀ (x y : G), f (x * y) = f x * f y
attribute [class] is_hom
variables [is_hom f]
lemma is_hom.one : f 1 = 1 :=
begin
  apply mul_right_eq_self.1,
  show (f 1) * (f 1) = (f 1),
  rw ←‹is_hom f›,
  simp,
end

lemma is_hom.inv (f : G → H) [is_hom f] {x} : f (x⁻¹) = (f x)⁻¹ :=
begin
  have : f x * f (x⁻¹) = f x * (f x)⁻¹,
  rw ←‹is_hom f›, simp, apply is_hom.one,
  exact mul_left_cancel this
end

example : is_hom f → is_hom g → is_hom (g ∘ f) :=
begin
  intros hf hg x y,
  simp,
  rewrite [hf,hg]
end

example : is_hom f → is_hom g → is_hom (g ∘ f) :=
begin
  -- intros, simp, rw [‹is_hom f›, ‹is_hom g›],
  assume : is_hom f,
  assume : is_hom g,
  assume (x y : G),
  calc g (f (x * y)) = g (f x * f y)         : by rewrite ‹is_hom f›
                 ... = (g (f x)) * (g (f y)) : by rewrite ‹is_hom g›,
end

-- def kernel (f : G → H) [is_hom f ] := {g : G | f g = 1}

def kernel (f : G → H) [h₁ : is_hom f] : subgroup G :=
begin
  refine {carrier := {g : G | f g = 1}, ..},
  apply is_hom.one,
    show ∀ (a b : G) (ha : f a = 1) (hb : f b = 1), f (a * b) = 1,
    intros,
    rw [‹is_hom f›, ha, hb],
    simp,
  show ∀ (a : G) (ha : f a = 1), f a⁻¹ = 1,
  intros,
  rw (is_hom.inv f),
  rw ha,
  simp
end

example (f : G → H) [h₁ : is_hom f] : subgroup.normal (kernel f) :=
begin
  split,
  show ∀ (k : G) (h₂ : k ∈ kernel f) (g : G), (f (g * k * g⁻¹) = 1),
  intros,
  have h₃ : f k = 1, from ‹k ∈ kernel f›,
  calc f (g * k * g⁻¹) = f (g * k) * f g⁻¹ : by rewrite ‹is_hom f›
                   ... = f g * f k * f g⁻¹ : by rewrite ‹is_hom f›
                   ... = f g * 1 * f g⁻¹   : by rewrite h₃
                   ... = f g * 1 * (f g)⁻¹ : by rewrite (is_hom.inv f)
                   ... = 1                 : by simp
end

end

section

variables {G : Type} [group G] {H : Type}

lemma test_1 (x y : G) (z : H) : Π (a b : G), x = x :=
begin [hp]
  trace_writeup,
  unroll,
end

variables {H : subgroup G} {a b : G}

lemma mem_own_left_coset : a ∈ left_coset a H :=
begin [hp]

  -- show ∃ (h : G), (h ∈ H) ∧ a * h = a,
  -- use (1 : G),
  -- split,
  -- show (1 : G) ∈ H,
  --   apply subgroup.one_mem,
  -- show a * (1 : G) = a,
  --   simp
end

theorem G1 : (left_coset a H = left_coset b H) ↔ b⁻¹ * a ∈ H :=
begin
  split,
  { assume he : left_coset a H = left_coset b H,
    obtain ⟨h,hH,p⟩ : ∃ (h : G), h ∈ H ∧ b * h = a,
      have : a ∈ left_coset a H,
        apply mem_own_left_coset,
      have : a ∈ left_coset b H,
        rw he at this,
        apply this,
      apply this,
    have : b⁻¹ * a = h,
      rw ← p, simp,
    rw this,
    assumption,
  },
  { intro H1,
    apply set.eq_of_subset_of_subset,
    { rintros g ⟨h,hH,e⟩,
      refine ⟨(b⁻¹ * a) * h,_,_⟩,
      apply subgroup.mul_mem, apply H1, apply hH,
      simp at e,
      rw [mul_assoc, e], simp,
    },
    { rintros g ⟨h,hH,e⟩,
      refine ⟨_,_,_⟩,
      rotate 2,
      rw ← e,
      simp,
      apply mul_eq_of_eq_inv_mul,
      refl,
      rw [←mul_assoc],
      apply subgroup.mul_mem,
      refine (subgroup.inv_mem_iff H).1 _,
      simp, apply H1, apply hH
    }
  }
end

/- Every kernel is a normal subgroup -/

-- def kernel {H G : Type} [group H] [group G] (f : H → G) [group_hom]

-- example :

-- /- This one is too classical.

--  -/
-- -- example : (¬ disjoint (left_coset a H) (left_coset b H)) → left_coset a H = left_coset b H :=
-- -- begin
-- --   intros h₁,
-- --   refine (G1 ).2 _,
-- --   apply set.disjoint.union_left
-- -- end

end

end examples


import tactic.tidy

import category_theory.category
import set_category.diagram_lemmas
import help_functions

namespace Equalizer

open set
     diagram_lemmas
     classical
     function
     help_functions
     category_theory

universes v u

local notation f ` ⊚ `:80 g:80 := category_struct.comp g f

def is_equalizer {X : Type v} [category X]
    {A B E : X} (f g : A ⟶ B)
                (e : E ⟶ A) : Prop :=
    f ⊚ e = g ⊚ e ∧
    Π {Q : X} (q : Q ⟶ A),
        f ⊚ q = g ⊚ q →
            ∃! h : Q ⟶ E, q = e ⊚ h

lemma equalizer_is_mono {X : Type v} [category X]
    {A B E : X} (f₁ f₂ : A ⟶ B)
    (e : E ⟶ A) (equaliz : is_equalizer f₁ f₂ e):
    mono e :=
    ⟨
        begin
            intros Q g₁ g₂ m,
            have s1 : f₁ ⊚ (e ⊚ g₁) = f₂ ⊚ (e ⊚ g₁) := by tidy,
            have compit : _ := equaliz.2 (e ⊚ g₁) s1,
            cases compit with h spec_h,
            have g₁_h : g₁ = h := spec_h.2 g₁ rfl,
            have g₂_h : g₂ = h := spec_h.2 g₂ m,
            simp [g₁_h , g₂_h]
        end
    ⟩

variables {A B : Type u}
variables (f g : A ⟶ B)

def equalizer_set : set A := λ a, f a = g a

lemma eqaulizer_set_is_equalizer :
    is_equalizer f g ((equalizer_set f g) ↪ A) :=
    let E := equalizer_set f g in
    let e := E ↪ A in
    ⟨
        have elements : ∀ a, (f ∘ e) a = (g ∘ e) a :=
                λ a, a.property,
        funext elements
        ,
        begin
            intros Q q fq_gq,
            have s0 : ∀ b : Q , (f ⊚ q) b = (g ⊚ q) b :=
                            assume b, by rw fq_gq,
            have s1 : ∀ b : Q , q b ∈ E :=
                        assume b, s0 b,
            let h : Q → E := λ b, ⟨q b, s1 b⟩,
            have q_eh : q = e ∘ h := by tidy,
            use h,
            split,
            exact q_eh,
            intros h₁ spec_h₁,
            tidy,
            have inj : injective e := inj_inclusion A E,
            have ey_eh: e ∘ h₁ = e ∘ h := by rw [← spec_h₁ , q_eh],
            have elements : ∀ b, (e ∘ h₁) b = (e ∘ h) b :=
                    assume a, by rw ey_eh,
            dsimp at *,
            solve_by_elim
        end
    ⟩

end Equalizer


import lib.m154

/-
# Quantificateur universel et disjonctions

Ce fichier est consacré au quantificateur universel, symbolisé par `∀`
et au connecteur logique de disjonction, noté simplement « ou » sur papier
et `∨` dans Lean ainsi que dans les livres de logique pure.

On rappelle qu'un *prédicat* sur un type d'objets mathématiques `X` est un énoncé
dépendant d'un objet `x` de type `X`. Le plus souvent pour nous `X = ℝ`, le type
des nombres réels. Un prédicat n'est donc pas un énoncé mathématique autonome.

À partir d'un prédicat `P` sur `X`, on peut former l'énoncé autonome :
« Pour tout x, P x », qu'on note `∀ x, P x`. La définition suivante
construit un énoncé, portant sur une fonction `f` fixée, à partir du prédicat
sur `ℝ` qui associe à tout nombre réel `x` l'énoncé `f (-x) = f x`
(notons que Lean est économe en parenthèses ici).
-/

def paire (f : ℝ → ℝ) := ∀ x, f (-x) = f x

/-
Dans l'énoncé `∀ x, f(-x) = f x`, le type `ℝ` de `x` n'apparait pas explicitement
car on peut le déduire de l'information que `f` est une fonction de `ℝ` dans `ℝ`
qui est visiblement appliquée à `x`.

Cependant il peut être plus clair de l'indiquer explicitement, et ce serait
indispensable sans l'indication fournie par `f x`. Sur papier on écrit
« ∀ x ∈ ℝ, » plutôt que « ∀ x : ℝ, »
-/

def impaire (f : ℝ → ℝ) := ∀ x : ℝ, f (-x) = -f x

/-
Pour *démontrer* un énoncé de la forme `∀ x, P x` où `P` est un prédicat,
il faut se donner un élément `x` arbitraire et démontrer l'énoncé `P x`.
Dans Lean on utilisera la commande `Soit x`, pour se donner un élément `x`.
Pour plus de clarté, on peut indiquer le type d'objet `x` considéré en écrivant
`Soit x : ℝ,`. Sur paper on écrirait plutôt : « Soit x un nombre réel »,
ou bien « Soit x ∈ ℝ ».

Pour *utiliser* un tel énoncé, on peut le spécialiser à n'importe quel objet `x`
de type `X`. Dans l'exemple suivant, on nomme `x₀` le nombre réel introduit
par la commande `Soit` pour insister sur le fait qu'il est fixé et bien voir
qu'après la ligne `On applique hf à x₀`, l'hypothèse `hf` ne porte plus que
sur ce seul nombre.
-/

-- Si f et g sont paires alors leur somme l'est aussi.
example (f g : ℝ → ℝ) : paire f → paire g →  paire (f + g) :=
begin
  Supposons (hf : ∀ x, f (-x) = f x) (hg : ∀ x, g (-x) = g x),
  Montrons que ∀ x, (f+g) (-x) = (f+g) x,
  Soit x₀ : ℝ,
  On applique hf à x₀,
  On applique hg à x₀,
  calc (f + g) (-x₀) = f (-x₀) + g (-x₀) : by On calcule
  ... = f x₀ + g (-x₀) : by On réécrit via hf
  ... = f x₀ + g x₀ : by On réécrit via hg
  ... = (f + g) x₀ : by On calcule
end

/-
Dans la démonstration précédente, la ligne commençant par "Montrons que"
est purement psychologique, Lean n'en a pas besoin du tout.
De plus on n'est pas obligé d'expliciter la définition de "paire"
dans la première ligne. On peut donc aussi utiliser la version ci-dessous.

De plus Lean n'a pas vraiment besoin qu'on lui dise
à quel réel appliquer les hypothèses de parité, il
lui suffit de chercher dans le but en cours donc les lignes
de spécialisation `On applique` sont inutiles.
-/

-- Si f et g sont paires alors leur somme l'est aussi, avec une démonstration moins bavarde.
example (f g : ℝ → ℝ) : paire f → paire g →  paire (f + g) :=
begin
  Supposons (hf : paire f) (hg : paire g),
  Soit x,
  calc (f + g) (-x) = f (-x) + g (-x) : by On calcule
  ... = f x + g (-x) : by On réécrit via hf
  ... = f x + g x : by On réécrit via hg
  ... = (f + g) x : by On calcule,
end

example (f g : ℝ → ℝ) : paire f → paire (g ∘ f) :=
begin
  sorry
end

example (f g : ℝ → ℝ) : impaire f → impaire g →  impaire (g ∘ f) :=
begin
  sorry
end

/-
Voyons maintenant comment manipuler des prédicats plus complexes.
On se donne une fonction `f : ℝ → ℝ` et on forme le prédicat
portant sur deux nombres `x₁̀` et `x₂` auxquels on associe
l'énoncé `x₁ ≤ x₂ → f x₁ ≤ f x₂` (Si x₁ ≤ x₂ alors f(x₁) ≤ f(x₂)).

On peut emboîter deux quantificateurs universels pour obtenir la définition
de fonction croissante.
-/

def croissante (f : ℝ → ℝ) := ∀ x₁, (∀ x₂, x₁ ≤ x₂ → f x₁ ≤ f x₂)

/-
Un tel emboîtement est un peu lourd à lire, on peut l'abréger comme
dans la définition suivante.
-/

def decroissante (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≥ f x₂

/-
Dans l'exemple suivant, la commande
`On conclut par (hf : croissante f) appliqué à [x₁, x₂, h],`
spécialise en vol l'énoncé `hf` en lui fournissant deux nombres réels
et une hypothèse d'inégalité.
Le rappel du contenu de `hf` n'est là que pour faciliter la lecture, on
aurait pu écrire
`On conclut par hf appliqué à [x₁, x₂, h],`
-/

example (f g : ℝ → ℝ) (hf : croissante f) (hg : croissante g) : croissante (g ∘ f) :=
begin
  Soit x₁ x₂,
  Supposons h : x₁ ≤ x₂,
  Montrons que g (f x₁) ≤ g (f x₂), -- Cette ligne est facultative mais facilite la lecture
  Fait F1 : f x₁ ≤ f x₂,
    On conclut par (hf : croissante f) appliqué à [x₁, x₂, h],
  On conclut par (hg : croissante g) appliqué à [f x₁, f x₂, F1],
end

/-
On peut aussi utiliser la commande `Par ... appliqué à ... on obtient`
pour spécialiser un énoncé quantifié universellement, comme dans
la variante suivante.
-/

example (f g : ℝ → ℝ) (hf : croissante f) (hg : croissante g) : croissante (g ∘ f) :=
begin
  Soit x₁ x₂,
  Supposons h : x₁ ≤ x₂,
  Montrons que g (f x₁) ≤ g (f x₂),
  Par hf appliqué à [x₁, x₂, h] on obtient hf' : f x₁ ≤ f x₂,
  On conclut par hg appliqué à [f x₁, f x₂, hf'],
end

/-
Dans le morceau de commande `on obtient hf' : f x₁ ≤ f x₂`,
la partie `: f x₁ ≤ f x₂` est facultative, car Lean sait bien
ce qu'on obtient en appliquant `hf`, mais elle aide à passer à
la rédaction sur papier. On peut donc commencer par ne pas
l'utiliser lors de la recherche de démonstration puis la rajouter
avant de passer sur papier.

Voici encore une autre variante, avec `On applique` :
-/
example (f g : ℝ → ℝ) (hf : croissante f) (hg : croissante g) : croissante (g ∘ f) :=
begin
  Soit x₁ x₂,
  Supposons h : x₁ ≤ x₂,
  Montrons que g (f x₁) ≤ g (f x₂),
  On applique hf à [x₁, x₂, h],
  On conclut par hg appliqué à [f x₁, f x₂, hf],
end

/- Le même en raisonnant vers l'arrière. On remarquera que Lean se débrouille pour comprendre à
quels nombres réels appliquer les hypothèses de croissance. -/
example (f g : ℝ → ℝ) (hf : croissante f) (hg : croissante g) : croissante (g ∘ f) :=
begin
  Soit x₁ x₂,
  Supposons h : x₁ ≤ x₂,
  Montrons que (g ∘ f) x₁ ≤ (g ∘ f) x₂,
  Par hg il suffit de montrer que f x₁ ≤ f x₂,
  Par hf il suffit de montrer que x₁ ≤ x₂,
  On conclut par h,
end

example (f g : ℝ → ℝ) (hf : croissante f) (hg : decroissante g) : decroissante (g ∘ f) :=
begin
  sorry
end

/-
Le symbole `∨` (qui n'est pas un v) désigne le connecteur logique « ou ».
Pour *utiliser* une hypothèse de la forme
`hyp : P ∨ Q`
lors de la démonstration d'un but `R`, on tape
`On discute en utilisant hyp,`
(ou bien `On discute en utilisant (hyp : P ∨ Q),` pour plus de clarté)
qui crée deux branches dans la démonstration :
une branche où il faut démontrer `P → R`
et l'autre où il faut démontrer `Q → R`.

Pour *démontrer* un but de la forme `P ∨ Q`, on utilise
`Montrons que P` et on démontre P ou `Montrons que Q` et
on démontre Q (il faut donc faire un choix stratégique).

Dans l'exemple suivant, on utilise aussi
la commande `On combine` suivie d'une liste d'hypothèses,
qui cherche à démontrer une égalité ou une inégalité
par combinaison linéaire de ces hypothèses.
Si la liste ne consiste qu'en une seule hypothèse,
il est plus naturel d'utiliser `On conclut par`.
Cette commande permet aussi de déduire `a ≤ b` de `a < b`
ou d'autres trivialités de ce genre.

Enfin on utilise le lemme
`mul_eq_zero : a*b = 0 ↔ a = 0 ∨ b = 0`
qui servira aussi dans l'exercice suivant.
-/

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  Supposons hyp : a=a*b,
  Fait H : a*(1 - b) = 0,
    calc a*(1 - b) = a - a*b : by On calcule
               ... = 0       : by On conclut par hyp,
  On réécrit via mul_eq_zero dans H qui devient a = 0 ∨ 1 - b = 0,
  On discute en utilisant (H : a = 0 ∨ 1 - b = 0),
    Supposons H : a = 0,
    Montrons que a = 0,
    On conclut par H,
  Supposons H : 1 - b = 0,
  Montrons que b = 1,
  On conclut par H,
end

example (x y : ℝ) : x^2 = y^2 → x = y ∨ x = -y :=
begin
  sorry
end

/-
On va maintenant combiner le quantificateur universel
et la disjonction dans deux exercices plus intéressants.

Dans l'exercice suivant, on pourra utiliser le lemme
`eq_or_lt_of_le : x ≤ y → x = y ∨ x < y`
-/
example (f : ℝ → ℝ) : croissante f ↔ ∀ x y, x < y → f x ≤ f y :=
begin
  sorry
end

/-
Dans l'exercice suivant, on pourra utiliser le lemme
`le_total x y : x ≤ y ∨ y ≤ x`

Cet exercice nécessite de réfléchir un peu plus que les
précédents, l'énoncé n'étant pas complètement évident.
-/
example (f : ℝ → ℝ) (h : croissante f) (h' : ∀ x, f (f x) = x) : ∀ x, f x = x :=
begin
  sorry
end


import tactic
import data.set.finite

open set

-- Definition d'un espace topologique :
@[ext]
class topological_space (X : Type) :=
  (is_open  : set X → Prop)
  (univ_mem : is_open univ)
  (union    : ∀ (B : set (set X)) (h : ∀ b ∈ B, is_open b), is_open (⋃₀ B))
  (inter    : ∀ {A B : set X} (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

namespace topological_space

-- Fermés :
def is_closed {X : Type} [topological_space X] : set X → Prop := λ F, is_open (compl F)

-- Preuve que l'ensemble vide est un ouvert à partir des autres axiomes :
lemma empty_mem {X : Type} [topological_space X] : is_open (∅ : set X) :=
begin
  have : (∅ : set X) = ⋃₀ ∅, simp, rw this,
  apply union,
  intros b hb, exfalso, exact hb,
end

-- Toute intersection finie d'ouverts est un ouvert :
lemma finite_inter {X : Type} [topological_space X] :
∀ (B : set (set X)) (hB : finite B) (h : ∀ b ∈ B, is_open b), is_open (⋂₀ B) :=
begin
  intros b hB,
  apply finite.induction_on hB,
  simp, exact univ_mem,
  intros a s ha hs h1 h2,
  have clef : ⋂₀insert a s = ⋂₀s ∩ a,
  { apply le_antisymm,
    { intros x hx,
      split,
      intros b hb,
      apply hx, right, exact hb,
      apply hx, left, refl, },
    { intros x hx,
      intros b hb,
      cases hb with hb1 hb2,
      rw hb1,
      exact hx.2,
      exact hx.1 b hb2, }, },
  rw clef,
  apply inter,
  { apply h1,
    intros b hb,
    apply h2 b,
    right,
    exact hb, },
  { apply h2 a,
    left,
    refl, },
end

-- Topologie discrete :
def discrete (X : Type) : topological_space X :=
{ is_open  := λ U, true,
  univ_mem := trivial,
  union    := begin intros B h, trivial, end,
  inter    := begin intros A hA B hB, trivial, end }

-- Definition d'un espace discret :
class discrete_space (X : Type) [topological_space X] :=
(all_open : ∀ U : set X, is_open U)

-- Topologie engendrée par un ensemble de parties :
inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
| generator : ∀ A ∈ g, generated_open A
| inter     : ∀ A B, generated_open A → generated_open B → generated_open (A ∩ B)
| union     : ∀ (B : set (set X)), (∀ b ∈ B, generated_open b) → generated_open (⋃₀ B)
| univ      : generated_open univ

def generate_from (X : Type) (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := generated_open.univ,
  inter     := generated_open.inter,
  union     := generated_open.union }

-- Topologie grossière :
def indiscrete (X : Type) : topological_space X :=
  generate_from X {∅, univ}

end topological_space

open topological_space

-- Topologie produit :
instance prod.topological_space (X Y : Type) [topological_space X]
  [topological_space Y] : topological_space (X × Y) :=
topological_space.generate_from (X × Y) {U | ∃ (Ux : set X) (Uy : set Y)
  (hx : is_open Ux) (hy : is_open Uy), U = set.prod Ux Uy}

-- Les ouverts pour la topologie produit sont les réunions d'ouverts élémentaires :
lemma is_open_prod_iff {X Y : Type} [topological_space X] [topological_space Y]
  {s : set (X × Y)} :
is_open s ↔ (∀a b, (a, b) ∈ s → ∃u v, is_open u ∧ is_open v ∧
                                  a ∈ u ∧ b ∈ v ∧ set.prod u v ⊆ s) :=
begin
  split,
  { intros hyp a b hab,
    induction hyp with U hU A B hA1 hB1 hA2 hB2 C hC1 hC2,
    { rcases hU with ⟨ Ux, Uy, hx, hy, hs ⟩,
      rw hs at hab,
      use [Ux, Uy, hx, hy, hab.1, hab.2],
      rw hs, },
    { rcases hA2 hab.1 with ⟨u1, v1, ⟨h1a, h1b, h1c, h1d, h1e⟩⟩,
      rcases hB2 hab.2 with ⟨u2, v2, ⟨h2a, h2b, h2c, h2d, h2e⟩⟩,
      refine ⟨u1 ∩ u2, v1 ∩ v2, inter h1a h2a, inter h1b h2b, ⟨h1c, h2c⟩,
      ⟨h1d, h2d⟩,_⟩,
      intros uv huv, split,
      apply h1e, split, exact huv.1.1, exact huv.2.1,
      apply h2e, split, exact huv.1.2, exact huv.2.2, },
    { rcases hab with ⟨c, hcC, habc ⟩,
      rcases hC2 c hcC habc with ⟨u, v, ⟨ha, hb, hc, hd, he⟩⟩,
      use [u, v, ha, hb, hc, hd],
      intros uv huv, use c, split, exact hcC, exact he huv, },
    { use [univ, univ],
      simp, split; exact univ_mem, }, },
  { intro hyp,
    choose f1 f2 hfa hfb hfc hfd hfe using hyp,
    have clef : s = ⋃₀ {(f1 a b hab).prod (f2 a b hab) | (a : X) (b : Y) (hab : (a, b) ∈ s)},
    { apply le_antisymm,
      { rintros ⟨a, b⟩ hab,
        use ((f1 a b hab).prod (f2 a b hab)),
        use [a, b, hab, hfc a b hab, hfd a b hab], },
      { rintros uv ⟨ UV, ⟨ ⟨a, b, hab, h⟩, huv ⟩⟩,
        rw ← h at huv,
        exact (hfe a b hab) huv }, },
    rw clef,
    apply union,
    rintros UV ⟨a, b, hab, h⟩,
    rw ← h,
    apply generated_open.generator,
    use [f1 a b hab, f2 a b hab, hfa a b hab, hfb a b hab], },
end

namespace topological_space

-- Definition d'une topologie à partir de ses fermés :
def mk_closed_sets
  (X : Type)
  (σ : set (set X))
  (empty_mem : ∅ ∈ σ)
  (univ_mem : univ ∈ σ)
  (inter : ∀ B ⊆ σ, ⋂₀ B ∈ σ)
  (union : ∀ (A ∈ σ) (B ∈ σ), A ∪ B ∈ σ) :
topological_space X := {
  is_open := λ U, U ∈ compl '' σ,
  univ_mem :=
  begin
    apply (mem_compl_image _ _).2,
    rw compl_univ,
    exact empty_mem
  end,
  union :=
  begin
    intros B hB,
    apply (mem_compl_image _ _).2,
    rw compl_sUnion,
    apply inter,
    intros cb hcb,
    rw ← compl_compl cb,
    exact (mem_compl_image _ _).1 (hB (compl cb) ((mem_compl_image _ _).1 hcb)),
  end,
  inter :=
  begin
    intros A B hA hB,
    apply (mem_compl_image _ _).2,
    rw compl_inter,
    exact union (compl A) ((mem_compl_image _ _).1 hA) (compl B) ((mem_compl_image _ _).1 hB),
  end,
  }

end topological_space


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

import algebra.group_power.lemmas
import algebra.order.field.basic
import data.nat.choose.basic

/-!
# Inequalities for binomial coefficients

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

This file proves exponential bounds on binomial coefficients. We might want to add here the
bounds `n^r/r^r ≤ n.choose r ≤ e^r n^r/r^r` in the future.

## Main declarations

* `nat.choose_le_pow`: `n.choose r ≤ n^r / r!`
* `nat.pow_le_choose`: `(n + 1 - r)^r / r! ≤ n.choose r`. Beware of the fishy ℕ-subtraction.
-/

open_locale nat

variables {α : Type*} [linear_ordered_semifield α]

namespace nat

lemma choose_le_pow (r n : ℕ) : (n.choose r : α) ≤ n^r / r! :=
begin
  rw le_div_iff',
  { norm_cast,
    rw ←nat.desc_factorial_eq_factorial_mul_choose,
    exact n.desc_factorial_le_pow r },
  exact_mod_cast r.factorial_pos,
end

-- horrific casting is due to ℕ-subtraction
lemma pow_le_choose (r n : ℕ) : ((n + 1 - r : ℕ)^r : α) / r! ≤ n.choose r :=
begin
  rw div_le_iff',
  { norm_cast,
    rw [←nat.desc_factorial_eq_factorial_mul_choose],
    exact n.pow_sub_le_desc_factorial r },
  exact_mod_cast r.factorial_pos,
end

end nat


abbrev N := Nat

def f : N → Nat
| 0   => 1
| n+1 => n

theorem ex1 : f 0 = 1 :=
rfl


theorem le_trans (a b c : mynat) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
begin
cases hab with s hs,
cases hbc with t ht,
use (s + t),
rwa [ht, hs, add_assoc],
end


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

! This file was ported from Lean 3 source module topology.metric_space.hausdorff_dimension
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.Hausdorff

/-!
# Hausdorff dimension

The Hausdorff dimension of a set `X` in an (extended) metric space is the unique number
`dimH s : ℝ≥0∞` such that for any `d : ℝ≥0` we have

- `μH[d] s = 0` if `dimH s < d`, and
- `μH[d] s = ∞` if `d < dimH s`.

In this file we define `dimH s` to be the Hausdorff dimension of `s`, then prove some basic
properties of Hausdorff dimension.

## Main definitions

* `measure_theory.dimH`: the Hausdorff dimension of a set. For the Hausdorff dimension of the whole
  space we use `measure_theory.dimH (set.univ : set X)`.

## Main results

### Basic properties of Hausdorff dimension

* `hausdorff_measure_of_lt_dimH`, `dimH_le_of_hausdorff_measure_ne_top`,
  `le_dimH_of_hausdorff_measure_eq_top`, `hausdorff_measure_of_dimH_lt`, `measure_zero_of_dimH_lt`,
  `le_dimH_of_hausdorff_measure_ne_zero`, `dimH_of_hausdorff_measure_ne_zero_ne_top`: various forms
  of the characteristic property of the Hausdorff dimension;
* `dimH_union`: the Hausdorff dimension of the union of two sets is the maximum of their Hausdorff
  dimensions.
* `dimH_Union`, `dimH_bUnion`, `dimH_sUnion`: the Hausdorff dimension of a countable union of sets
  is the supremum of their Hausdorff dimensions;
* `dimH_empty`, `dimH_singleton`, `set.subsingleton.dimH_zero`, `set.countable.dimH_zero` : `dimH s
  = 0` whenever `s` is countable;

### (Pre)images under (anti)lipschitz and Hölder continuous maps

* `holder_with.dimH_image_le` etc: if `f : X → Y` is Hölder continuous with exponent `r > 0`, then
  for any `s`, `dimH (f '' s) ≤ dimH s / r`. We prove versions of this statement for `holder_with`,
  `holder_on_with`, and locally Hölder maps, as well as for `set.image` and `set.range`.
* `lipschitz_with.dimH_image_le` etc: Lipschitz continuous maps do not increase the Hausdorff
  dimension of sets.
* for a map that is known to be both Lipschitz and antilipschitz (e.g., for an `isometry` or
  a `continuous_linear_equiv`) we also prove `dimH (f '' s) = dimH s`.

### Hausdorff measure in `ℝⁿ`

* `real.dimH_of_nonempty_interior`: if `s` is a set in a finite dimensional real vector space `E`
  with nonempty interior, then the Hausdorff dimension of `s` is equal to the dimension of `E`.
* `dense_compl_of_dimH_lt_finrank`: if `s` is a set in a finite dimensional real vector space `E`
  with Hausdorff dimension strictly less than the dimension of `E`, the `s` has a dense complement.
* `cont_diff.dense_compl_range_of_finrank_lt_finrank`: the complement to the range of a `C¹`
  smooth map is dense provided that the dimension of the domain is strictly less than the dimension
  of the codomain.

## Notations

We use the following notation localized in `measure_theory`. It is defined in
`measure_theory.measure.hausdorff`.

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

## Implementation notes

* The definition of `dimH` explicitly uses `borel X` as a measurable space structure. This way we
  can formulate lemmas about Hausdorff dimension without assuming that the environment has a
  `[measurable_space X]` instance that is equal but possibly not defeq to `borel X`.

  Lemma `dimH_def` unfolds this definition using whatever `[measurable_space X]` instance we have in
  the environment (as long as it is equal to `borel X`).

* The definition `dimH` is irreducible; use API lemmas or `dimH_def` instead.

## Tags

Hausdorff measure, Hausdorff dimension, dimension
-/

open MeasureTheory ENNReal NNReal Topology

open MeasureTheory MeasureTheory.Measure Set TopologicalSpace FiniteDimensional Filter

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

/-- Hausdorff dimension of a set in an (e)metric space. -/
noncomputable irreducible_def dimH (s : Set X) : ℝ≥0∞ :=
  by
  borelize X
  exact ⨆ (d : ℝ≥0) (hd : @hausdorff_measure X _ _ ⟨rfl⟩ d s = ∞), d
#align dimH dimH

/-!
### Basic properties
-/

section Measurable

variable [MeasurableSpace X] [BorelSpace X]

/-- Unfold the definition of `dimH` using `[measurable_space X] [borel_space X]` from the
environment. -/
theorem dimH_def (s : Set X) : dimH s = ⨆ (d : ℝ≥0) (hd : μH[d] s = ∞), d :=
  by
  borelize X
  rw [dimH]
#align dimH_def dimH_def

theorem hausdorffMeasure_of_lt_dimH {s : Set X} {d : ℝ≥0} (h : ↑d < dimH s) : μH[d] s = ∞ :=
  by
  simp only [dimH_def, lt_supᵢ_iff] at h
  rcases h with ⟨d', hsd', hdd'⟩
  rw [ENNReal.coe_lt_coe, ← NNReal.coe_lt_coe] at hdd'
  exact top_unique (hsd' ▸ hausdorff_measure_mono hdd'.le _)
#align hausdorff_measure_of_lt_dimH hausdorffMeasure_of_lt_dimH

theorem dimH_le {s : Set X} {d : ℝ≥0∞} (H : ∀ d' : ℝ≥0, μH[d'] s = ∞ → ↑d' ≤ d) : dimH s ≤ d :=
  (dimH_def s).trans_le <| supᵢ₂_le H
#align dimH_le dimH_le

theorem dimH_le_of_hausdorffMeasure_ne_top {s : Set X} {d : ℝ≥0} (h : μH[d] s ≠ ∞) : dimH s ≤ d :=
  le_of_not_lt <| mt hausdorffMeasure_of_lt_dimH h
#align dimH_le_of_hausdorff_measure_ne_top dimH_le_of_hausdorffMeasure_ne_top

theorem le_dimH_of_hausdorffMeasure_eq_top {s : Set X} {d : ℝ≥0} (h : μH[d] s = ∞) : ↑d ≤ dimH s :=
  by
  rw [dimH_def]
  exact le_supᵢ₂ d h
#align le_dimH_of_hausdorff_measure_eq_top le_dimH_of_hausdorffMeasure_eq_top

theorem hausdorffMeasure_of_dimH_lt {s : Set X} {d : ℝ≥0} (h : dimH s < d) : μH[d] s = 0 :=
  by
  rw [dimH_def] at h
  rcases ENNReal.lt_iff_exists_nnreal_btwn.1 h with ⟨d', hsd', hd'd⟩
  rw [ENNReal.coe_lt_coe, ← NNReal.coe_lt_coe] at hd'd
  exact (hausdorff_measure_zero_or_top hd'd s).resolve_right fun h => hsd'.not_le <| le_supᵢ₂ d' h
#align hausdorff_measure_of_dimH_lt hausdorffMeasure_of_dimH_lt

theorem measure_zero_of_dimH_lt {μ : Measure X} {d : ℝ≥0} (h : μ ≪ μH[d]) {s : Set X}
    (hd : dimH s < d) : μ s = 0 :=
  h <| hausdorffMeasure_of_dimH_lt hd
#align measure_zero_of_dimH_lt measure_zero_of_dimH_lt

theorem le_dimH_of_hausdorffMeasure_ne_zero {s : Set X} {d : ℝ≥0} (h : μH[d] s ≠ 0) : ↑d ≤ dimH s :=
  le_of_not_lt <| mt hausdorffMeasure_of_dimH_lt h
#align le_dimH_of_hausdorff_measure_ne_zero le_dimH_of_hausdorffMeasure_ne_zero

theorem dimH_of_hausdorffMeasure_ne_zero_ne_top {d : ℝ≥0} {s : Set X} (h : μH[d] s ≠ 0)
    (h' : μH[d] s ≠ ∞) : dimH s = d :=
  le_antisymm (dimH_le_of_hausdorffMeasure_ne_top h') (le_dimH_of_hausdorffMeasure_ne_zero h)
#align dimH_of_hausdorff_measure_ne_zero_ne_top dimH_of_hausdorffMeasure_ne_zero_ne_top

end Measurable

@[mono]
theorem dimH_mono {s t : Set X} (h : s ⊆ t) : dimH s ≤ dimH t :=
  by
  borelize X
  exact dimH_le fun d hd => le_dimH_of_hausdorffMeasure_eq_top <| top_unique <| hd ▸ measure_mono h
#align dimH_mono dimH_mono

theorem dimH_subsingleton {s : Set X} (h : s.Subsingleton) : dimH s = 0 :=
  by
  borelize X
  apply le_antisymm _ (zero_le _)
  refine' dimH_le_of_hausdorffMeasure_ne_top _
  exact ((hausdorff_measure_le_one_of_subsingleton h le_rfl).trans_lt ENNReal.one_lt_top).Ne
#align dimH_subsingleton dimH_subsingleton

alias dimH_subsingleton ← Set.Subsingleton.dimH_zero
#align set.subsingleton.dimH_zero Set.Subsingleton.dimH_zero

@[simp]
theorem dimH_empty : dimH (∅ : Set X) = 0 :=
  subsingleton_empty.dimH_zero
#align dimH_empty dimH_empty

@[simp]
theorem dimH_singleton (x : X) : dimH ({x} : Set X) = 0 :=
  subsingleton_singleton.dimH_zero
#align dimH_singleton dimH_singleton

@[simp]
theorem dimH_unionᵢ [Encodable ι] (s : ι → Set X) : dimH (⋃ i, s i) = ⨆ i, dimH (s i) :=
  by
  borelize X
  refine' le_antisymm (dimH_le fun d hd => _) (supᵢ_le fun i => dimH_mono <| subset_Union _ _)
  contrapose! hd
  have : ∀ i, μH[d] (s i) = 0 := fun i =>
    hausdorffMeasure_of_dimH_lt ((le_supᵢ (fun i => dimH (s i)) i).trans_lt hd)
  rw [measure_Union_null this]
  exact ENNReal.zero_ne_top
#align dimH_Union dimH_unionᵢ

@[simp]
theorem dimH_bUnion {s : Set ι} (hs : s.Countable) (t : ι → Set X) :
    dimH (⋃ i ∈ s, t i) = ⨆ i ∈ s, dimH (t i) :=
  by
  haveI := hs.to_encodable
  rw [bUnion_eq_Union, dimH_unionᵢ, ← supᵢ_subtype'']
#align dimH_bUnion dimH_bUnion

@[simp]
theorem dimH_unionₛ {S : Set (Set X)} (hS : S.Countable) : dimH (⋃₀ S) = ⨆ s ∈ S, dimH s := by
  rw [sUnion_eq_bUnion, dimH_bUnion hS]
#align dimH_sUnion dimH_unionₛ

@[simp]
theorem dimH_union (s t : Set X) : dimH (s ∪ t) = max (dimH s) (dimH t) := by
  rw [union_eq_Union, dimH_unionᵢ, supᵢ_bool_eq, cond, cond, ENNReal.sup_eq_max]
#align dimH_union dimH_union

theorem dimH_countable {s : Set X} (hs : s.Countable) : dimH s = 0 :=
  bunionᵢ_of_singleton s ▸ by simp only [dimH_bUnion hs, dimH_singleton, ENNReal.supᵢ_zero_eq_zero]
#align dimH_countable dimH_countable

alias dimH_countable ← Set.Countable.dimH_zero
#align set.countable.dimH_zero Set.Countable.dimH_zero

theorem dimH_finite {s : Set X} (hs : s.Finite) : dimH s = 0 :=
  hs.Countable.dimH_zero
#align dimH_finite dimH_finite

alias dimH_finite ← Set.Finite.dimH_zero
#align set.finite.dimH_zero Set.Finite.dimH_zero

@[simp]
theorem dimH_coe_finset (s : Finset X) : dimH (s : Set X) = 0 :=
  s.finite_toSet.dimH_zero
#align dimH_coe_finset dimH_coe_finset

alias dimH_coe_finset ← Finset.dimH_zero
#align finset.dimH_zero Finset.dimH_zero

/-!
### Hausdorff dimension as the supremum of local Hausdorff dimensions
-/

section

variable [SecondCountableTopology X]

/-- If `r` is less than the Hausdorff dimension of a set `s` in an (extended) metric space with
second countable topology, then there exists a point `x ∈ s` such that every neighborhood
`t` of `x` within `s` has Hausdorff dimension greater than `r`. -/
theorem exists_mem_nhdsWithin_lt_dimH_of_lt_dimH {s : Set X} {r : ℝ≥0∞} (h : r < dimH s) :
    ∃ x ∈ s, ∀ t ∈ 𝓝[s] x, r < dimH t := by
  contrapose! h; choose! t htx htr using h
  rcases countable_cover_nhds_within htx with ⟨S, hSs, hSc, hSU⟩
  calc
    dimH s ≤ dimH (⋃ x ∈ S, t x) := dimH_mono hSU
    _ = ⨆ x ∈ S, dimH (t x) := (dimH_bUnion hSc _)
    _ ≤ r := supᵢ₂_le fun x hx => htr x <| hSs hx

#align exists_mem_nhds_within_lt_dimH_of_lt_dimH exists_mem_nhdsWithin_lt_dimH_of_lt_dimH

/-- In an (extended) metric space with second countable topology, the Hausdorff dimension
of a set `s` is the supremum over `x ∈ s` of the limit superiors of `dimH t` along
`(𝓝[s] x).small_sets`. -/
theorem bsupr_limsup_dimH (s : Set X) : (⨆ x ∈ s, limsup dimH (𝓝[s] x).smallSets) = dimH s :=
  by
  refine' le_antisymm (supᵢ₂_le fun x hx => _) _
  · refine' Limsup_le_of_le (by infer_param) (eventually_map.2 _)
    exact eventually_small_sets.2 ⟨s, self_mem_nhdsWithin, fun t => dimH_mono⟩
  · refine' le_of_forall_ge_of_dense fun r hr => _
    rcases exists_mem_nhdsWithin_lt_dimH_of_lt_dimH hr with ⟨x, hxs, hxr⟩
    refine' le_supᵢ₂_of_le x hxs _
    rw [limsup_eq]
    refine' le_infₛ fun b hb => _
    rcases eventually_small_sets.1 hb with ⟨t, htx, ht⟩
    exact (hxr t htx).le.trans (ht t subset.rfl)
#align bsupr_limsup_dimH bsupr_limsup_dimH

/-- In an (extended) metric space with second countable topology, the Hausdorff dimension
of a set `s` is the supremum over all `x` of the limit superiors of `dimH t` along
`(𝓝[s] x).small_sets`. -/
theorem supᵢ_limsup_dimH (s : Set X) : (⨆ x, limsup dimH (𝓝[s] x).smallSets) = dimH s :=
  by
  refine' le_antisymm (supᵢ_le fun x => _) _
  · refine' Limsup_le_of_le (by infer_param) (eventually_map.2 _)
    exact eventually_small_sets.2 ⟨s, self_mem_nhdsWithin, fun t => dimH_mono⟩
  · rw [← bsupr_limsup_dimH]
    exact supᵢ₂_le_supᵢ _ _
#align supr_limsup_dimH supᵢ_limsup_dimH

end

/-!
### Hausdorff dimension and Hölder continuity
-/

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

/-- If `f` is a Hölder continuous map with exponent `r > 0`, then `dimH (f '' s) ≤ dimH s / r`. -/
theorem HolderOnWith.dimH_image_le (h : HolderOnWith C r f s) (hr : 0 < r) :
    dimH (f '' s) ≤ dimH s / r := by
  borelize X Y
  refine' dimH_le fun d hd => _
  have := h.hausdorff_measure_image_le hr d.coe_nonneg
  rw [hd, ENNReal.coe_rpow_of_nonneg _ d.coe_nonneg, top_le_iff] at this
  have Hrd : μH[(r * d : ℝ≥0)] s = ⊤ := by
    contrapose this
    exact ENNReal.mul_ne_top ENNReal.coe_ne_top this
  rw [ENNReal.le_div_iff_mul_le, mul_comm, ← ENNReal.coe_mul]
  exacts[le_dimH_of_hausdorffMeasure_eq_top Hrd, Or.inl (mt ENNReal.coe_eq_zero.1 hr.ne'),
    Or.inl ENNReal.coe_ne_top]
#align holder_on_with.dimH_image_le HolderOnWith.dimH_image_le

namespace HolderWith

/-- If `f : X → Y` is Hölder continuous with a positive exponent `r`, then the Hausdorff dimension
of the image of a set `s` is at most `dimH s / r`. -/
theorem dimH_image_le (h : HolderWith C r f) (hr : 0 < r) (s : Set X) :
    dimH (f '' s) ≤ dimH s / r :=
  (h.HolderOnWith s).dimH_image_le hr
#align holder_with.dimH_image_le HolderWith.dimH_image_le

/-- If `f` is a Hölder continuous map with exponent `r > 0`, then the Hausdorff dimension of its
range is at most the Hausdorff dimension of its domain divided by `r`. -/
theorem dimH_range_le (h : HolderWith C r f) (hr : 0 < r) :
    dimH (range f) ≤ dimH (univ : Set X) / r :=
  @image_univ _ _ f ▸ h.dimH_image_le hr univ
#align holder_with.dimH_range_le HolderWith.dimH_range_le

end HolderWith

/-- If `s` is a set in a space `X` with second countable topology and `f : X → Y` is Hölder
continuous in a neighborhood within `s` of every point `x ∈ s` with the same positive exponent `r`
but possibly different coefficients, then the Hausdorff dimension of the image `f '' s` is at most
the Hausdorff dimension of `s` divided by `r`. -/
theorem dimH_image_le_of_locally_holder_on [SecondCountableTopology X] {r : ℝ≥0} {f : X → Y}
    (hr : 0 < r) {s : Set X} (hf : ∀ x ∈ s, ∃ C : ℝ≥0, ∃ t ∈ 𝓝[s] x, HolderOnWith C r f t) :
    dimH (f '' s) ≤ dimH s / r := by
  choose! C t htn hC using hf
  rcases countable_cover_nhds_within htn with ⟨u, hus, huc, huU⟩
  replace huU := inter_eq_self_of_subset_left huU; rw [inter_Union₂] at huU
  rw [← huU, image_Union₂, dimH_bUnion huc, dimH_bUnion huc]; simp only [ENNReal.supᵢ_div]
  exact supᵢ₂_mono fun x hx => ((hC x (hus hx)).mono (inter_subset_right _ _)).dimH_image_le hr
#align dimH_image_le_of_locally_holder_on dimH_image_le_of_locally_holder_on

/-- If `f : X → Y` is Hölder continuous in a neighborhood of every point `x : X` with the same
positive exponent `r` but possibly different coefficients, then the Hausdorff dimension of the range
of `f` is at most the Hausdorff dimension of `X` divided by `r`. -/
theorem dimH_range_le_of_locally_holder_on [SecondCountableTopology X] {r : ℝ≥0} {f : X → Y}
    (hr : 0 < r) (hf : ∀ x : X, ∃ C : ℝ≥0, ∃ s ∈ 𝓝 x, HolderOnWith C r f s) :
    dimH (range f) ≤ dimH (univ : Set X) / r :=
  by
  rw [← image_univ]
  refine' dimH_image_le_of_locally_holder_on hr fun x _ => _
  simpa only [exists_prop, nhdsWithin_univ] using hf x
#align dimH_range_le_of_locally_holder_on dimH_range_le_of_locally_holder_on

/-!
### Hausdorff dimension and Lipschitz continuity
-/

/-- If `f : X → Y` is Lipschitz continuous on `s`, then `dimH (f '' s) ≤ dimH s`. -/
theorem LipschitzOnWith.dimH_image_le (h : LipschitzOnWith K f s) : dimH (f '' s) ≤ dimH s := by
  simpa using h.holder_on_with.dimH_image_le zero_lt_one
#align lipschitz_on_with.dimH_image_le LipschitzOnWith.dimH_image_le

namespace LipschitzWith

/-- If `f` is a Lipschitz continuous map, then `dimH (f '' s) ≤ dimH s`. -/
theorem dimH_image_le (h : LipschitzWith K f) (s : Set X) : dimH (f '' s) ≤ dimH s :=
  (h.LipschitzOnWith s).dimH_image_le
#align lipschitz_with.dimH_image_le LipschitzWith.dimH_image_le

/-- If `f` is a Lipschitz continuous map, then the Hausdorff dimension of its range is at most the
Hausdorff dimension of its domain. -/
theorem dimH_range_le (h : LipschitzWith K f) : dimH (range f) ≤ dimH (univ : Set X) :=
  @image_univ _ _ f ▸ h.dimH_image_le univ
#align lipschitz_with.dimH_range_le LipschitzWith.dimH_range_le

end LipschitzWith

/-- If `s` is a set in an extended metric space `X` with second countable topology and `f : X → Y`
is Lipschitz in a neighborhood within `s` of every point `x ∈ s`, then the Hausdorff dimension of
the image `f '' s` is at most the Hausdorff dimension of `s`. -/
theorem dimH_image_le_of_locally_lipschitz_on [SecondCountableTopology X] {f : X → Y} {s : Set X}
    (hf : ∀ x ∈ s, ∃ C : ℝ≥0, ∃ t ∈ 𝓝[s] x, LipschitzOnWith C f t) : dimH (f '' s) ≤ dimH s :=
  by
  have : ∀ x ∈ s, ∃ C : ℝ≥0, ∃ t ∈ 𝓝[s] x, HolderOnWith C 1 f t := by
    simpa only [holderOnWith_one] using hf
  simpa only [ENNReal.coe_one, div_one] using dimH_image_le_of_locally_holder_on zero_lt_one this
#align dimH_image_le_of_locally_lipschitz_on dimH_image_le_of_locally_lipschitz_on

/-- If `f : X → Y` is Lipschitz in a neighborhood of each point `x : X`, then the Hausdorff
dimension of `range f` is at most the Hausdorff dimension of `X`. -/
theorem dimH_range_le_of_locally_lipschitz_on [SecondCountableTopology X] {f : X → Y}
    (hf : ∀ x : X, ∃ C : ℝ≥0, ∃ s ∈ 𝓝 x, LipschitzOnWith C f s) :
    dimH (range f) ≤ dimH (univ : Set X) :=
  by
  rw [← image_univ]
  refine' dimH_image_le_of_locally_lipschitz_on fun x _ => _
  simpa only [exists_prop, nhdsWithin_univ] using hf x
#align dimH_range_le_of_locally_lipschitz_on dimH_range_le_of_locally_lipschitz_on

namespace AntilipschitzWith

theorem dimH_preimage_le (hf : AntilipschitzWith K f) (s : Set Y) : dimH (f ⁻¹' s) ≤ dimH s :=
  by
  borelize X Y
  refine' dimH_le fun d hd => le_dimH_of_hausdorffMeasure_eq_top _
  have := hf.hausdorff_measure_preimage_le d.coe_nonneg s
  rw [hd, top_le_iff] at this
  contrapose! this
  exact ENNReal.mul_ne_top (by simp) this
#align antilipschitz_with.dimH_preimage_le AntilipschitzWith.dimH_preimage_le

theorem le_dimH_image (hf : AntilipschitzWith K f) (s : Set X) : dimH s ≤ dimH (f '' s) :=
  calc
    dimH s ≤ dimH (f ⁻¹' (f '' s)) := dimH_mono (subset_preimage_image _ _)
    _ ≤ dimH (f '' s) := hf.dimH_preimage_le _

#align antilipschitz_with.le_dimH_image AntilipschitzWith.le_dimH_image

end AntilipschitzWith

/-!
### Isometries preserve Hausdorff dimension
-/

theorem Isometry.dimH_image (hf : Isometry f) (s : Set X) : dimH (f '' s) = dimH s :=
  le_antisymm (hf.lipschitz.dimH_image_le _) (hf.antilipschitz.le_dimH_image _)
#align isometry.dimH_image Isometry.dimH_image

namespace IsometryEquiv

@[simp]
theorem dimH_image (e : X ≃ᵢ Y) (s : Set X) : dimH (e '' s) = dimH s :=
  e.Isometry.dimH_image s
#align isometry_equiv.dimH_image IsometryEquiv.dimH_image

@[simp]
theorem dimH_preimage (e : X ≃ᵢ Y) (s : Set Y) : dimH (e ⁻¹' s) = dimH s := by
  rw [← e.image_symm, e.symm.dimH_image]
#align isometry_equiv.dimH_preimage IsometryEquiv.dimH_preimage

theorem dimH_univ (e : X ≃ᵢ Y) : dimH (univ : Set X) = dimH (univ : Set Y) := by
  rw [← e.dimH_preimage univ, preimage_univ]
#align isometry_equiv.dimH_univ IsometryEquiv.dimH_univ

end IsometryEquiv

namespace ContinuousLinearEquiv

variable {𝕜 E F : Type _} [NontriviallyNormedField 𝕜] [NormedAddCommGroup E] [NormedSpace 𝕜 E]
  [NormedAddCommGroup F] [NormedSpace 𝕜 F]

@[simp]
theorem dimH_image (e : E ≃L[𝕜] F) (s : Set E) : dimH (e '' s) = dimH s :=
  le_antisymm (e.lipschitz.dimH_image_le s) <| by
    simpa only [e.symm_image_image] using e.symm.lipschitz.dimH_image_le (e '' s)
#align continuous_linear_equiv.dimH_image ContinuousLinearEquiv.dimH_image

@[simp]
theorem dimH_preimage (e : E ≃L[𝕜] F) (s : Set F) : dimH (e ⁻¹' s) = dimH s := by
  rw [← e.image_symm_eq_preimage, e.symm.dimH_image]
#align continuous_linear_equiv.dimH_preimage ContinuousLinearEquiv.dimH_preimage

theorem dimH_univ (e : E ≃L[𝕜] F) : dimH (univ : Set E) = dimH (univ : Set F) := by
  rw [← e.dimH_preimage, preimage_univ]
#align continuous_linear_equiv.dimH_univ ContinuousLinearEquiv.dimH_univ

end ContinuousLinearEquiv

/-!
### Hausdorff dimension in a real vector space
-/

namespace Real

variable {E : Type _} [Fintype ι] [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]

theorem dimH_ball_pi (x : ι → ℝ) {r : ℝ} (hr : 0 < r) : dimH (Metric.ball x r) = Fintype.card ι :=
  by
  cases isEmpty_or_nonempty ι
  · rwa [dimH_subsingleton, eq_comm, Nat.cast_eq_zero, Fintype.card_eq_zero_iff]
    exact fun x _ y _ => Subsingleton.elim x y
  · rw [← ENNReal.coe_nat]
    have : μH[Fintype.card ι] (Metric.ball x r) = ENNReal.ofReal ((2 * r) ^ Fintype.card ι) := by
      rw [hausdorff_measure_pi_real, Real.volume_pi_ball _ hr]
    refine' dimH_of_hausdorffMeasure_ne_zero_ne_top _ _ <;> rw [NNReal.coe_nat_cast, this]
    · simp [pow_pos (mul_pos (zero_lt_two' ℝ) hr)]
    · exact ENNReal.ofReal_ne_top
#align real.dimH_ball_pi Real.dimH_ball_pi

theorem dimH_ball_pi_fin {n : ℕ} (x : Fin n → ℝ) {r : ℝ} (hr : 0 < r) :
    dimH (Metric.ball x r) = n := by rw [dimH_ball_pi x hr, Fintype.card_fin]
#align real.dimH_ball_pi_fin Real.dimH_ball_pi_fin

theorem dimH_univ_pi (ι : Type _) [Fintype ι] : dimH (univ : Set (ι → ℝ)) = Fintype.card ι := by
  simp only [← Metric.unionᵢ_ball_nat_succ (0 : ι → ℝ), dimH_unionᵢ,
    dimH_ball_pi _ (Nat.cast_add_one_pos _), supᵢ_const]
#align real.dimH_univ_pi Real.dimH_univ_pi

theorem dimH_univ_pi_fin (n : ℕ) : dimH (univ : Set (Fin n → ℝ)) = n := by
  rw [dimH_univ_pi, Fintype.card_fin]
#align real.dimH_univ_pi_fin Real.dimH_univ_pi_fin

theorem dimH_of_mem_nhds {x : E} {s : Set E} (h : s ∈ 𝓝 x) : dimH s = finrank ℝ E :=
  by
  have e : E ≃L[ℝ] Fin (finrank ℝ E) → ℝ :=
    ContinuousLinearEquiv.ofFinrankEq (FiniteDimensional.finrank_fin_fun ℝ).symm
  rw [← e.dimH_image]
  refine' le_antisymm _ _
  · exact (dimH_mono (subset_univ _)).trans_eq (dimH_univ_pi_fin _)
  · have : e '' s ∈ 𝓝 (e x) := by
      rw [← e.map_nhds_eq]
      exact image_mem_map h
    rcases metric.nhds_basis_ball.mem_iff.1 this with ⟨r, hr0, hr⟩
    simpa only [dimH_ball_pi_fin (e x) hr0] using dimH_mono hr
#align real.dimH_of_mem_nhds Real.dimH_of_mem_nhds

theorem dimH_of_nonempty_interior {s : Set E} (h : (interior s).Nonempty) : dimH s = finrank ℝ E :=
  let ⟨x, hx⟩ := h
  dimH_of_mem_nhds (mem_interior_iff_mem_nhds.1 hx)
#align real.dimH_of_nonempty_interior Real.dimH_of_nonempty_interior

variable (E)

theorem dimH_univ_eq_finrank : dimH (univ : Set E) = finrank ℝ E :=
  dimH_of_mem_nhds (@univ_mem _ (𝓝 0))
#align real.dimH_univ_eq_finrank Real.dimH_univ_eq_finrank

theorem dimH_univ : dimH (univ : Set ℝ) = 1 := by
  rw [dimH_univ_eq_finrank ℝ, FiniteDimensional.finrank_self, Nat.cast_one]
#align real.dimH_univ Real.dimH_univ

end Real

variable {E F : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]
  [NormedAddCommGroup F] [NormedSpace ℝ F]

theorem dense_compl_of_dimH_lt_finrank {s : Set E} (hs : dimH s < finrank ℝ E) : Dense (sᶜ) :=
  by
  refine' fun x => mem_closure_iff_nhds.2 fun t ht => nonempty_iff_ne_empty.2 fun he => hs.not_le _
  rw [← diff_eq, diff_eq_empty] at he
  rw [← Real.dimH_of_mem_nhds ht]
  exact dimH_mono he
#align dense_compl_of_dimH_lt_finrank dense_compl_of_dimH_lt_finrank

/-!
### Hausdorff dimension and `C¹`-smooth maps

`C¹`-smooth maps are locally Lipschitz continuous, hence they do not increase the Hausdorff
dimension of sets.
-/

/-- Let `f` be a function defined on a finite dimensional real normed space. If `f` is `C¹`-smooth
on a convex set `s`, then the Hausdorff dimension of `f '' s` is less than or equal to the Hausdorff
dimension of `s`.

TODO: do we actually need `convex ℝ s`? -/
theorem ContDiffOn.dimH_image_le {f : E → F} {s t : Set E} (hf : ContDiffOn ℝ 1 f s)
    (hc : Convex ℝ s) (ht : t ⊆ s) : dimH (f '' t) ≤ dimH t :=
  dimH_image_le_of_locally_lipschitz_on fun x hx =>
    let ⟨C, u, hu, hf⟩ := (hf x (ht hx)).exists_lipschitzOnWith hc
    ⟨C, u, nhdsWithin_mono _ ht hu, hf⟩
#align cont_diff_on.dimH_image_le ContDiffOn.dimH_image_le

/-- The Hausdorff dimension of the range of a `C¹`-smooth function defined on a finite dimensional
real normed space is at most the dimension of its domain as a vector space over `ℝ`. -/
theorem ContDiff.dimH_range_le {f : E → F} (h : ContDiff ℝ 1 f) : dimH (range f) ≤ finrank ℝ E :=
  calc
    dimH (range f) = dimH (f '' univ) := by rw [image_univ]
    _ ≤ dimH (univ : Set E) := (h.ContDiffOn.dimH_image_le convex_univ Subset.rfl)
    _ = finrank ℝ E := Real.dimH_univ_eq_finrank E

#align cont_diff.dimH_range_le ContDiff.dimH_range_le

/-- A particular case of Sard's Theorem. Let `f : E → F` be a map between finite dimensional real
vector spaces. Suppose that `f` is `C¹` smooth on a convex set `s` of Hausdorff dimension strictly
less than the dimension of `F`. Then the complement of the image `f '' s` is dense in `F`. -/
theorem ContDiffOn.dense_compl_image_of_dimH_lt_finrank [FiniteDimensional ℝ F] {f : E → F}
    {s t : Set E} (h : ContDiffOn ℝ 1 f s) (hc : Convex ℝ s) (ht : t ⊆ s)
    (htF : dimH t < finrank ℝ F) : Dense ((f '' t)ᶜ) :=
  dense_compl_of_dimH_lt_finrank <| (h.dimH_image_le hc ht).trans_lt htF
#align cont_diff_on.dense_compl_image_of_dimH_lt_finrank ContDiffOn.dense_compl_image_of_dimH_lt_finrank

/-- A particular case of Sard's Theorem. If `f` is a `C¹` smooth map from a real vector space to a
real vector space `F` of strictly larger dimension, then the complement of the range of `f` is dense
in `F`. -/
theorem ContDiff.dense_compl_range_of_finrank_lt_finrank [FiniteDimensional ℝ F] {f : E → F}
    (h : ContDiff ℝ 1 f) (hEF : finrank ℝ E < finrank ℝ F) : Dense (range fᶜ) :=
  dense_compl_of_dimH_lt_finrank <| h.dimH_range_le.trans_lt <| Nat.cast_lt.2 hEF
#align cont_diff.dense_compl_range_of_finrank_lt_finrank ContDiff.dense_compl_range_of_finrank_lt_finrank