/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.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_locale measure_theory ennreal nnreal topology
open measure_theory measure_theory.measure set topological_space finite_dimensional filter

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

/-- Hausdorff dimension of a set in an (e)metric space. -/
@[irreducible] noncomputable def dimH (s : set X) : ℝ≥0∞ :=
by { borelize X, exact ⨆ (d : ℝ≥0) (hd : @hausdorff_measure X _ _ ⟨rfl⟩ d s = ∞), d }

/-!
### Basic properties
-/
section measurable

variables [measurable_space X] [borel_space X]

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

lemma hausdorff_measure_of_lt_dimH {s : set X} {d : ℝ≥0} (h : ↑d < dimH s) : μH[d] s = ∞ :=
begin
  simp only [dimH_def, lt_supr_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 _)
end

lemma dimH_le {s : set X} {d : ℝ≥0∞} (H : ∀ d' : ℝ≥0, μH[d'] s = ∞ → ↑d' ≤ d) : dimH s ≤ d :=
(dimH_def s).trans_le $ supr₂_le H

lemma dimH_le_of_hausdorff_measure_ne_top {s : set X} {d : ℝ≥0} (h : μH[d] s ≠ ∞) :
  dimH s ≤ d :=
le_of_not_lt $ mt hausdorff_measure_of_lt_dimH h

lemma le_dimH_of_hausdorff_measure_eq_top {s : set X} {d : ℝ≥0} (h : μH[d] s = ∞) :
  ↑d ≤ dimH s :=
by { rw dimH_def, exact le_supr₂ d h }

lemma hausdorff_measure_of_dimH_lt {s : set X} {d : ℝ≥0}
  (h : dimH s < d) : μH[d] s = 0 :=
begin
  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 (λ h, hsd'.not_le $ le_supr₂ d' h)
end

lemma measure_zero_of_dimH_lt {μ : measure X} {d : ℝ≥0}
  (h : μ ≪ μH[d]) {s : set X} (hd : dimH s < d) :
  μ s = 0 :=
h $ hausdorff_measure_of_dimH_lt hd

lemma le_dimH_of_hausdorff_measure_ne_zero {s : set X} {d : ℝ≥0} (h : μH[d] s ≠ 0) :
  ↑d ≤ dimH s :=
le_of_not_lt $ mt hausdorff_measure_of_dimH_lt h

lemma dimH_of_hausdorff_measure_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_hausdorff_measure_ne_top h') (le_dimH_of_hausdorff_measure_ne_zero h)

end measurable

@[mono] lemma dimH_mono {s t : set X} (h : s ⊆ t) : dimH s ≤ dimH t :=
begin
  borelize X,
  exact dimH_le (λ d hd, le_dimH_of_hausdorff_measure_eq_top $
    top_unique $ hd ▸ measure_mono h)
end

lemma dimH_subsingleton {s : set X} (h : s.subsingleton) : dimH s = 0 :=
begin
  borelize X,
  apply le_antisymm _ (zero_le _),
  refine dimH_le_of_hausdorff_measure_ne_top _,
  exact ((hausdorff_measure_le_one_of_subsingleton h le_rfl).trans_lt ennreal.one_lt_top).ne,
end

alias dimH_subsingleton ← set.subsingleton.dimH_zero

@[simp] lemma dimH_empty : dimH (∅ : set X) = 0 := subsingleton_empty.dimH_zero

@[simp] lemma dimH_singleton (x : X) : dimH ({x} : set X) = 0 := subsingleton_singleton.dimH_zero

@[simp] lemma dimH_Union [encodable ι] (s : ι → set X) :
  dimH (⋃ i, s i) = ⨆ i, dimH (s i) :=
begin
  borelize X,
  refine le_antisymm (dimH_le $ λ d hd, _) (supr_le $ λ i, dimH_mono $ subset_Union _ _),
  contrapose! hd,
  have : ∀ i, μH[d] (s i) = 0,
    from λ i, hausdorff_measure_of_dimH_lt ((le_supr (λ i, dimH (s i)) i).trans_lt hd),
  rw measure_Union_null this,
  exact ennreal.zero_ne_top
end

@[simp] lemma dimH_bUnion {s : set ι} (hs : s.countable) (t : ι → set X) :
  dimH (⋃ i ∈ s, t i) = ⨆ i ∈ s, dimH (t i) :=
begin
  haveI := hs.to_encodable,
  rw [bUnion_eq_Union, dimH_Union, ← supr_subtype'']
end

@[simp] lemma dimH_sUnion {S : set (set X)} (hS : S.countable) : dimH (⋃₀ S) = ⨆ s ∈ S, dimH s :=
by rw [sUnion_eq_bUnion, dimH_bUnion hS]

@[simp] lemma dimH_union (s t : set X) : dimH (s ∪ t) = max (dimH s) (dimH t) :=
by rw [union_eq_Union, dimH_Union, supr_bool_eq, cond, cond, ennreal.sup_eq_max]

lemma dimH_countable {s : set X} (hs : s.countable) : dimH s = 0 :=
bUnion_of_singleton s ▸ by simp only [dimH_bUnion hs, dimH_singleton, ennreal.supr_zero_eq_zero]

alias dimH_countable ← set.countable.dimH_zero

lemma dimH_finite {s : set X} (hs : s.finite) : dimH s = 0 := hs.countable.dimH_zero

alias dimH_finite ← set.finite.dimH_zero

@[simp] lemma dimH_coe_finset (s : finset X) : dimH (s : set X) = 0 := s.finite_to_set.dimH_zero

alias dimH_coe_finset ← finset.dimH_zero

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

section

variables [second_countable_topology 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`. -/
lemma exists_mem_nhds_within_lt_dimH_of_lt_dimH {s : set X} {r : ℝ≥0∞} (h : r < dimH s) :
  ∃ x ∈ s, ∀ t ∈ 𝓝[s] x, r < dimH t :=
begin
  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 : supr₂_le (λ x hx, htr x $ hSs hx)
end

/-- 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`. -/
lemma bsupr_limsup_dimH (s : set X) : (⨆ x ∈ s, limsup dimH (𝓝[s] x).small_sets) = dimH s :=
begin
  refine le_antisymm (supr₂_le $ λ x hx, _) _,
  { refine Limsup_le_of_le (by apply_auto_param) (eventually_map.2 _),
    exact eventually_small_sets.2 ⟨s, self_mem_nhds_within, λ t, dimH_mono⟩ },
  { refine le_of_forall_ge_of_dense (λ r hr, _),
    rcases exists_mem_nhds_within_lt_dimH_of_lt_dimH hr with ⟨x, hxs, hxr⟩,
    refine le_supr₂_of_le x hxs _, rw limsup_eq, refine le_Inf (λ b hb, _),
    rcases eventually_small_sets.1 hb with ⟨t, htx, ht⟩,
    exact (hxr t htx).le.trans (ht t subset.rfl) }
end

/-- 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`. -/
lemma supr_limsup_dimH (s : set X) : (⨆ x, limsup dimH (𝓝[s] x).small_sets) = dimH s :=
begin
  refine le_antisymm (supr_le $ λ x, _) _,
  { refine Limsup_le_of_le (by apply_auto_param) (eventually_map.2 _),
    exact eventually_small_sets.2 ⟨s, self_mem_nhds_within, λ t, dimH_mono⟩ },
  { rw ← bsupr_limsup_dimH, exact supr₂_le_supr _ _ }
end

end

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

variables {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`. -/
lemma holder_on_with.dimH_image_le (h : holder_on_with C r f s) (hr : 0 < r) :
  dimH (f '' s) ≤ dimH s / r :=
begin
  borelize [X, Y],
  refine dimH_le (λ 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 = ⊤,
  { 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_hausdorff_measure_eq_top Hrd, or.inl (mt ennreal.coe_eq_zero.1 hr.ne'),
    or.inl ennreal.coe_ne_top]
end

namespace holder_with

/-- 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`. -/
lemma dimH_image_le (h : holder_with C r f) (hr : 0 < r) (s : set X) :
  dimH (f '' s) ≤ dimH s / r :=
(h.holder_on_with s).dimH_image_le hr

/-- 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`. -/
lemma dimH_range_le (h : holder_with C r f) (hr : 0 < r) :
  dimH (range f) ≤ dimH (univ : set X) / r :=
@image_univ _ _ f ▸ h.dimH_image_le hr univ

end holder_with

/-- 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`. -/
lemma dimH_image_le_of_locally_holder_on [second_countable_topology X] {r : ℝ≥0} {f : X → Y}
  (hr : 0 < r) {s : set X} (hf : ∀ x ∈ s, ∃ (C : ℝ≥0) (t ∈ 𝓝[s] x), holder_on_with C r f t) :
  dimH (f '' s) ≤ dimH s / r :=
begin
  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.supr_div],
  exact supr₂_mono (λ x hx, ((hC x (hus hx)).mono (inter_subset_right _ _)).dimH_image_le hr)
end

/-- 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`. -/
lemma dimH_range_le_of_locally_holder_on [second_countable_topology X] {r : ℝ≥0} {f : X → Y}
  (hr : 0 < r) (hf : ∀ x : X, ∃ (C : ℝ≥0) (s ∈ 𝓝 x), holder_on_with C r f s) :
  dimH (range f) ≤ dimH (univ : set X) / r :=
begin
  rw ← image_univ,
  refine dimH_image_le_of_locally_holder_on hr (λ x _, _),
  simpa only [exists_prop, nhds_within_univ] using hf x
end

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

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

namespace lipschitz_with

/-- If `f` is a Lipschitz continuous map, then `dimH (f '' s) ≤ dimH s`. -/
lemma dimH_image_le (h : lipschitz_with K f) (s : set X) : dimH (f '' s) ≤ dimH s :=
(h.lipschitz_on_with s).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. -/
lemma dimH_range_le (h : lipschitz_with K f) : dimH (range f) ≤ dimH (univ : set X) :=
@image_univ _ _ f ▸ h.dimH_image_le univ

end lipschitz_with

/-- 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`. -/
lemma dimH_image_le_of_locally_lipschitz_on [second_countable_topology X] {f : X → Y}
  {s : set X} (hf : ∀ x ∈ s, ∃ (C : ℝ≥0) (t ∈ 𝓝[s] x), lipschitz_on_with C f t) :
  dimH (f '' s) ≤ dimH s :=
begin
  have : ∀ x ∈ s, ∃ (C : ℝ≥0) (t ∈ 𝓝[s] x), holder_on_with C 1 f t,
    by simpa only [holder_on_with_one] using hf,
  simpa only [ennreal.coe_one, div_one]
    using dimH_image_le_of_locally_holder_on zero_lt_one this
end

/-- 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`. -/
lemma dimH_range_le_of_locally_lipschitz_on [second_countable_topology X] {f : X → Y}
  (hf : ∀ x : X, ∃ (C : ℝ≥0) (s ∈ 𝓝 x), lipschitz_on_with C f s) :
  dimH (range f) ≤ dimH (univ : set X) :=
begin
  rw ← image_univ,
  refine dimH_image_le_of_locally_lipschitz_on (λ x _, _),
  simpa only [exists_prop, nhds_within_univ] using hf x
end

namespace antilipschitz_with

lemma dimH_preimage_le (hf : antilipschitz_with K f) (s : set Y) :
  dimH (f ⁻¹' s) ≤ dimH s :=
begin
  borelize [X, Y],
  refine dimH_le (λ d hd, le_dimH_of_hausdorff_measure_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
end

lemma le_dimH_image (hf : antilipschitz_with 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 _

end antilipschitz_with

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

lemma 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 _)

namespace isometry_equiv

@[simp] lemma dimH_image (e : X ≃ᵢ Y) (s : set X) : dimH (e '' s) = dimH s :=
e.isometry.dimH_image s

@[simp] lemma dimH_preimage (e : X ≃ᵢ Y) (s : set Y) : dimH (e ⁻¹' s) = dimH s :=
by rw [← e.image_symm, e.symm.dimH_image]

lemma dimH_univ (e : X ≃ᵢ Y) : dimH (univ : set X) = dimH (univ : set Y) :=
by rw [← e.dimH_preimage univ, preimage_univ]

end isometry_equiv

namespace continuous_linear_equiv

variables {𝕜 E F : Type*} [nontrivially_normed_field 𝕜]
  [normed_add_comm_group E] [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F]

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

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

lemma dimH_univ (e : E ≃L[𝕜] F) : dimH (univ : set E) = dimH (univ : set F) :=
by rw [← e.dimH_preimage, preimage_univ]

end continuous_linear_equiv

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

namespace real

variables {E : Type*} [fintype ι] [normed_add_comm_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E]

theorem dimH_ball_pi (x : ι → ℝ) {r : ℝ} (hr : 0 < r) :
  dimH (metric.ball x r) = fintype.card ι :=
begin
  casesI is_empty_or_nonempty ι,
  { rwa [dimH_subsingleton, eq_comm, nat.cast_eq_zero, fintype.card_eq_zero_iff],
    exact λ x _ y _, subsingleton.elim x y },
  { rw ← ennreal.coe_nat,
    have : μH[fintype.card ι] (metric.ball x r) = ennreal.of_real ((2 * r) ^ fintype.card ι),
      by rw [hausdorff_measure_pi_real, real.volume_pi_ball _ hr],
    refine dimH_of_hausdorff_measure_ne_zero_ne_top _ _; rw [nnreal.coe_nat_cast, this],
    { simp [pow_pos (mul_pos (zero_lt_two' ℝ) hr)] },
    { exact ennreal.of_real_ne_top } }
end

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]

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 _), supr_const]

theorem dimH_univ_pi_fin (n : ℕ) : dimH (univ : set (fin n → ℝ)) = n :=
by rw [dimH_univ_pi, fintype.card_fin]

theorem dimH_of_mem_nhds {x : E} {s : set E} (h : s ∈ 𝓝 x) :
  dimH s = finrank ℝ E :=
begin
  have e : E ≃L[ℝ] (fin (finrank ℝ E) → ℝ),
    from continuous_linear_equiv.of_finrank_eq (finite_dimensional.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 }
end

theorem dimH_of_nonempty_interior {s : set E} (h : (interior s).nonempty) :
  dimH s = finrank ℝ E :=
let ⟨x, hx⟩ := h in dimH_of_mem_nhds (mem_interior_iff_mem_nhds.1 hx)

variable (E)

theorem dimH_univ_eq_finrank : dimH (univ : set E) = finrank ℝ E :=
dimH_of_mem_nhds (@univ_mem _ (𝓝 0))

theorem dimH_univ : dimH (univ : set ℝ) = 1 :=
by rw [dimH_univ_eq_finrank ℝ, finite_dimensional.finrank_self, nat.cast_one]

end real

variables {E F : Type*}
  [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  [normed_add_comm_group F] [normed_space ℝ F]

theorem dense_compl_of_dimH_lt_finrank {s : set E} (hs : dimH s < finrank ℝ E) : dense sᶜ :=
begin
  refine λ x, mem_closure_iff_nhds.2 (λ t ht, nonempty_iff_ne_empty.2 $ λ he, hs.not_le _),
  rw [← diff_eq, diff_eq_empty] at he,
  rw [← real.dimH_of_mem_nhds ht],
  exact dimH_mono he
end

/-!
### 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`? -/
lemma cont_diff_on.dimH_image_le {f : E → F} {s t : set E} (hf : cont_diff_on ℝ 1 f s)
  (hc : convex ℝ s) (ht : t ⊆ s) :
  dimH (f '' t) ≤ dimH t :=
dimH_image_le_of_locally_lipschitz_on $ λ x hx,
  let ⟨C, u, hu, hf⟩ := (hf x (ht hx)).exists_lipschitz_on_with hc
  in ⟨C, u, nhds_within_mono _ ht hu, hf⟩

/-- 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 `ℝ`. -/
lemma cont_diff.dimH_range_le {f : E → F} (h : cont_diff ℝ 1 f) :
  dimH (range f) ≤ finrank ℝ E :=
calc dimH (range f) = dimH (f '' univ) : by rw image_univ
... ≤ dimH (univ : set E) : h.cont_diff_on.dimH_image_le convex_univ subset.rfl
... = finrank ℝ E : real.dimH_univ_eq_finrank E

/-- 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`. -/
lemma cont_diff_on.dense_compl_image_of_dimH_lt_finrank [finite_dimensional ℝ F] {f : E → F}
  {s t : set E} (h : cont_diff_on ℝ 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

/-- 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`. -/
lemma cont_diff.dense_compl_range_of_finrank_lt_finrank [finite_dimensional ℝ F] {f : E → F}
  (h : cont_diff ℝ 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


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import number_theory.lucas_lehmer

/-!
# Explicit Mersenne primes

We run some Lucas-Lehmer tests to prove some Mersenne primes are prime.

See the discussion at the end of [src/number_theory/lucas_lehmer.lean]
for ideas about extending this to larger Mersenne primes.
-/

example : (mersenne 13).prime :=
lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).
example : (mersenne 17).prime :=
lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).
example : (mersenne 19).prime :=
lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).

/-- 2147483647.prime, Euler (1772) -/
example : (mersenne 31).prime :=
lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).

/-!
The next four primality tests are too slow to run interactively with -T100000,
but work fine on the command line.
-/

-- /-- 2305843009213693951.prime, Pervouchine (1883), Seelhoff (1886) -/
-- example : (mersenne 61).prime :=
-- lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).
-- /-- 618970019642690137449562111.prime, Powers (1911) -/
-- -- takes ~100s
-- example : (mersenne 89).prime :=
-- lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).
-- /-- 162259276829213363391578010288127.prime, Power (1914) -/
-- -- takes ~190s
-- example : (mersenne 107).prime :=
-- lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).
-- /-- 170141183460469231731687303715884105727.prime, Lucas (1876) -/
-- -- takes ~370s
-- example : (mersenne 127).prime :=
-- lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).

/- This still doesn't get us over the big gap and into the computer era, unfortunately. -/

-- /-- (2^521 - 1).prime, Robinson (1954) -/
-- -- This has not been run successfully!
-- example : (mersenne 521).prime :=
-- lucas_lehmer_sufficiency _ (by norm_num) (by lucas_lehmer.run_test).


import tactic
variables P Q : Prop

open_locale classical

-- BEGIN
example (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
    intro hpq,
      by_contra h',
      push_neg at h',
      cases h' with h'p h'nq,
      apply h'nq (hpq (h'p)),
    intros hnpq hp,
      cases hnpq with hnp hq,
      contradiction,
      exact hq,
end

/- using the by_cases tactic -/
example (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
    intro hpq,
      by_cases h : P,
        right,
          exact hpq h,
        left,
          exact h,
    intros hnpq hp,
      cases hnpq with hnp hq,
        contradiction,
        exact hq,
end
-- END


variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun hpq : p ∧ q =>
      ⟨hpq.right, hpq.left⟩
    )
    (fun hqp : q ∧ p =>
      ⟨hqp.right, hqp.left⟩
    )

example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (fun hpq : p ∨ q =>
      Or.elim
        hpq
        (fun hp : p => Or.intro_right q hp)
        (fun hq : q => Or.intro_left p hq)
    )
    (fun hqp : q ∨ p =>
      Or.elim
        hqp
        (fun hq : q => Or.intro_right p hq)
        (fun hp : p => Or.intro_left q hp)
    )

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
    Iff.intro
      (fun itz : (p ∧ q) ∧ r => ⟨itz.left.left, itz.left.right, itz.right⟩)
      (fun itz : p ∧ (q ∧ r) => ⟨⟨itz.left, itz.right.left⟩, itz.right.right⟩)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
    Iff.intro
      (fun lbrack : (p ∨ q) ∨ r =>
        Or.elim
          lbrack
          (fun hpq : p ∨ q =>
            Or.elim
              hpq
              (fun hp : p => Or.intro_left (q ∨ r) hp)
              (fun hq : q => Or.intro_right p (Or.intro_left r hq))
          )
          (fun hr : r => Or.intro_right p (Or.intro_right q hr))
      )
      (fun rbrack : p ∨ (q ∨ r) =>
        Or.elim
          rbrack
          (fun hp : p => Or.intro_left r (Or.intro_left q hp))
          (fun hqr : q ∨ r =>
            Or.elim
            hqr
            (fun hq : q => Or.intro_left r (Or.intro_right p hq))
            (fun hr : r => Or.intro_right (p ∨ q) hr)
          )
      )

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    Iff.intro
      (fun hyp : p ∧ (q ∨ r) =>
        Or.elim
          hyp.right
          (fun hq : q => Or.intro_left (p ∧ r) ⟨hyp.left, hq⟩)
          (fun hr : r => Or.intro_right (p ∧ q) ⟨hyp.left, hr⟩)
      )
      (fun hyp : (p ∧ q) ∨ (p ∧ r) =>
        Or.elim
          hyp
          (fun hpq : p ∧ q => And.intro hpq.left (Or.intro_left r hpq.right))
          (fun hpr : p ∧ r => And.intro hpr.left (Or.intro_right q hpr.right))
      )

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
    Iff.intro
      (fun hyp : p ∨ (q ∧ r) =>
        Or.elim
          hyp
          (fun hp : p => And.intro (Or.intro_left q hp) (Or.intro_left r hp))
          (fun hqr : q ∧ r => And.intro (Or.intro_right p hqr.left) (Or.intro_right p hqr.right))
      )
      (fun hyp : (p ∨ q) ∧ (p ∨ r) =>
        Or.elim
          hyp.left
          (fun hp : p => Or.intro_left (q ∧ r) hp)
          (fun hq : q =>
            Or.elim
              hyp.right
              (fun hp : p => Or.intro_left (q ∧ r) hp)
              (fun hr : r => Or.intro_right p ⟨hq, hr⟩)
          )
      )

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
    Iff.intro
      (fun hpqr : p → (q → r) =>
        fun hpq : p ∧ q =>
          hpqr hpq.left hpq.right
      )
      (fun hpqr : p ∧ q → r =>
        fun hp : p =>
          fun hq : q =>
            hpqr ⟨hp, hq⟩
      )

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
    Iff.intro
      (fun hpqr : (p ∨ q) → r =>
        And.intro
          (fun hp : p => hpqr (Or.intro_left q hp))
          (fun hq : q => hpqr (Or.intro_right p hq))
      )
      (fun conj : (p → r) ∧ (q → r) =>
        fun disj : p ∨ q =>
          Or.elim
            disj
            (fun hp : p => conj.left hp)
            (fun hq : q => conj.right hq)
      )

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
    Iff.intro
      (fun hpq : ¬(p ∨ q) =>
        And.intro
          (fun hp : p =>
            show False from hpq (Or.intro_left q hp)
          )
          (fun hq : q =>
            show False from hpq (Or.intro_right p hq)
          )
      )
      (fun hpq : ¬p ∧ ¬q =>
        (fun disj : p ∨ q =>
          show False from
            Or.elim
             disj
             (fun hp : p => hpq.left hp)
             (fun hq : q => hpq.right hq)
        )
      )

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    fun hpq : ¬p ∨ ¬q =>
      Or.elim
        hpq
        (fun hp : ¬p =>
          fun hpq : p ∧ q =>
            show False from hp hpq.left
        )
        (fun hq : ¬q =>
          fun hpq : p ∧ q =>
            show False from hq hpq.right
        )

example : ¬(p ∧ ¬p) :=
    fun nonc : p ∧ ¬p =>
      show False from nonc.right nonc.left

example : p ∧ ¬q → ¬(p → q) :=
    fun hpq : p ∧ ¬q =>
      fun con : p → q =>
        show False from hpq.right (con hpq.left)

example : ¬p → (p → q) :=
    fun hnp : ¬p =>
      fun hp : p =>
        False.elim (hnp hp)

example : (¬p ∨ q) → (p → q) :=
    fun hpq : ¬p ∨ q =>
      Or.elim
        hpq
        (fun hnp : ¬p => (fun hp : p => False.elim (hnp hp)))
        (fun hq : q => (fun p => hq))

example : p ∨ False ↔ p :=
    Iff.intro
      (fun hpf : p ∨ False =>
        Or.elim
          hpf
          (fun p => p)
          (fun False => False.elim)
      )
      (fun hp : p => Or.intro_left False hp)

example : p ∧ False ↔ False :=
    Iff.intro
      (fun hpf : p ∧ False => hpf.right)
      (fun False => False.elim)

example : (p → q) → (¬q → ¬p) :=
  fun hpq : p → q =>
    fun hnq : ¬q =>
      fun hp : p => show False from hnq (hpq hp)


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Neil Strickland

! This file was ported from Lean 3 source module data.pnat.defs
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

import Mathlib.Algebra.NeZero
import Mathlib.Data.Nat.Cast.Defs
import Mathlib.Order.Basic
import Mathlib.Tactic.Coe
import Mathlib.Tactic.Lift

/-!
# The positive natural numbers

This file contains the definitions, and basic results.
Most algebraic facts are deferred to `Data.PNat.Basic`, as they need more imports.
-/

/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype,
  and the VM representation of `ℕ+` is the same as `ℕ` because the proof
  is not stored. -/
def PNat := { n : ℕ // 0 < n }
  deriving DecidableEq, LinearOrder
#align pnat PNat

@[inherit_doc]
notation "ℕ+" => PNat

instance : One ℕ+ :=
  ⟨⟨1, Nat.zero_lt_one⟩⟩

/-- The underlying natural number -/
@[coe]
def PNat.val : ℕ+ → ℕ := Subtype.val

instance coePNatNat : Coe ℕ+ ℕ :=
  ⟨PNat.val⟩
#align coe_pnat_nat coePNatNat

instance : Repr ℕ+ :=
  ⟨fun n n' => reprPrec n.1 n'⟩

--Porting note: New instance not in Lean3
instance (n : ℕ) : OfNat ℕ+ (n+1) :=
  ⟨⟨n + 1, Nat.succ_pos n⟩⟩

namespace PNat

-- Note: similar to Subtype.coe_mk
@[simp]
theorem mk_coe (n h) : (PNat.val (⟨n, h⟩ : ℕ+) : ℕ) = n :=
  rfl
#align pnat.mk_coe PNat.mk_coe

/-- Predecessor of a `ℕ+`, as a `ℕ`. -/
def natPred (i : ℕ+) : ℕ :=
  i - 1
#align pnat.nat_pred PNat.natPred

@[simp]

end PNat

namespace Nat

/-- Convert a natural number to a positive natural number. The
  positivity assumption is inferred by `dec_trivial`. -/
def toPNat (n : ℕ) (h : 0 < n := by decide) : ℕ+ :=
  ⟨n, h⟩
#align nat.to_pnat Nat.toPNat

/-- Write a successor as an element of `ℕ+`. -/
def succPNat (n : ℕ) : ℕ+ :=
  ⟨succ n, succ_pos n⟩
#align nat.succ_pnat Nat.succPNat

@[simp]
theorem succPNat_coe (n : ℕ) : (succPNat n : ℕ) = succ n :=
  rfl
#align nat.succ_pnat_coe Nat.succPNat_coe

@[simp]
theorem natPred_succPNat (n : ℕ) : n.succPNat.natPred = n :=
  rfl
#align nat.nat_pred_succ_pnat Nat.natPred_succPNat

@[simp]
theorem _root_.PNat.succPNat_natPred (n : ℕ+) : n.natPred.succPNat = n :=
  Subtype.eq <| succ_pred_eq_of_pos n.2
#align pnat.succ_pnat_nat_pred PNat.succPNat_natPred

/-- Convert a natural number to a `PNat`. `n+1` is mapped to itself,
  and `0` becomes `1`. -/
def toPNat' (n : ℕ) : ℕ+ :=
  succPNat (pred n)
#align nat.to_pnat' Nat.toPNat'

@[simp]
theorem toPNat'_coe : ∀ n : ℕ, (toPNat' n : ℕ) = ite (0 < n) n 1
  | 0 => rfl
  | m + 1 => by
    rw [if_pos (succ_pos m)]
    rfl
#align nat.to_pnat'_coe Nat.toPNat'_coe

end Nat

namespace PNat

open Nat

/-- We now define a long list of structures on ℕ+ induced by
 similar structures on ℕ. Most of these behave in a completely
 obvious way, but there are a few things to be said about
 subtraction, division and powers.
-/
-- Porting note: no `simp`  because simp can prove it
theorem mk_le_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : (⟨n, hn⟩ : ℕ+) ≤ ⟨k, hk⟩ ↔ n ≤ k :=
  Iff.rfl
#align pnat.mk_le_mk PNat.mk_le_mk

-- Porting note: no `simp`  because simp can prove it
theorem mk_lt_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : (⟨n, hn⟩ : ℕ+) < ⟨k, hk⟩ ↔ n < k :=
  Iff.rfl
#align pnat.mk_lt_mk PNat.mk_lt_mk

@[simp, norm_cast]
theorem coe_le_coe (n k : ℕ+) : (n : ℕ) ≤ k ↔ n ≤ k :=
  Iff.rfl
#align pnat.coe_le_coe PNat.coe_le_coe

@[simp, norm_cast]
theorem coe_lt_coe (n k : ℕ+) : (n : ℕ) < k ↔ n < k :=
  Iff.rfl
#align pnat.coe_lt_coe PNat.coe_lt_coe

@[simp]
theorem pos (n : ℕ+) : 0 < (n : ℕ) :=
  n.2
#align pnat.pos PNat.pos

theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n :=
  Subtype.eq
#align pnat.eq PNat.eq

theorem coe_injective : Function.Injective (fun (a : ℕ+) => (a : ℕ)) :=
  Subtype.coe_injective
#align pnat.coe_injective PNat.coe_injective

@[simp]
theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 :=
  n.2.ne'
#align pnat.ne_zero PNat.ne_zero

instance _root_.NeZero.pnat {a : ℕ+} : NeZero (a : ℕ) :=
  ⟨a.ne_zero⟩
#align ne_zero.pnat NeZero.pnat

theorem toPNat'_coe {n : ℕ} : 0 < n → (n.toPNat' : ℕ) = n :=
  succ_pred_eq_of_pos
#align pnat.to_pnat'_coe PNat.toPNat'_coe

@[simp]
theorem coe_toPNat' (n : ℕ+) : (n : ℕ).toPNat' = n :=
  eq (toPNat'_coe n.pos)
#align pnat.coe_to_pnat' PNat.coe_toPNat'

@[simp]
theorem one_le (n : ℕ+) : (1 : ℕ+) ≤ n :=
  n.2
#align pnat.one_le PNat.one_le

@[simp]
theorem not_lt_one (n : ℕ+) : ¬n < 1 :=
  not_lt_of_le n.one_le
#align pnat.not_lt_one PNat.not_lt_one

instance : Inhabited ℕ+ :=
  ⟨1⟩

-- Some lemmas that rewrite `PNat.mk n h`, for `n` an explicit numeral, into explicit numerals.
@[simp]
theorem mk_one {h} : (⟨1, h⟩ : ℕ+) = (1 : ℕ+) :=
  rfl
#align pnat.mk_one PNat.mk_one

@[simp, norm_cast]
theorem one_coe : ((1 : ℕ+) : ℕ) = 1 :=
  rfl
#align pnat.one_coe PNat.one_coe

@[simp, norm_cast]
theorem coe_eq_one_iff {m : ℕ+} : (m : ℕ) = 1 ↔ m = 1 :=
  Subtype.coe_injective.eq_iff' one_coe
#align pnat.coe_eq_one_iff PNat.coe_eq_one_iff

instance : WellFoundedRelation ℕ+ :=
  measure (fun (a : ℕ+) => (a : ℕ))

/-- Strong induction on `ℕ+`. -/
def strongInductionOn {p : ℕ+ → Sort _} (n : ℕ+) : (∀ k, (∀ m, m < k → p m) → p k) → p n
  | IH => IH _ fun a _ => strongInductionOn a IH
termination_by _ => n.1

#align pnat.strong_induction_on PNat.strongInductionOn

/-- We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def modDivAux : ℕ+ → ℕ → ℕ → ℕ+ × ℕ
  | k, 0, q => ⟨k, q.pred⟩
  | _, r + 1, q => ⟨⟨r + 1, Nat.succ_pos r⟩, q⟩
#align pnat.mod_div_aux PNat.modDivAux

/-- `mod_div m k = (m % k, m / k)`.
  We define `m % k` and `m / k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` and
  `m / k = n - 1`.  This ensures that `m % k` is always positive
  and `m = (m % k) + k * (m / k)` in all cases.  Later we
  define a function `div_exact` which gives the usual `m / k`
  in the case where `k` divides `m`.
-/
def modDiv (m k : ℕ+) : ℕ+ × ℕ :=
  modDivAux k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ))
#align pnat.mod_div PNat.modDiv

/-- We define `m % k` in the same way as for `ℕ`
  except that when `m = n * k` we take `m % k = k` This ensures that `m % k` is always positive.
-/
def mod (m k : ℕ+) : ℕ+ :=
  (modDiv m k).1
#align pnat.mod PNat.mod

/-- We define `m / k` in the same way as for `ℕ` except that when `m = n * k` we take
  `m / k = n - 1`. This ensures that `m = (m % k) + k * (m / k)` in all cases. Later we
  define a function `div_exact` which gives the usual `m / k` in the case where `k` divides `m`.
-/
def div (m k : ℕ+) : ℕ :=
  (modDiv m k).2
#align pnat.div PNat.div

theorem mod_coe (m k : ℕ+) :
  (mod m k : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) (k : ℕ) ((m : ℕ) % (k : ℕ)) := by
  dsimp [mod, modDiv]
  cases (m : ℕ) % (k : ℕ) with
  | zero =>
    rw [if_pos rfl]
    rfl

  | succ n =>
    rw [if_neg n.succ_ne_zero]
    rfl

#align pnat.mod_coe PNat.mod_coe

theorem div_coe (m k : ℕ+) :
  (div m k : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) ((m : ℕ) / (k : ℕ)).pred ((m : ℕ) / (k : ℕ)) := by
  dsimp [div, modDiv]
  cases (m : ℕ) % (k : ℕ) with
  | zero =>
    rw [if_pos rfl]
    rfl

  | succ n =>
    rw [if_neg n.succ_ne_zero]
    rfl

#align pnat.div_coe PNat.div_coe

/-- If `h : k | m`, then `k * (div_exact m k) = m`. Note that this is not equal to `m / k`. -/
def divExact (m k : ℕ+) : ℕ+ :=
  ⟨(div m k).succ, Nat.succ_pos _⟩
#align pnat.div_exact PNat.divExact

end PNat

section CanLift

instance Nat.canLiftPNat : CanLift ℕ ℕ+ (↑) (fun n => 0 < n) :=
  ⟨fun n hn => ⟨Nat.toPNat' n, PNat.toPNat'_coe hn⟩⟩
#align nat.can_lift_pnat Nat.canLiftPNat

instance Int.canLiftPNat : CanLift ℤ ℕ+ (↑) ((0 < ·)) :=
  ⟨fun n hn =>
    ⟨Nat.toPNat' (Int.natAbs n), by
      rw [Nat.toPNat'_coe, if_pos (Int.natAbs_pos.2 hn.ne'),
        Int.natAbs_of_nonneg hn.le]⟩⟩
#align int.can_lift_pnat Int.canLiftPNat

end CanLift


-- Существование

example : ∃ x : ℕ, x > 0 :=                     -- с места в карьер докажем существование (\exists для ∃) натурального числа
  have h : 1 > 0, from nat.zero_lt_succ 0,      -- больше 0 предъявим 1, который больше нуля по великой лемме zero_lt_one
  show ∃ x : ℕ, x > 0, from exists.intro 1 h    -- с помощью exists.intro построим из h искомое утверждение

#check (⟨1, zero_lt_one⟩ : ∃ x : ℕ, x > 0)      -- альтернативный синтаксис для exists.intro a b — ⟨a, b⟩

#check @exists.intro -- ∀ {α : Type u} {p : α → Prop} (w : α), p w → Exists p
                                                -- эта конструкция получает некоторый Exists p благодаря одному примеру,
                                                -- на котором p выполняется

variable g : ℕ → ℕ → ℕ                          -- в записе exists.intro присутствует неявный аргумент {p : α → Prop},
variable hg : g 0 0 = 0                         -- который может принимать разные значения в зависимости от контекста

set_option pp.implicit true                     -- показ неявных аргументов при печати

theorem gex1 : ∃ x, g x x = x := ⟨0, hg⟩        -- p = λ (x : ℕ), g x x = x
#print gex1

theorem gex2 : ∃ x, g x 0 = x := ⟨0, hg⟩        -- p = λ (x : ℕ), g x 0 = x
#print gex2

theorem gex3 : ∃ x, g 0 0 = x := ⟨0, hg⟩        -- p = λ (x : ℕ), g 0 0 = x
#print gex3

theorem gex4 : ∃ x, g x x = 0 := ⟨0, hg⟩        -- p = λ (x : ℕ), g x x = 0
#print gex4

#check @Exists -- Π {α : Type u}, (α → Prop) → Prop
                                                -- тип самого Exists понятен: из некоторого предиката в утверждение о существовании
                                                -- значения, делающего предикат истиным
                                                -- exists.intro в этом случае является просто конструктором типа Exists

example (x y z : ℕ)                             -- рассмотрим еще один пример
        (hxy : x < y)                           -- два условия устанавливают, что между x, y и z есть порядок: x < y < z
        (hyz : y < z) :
        ∃ w : ℕ, x < w ∧ w < z :=               -- доказываем, что есть такой w, что он между y и z
  have x < y ∧ y < z, from and.intro hxy hyz,   -- такой w есть – это сам y, что мы показываем, соединяя конъюнкцией два исходных условия
  show ∃ w : ℕ, x < w ∧ w < z,                  -- получаем результат путем введения exists.intro
    from exists.intro y this

example (x y z : ℕ)                             -- вспомним синтаксический сахар для and.intro и exists.intro
        (hxy : x < y)
        (hyz : y < z) :
        ∃ w : ℕ, x < w ∧ w < z :=
  have x < y ∧ y < z, from ⟨hxy, hyz⟩,          -- треугольные скобки заменяют and
  show ∃ w : ℕ, x < w ∧ w < z, from ⟨y, this⟩   -- треугольные скобки заменяют exists.intro (и это не просто так :) )
                                                -- при этом this = ⟨hxy, hyz⟩, а значит можем еще сильнее укоротить
                                                -- про не просто так. ∃ x : α, p x - это сахар для Σ x : α, p x :)
                                                -- то есть существование - это просто зависимая пара из элемента и предиката

example (x y z : ℕ)
        (hxy : x < y)
        (hyz : y < z) :
        ∃ w : ℕ, x < w ∧ w < z :=
  show ∃ w : ℕ, x < w ∧ w < z,                  -- show можно убрать, оставив только тело from
    from ⟨y, ⟨hxy, hyz⟩⟩                        -- скобки ассоциативны, и их можно сократить

example (x y z : ℕ)                             -- вот и все доказательство
        (hxy : x < y)
        (hyz : y < z) :
        ∃ w : ℕ, x < w ∧ w < z :=
  ⟨y, hxy, hyz⟩

-- Разбор существования

universe u
variable α : Type u
variables p q : α → Prop

example (h : ∃ x : α, p x ∧ q x) :              -- докажем следующее утверждение
          ∃ y : α, q y ∧ p y :=
  exists.elim h                                 -- exists.elim позволяет разобрать нашу зависимую пару на два элемента,
    (assume w : α,                              -- которые можно затем удобно использовать
     assume hw : p w ∧ q w,
     show ∃ y : α, q y ∧ p y, from exists.intro w ⟨hw.right, hw.left⟩)

#check @exists.elim -- ∀ {a : Type u} {p : α → Prop} {b : Prop}
                    --   (∃ x : α, p x) → (∀ a : α, p a → b) → b
                    --                       |      |
                    --                       |      +-- второй элемент пары
                    --                       +-- первый элемент пары

example (h : ∃ x : α, p x ∧ q x) :              -- альтернативным методом является применение pattern matching
          ∃ y : α, q y ∧ p y :=                 -- любое утверждение о существовании можно смэтчить с парой
  match h with ⟨w, hw⟩ :=
    exists.intro w ⟨hw.right, hw.left⟩          -- здесь можно было написать ⟨w, hw.right, hw.left⟩
  end

-- общий синтаксис match:
-- match {expr} with {pattern} :=
--   {operations}
-- end

example (h : ∃ x : α, p x ∧ q x) :              -- при pattern matching можно сразу разобрать конъюнкцию
          ∃ y : α, q y ∧ p y :=
  match h with ⟨w, hwl, hwr⟩ :=
    ⟨w, hwr, hwl⟩
  end

example (h : ∃ x : α, p x ∧ q x) :              -- также pattern matching доступен при локальном связывании
          ∃ y : α, q y ∧ p y :=
  let ⟨w, hwl, hwr⟩ := h in ⟨w, hwr, hwl⟩

-- Пример теоремы

def is_even (n : ℕ) : Prop :=
  ∃ b : ℕ, n = 2 * b

theorem even_plus_even {a b : ℕ}                -- рассмотрим два четных натуральных числа
                       (h₁ : is_even a)         -- это означает, что у нас есть доказательства их четности
                       (h₂ : is_even b) :
                         is_even (a + b) :=     -- докажем четность их суммы
  exists.elim h₁                                -- разберем доказательство четности первого числа
    (assume w₁  : ℕ,                            -- есть такое w₁, что a = 2 * w₁
     assume hw₁ : a = 2 * w₁,
     exists.elim h₂                             -- аналогично разберем доказательство четности второго числа
       (assume w₂  : ℕ,                         -- есть такое w₂, что b = 2 * w₂
        assume hw₂ : b = 2 * w₂,
        exists.intro (w₁ + w₂)                  -- покажем, что существует такое (w₁ + w₂), что a + b = 2 * (w₁ + w₂)
          (calc
            a + b = 2 * w₁ + 2 * w₂ : by rw [hw₁, hw₂]
            ...   = 2 * (w₁ + w₂)   : by rw mul_add)
       ))

theorem even_plus_even' {a b : ℕ}               -- докажем то же, через pattern matching
                        (h₁ : is_even a)
                        (h₂ : is_even b) :
                          is_even (a + b) :=
  match h₁, h₂ with                             -- вычисления выше значительно сокращаются
    ⟨w₁, hw₁⟩, ⟨w₂, hw₂⟩ :=
      exists.intro  (w₁ + w₂)                   -- сократить можно и эту часть, переписав calc как by rw [hw₁, hw₂, mul_add]
        (calc
          a + b = 2 * w₁ + 2 * w₂ : by rw [hw₁, hw₂]
          ...   = 2 * (w₁ + w₂)   : by rw mul_add)
  end


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

/-!
# Matrices as a normed space

In this file we provide the following non-instances on matrices, using the elementwise norm:

* `matrix.semi_normed_group`
* `matrix.normed_group`
* `matrix.normed_space`

These are not declared as instances because there are several natural choices for defining the norm
of a matrix.
-/

noncomputable theory

namespace matrix

variables {R n m α : Type*} [fintype n] [fintype m]

section semi_normed_group
variables [semi_normed_group α]

/-- Seminormed group instance (using sup norm of sup norm) for matrices over a seminormed ring. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def semi_normed_group : semi_normed_group (matrix n m α) :=
pi.semi_normed_group

local attribute [instance] matrix.semi_normed_group

lemma norm_le_iff {r : ℝ} (hr : 0 ≤ r) {A : matrix n m α} :
  ∥A∥ ≤ r ↔ ∀ i j, ∥A i j∥ ≤ r :=
by simp [pi_norm_le_iff hr]

lemma norm_lt_iff {r : ℝ} (hr : 0 < r) {A : matrix n m α} :
  ∥A∥ < r ↔ ∀ i j, ∥A i j∥ < r :=
by simp [pi_norm_lt_iff hr]

lemma norm_entry_le_entrywise_sup_norm (A : matrix n m α) {i : n} {j : m} :
  ∥A i j∥ ≤ ∥A∥ :=
(norm_le_pi_norm (A i) j).trans (norm_le_pi_norm A i)

end semi_normed_group

/-- Normed group instance (using sup norm of sup norm) for matrices over a normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normed_group [normed_group α] : normed_group (matrix n m α) :=
pi.normed_group

section normed_space
local attribute [instance] matrix.semi_normed_group

variables [normed_field R] [semi_normed_group α] [normed_space R α]

/-- Normed space instance (using sup norm of sup norm) for matrices over a normed field.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normed_space : normed_space R (matrix n m α) :=
pi.normed_space

end normed_space

end matrix


import .basic

namespace vect

definition is_all {α : Type _} (p : α → Prop) : ∀ {n : ℕ}, vect α n → Prop
| _ ⁅⁆ := true
| _ (a ∺ as) := p a ∧ is_all as

definition is_any {α : Type _} (p : α → Prop) : ∀ {n : ℕ}, vect α n → Prop
| _ ⁅⁆ := false
| _ (a ∺ as) := p a ∨ is_any as

--- All entries of `vect` of sybtype `subtype p` satisfy `p`
theorem is_all_subtype {α : Type _} {p : α → Prop} : ∀ {n} {xs : vect {a//p a} n}, is_all p (xs.map subtype.val)
| _ ⁅⁆ := true.intro
| _ (x ∺ xs) := ⟨x.property, is_all_subtype⟩

--- If all mapped values of `f` satisfy `p`, then all entries of `map f` of a vector satisfy `p`.
theorem map_all {α β : Type _} {f : α → β} (p : β → Prop) (hpf : ∀ a, p (f a)) : ∀ {n : ℕ} {v : vect α n}, is_all p (vect.map f v)
| _ ⁅⁆ := true.intro
| _ (a ∺ as) := ⟨hpf a, map_all⟩

--- Assertion that a given vector consists of a unique element.
definition is_diagonal {α : Type _} (a : α) : ∀ {n : ℕ}, vect α n → Prop := @is_all α (λ b, a=b)

theorem is_diagonal_eq_repeat {α : Type _} (a : α) : ∀ {n : ℕ} {as : vect α n}, is_diagonal a as → as = repeat a n
| _ ⁅⁆ _ := rfl
| (n+1) (a' ∺ as) hdiag :=
  begin
    dsimp [repeat];
    rw [←hdiag.left, is_diagonal_eq_repeat hdiag.right],
  end

end vect


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import algebra.char_p.basic
import group_theory.perm.cycle.type

/-!
# Characteristic and cardinality

We prove some results relating characteristic and cardinality of finite rings

## Tags
characterstic, cardinality, ring
-/

/-- A prime `p` is a unit in a commutative ring `R` of nonzero characterstic iff it does not divide
the characteristic. -/
lemma is_unit_iff_not_dvd_char_of_ring_char_ne_zero (R : Type*) [comm_ring R] (p : ℕ) [fact p.prime]
  (hR : ring_char R ≠ 0) :
  is_unit (p : R) ↔ ¬ p ∣ ring_char R :=
begin
  have hch := char_p.cast_eq_zero R (ring_char R),
  have hp : p.prime := fact.out p.prime,
  split,
  { rintros h₁ ⟨q, hq⟩,
    rcases is_unit.exists_left_inv h₁ with ⟨a, ha⟩,
    have h₃ : ¬ ring_char R ∣ q :=
    begin
      rintro ⟨r, hr⟩,
      rw [hr, ← mul_assoc, mul_comm p, mul_assoc] at hq,
      nth_rewrite 0 ← mul_one (ring_char R) at hq,
      exact nat.prime.not_dvd_one hp ⟨r, mul_left_cancel₀ hR hq⟩,
    end,
    have h₄ := mt (char_p.int_cast_eq_zero_iff R (ring_char R) q).mp,
    apply_fun (coe : ℕ → R) at hq,
    apply_fun ((*) a) at hq,
    rw [nat.cast_mul, hch, mul_zero, ← mul_assoc, ha, one_mul] at hq,
    norm_cast at h₄,
    exact h₄ h₃ hq.symm, },
  { intro h,
    rcases (hp.coprime_iff_not_dvd.mpr h).is_coprime with ⟨a, b, hab⟩,
    apply_fun (coe : ℤ → R) at hab,
    push_cast at hab,
    rw [hch, mul_zero, add_zero, mul_comm] at hab,
    exact is_unit_of_mul_eq_one (p : R) a hab, },
end

/-- A prime `p` is a unit in a finite commutative ring `R`
iff it does not divide the characteristic. -/
lemma is_unit_iff_not_dvd_char (R : Type*) [comm_ring R] (p : ℕ) [fact p.prime] [finite R] :
  is_unit (p : R) ↔ ¬ p ∣ ring_char R :=
is_unit_iff_not_dvd_char_of_ring_char_ne_zero R p $ char_p.char_ne_zero_of_finite R (ring_char R)

/-- The prime divisors of the characteristic of a finite commutative ring are exactly
the prime divisors of its cardinality. -/
lemma prime_dvd_char_iff_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime] :
  p ∣ ring_char R ↔ p ∣ fintype.card R :=
begin
  refine ⟨λ h, h.trans $ int.coe_nat_dvd.mp $ (char_p.int_cast_eq_zero_iff R (ring_char R)
    (fintype.card R)).mp $ by exact_mod_cast char_p.cast_card_eq_zero R, λ h, _⟩,
  by_contra h₀,
  rcases exists_prime_add_order_of_dvd_card p h with ⟨r, hr⟩,
  have hr₁ := add_order_of_nsmul_eq_zero r,
  rw [hr, nsmul_eq_mul] at hr₁,
  rcases is_unit.exists_left_inv ((is_unit_iff_not_dvd_char R p).mpr h₀) with ⟨u, hu⟩,
  apply_fun ((*) u) at hr₁,
  rw [mul_zero, ← mul_assoc, hu, one_mul] at hr₁,
  exact mt add_monoid.order_of_eq_one_iff.mpr
          (ne_of_eq_of_ne hr (nat.prime.ne_one (fact.out p.prime))) hr₁,
end

/-- A prime that does not divide the cardinality of a finite commutative ring `R`
is a unit in `R`. -/
lemma not_is_unit_prime_of_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime]
 (hp : p ∣ fintype.card R) : ¬ is_unit (p : R) :=
mt (is_unit_iff_not_dvd_char R p).mp (not_not.mpr ((prime_dvd_char_iff_dvd_card p).mpr hp))


import game.order.level03

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 4

This level invites you to work out a property of the absolute value.
In Lean the absolute value of $x$ is denoted by `abs x`.
For ease of use, a notation can be used around that definition as below.
Feel free to use the triangle inequality on the real numbers,

`abs_add : ∀ (a b : ?M_1), |a + b| ≤ |a| + |b|`

together with the `linarith` and `norm_num` tactics.
-/

notation `|` x `|` := abs x

/- Lemma
For any two real numbers $a$ and $b$, we have that
$$| a - b| ≤ |a| + |b|$$.
-/
theorem abs_sub_le_sum_abs (a b : ℝ) : |a - b| ≤ |a| + |b| :=
begin
    have H : a - b = a + (-b), linarith,
    rw H,
    have G := abs_add a (-b),
    have F : abs (-b) = abs b, norm_num,
    rw F at G, exact G, done
end

end xena --hide


import data.real.basic

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc b c a,
  rw mul_comm c a,
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw mul_comm a (b * c),
  rw mul_assoc b c a,
  rw mul_comm c a,
end

example (a b c : ℝ) : a * (b * c) = b * (c * a) :=
begin
  rw mul_comm,
  rw mul_assoc,
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw mul_comm a,
  rw mul_assoc,
  rw mul_comm c,
end

example (a b c d e f : ℝ) (h : a * b = c * d) (h' : e = f) :
  a * (b * e) = c * (d * f) :=
begin
  rw h',
  rw ←mul_assoc,
  rw h,
  rw mul_assoc,
end

example (a b c d e f : ℝ) (h : b * c = e * f) :
  a * b * c * d = a * e * f * d :=
begin
  rw mul_assoc a b c,
  rw h,
  rw ←mul_assoc,
end

example (a b c d : ℝ) (hyp : c = b * a - d) (hyp' : d = a * b) : c = 0 :=
begin
  rw hyp,
  rw hyp',
  rw mul_comm,
  rw sub_self,
end

variables a b c d e f g : ℝ

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
begin
  rw [add_mul, mul_add, mul_add],
  rw add_assoc (a * a) (a * b) (b * a + b * b),
  rw ←add_assoc (a * b) (b * a) (b * b),
  rw mul_comm b a,
  rw ←two_mul,
  rw add_assoc,
end

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) :
          by rw [mul_add, add_mul, add_mul]
  ... = a * a + (b * a + a * b) + b * b :
          by rw [←add_assoc, add_assoc (a * a)]
  ... = a * a + 2 * (a * b) + b * b     :
          by rw [mul_comm b a, ←two_mul]

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
begin
  rw [mul_add, add_mul, add_mul, ←add_assoc],
  rw [add_assoc, add_assoc, ←add_assoc (b*c)],
  rw [add_comm (b * c)],
  rw [add_assoc, ←add_assoc, ←add_assoc],
end

example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
calc
  (a + b) * (c + d)
      = a * c + b * c + a * d + b * d :
        by rw [mul_add, add_mul, add_mul, ←add_assoc]
  ... = a * c + (b * c + a * d + b * d) :
        by rw [add_assoc, add_assoc, ←add_assoc (b*c)]
  ... = a * c + (a * d + b * c + b * d) :
        by rw [add_comm (b * c)]
  ... = a * c + a * d + b * c + b * d :
        by rw [add_assoc, ←add_assoc, ←add_assoc]

example (a b : ℝ) : (a + b) * (a - b) = a^2 - b^2 :=
begin
  rw [add_mul, mul_sub, mul_sub],
  rw [add_sub, sub_add, mul_comm a b],
  rw [sub_self, sub_zero, pow_two, pow_two],
end

#check pow_two a
#check mul_sub a b c
#check add_mul a b c
#check add_sub a b c
#check sub_sub a b c
#check add_zero a

example (a b c d : ℝ) (hyp : c = d * a + b) (hyp' : b = a * d) :
  c = 2 * a * d :=
begin
  rw hyp' at hyp,
  rw [mul_comm] at hyp,
  rw [←two_mul, ←mul_assoc] at hyp,
  assumption
end

example : (c * b) * a = b * (a * c) :=
by ring

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
by ring

example : (a + b) * (a - b) = a^2 - b^2 :=
by ring

example (hyp : c = d * a + b) (hyp' : b = a * d) :
  c = 2 * a * d :=
begin
  rw [hyp, hyp'],
  ring
end


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

import LeanMusic.Utils

abbrev Intervals := List Int

namespace Intervals

@[simp] def allPositive : Intervals → Prop
  | h :: t => 0 < h ∧ allPositive t
  | _      => True

@[simp] def delta : Intervals → Int
  | h :: t => h + delta t
  | _      => 0

def invertedAt : Intervals → Int → Intervals
  | h :: (t : Intervals), a => t ++ [a - delta (h :: t)]
  | _,                    _ => []

theorem appendPosOfPos (l l' : Intervals)
    (hpl : l.allPositive) (hpl' : l'.allPositive) :
      (l ++ l').allPositive := by
  induction l with
    | nil         => rw [List.nil_append]; exact hpl'
    | cons _ _ hi => exact ⟨hpl.1, hi hpl.2⟩

theorem deltaAppendEqSumDeltas (l l' : Intervals) :
    delta (l ++ l') = delta l + delta l' := by
  induction l with
    | nil         => simp [Int.ZeroAdd]
    | cons _ _ hi =>
      simp only [HAppend.hAppend, Append.append] at hi
      simp [hi, Int.AddAssoc]

theorem posInvOfPosAndBound (l : Intervals) (i : Int)
    (hp : l.allPositive) (hb : l.delta < i) :
      (l.invertedAt i).allPositive := by
  cases l with
    | nil      => simp
    | cons h t =>
      let iSubDelta := [(i - (h + delta t))]
      have hpid : allPositive iSubDelta := by
        exact ⟨Int.zeroLtSubOfLt (h + delta t) i hb, ⟨⟩⟩
      exact appendPosOfPos t iSubDelta hp.2 hpid

theorem boundInvOfPosAndBound (l : Intervals) (i : Int)
    (hp : l.allPositive) (hb : l.delta < i) :
      (l.invertedAt i).delta < i := by
  cases l with
    | nil => exact hb
    | cons h t =>
      simp only [invertedAt, deltaAppendEqSumDeltas]
      exact Int.what (delta t) i h hp.1

end Intervals


variables P Q : Prop

variable forward: P → Q
variable backward: Q → P

def pqEquiv : P ↔ Q := (iff.intro forward backward)
#check pqEquiv
#check iff.elim_left (pqEquiv P Q forward backward)

theorem ifftrans' {P Q R : Prop} (pq: P ↔ Q)  (qr: Q ↔ R): P ↔ R :=
begin
    apply iff.intro,
        assume p,
            have ptq := iff.elim_left pq,
            have qtr := iff.elim_left qr,
            show R, from qtr (ptq p),

        assume r,
            have qtp := iff.elim_right pq,
            have rtq := iff.elim_right qr,
            show P, from qtp (rtq r),
end

-- cheating here
theorem ifftrans'' {P Q R : Prop} (pq: P ↔ Q) (qr: Q ↔ R) : P ↔ R :=
begin
    exact iff.trans pq qr
end

#check ifftrans'
#check iff.trans

theorem ifftrans : ∀ {P Q R}, (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
    assume P Q R,
    assume pq qr,
        apply iff.intro,
            assume p,
                have ptq := iff.elim_left pq,
                have qtr := iff.elim_left qr,
                show R, from qtr (ptq p),

            assume r,
                have qtp := iff.elim_right pq,
                have rtq := iff.elim_right qr,
                show P, from qtp (rtq r),
end

lemma andcomm : ∀ {P Q}, P ∧ Q ↔ Q ∧ P :=
by {assume p q, apply iff.intro,
assume pq, split, exact pq.2, exact pq.1,
assume qp, split, exact qp.2, exact qp.1}

lemma andcomm' : ∀ {P Q}, P ∧ Q ↔ Q ∧ P := λ P Q, and.comm

lemma a_imp_b_imp_c_iff_a_and_b_imp_c:
    ∀ A B C: Prop, (A → B → C) ↔ ((A ∧ B) → C) :=
    λ A B C: Prop,
    begin
        apply iff.intro,
            assume abc,
            assume aandb,
            exact abc aandb.1 aandb.2,

            assume abc,
            assume a,
            assume b,
            exact abc (and.intro a b)
    end

example : 0 = 1 ∨ 0 = 0 :=
begin
    apply or.intro_right,
    apply rfl
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import group_theory.group_action.defs
import algebra.group.units
import algebra.group_with_zero
import data.equiv.mul_add
import data.equiv.mul_add_aut
import group_theory.perm.basic

/-!
# Group actions applied to various types of group

This file contains lemmas about `smul` on `units`, `group_with_zero`, and `group`.
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

section mul_action

section units
variables [monoid α] [mul_action α β]

@[simp, to_additive] lemma units.inv_smul_smul (u : units α) (x : β) :
  (↑u⁻¹:α) • (u:α) • x = x :=
by rw [smul_smul, u.inv_mul, one_smul]

@[simp, to_additive] lemma units.smul_inv_smul (u : units α) (x : β) :
  (u:α) • (↑u⁻¹:α) • x = x :=
by rw [smul_smul, u.mul_inv, one_smul]

/-- If a monoid `α` acts on `β`, then each `u : units α` defines a permutation of `β`. -/
@[to_additive] def units.smul_perm (u : units α) : equiv.perm β :=
⟨λ x, (u:α) • x, λ x, (↑u⁻¹:α) • x, u.inv_smul_smul, u.smul_inv_smul⟩

/-- If an additive monoid `α` acts on `β`, then each `u : add_units α` defines a permutation
of `β`. -/
add_decl_doc add_units.vadd_perm

/-- If a monoid `α` acts on `β`, then each `u : units α` defines a permutation of `β`. -/
def units.smul_perm_hom : units α →* equiv.perm β :=
{ to_fun := units.smul_perm,
  map_one' := equiv.ext $ one_smul α,
  map_mul' := λ u₁ u₂, equiv.ext $ mul_smul (u₁:α) u₂ }

/-- If an additive monoid `α` acts on `β`, then each `u : add_units α` defines a permutation
of `β`. -/
def add_units.vadd_perm_hom {M : Type*} [add_monoid M] [add_action M β] :
  add_units M →+ additive (equiv.perm β) :=
{ to_fun := λ u, additive.of_mul u.vadd_perm,
  map_zero' := equiv.ext $ zero_vadd M,
  map_add' := λ u₁ u₂, equiv.ext $ add_vadd (u₁:M) u₂ }

@[simp, to_additive] lemma units.smul_left_cancel (u : units α) {x y : β} :
  (u:α) • x = (u:α) • y ↔ x = y :=
u.smul_perm.apply_eq_iff_eq

@[to_additive] lemma units.smul_eq_iff_eq_inv_smul (u : units α) {x y : β} :
  (u:α) • x = y ↔ x = (↑u⁻¹:α) • y :=
u.smul_perm.apply_eq_iff_eq_symm_apply

@[to_additive] lemma is_unit.smul_left_cancel {a : α} (ha : is_unit a) {x y : β} :
  a • x = a • y ↔ x = y :=
let ⟨u, hu⟩ := ha in hu ▸ u.smul_left_cancel

end units

section gwz
variables [group_with_zero α] [mul_action α β]

@[simp]
lemma inv_smul_smul' {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
(units.mk0 c hc).inv_smul_smul x

@[simp]
lemma smul_inv_smul' {c : α} (hc : c ≠ 0) (x : β) : c • c⁻¹ • x = x :=
(units.mk0 c hc).smul_inv_smul x

lemma inv_smul_eq_iff' {a : α} (ha : a ≠ 0) {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(units.mk0 a ha).smul_perm.symm_apply_eq

lemma eq_inv_smul_iff' {a : α} (ha : a ≠ 0) {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(units.mk0 a ha).smul_perm.eq_symm_apply

end gwz

section group
variables [group α] [mul_action α β]

@[simp, to_additive] lemma inv_smul_smul (c : α) (x : β) : c⁻¹ • c • x = x :=
(to_units c).inv_smul_smul x

@[simp, to_additive] lemma smul_inv_smul (c : α) (x : β) : c • c⁻¹ • x = x :=
(to_units c).smul_inv_smul x

@[to_additive] lemma inv_smul_eq_iff {a : α} {x y : β} : a⁻¹ • x = y ↔ x = a • y :=
(to_units a).smul_perm.symm_apply_eq

@[to_additive] lemma eq_inv_smul_iff {a : α} {x y : β} : x = a⁻¹ • y ↔ a • x = y :=
(to_units a).smul_perm.eq_symm_apply

variables (α) (β)

/-- Given an action of a group `α` on a set `β`, each `g : α` defines a permutation of `β`. -/
def mul_action.to_perm : α →* equiv.perm β :=
units.smul_perm_hom.comp to_units.to_monoid_hom

variables {α} {β}

@[to_additive] protected lemma mul_action.bijective (g : α) : function.bijective (λ b : β, g • b) :=
(to_units g).smul_perm.bijective

@[to_additive] protected lemma mul_action.injective (g : α) : function.injective (λ b : β, g • b) :=
(mul_action.bijective g).injective

@[to_additive] lemma smul_left_cancel (g : α) {x y : β} (h : g • x = g • y) : x = y :=
mul_action.injective g h

@[simp, to_additive] lemma smul_left_cancel_iff (g : α) {x y : β} : g • x = g • y ↔ x = y :=
(mul_action.injective g).eq_iff

end group

end mul_action

section distrib_mul_action
variables [monoid α] [add_monoid β] [distrib_mul_action α β]

theorem units.smul_eq_zero (u : units α) {x : β} : (u : α) • x = 0 ↔ x = 0 :=
⟨λ h, by rw [← u.inv_smul_smul x, h, smul_zero], λ h, h.symm ▸ smul_zero _⟩

theorem units.smul_ne_zero (u : units α) {x : β} : (u : α) • x ≠ 0 ↔ x ≠ 0 :=
not_congr u.smul_eq_zero

@[simp] theorem is_unit.smul_eq_zero {u : α} (hu : is_unit u) {x : β} :
  u • x = 0 ↔ x = 0 :=
exists.elim hu $ λ u hu, hu ▸ u.smul_eq_zero

end distrib_mul_action

section arrow

/-- If `G` acts on `A`, then it acts also on `A → B`, by `(g • F) a = F (g⁻¹ • a)`. -/
@[simps] def arrow_action {G A B : Type*} [group G] [mul_action G A] : mul_action G (A → B) :=
{ smul := λ g F a, F (g⁻¹ • a),
  one_smul := by { intro, simp only [one_inv, one_smul] },
  mul_smul := by { intros, simp only [mul_smul, mul_inv_rev] } }

local attribute [instance] arrow_action

/-- Given groups `G H` with `G` acting on `A`, `G` acts by
  multiplicative automorphisms on `A → H`. -/
@[simps] def mul_aut_arrow {G A H} [group G] [mul_action G A] [group H] : G →* mul_aut (A → H) :=
{ to_fun := λ g,
  { to_fun := λ F, g • F,
    inv_fun := λ F, g⁻¹ • F,
    left_inv := λ F, inv_smul_smul g F,
    right_inv := λ F, smul_inv_smul g F,
    map_mul' := by { intros, ext, simp only [arrow_action_to_has_scalar_smul, pi.mul_apply] } },
  map_one' := by { ext, simp only [mul_aut.one_apply, mul_equiv.coe_mk, one_smul] },
  map_mul' := by { intros, ext, simp only [mul_smul, mul_equiv.coe_mk, mul_aut.mul_apply] } }

end arrow


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Insertion sort and merge sort.
-/
import data.list.perm
open list.perm

namespace list

section sorted
universe variable uu
variables {α : Type uu} {r : α → α → Prop}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

theorem sorted_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) → sorted r l :=
pairwise_of_pairwise_cons

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

theorem eq_of_sorted_of_perm [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { rw eq_nil_of_perm_nil p },
  { have : a ∈ l₂ := perm_subset p (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    have := IH p' (pairwise_of_sublist (by simp) s₂), subst l₁,
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

end sorted

/-
  sorting procedures
-/

section sort
universe variable uu
parameters {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix `≼` : 50 := r

/- insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert b (insertion_sort l)

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    (perm.skip _ (perm_ordered_insert l)).trans (perm.swap _ _ _)]

theorem perm_insertion_sort : ∀ l : list α, insertion_sort l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans (perm.skip b (perm_insertion_sort l))

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted_ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', sorted_ordered_insert l (sorted_of_sorted_cons h)] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      perm_subset (perm_ordered_insert _ _ _) bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort l)
| []       := sorted_nil
| (a :: l) := sorted_ordered_insert a _ (sorted_insertion_sort l)

end total_and_transitive
end correctness
end insertion_sort

/- merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact perm.skip a ((perm_split e).trans perm_app_comm),
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort (a::b::l) = merge (merge_sort l₁) (merge_sort l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge l l' ~ l ++ l'
| []       []        := perm.nil
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using skip _ (perm_merge _ _) },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact (skip _ (perm_merge _ _)).trans ((swap _ _ _).trans (skip _ perm_middle.symm)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort l ~ l
| []        := perm.refl _
| [a]       := perm.refl _
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact (perm_app (perm_merge_sort l₁) (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted_merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge l l')
| []       []        h₁ h₂ := sorted_nil
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, sorted_merge (sorted_of_sorted_cons h₁) h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      perm_subset (perm_merge _ _ _) bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, sorted_merge h₁ (sorted_of_sorted_cons h₂)] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      perm_subset (perm_merge _ _ _) bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort l)
| []        := sorted_nil
| [a]       := sorted_singleton _
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact sorted_merge r (sorted_merge_sort l₁) (sorted_merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort l = l :=
eq_of_sorted_of_perm (perm_merge_sort _) (sorted_merge_sort _)

end total_and_transitive
end correctness
end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.basic
import linear_algebra.direct_sum.finsupp

/-!
# Direct sums of Lie algebras and Lie modules

Direct sums of Lie algebras and Lie modules carry natural algbebra and module structures.

## Tags

lie algebra, lie module, direct sum
-/

universes u v w w₁

namespace direct_sum
open dfinsupp
open_locale direct_sum

variables {R : Type u} {ι : Type v} [comm_ring R]

section modules

/-! The direct sum of Lie modules over a fixed Lie algebra carries a natural Lie module
structure. -/

variables {L : Type w₁} {M : ι → Type w}
variables [lie_ring L] [lie_algebra R L]
variables [Π i, add_comm_group (M i)] [Π i, module R (M i)]
variables [Π i, lie_ring_module L (M i)] [Π i, lie_module R L (M i)]

instance : lie_ring_module L (⨁ i, M i) :=
{ bracket     := λ x m, m.map_range (λ i m', ⁅x, m'⁆) (λ i, lie_zero x),
  add_lie     := λ x y m, by { ext, simp only [map_range_apply, add_apply, add_lie], },
  lie_add     := λ x m n, by { ext, simp only [map_range_apply, add_apply, lie_add], },
  leibniz_lie := λ x y m, by { ext, simp only [map_range_apply, lie_lie, add_apply,
    sub_add_cancel], }, }

@[simp] lemma lie_module_bracket_apply (x : L) (m : ⨁ i, M i) (i : ι) :
  ⁅x, m⁆ i = ⁅x, m i⁆ := map_range_apply _ _ m i

instance : lie_module R L (⨁ i, M i) :=
{ smul_lie := λ t x m, by { ext i, simp only [smul_lie, lie_module_bracket_apply, smul_apply], },
  lie_smul := λ t x m, by { ext i, simp only [lie_smul, lie_module_bracket_apply, smul_apply], }, }

variables (R ι L M)

/-- The inclusion of each component into a direct sum as a morphism of Lie modules. -/
def lie_module_of [decidable_eq ι] (j : ι) : M j →ₗ⁅R,L⁆ ⨁ i, M i :=
{ map_lie' := λ x m,
    begin
      ext i, by_cases h : j = i,
      { rw ← h, simp, },
      { simp [lof, single_eq_of_ne h], },
    end,
  ..lof R ι M j }

/-- The projection map onto one component, as a morphism of Lie modules. -/
def lie_module_component (j : ι) : (⨁ i, M i) →ₗ⁅R,L⁆ M j :=
{ map_lie' := λ x m,
    by simp only [component, lapply_apply, lie_module_bracket_apply, linear_map.to_fun_eq_coe],
  ..component R ι M j }

end modules

section algebras

/-! The direct sum of Lie algebras carries a natural Lie algebra structure. -/

variables {L : ι → Type w}
variables [Π i, lie_ring (L i)] [Π i, lie_algebra R (L i)]

instance : lie_ring (⨁ i, L i) :=
{ bracket     := zip_with (λ i, λ x y, ⁅x, y⁆) (λ i, lie_zero 0),
  add_lie     := λ x y z, by { ext, simp only [zip_with_apply, add_apply, add_lie], },
  lie_add     := λ x y z, by { ext, simp only [zip_with_apply, add_apply, lie_add], },
  lie_self    := λ x, by { ext, simp only [zip_with_apply, add_apply, lie_self, zero_apply], },
  leibniz_lie := λ x y z, by { ext, simp only [sub_apply,
    zip_with_apply, add_apply, zero_apply], apply leibniz_lie, },
  ..(infer_instance : add_comm_group _) }

@[simp] lemma bracket_apply (x y : ⨁ i, L i) (i : ι) :
  ⁅x, y⁆ i = ⁅x i, y i⁆ := zip_with_apply _ _ x y i

instance : lie_algebra R (⨁ i, L i) :=
{ lie_smul := λ c x y, by { ext, simp only [
    zip_with_apply, smul_apply, bracket_apply, lie_smul] },
  ..(infer_instance : module R _) }

variables (R ι L)

/-- The inclusion of each component into the direct sum as morphism of Lie algebras. -/
def lie_algebra_of [decidable_eq ι] (j : ι) : L j →ₗ⁅R⁆ ⨁ i, L i :=
{ map_lie' := λ x y, by
  { ext i, by_cases h : j = i,
    { rw ← h, simp, },
    { simp [lof, single_eq_of_ne h], }, },
  ..lof R ι L j, }

/-- The projection map onto one component, as a morphism of Lie algebras. -/
def lie_algebra_component (j : ι) : (⨁ i, L i) →ₗ⁅R⁆ L j :=
{ map_lie' := λ x y,
    by simp only [component, bracket_apply, lapply_apply, linear_map.to_fun_eq_coe],
  ..component R ι L j }

end algebras

end direct_sum


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

import algebra.module.basic
import linear_algebra.finsupp
import linear_algebra.free_module.basic

/-!

# Projective modules

This file contains a definition of a projective module, the proof that
our definition is equivalent to a lifting property, and the
proof that all free modules are projective.

## Main definitions

Let `R` be a ring (or a semiring) and let `M` be an `R`-module.

* `is_projective R M` : the proposition saying that `M` is a projective `R`-module.

## Main theorems

* `is_projective.lifting_property` : a map from a projective module can be lifted along
  a surjection.

* `is_projective.of_lifting_property` : If for all R-module surjections `A →ₗ B`, all
  maps `M →ₗ B` lift to `M →ₗ A`, then `M` is projective.

* `is_projective.of_free` : Free modules are projective

## Implementation notes

The actual definition of projective we use is that the natural R-module map
from the free R-module on the type M down to M splits. This is more convenient
than certain other definitions which involve quantifying over universes,
and also universe-polymorphic (the ring and module can be in different universes).

We require that the module sits in at least as high a universe as the ring:
without this, free modules don't even exist,
and it's unclear if projective modules are even a useful notion.

## References

https://en.wikipedia.org/wiki/Projective_module

## TODO

- Direct sum of two projective modules is projective.
- Arbitrary sum of projective modules is projective.

All of these should be relatively straightforward.

## Tags

projective module

-/

universes u v

/- The actual implementation we choose: `P` is projective if the natural surjection
   from the free `R`-module on `P` to `P` splits. -/
/-- An R-module is projective if it is a direct summand of a free module, or equivalently
  if maps from the module lift along surjections. There are several other equivalent
  definitions. -/
class module.projective (R : Type u) [semiring R] (P : Type (max u v)) [add_comm_monoid P]
  [module R P] : Prop :=
(out : ∃ s : P →ₗ[R] (P →₀ R), function.left_inverse (finsupp.total P P R id) s)

namespace module

lemma projective_def {R : Type u} [semiring R] {P : Type (max u v)} [add_comm_monoid P]
  [module R P] : projective R P ↔
  (∃ s : P →ₗ[R] (P →₀ R), function.left_inverse (finsupp.total P P R id) s) :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

section semiring

variables {R : Type u} [semiring R] {P : Type (max u v)} [add_comm_monoid P] [module R P]
  {M : Type (max u v)} [add_comm_group M] [module R M] {N : Type*} [add_comm_group N] [module R N]

/-- A projective R-module has the property that maps from it lift along surjections. -/
theorem projective_lifting_property [h : projective R P] (f : M →ₗ[R] N) (g : P →ₗ[R] N)
  (hf : function.surjective f) : ∃ (h : P →ₗ[R] M), f.comp h = g :=
begin
  /-
  Here's the first step of the proof.
  Recall that `X →₀ R` is Lean's way of talking about the free `R`-module
  on a type `X`. The universal property `finsupp.total` says that to a map
  `X → N` from a type to an `R`-module, we get an associated R-module map
  `(X →₀ R) →ₗ N`. Apply this to a (noncomputable) map `P → M` coming from the map
  `P →ₗ N` and a random splitting of the surjection `M →ₗ N`, and we get
  a map `φ : (P →₀ R) →ₗ M`.
  -/
  let φ : (P →₀ R) →ₗ[R] M := finsupp.total _ _ _ (λ p, function.surj_inv hf (g p)),
  -- By projectivity we have a map `P →ₗ (P →₀ R)`;
  cases h.out with s hs,
  -- Compose to get `P →ₗ M`. This works.
  use φ.comp s,
  ext p,
  conv_rhs {rw ← hs p},
  simp [φ, finsupp.total_apply, function.surj_inv_eq hf],
end

/-- A module which satisfies the universal property is projective. Note that the universe variables
in `huniv` are somewhat restricted. -/
theorem projective_of_lifting_property'
  -- If for all surjections of `R`-modules `M →ₗ N`, all maps `P →ₗ N` lift to `P →ₗ M`,
  (huniv : ∀ {M : Type (max v u)} {N : Type (max u v)} [add_comm_monoid M] [add_comm_monoid N],
    by exactI
    ∀ [module R M] [module R N],
    by exactI
    ∀ (f : M →ₗ[R] N) (g : P →ₗ[R] N),
  function.surjective f → ∃ (h : P →ₗ[R] M), f.comp h = g) :
  -- then `P` is projective.
  projective R P :=
begin
  -- let `s` be the universal map `(P →₀ R) →ₗ P` coming from the identity map `P →ₗ P`.
  obtain ⟨s, hs⟩ : ∃ (s : P →ₗ[R] P →₀ R),
    (finsupp.total P P R id).comp s = linear_map.id :=
    huniv (finsupp.total P P R (id : P → P)) (linear_map.id : P →ₗ[R] P) _,
  -- This `s` works.
  { use s,
    rwa linear_map.ext_iff at hs },
  { intro p,
    use finsupp.single p 1,
    simp },
end

end semiring

section ring

variables {R : Type u} [ring R] {P : Type (max u v)} [add_comm_group P] [module R P]

/-- A variant of `of_lifting_property'` when we're working over a `[ring R]`,
which only requires quantifying over modules with an `add_comm_group` instance. -/
theorem projective_of_lifting_property
  -- If for all surjections of `R`-modules `M →ₗ N`, all maps `P →ₗ N` lift to `P →ₗ M`,
  (huniv : ∀ {M : Type (max v u)} {N : Type (max u v)} [add_comm_group M] [add_comm_group N],
    by exactI
    ∀ [module R M] [module R N],
    by exactI
    ∀ (f : M →ₗ[R] N) (g : P →ₗ[R] N),
  function.surjective f → ∃ (h : P →ₗ[R] M), f.comp h = g) :
  -- then `P` is projective.
  projective R P :=
-- We could try and prove this *using* `of_lifting_property`,
-- but this quickly leads to typeclass hell,
-- so we just prove it over again.
begin
  -- let `s` be the universal map `(P →₀ R) →ₗ P` coming from the identity map `P →ₗ P`.
  obtain ⟨s, hs⟩ : ∃ (s : P →ₗ[R] P →₀ R),
    (finsupp.total P P R id).comp s = linear_map.id :=
    huniv (finsupp.total P P R (id : P → P)) (linear_map.id : P →ₗ[R] P) _,
  -- This `s` works.
  { use s,
    rwa linear_map.ext_iff at hs },
  { intro p,
    use finsupp.single p 1,
    simp },
end

/-- Free modules are projective. -/
theorem projective_of_basis {ι : Type*} (b : basis ι R P) : projective R P :=
begin
  -- need P →ₗ (P →₀ R) for definition of projective.
  -- get it from `ι → (P →₀ R)` coming from `b`.
  use b.constr ℕ (λ i, finsupp.single (b i) (1 : R)),
  intro m,
  simp only [b.constr_apply, mul_one, id.def, finsupp.smul_single', finsupp.total_single,
    linear_map.map_finsupp_sum],
  exact b.total_repr m,
end

@[priority 100]
instance projective_of_free [module.free R P] : module.projective R P :=
projective_of_basis $ module.free.choose_basis R P

end ring

end module


import tactic
import algebra.ring

section defs
/- Let R be an arbitrary commutative ring -/
variables (R : Type*) [comm_ring R]

/- Definition of an ideal.
  In order to define an ideal, one needs to specify its
  underlying set (carrier), as well as three proofs
-/
@[ext] structure ideal :=
(carrier : set R)
(zero_mem' : (0 : R) ∈ carrier)
(add_mem' {x y : R} : x ∈ carrier → y ∈ carrier → x + y ∈ carrier)
(smul_mem' (r : R) {x : R} : x ∈ carrier → r*x ∈ carrier)

/- The set {0} is an ideal -/
instance : has_zero (ideal R) := ⟨{
  carrier := {0}, --the singleton set containing 0
  zero_mem' := rfl, --proof that 0 ∈ {0}
  add_mem' := λ x y hx hy, by simp * at *, --proof that if x ∈ {0} and y ∈ {0}, then
                                          -- x + y ∈ {0}. "simp" is a tactic that is
                                          -- able to perform basic simplifications,
                                          -- so it can replace the hypothesis x ∈ {0}
                                          -- with x = 0, and it knows 0 + 0 = 0.
  smul_mem' := λ r x hx, by simp * at *   --simp also knows r*0 = 0
}⟩

/- R itself is an ideal-/
def univ : ideal R := {
  carrier := set.univ, --set.univ is the set of all elements of R
  zero_mem' := by triv,
  add_mem' := by simp,
  smul_mem' := by simp
}

/- Definition of a principal ideal -/
def prin {R : Type*} [comm_ring R] (x : R) : ideal R := {
  carrier := {r : R | ∃ s : R, r = s*x},
  zero_mem' := ⟨0, (zero_mul x).symm⟩,
  add_mem' :=
    begin
      rintros _ _ ⟨a, rfl⟩ ⟨b, rfl⟩, --if a*x, b*x ∈ prin x...
      exact ⟨a + b, by rw ← add_mul⟩, --then a*x + b*x = (a + b)*x ∈ prin x
    end,
  smul_mem' :=
    begin
      rintros r _ ⟨a, rfl⟩, -- if a*x ∈ prin x...
      exact ⟨r * a, (mul_assoc _ _ _).symm⟩ -- then r*(a*x) = (r*a)*x ∈ prin x
    end
}

lemma univ_eq_prin_one : univ R = prin (1 : R) :=
begin
  ext,
  split,
  { intro h,
    simp [prin],}, --what is going on here??
  { intro h,
    triv,
  },
end

end defs

/- Here we define the membership relation, as well as any
  operations on ideals: intersection, sum, etc.
  We could also add a lot from e.g. Atiyah MacDonald ch 1:
  ideal quotients, radical ideals, the radical operation,
  and facts about these objects.
-/
section operations
variables {R : Type*} [comm_ring R]

/- This lets us write r ∈ I for r : R and I : ideal R -/
instance : has_mem R (ideal R) := ⟨λ x I, x ∈ I.carrier⟩
/- This lets us write I ⊆ J for I J : ideal R -/
instance : has_subset (ideal R) := ⟨λ I J, I.carrier ⊆ J.carrier⟩
/- This lets us write I ⊂ J for I J : ideal R -/
instance : has_ssubset (ideal R) := ⟨λ I J, I.carrier ⊂ J.carrier⟩
/- This lets us write I ∩ J for I J : ideal R -/
instance : has_inter (ideal R) := ⟨λ I J,
  {
    carrier := I.carrier ∩ J.carrier,
    zero_mem' := ⟨I.zero_mem', J.zero_mem'⟩,
    add_mem' := λ x y hx hy, ⟨I.add_mem' hx.1 hy.1, J.add_mem' hx.2 hy.2⟩,
    smul_mem' := λ r x hx, ⟨I.smul_mem' r hx.1, J.smul_mem' r hx.2⟩,
  }⟩

/- This lets us write I + J for I J : ideal R -/
instance : has_add (ideal R) := ⟨λ I J,
  {
    carrier := {x | ∃ i j : R, i ∈ I ∧ j ∈ J ∧ x = i + j},
    zero_mem' := ⟨0,0, I.zero_mem', J.zero_mem', by simp⟩,
    add_mem' :=
      begin
        rintros _ _ ⟨ix, jx, hix, hjx, rfl⟩ ⟨iy, jy, hiy, hjy, rfl⟩,
        exact ⟨ix + iy, jx + jy, I.add_mem' hix hiy, J.add_mem' hjx hjy, by ring⟩,
      end,
    smul_mem' :=
      begin
        rintros r _ ⟨i, j, hi, hj, rfl⟩,
        exact ⟨r*i, r*j, I.smul_mem' r hi, J.smul_mem' r hj, by ring⟩
      end
  }⟩

def union_of_directed_family {I} [inhabited I] (f : I → ideal R) (d : directed (⊆) f) : ideal R := {
  carrier := ⋃ i, (f i).carrier,
  zero_mem' := ⟨(f (arbitrary I)).carrier, ⟨arbitrary I, eq.refl _⟩, ideal.zero_mem' _⟩,
  add_mem' := by {
    intros x y hx hy,
    cases hx with S hx, cases hx with w hx, cases w with i hi, subst hi,
    cases hy with S' hy, cases hy with w hy, cases w with j hj, subst hj,
    cases d i j with k hk,
    existsi (f k).carrier, existsi _,
    { cases hk, apply ideal.add_mem',
      { apply hk_left, assumption },
      { apply hk_right, assumption } },
    { existsi k, refl } },
  smul_mem' := by {
    intros x r hx, cases hx with S hx, cases hx with w hx, cases w with i hi, subst hi,
    existsi (f i).carrier, existsi _,
    { apply ideal.smul_mem', assumption },
    { existsi i, refl }
  }
}

/- Easy lemmas -/
@[simp] lemma zero_mem (I : ideal R) : (0 : R) ∈ I := I.zero_mem'
@[simp] lemma sub_add_left (I J : ideal R) : I ⊆ I + J := λ i hi, ⟨i, 0, hi, by simp⟩
@[simp] lemma sub_add_right (I J : ideal R) : J ⊆ I + J := λ j hj, ⟨0, j, by simp, hj, by simp⟩

end operations

lemma mem_prin {R : Type*} [comm_ring R] (x : R) : x ∈ prin x := ⟨1, by simp⟩

/- Definitions and facts about prime and maximal ideals -/
variables {R : Type*} [comm_ring R]
def is_prin (I : ideal R) := ∃ (x : R), I = prin x
def radical (I : ideal R) := ∀ (x : R) (n : ℕ), x^(n + 1) ∈ I → x ∈ I
def prime (I : ideal R) := ((1 : R) ∉ I) ∧ (∀ x y : R, x*y ∈ I → x ∈ I ∨ y ∈ I)
def maximal (I : ideal R) := (1 : R) ∉ I ∧ ∀ J : ideal R, I ⊂ J → J = univ R

/- TODO replace prime with ideal.prime, etc -/
-- (preimage my_ideal_object).prime
--example : ¬ (univ R).prime :=
--begin
--  intro h,
--  unfold ideal.prime at h,
--  apply h.1,
--  triv,
--end

lemma is_unit_iff (x : R) : is_unit x ↔ ∃ y : R, x*y = 1 :=
  begin
    split,
    { intro h,
      rcases h with ⟨x,rfl⟩,
      cases x with x y h1 h2,
      use y,
      exact h1,
    },
    { rintros ⟨y,hy⟩,
      unfold is_unit,
      use x,
      exact y,
      exact hy,
      rw mul_comm,
      exact hy,
      refl,
    }
  end
def irreducible (x : R) := ∀ y z : R, y*z = x → is_unit y ∨ is_unit z
def preimage {S : Type*} [comm_ring S] (f: S →+* R) (I : ideal R) : ideal S :=
  { carrier := f ⁻¹' (I.carrier),
    zero_mem' := by simp[map_zero f, ideal.zero_mem'],
    add_mem' := λ x y hx hy, by simp [ideal.add_mem' I hx hy],
    smul_mem' := λ r x hx, by simp [ideal.smul_mem' I (f r) hx],
  }
@[simp] lemma mem_preimage_iff {S : Type*} [comm_ring S] (f: S →+* R) (I : ideal R) (x : S) :
    x ∈ preimage f I ↔ f x ∈ I := iff.rfl

/- Pretty messy, definitely could use more outside lemmas
  This is what formalizing proofs "usually" looks like,
  with the entire thing written in tactic mode
-/
theorem prime_of_maximal {I : ideal R} (hI : maximal I) : prime I :=
begin
  split,
  exact hI.1,
  intros x y hxy,
  by_cases h : x ∈ I,
  { left,
    exact h
  },
  { right,
    have h2 := sub_add_left I (prin x),
    have h3 : I ⊂ I + (prin x),
    {
      unfold has_ssubset.ssubset,
      simp,
      rw set.ssubset_iff_of_subset,
      use x,
      exact ⟨(sub_add_right I (prin x)) (mem_prin x), h⟩,
      exact h2,
    },
    have h4 := hI.2 (I + prin x) h3,
    have h5 : (1 : R) ∈ univ R := by simp [univ],
    rw ← h4 at h5,
    rcases h5 with ⟨i, _, hi, ⟨s, rfl⟩, hh⟩,
    rw ← (one_mul y),
    rw hh,
    rw add_mul,
    apply I.add_mem',
    { rw mul_comm,
      exact I.smul_mem' y hi,
    },
    { rw mul_assoc,
      exact I.smul_mem' s hxy,
    }
  }
end

theorem prime_of_preimage {S : Type*} [comm_ring S]
  (f : R →+* S) {I : ideal S}
  (hI : prime I) : prime (preimage f I) :=
begin
  unfold prime,
  split,
  { intros h1,
    simp * at *,
    exact hI.1 h1,},
  { intros x y g,
    simp only [mem_preimage_iff, map_mul] at *,
    exact hI.2 _ _ g,}
end

theorem radical_of_prime {I : ideal R} (hI : prime I) : radical I :=
begin
  intros x n h,
  induction n with m hm,
  { simp at h,
    exact h,
  },
  {
    have h2 : x*x^(m+1) ∈ I,
    {
      convert h,
      rw nat.succ_eq_add_one,
      repeat {rw pow_add},
      ring,
    },
    cases (hI.2 x (x^(m+1)) h2) with hx hbig,
    {
      exact hx,
    },
    {
      exact hm hbig,
    }
  }
end