/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Riccardo Brasca
-/
import analysis.normed_space.basic
import analysis.normed.group.hom
import ring_theory.ideal.quotient_operations

/-!
# Quotients of seminormed groups

For any `seminormed_add_comm_group M` and any `S : add_subgroup M`, we provide a
`seminormed_add_comm_group`, the group quotient `M ⧸ S`.
If `S` is closed, we provide `normed_add_comm_group (M ⧸ S)` (regardless of whether `M` itself is
separated). The two main properties of these structures are the underlying topology is the quotient
topology and the projection is a normed group homomorphism which is norm non-increasing
(better, it has operator norm exactly one unless `S` is dense in `M`). The corresponding
universal property is that every normed group hom defined on `M` which vanishes on `S` descends
to a normed group hom defined on `M ⧸ S`.

This file also introduces a predicate `is_quotient` characterizing normed group homs that
are isomorphic to the canonical projection onto a normed group quotient.

In addition, this file also provides normed structures for quotients of modules by submodules, and
of (commutative) rings by ideals. The `seminormed_add_comm_group` and `normed_add_comm_group`
instances described above are transferred directly, but we also define instances of `normed_space`,
`semi_normed_comm_ring`, `normed_comm_ring` and `normed_algebra` under appropriate type class
assumptions on the original space. Moreover, while `quotient_add_group.complete_space` works
out-of-the-box for quotients of `normed_add_comm_group`s by `add_subgroup`s, we need to transfer
this instance in `submodule.quotient.complete_space` so that it applies to these other quotients.

## Main definitions

We use `M` and `N` to denote seminormed groups and `S : add_subgroup M`.
All the following definitions are in the `add_subgroup` namespace. Hence we can access
`add_subgroup.normed_mk S` as `S.normed_mk`.

* `seminormed_add_comm_group_quotient` : The seminormed group structure on the quotient by
    an additive subgroup. This is an instance so there is no need to explictly use it.

* `normed_add_comm_group_quotient` : The normed group structure on the quotient by
    a closed additive subgroup. This is an instance so there is no need to explictly use it.

* `normed_mk S` : the normed group hom from `M` to `M ⧸ S`.

* `lift S f hf`: implements the universal property of `M ⧸ S`. Here
    `(f : normed_add_group_hom M N)`, `(hf : ∀ s ∈ S, f s = 0)` and
    `lift S f hf : normed_add_group_hom (M ⧸ S) N`.

* `is_quotient`: given `f : normed_add_group_hom M N`, `is_quotient f` means `N` is isomorphic
    to a quotient of `M` by a subgroup, with projection `f`. Technically it asserts `f` is
    surjective and the norm of `f x` is the infimum of the norms of `x + m` for `m` in `f.ker`.

## Main results

* `norm_normed_mk` : the operator norm of the projection is `1` if the subspace is not dense.

* `is_quotient.norm_lift`: Provided `f : normed_hom M N` satisfies `is_quotient f`, for every
     `n : N` and positive `ε`, there exists `m` such that `f m = n ∧ ‖m‖ < ‖n‖ + ε`.

## Implementation details

For any `seminormed_add_comm_group M` and any `S : add_subgroup M` we define a norm on `M ⧸ S` by
`‖x‖ = Inf (norm '' {m | mk' S m = x})`. This formula is really an implementation detail, it
shouldn't be needed outside of this file setting up the theory.

Since `M ⧸ S` is automatically a topological space (as any quotient of a topological space),
one needs to be careful while defining the `seminormed_add_comm_group` instance to avoid having two
different topologies on this quotient. This is not purely a technological issue.
Mathematically there is something to prove. The main point is proved in the auxiliary lemma
`quotient_nhd_basis` that has no use beyond this verification and states that zero in the quotient
admits as basis of neighborhoods in the quotient topology the sets `{x | ‖x‖ < ε}` for positive `ε`.

Once this mathematical point it settled, we have two topologies that are propositionaly equal. This
is not good enough for the type class system. As usual we ensure *definitional* equality
using forgetful inheritance, see Note [forgetful inheritance]. A (semi)-normed group structure
includes a uniform space structure which includes a topological space structure, together
with propositional fields asserting compatibility conditions.
The usual way to define a `seminormed_add_comm_group` is to let Lean build a uniform space structure
using the provided norm, and then trivially build a proof that the norm and uniform structure are
compatible. Here the uniform structure is provided using `topological_add_group.to_uniform_space`
which uses the topological structure and the group structure to build the uniform structure. This
uniform structure induces the correct topological structure by construction, but the fact that it
is compatible with the norm is not obvious; this is where the mathematical content explained in
the previous paragraph kicks in.

-/

noncomputable theory

open quotient_add_group metric set
open_locale topology nnreal

variables {M N : Type*} [seminormed_add_comm_group M] [seminormed_add_comm_group N]

/-- The definition of the norm on the quotient by an additive subgroup. -/
noncomputable
instance norm_on_quotient (S : add_subgroup M) : has_norm (M ⧸ S) :=
{ norm := λ x, Inf (norm '' {m | mk' S m = x}) }

lemma add_subgroup.quotient_norm_eq {S : add_subgroup M} (x : M ⧸ S) :
  ‖x‖ = Inf (norm '' {m : M | (m : M ⧸ S) = x}) :=
rfl

lemma image_norm_nonempty {S : add_subgroup M} :
  ∀ x : M ⧸ S, (norm '' {m | mk' S m = x}).nonempty :=
begin
  rintro ⟨m⟩,
  rw set.nonempty_image_iff,
  use m,
  change mk' S m = _,
  refl
end

lemma bdd_below_image_norm (s : set M) : bdd_below (norm '' s) :=
begin
  use 0,
  rintro _ ⟨x, hx, rfl⟩,
  apply norm_nonneg
end

/-- The norm on the quotient satisfies `‖-x‖ = ‖x‖`. -/
lemma quotient_norm_neg {S : add_subgroup M} (x : M ⧸ S) : ‖-x‖ = ‖x‖ :=
begin
  suffices : norm '' {m | mk' S m = x} = norm '' {m | mk' S m = -x},
    by simp only [this, norm],
  ext r,
  split,
  { rintros ⟨m, rfl : mk' S m = x, rfl⟩,
    rw ← norm_neg,
    exact ⟨-m, by simp only [(mk' S).map_neg, set.mem_set_of_eq], rfl⟩ },
  { rintros ⟨m, hm : mk' S m = -x, rfl⟩,
    exact ⟨-m, by simpa using neg_eq_iff_eq_neg.mpr ((mk'_apply _ _).symm.trans hm)⟩ }
end

lemma quotient_norm_sub_rev {S : add_subgroup M} (x y : M ⧸ S) : ‖x - y‖ = ‖y - x‖ :=
by rw [show x - y = -(y - x), by abel, quotient_norm_neg]

/-- The norm of the projection is smaller or equal to the norm of the original element. -/
lemma quotient_norm_mk_le (S : add_subgroup M) (m : M) :
  ‖mk' S m‖ ≤ ‖m‖ :=
begin
  apply cInf_le,
  use 0,
  { rintros _ ⟨n, h, rfl⟩,
    apply norm_nonneg },
  { apply set.mem_image_of_mem,
    rw set.mem_set_of_eq }
end

/-- The norm of the projection is smaller or equal to the norm of the original element. -/
lemma quotient_norm_mk_le' (S : add_subgroup M) (m : M) :
  ‖(m : M ⧸ S)‖ ≤ ‖m‖ := quotient_norm_mk_le S m

/-- The norm of the image under the natural morphism to the quotient. -/
lemma quotient_norm_mk_eq (S : add_subgroup M) (m : M) :
  ‖mk' S m‖ = Inf ((λ x, ‖m + x‖) '' S) :=
begin
  change Inf _ = _,
  congr' 1,
  ext r,
  simp_rw [coe_mk', eq_iff_sub_mem],
  split,
  { rintros ⟨y, h, rfl⟩,
    use [y - m, h],
    simp },
  { rintros ⟨y, h, rfl⟩,
    use m + y,
    simpa using h },
end

/-- The quotient norm is nonnegative. -/
lemma quotient_norm_nonneg (S : add_subgroup M) : ∀ x : M ⧸ S, 0 ≤ ‖x‖ :=
begin
  rintros ⟨m⟩,
  change 0 ≤ ‖mk' S m‖,
  apply le_cInf (image_norm_nonempty _),
  rintros _ ⟨n, h, rfl⟩,
  apply norm_nonneg
end

/-- The quotient norm is nonnegative. -/
lemma norm_mk_nonneg (S : add_subgroup M) (m : M) : 0 ≤ ‖mk' S m‖ :=
quotient_norm_nonneg S _

/-- The norm of the image of `m : M` in the quotient by `S` is zero if and only if `m` belongs
to the closure of `S`. -/
lemma quotient_norm_eq_zero_iff (S : add_subgroup M) (m : M) :
  ‖mk' S m‖ = 0 ↔ m ∈ closure (S : set M) :=
begin
  have : 0 ≤ ‖mk' S m‖ := norm_mk_nonneg S m,
  rw [← this.le_iff_eq, quotient_norm_mk_eq, real.Inf_le_iff],
  simp_rw [zero_add],
  { calc (∀ ε > (0 : ℝ), ∃ r ∈ (λ x, ‖m + x‖) '' (S : set M), r < ε) ↔
        (∀ ε > 0, (∃ x ∈ S, ‖m + x‖ < ε)) : by simp [set.bex_image_iff]
     ... ↔ ∀ ε > 0, (∃ x ∈ S, ‖m + -x‖ < ε) : _
     ... ↔ ∀ ε > 0, (∃ x ∈ S, x ∈ metric.ball m ε) : by simp [dist_eq_norm, ← sub_eq_add_neg,
                                                              norm_sub_rev]
     ... ↔ m ∈ closure ↑S : by simp [metric.mem_closure_iff, dist_comm],
    refine forall₂_congr (λ ε ε_pos, _),
    rw [← S.exists_neg_mem_iff_exists_mem],
    simp },
  { use 0,
    rintro _ ⟨x, x_in, rfl⟩,
    apply norm_nonneg },
  rw set.nonempty_image_iff,
  use [0, S.zero_mem]
end

/-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `mk' S m = x`
and `‖m‖ < ‖x‖ + ε`. -/
lemma norm_mk_lt {S : add_subgroup M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) :
  ∃ (m : M), mk' S m = x ∧ ‖m‖ < ‖x‖ + ε :=
begin
  obtain ⟨_, ⟨m : M, H : mk' S m = x, rfl⟩, hnorm : ‖m‖ < ‖x‖ + ε⟩ :=
    real.lt_Inf_add_pos (image_norm_nonempty x) hε,
  subst H,
  exact ⟨m, rfl, hnorm⟩,
end

/-- For any `m : M` and any `0 < ε`, there is `s ∈ S` such that `‖m + s‖ < ‖mk' S m‖ + ε`. -/
lemma norm_mk_lt' (S : add_subgroup M) (m : M) {ε : ℝ} (hε : 0 < ε) :
  ∃ s ∈ S, ‖m + s‖ < ‖mk' S m‖ + ε :=
begin
  obtain ⟨n : M, hn : mk' S n = mk' S m, hn' : ‖n‖ < ‖mk' S m‖ + ε⟩ :=
    norm_mk_lt (quotient_add_group.mk' S m) hε,
  erw [eq_comm, quotient_add_group.eq] at hn,
  use [- m + n, hn],
  rwa [add_neg_cancel_left]
end

/-- The quotient norm satisfies the triangle inequality. -/
lemma quotient_norm_add_le (S : add_subgroup M) (x y : M ⧸ S) : ‖x + y‖ ≤ ‖x‖ + ‖y‖ :=
begin
  refine le_of_forall_pos_le_add (λ ε hε, _),
  replace hε := half_pos hε,
  obtain ⟨m, rfl, hm : ‖m‖ < ‖mk' S m‖ + ε / 2⟩ := norm_mk_lt x hε,
  obtain ⟨n, rfl, hn : ‖n‖ < ‖mk' S n‖ + ε / 2⟩ := norm_mk_lt y hε,
  calc ‖mk' S m + mk' S n‖ = ‖mk' S (m +  n)‖ : by rw (mk' S).map_add
  ... ≤ ‖m + n‖ : quotient_norm_mk_le S (m + n)
  ... ≤ ‖m‖ + ‖n‖ : norm_add_le _ _
  ... ≤ ‖mk' S m‖ + ‖mk' S n‖ + ε : by linarith
end

/-- The quotient norm of `0` is `0`. -/
lemma norm_mk_zero (S : add_subgroup M) : ‖(0 : M ⧸ S)‖ = 0 :=
begin
  erw quotient_norm_eq_zero_iff,
  exact subset_closure S.zero_mem
end

/-- If `(m : M)` has norm equal to `0` in `M ⧸ S` for a closed subgroup `S` of `M`, then
`m ∈ S`. -/
lemma norm_zero_eq_zero (S : add_subgroup M) (hS : is_closed (S : set M)) (m : M)
  (h : ‖mk' S m‖ = 0) : m ∈ S :=
by rwa [quotient_norm_eq_zero_iff, hS.closure_eq] at h

lemma quotient_nhd_basis (S : add_subgroup M) :
  (𝓝 (0 : M ⧸ S)).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {x | ‖x‖ < ε}) :=
⟨begin
  intros U,
  split,
  { intros U_in,
    rw ← (mk' S).map_zero at U_in,
    have := preimage_nhds_coinduced U_in,
    rcases metric.mem_nhds_iff.mp this with ⟨ε, ε_pos, H⟩,
    use [ε/2, half_pos ε_pos],
    intros x x_in,
    dsimp at x_in,
    rcases norm_mk_lt x (half_pos ε_pos) with ⟨y, rfl, ry⟩,
    apply H,
    rw ball_zero_eq,
    dsimp,
    linarith },
  { rintros ⟨ε, ε_pos, h⟩,
    have : (mk' S) '' (ball (0 : M) ε) ⊆ {x | ‖x‖ < ε},
    { rintros _ ⟨x, x_in, rfl⟩,
      rw mem_ball_zero_iff at x_in,
      exact lt_of_le_of_lt (quotient_norm_mk_le S x) x_in },
    apply filter.mem_of_superset _ (set.subset.trans this h),
    clear h U this,
    apply is_open.mem_nhds,
    { change is_open ((mk' S) ⁻¹' _),
      erw quotient_add_group.preimage_image_coe,
      apply is_open_Union,
      rintros ⟨s, s_in⟩,
      exact (continuous_add_right s).is_open_preimage _ is_open_ball },
    { exact ⟨(0 : M), mem_ball_self ε_pos, (mk' S).map_zero⟩ } },
end⟩

/-- The seminormed group structure on the quotient by an additive subgroup. -/
noncomputable
instance add_subgroup.seminormed_add_comm_group_quotient (S : add_subgroup M) :
  seminormed_add_comm_group (M ⧸ S) :=
{ dist               := λ x y, ‖x - y‖,
  dist_self          := λ x, by simp only [norm_mk_zero, sub_self],
  dist_comm          := quotient_norm_sub_rev,
  dist_triangle      := λ x y z,
  begin
    unfold dist,
    have : x - z = (x - y) + (y - z) := by abel,
    rw this,
    exact quotient_norm_add_le S (x - y) (y - z)
  end,
  dist_eq := λ x y, rfl,
  to_uniform_space   := topological_add_group.to_uniform_space (M ⧸ S),
  uniformity_dist    :=
  begin
    rw uniformity_eq_comap_nhds_zero',
    have := (quotient_nhd_basis S).comap (λ (p : (M ⧸ S) × M ⧸ S), p.2 - p.1),
    apply this.eq_of_same_basis,
    have : ∀ ε : ℝ, (λ (p : (M ⧸ S) × M ⧸ S), p.snd - p.fst) ⁻¹' {x | ‖x‖ < ε} =
      {p : (M ⧸ S) × M ⧸ S | ‖p.fst - p.snd‖ < ε},
    { intro ε,
      ext x,
      dsimp,
      rw quotient_norm_sub_rev },
    rw funext this,
    refine filter.has_basis_binfi_principal _ set.nonempty_Ioi,
    rintros ε (ε_pos : 0 < ε) η (η_pos : 0 < η),
    refine ⟨min ε η, lt_min ε_pos η_pos, _, _⟩,
    { suffices : ∀ (a b : M ⧸ S), ‖a - b‖ < ε → ‖a - b‖ < η → ‖a - b‖ < ε, by simpa,
      exact λ a b h h', h },
    { simp }
  end }

-- This is a sanity check left here on purpose to ensure that potential refactors won't destroy
-- this important property.
example (S : add_subgroup M) : (quotient.topological_space : topological_space $ M ⧸ S) =
S.seminormed_add_comm_group_quotient.to_uniform_space.to_topological_space :=
rfl

/-- The quotient in the category of normed groups. -/
noncomputable
instance add_subgroup.normed_add_comm_group_quotient (S : add_subgroup M) [is_closed (S : set M)] :
  normed_add_comm_group (M ⧸ S) :=
{ eq_of_dist_eq_zero :=
  begin
    rintros ⟨m⟩ ⟨m'⟩ (h : ‖mk' S m - mk' S m'‖ = 0),
    erw [← (mk' S).map_sub, quotient_norm_eq_zero_iff, ‹is_closed _›.closure_eq,
         ← quotient_add_group.eq_iff_sub_mem] at h,
    exact h
  end,
  .. add_subgroup.seminormed_add_comm_group_quotient S }

-- This is a sanity check left here on purpose to ensure that potential refactors won't destroy
-- this important property.
example (S : add_subgroup M) [is_closed (S : set M)] :
  S.seminormed_add_comm_group_quotient = normed_add_comm_group.to_seminormed_add_comm_group := rfl

namespace add_subgroup

open normed_add_group_hom

/-- The morphism from a seminormed group to the quotient by a subgroup. -/
noncomputable
def normed_mk (S : add_subgroup M) : normed_add_group_hom M (M ⧸ S) :=
{ bound' := ⟨1, λ m, by simpa [one_mul] using quotient_norm_mk_le  _ m⟩,
  .. quotient_add_group.mk' S }

/-- `S.normed_mk` agrees with `quotient_add_group.mk' S`. -/
@[simp]
lemma normed_mk.apply (S : add_subgroup M) (m : M) : normed_mk S m = quotient_add_group.mk' S m :=
rfl

/-- `S.normed_mk` is surjective. -/
lemma surjective_normed_mk (S : add_subgroup M) : function.surjective (normed_mk S) :=
surjective_quot_mk _

/-- The kernel of `S.normed_mk` is `S`. -/
lemma ker_normed_mk (S : add_subgroup M) : S.normed_mk.ker = S :=
quotient_add_group.ker_mk  _

/-- The operator norm of the projection is at most `1`. -/
lemma norm_normed_mk_le (S : add_subgroup M) : ‖S.normed_mk‖ ≤ 1 :=
normed_add_group_hom.op_norm_le_bound _ zero_le_one (λ m, by simp [quotient_norm_mk_le'])

/-- The operator norm of the projection is `1` if the subspace is not dense. -/
lemma norm_normed_mk (S : add_subgroup M) (h : (S.topological_closure : set M) ≠ univ) :
  ‖S.normed_mk‖ = 1 :=
begin
  obtain ⟨x, hx⟩ := set.nonempty_compl.2 h,
  let y := S.normed_mk x,
  have hy : ‖y‖ ≠ 0,
  { intro h0,
    exact set.not_mem_of_mem_compl hx ((quotient_norm_eq_zero_iff S x).1 h0) },
  refine le_antisymm (norm_normed_mk_le S) (le_of_forall_pos_le_add (λ ε hε, _)),
  suffices : 1 ≤ ‖S.normed_mk‖ + min ε ((1 : ℝ)/2),
  { exact le_add_of_le_add_left this (min_le_left ε ((1 : ℝ)/2)) },
  have hδ := sub_pos.mpr (lt_of_le_of_lt (min_le_right ε ((1 : ℝ)/2)) one_half_lt_one),
  have hδpos : 0 < min ε ((1 : ℝ)/2) := lt_min hε one_half_pos,
  have hδnorm := mul_pos (div_pos hδpos hδ) (lt_of_le_of_ne (norm_nonneg y) hy.symm),
  obtain ⟨m, hm, hlt⟩ := norm_mk_lt y hδnorm,
  have hrw : ‖y‖ + min ε (1 / 2) / (1 - min ε (1 / 2)) * ‖y‖ =
    ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring,
  rw [hrw] at hlt,
  have hm0 : ‖m‖ ≠ 0,
  { intro h0,
    have hnorm := quotient_norm_mk_le S m,
    rw [h0, hm] at hnorm,
    replace hnorm := le_antisymm hnorm (norm_nonneg _),
    simpa [hnorm] using hy },
  replace hlt := (div_lt_div_right (lt_of_le_of_ne (norm_nonneg m) hm0.symm)).2 hlt,
  simp only [hm0, div_self, ne.def, not_false_iff] at hlt,
  have hrw₁ : ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) / ‖m‖ =
    (‖y‖ / ‖m‖) * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring,
  rw [hrw₁] at hlt,
  replace hlt := (inv_pos_lt_iff_one_lt_mul (lt_trans (div_pos hδpos hδ) (lt_one_add _))).2 hlt,
  suffices : ‖S.normed_mk‖ ≥ 1 - min ε (1 / 2),
  { exact sub_le_iff_le_add.mp this },
  calc ‖S.normed_mk‖ ≥ ‖(S.normed_mk) m‖ / ‖m‖ : ratio_le_op_norm S.normed_mk m
  ...  = ‖y‖ / ‖m‖ : by rw [normed_mk.apply, hm]
  ... ≥ (1 + min ε (1 / 2) / (1 - min ε (1 / 2)))⁻¹ : le_of_lt hlt
  ... = 1 - min ε (1 / 2) : by field_simp [(ne_of_lt hδ).symm]
end

/-- The operator norm of the projection is `0` if the subspace is dense. -/
lemma norm_trivial_quotient_mk (S : add_subgroup M)
  (h : (S.topological_closure : set M) = set.univ) : ‖S.normed_mk‖ = 0 :=
begin
  refine le_antisymm (op_norm_le_bound _ le_rfl (λ x, _)) (norm_nonneg _),
  have hker : x ∈ (S.normed_mk).ker.topological_closure,
  { rw [S.ker_normed_mk],
    exact set.mem_of_eq_of_mem h trivial },
  rw [ker_normed_mk] at hker,
  simp only [(quotient_norm_eq_zero_iff S x).mpr hker, normed_mk.apply, zero_mul],
end

end add_subgroup

namespace normed_add_group_hom

/-- `is_quotient f`, for `f : M ⟶ N` means that `N` is isomorphic to the quotient of `M`
by the kernel of `f`. -/
structure is_quotient (f : normed_add_group_hom M N) : Prop :=
(surjective : function.surjective f)
(norm : ∀ x, ‖f x‖ = Inf ((λ m, ‖x + m‖) '' f.ker))

/-- Given  `f : normed_add_group_hom M N` such that `f s = 0` for all `s ∈ S`, where,
`S : add_subgroup M` is closed, the induced morphism `normed_add_group_hom (M ⧸ S) N`. -/
noncomputable
def lift {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M)
  (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) :
  normed_add_group_hom (M ⧸ S) N :=
{ bound' :=
  begin
    obtain ⟨c : ℝ, hcpos : (0 : ℝ) < c, hc : ∀ x, ‖f x‖ ≤ c * ‖x‖⟩ := f.bound,
    refine ⟨c, λ mbar, le_of_forall_pos_le_add (λ ε hε, _)⟩,
    obtain ⟨m : M, rfl : mk' S m = mbar, hmnorm : ‖m‖ < ‖mk' S m‖ + ε/c⟩ :=
      norm_mk_lt mbar (div_pos hε hcpos),
    calc ‖f m‖ ≤ c * ‖m‖ : hc m
    ... ≤ c*(‖mk' S m‖ + ε/c) : ((mul_lt_mul_left hcpos).mpr hmnorm).le
    ... = c * ‖mk' S m‖ + ε : by rw [mul_add, mul_div_cancel' _ hcpos.ne.symm]
  end,
  .. quotient_add_group.lift S f.to_add_monoid_hom hf }

lemma lift_mk {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M)
  (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) (m : M) :
  lift S f hf (S.normed_mk m) = f m := rfl

lemma lift_unique {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M)
  (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0)
  (g : normed_add_group_hom (M ⧸ S) N) :
  g.comp (S.normed_mk) = f → g = lift S f hf :=
begin
  intro h,
  ext,
  rcases add_subgroup.surjective_normed_mk _ x with ⟨x,rfl⟩,
  change (g.comp (S.normed_mk) x) = _,
  simpa only [h]
end

/-- `S.normed_mk` satisfies `is_quotient`. -/
lemma is_quotient_quotient (S : add_subgroup M) : is_quotient (S.normed_mk) :=
⟨S.surjective_normed_mk, λ m, by simpa [S.ker_normed_mk] using quotient_norm_mk_eq _ m⟩

lemma is_quotient.norm_lift {f : normed_add_group_hom M N} (hquot : is_quotient f) {ε : ℝ}
  (hε : 0 < ε) (n : N) : ∃ (m : M), f m = n ∧ ‖m‖ < ‖n‖ + ε :=
begin
  obtain ⟨m, rfl⟩ := hquot.surjective n,
  have nonemp : ((λ m', ‖m + m'‖) '' f.ker).nonempty,
  { rw set.nonempty_image_iff,
    exact ⟨0, f.ker.zero_mem⟩ },
  rcases real.lt_Inf_add_pos nonemp hε with
    ⟨_, ⟨⟨x, hx, rfl⟩, H : ‖m + x‖ < Inf ((λ (m' : M), ‖m + m'‖) '' f.ker) + ε⟩⟩,
  exact ⟨m+x, by rw [map_add,(normed_add_group_hom.mem_ker f x).mp hx, add_zero],
               by rwa hquot.norm⟩,
end

lemma is_quotient.norm_le {f : normed_add_group_hom M N} (hquot : is_quotient f) (m : M) :
  ‖f m‖ ≤ ‖m‖ :=
begin
  rw hquot.norm,
  apply cInf_le,
  { use 0,
    rintros _ ⟨m', hm', rfl⟩,
    apply norm_nonneg },
  { exact ⟨0, f.ker.zero_mem, by simp⟩ }
end

lemma lift_norm_le {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M)
  (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0)
  {c : ℝ≥0} (fb : ‖f‖ ≤ c) :
  ‖lift S f hf‖ ≤ c :=
begin
  apply op_norm_le_bound _ c.coe_nonneg,
  intros x,
  by_cases hc : c = 0,
  { simp only [hc, nnreal.coe_zero, zero_mul] at fb ⊢,
    obtain ⟨x, rfl⟩ := surjective_quot_mk _ x,
    show ‖f x‖ ≤ 0,
    calc ‖f x‖ ≤ 0 * ‖x‖ : f.le_of_op_norm_le fb x
          ... = 0 : zero_mul _ },
  { replace hc : 0 < c := pos_iff_ne_zero.mpr hc,
    apply le_of_forall_pos_le_add,
    intros ε hε,
    have aux : 0 < (ε / c) := div_pos hε hc,
    obtain ⟨x, rfl, Hx⟩ : ∃ x', S.normed_mk x' = x ∧ ‖x'‖ < ‖x‖ + (ε / c) :=
      (is_quotient_quotient _).norm_lift aux _,
    rw lift_mk,
    calc ‖f x‖ ≤ c * ‖x‖ : f.le_of_op_norm_le fb x
          ... ≤ c * (‖S.normed_mk x‖ + ε / c) : (mul_le_mul_left _).mpr Hx.le
          ... = c * _ + ε : _,
    { exact_mod_cast hc },
    { rw [mul_add, mul_div_cancel'], exact_mod_cast hc.ne' } },
end

lemma lift_norm_noninc {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M)
  (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0)
  (fb : f.norm_noninc) :
  (lift S f hf).norm_noninc :=
λ x,
begin
  have fb' : ‖f‖ ≤ (1 : ℝ≥0) := norm_noninc.norm_noninc_iff_norm_le_one.mp fb,
  simpa using le_of_op_norm_le _ (f.lift_norm_le _ _ fb') _,
end

end normed_add_group_hom

/-!
### Submodules and ideals

In what follows, the norm structures created above for quotients of (semi)`normed_add_comm_group`s
by `add_subgroup`s are transferred via definitional equality to quotients of modules by submodules,
and of rings by ideals, thereby preserving the definitional equality for the topological group and
uniform structures worked for above. Completeness is also transferred via this definitional
equality.

In addition, instances are constructed for `normed_space`, `semi_normed_comm_ring`,
`normed_comm_ring` and `normed_algebra` under the appropriate hypotheses. Currently, we do not
have quotients of rings by two-sided ideals, hence the commutativity hypotheses are required.
 -/

section submodule

variables {R : Type*} [ring R] [module R M] (S : submodule R M)

instance submodule.quotient.seminormed_add_comm_group :
  seminormed_add_comm_group (M ⧸ S) :=
add_subgroup.seminormed_add_comm_group_quotient S.to_add_subgroup

instance submodule.quotient.normed_add_comm_group [hS : is_closed (S : set M)] :
  normed_add_comm_group (M ⧸ S) :=
@add_subgroup.normed_add_comm_group_quotient _ _ S.to_add_subgroup hS

instance submodule.quotient.complete_space [complete_space M] : complete_space (M ⧸ S) :=
quotient_add_group.complete_space M S.to_add_subgroup

/-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `submodule.quotient.mk m = x`
and `‖m‖ < ‖x‖ + ε`. -/
lemma submodule.quotient.norm_mk_lt {S : submodule R M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) :
  ∃ m : M, submodule.quotient.mk m = x ∧ ‖m‖ < ‖x‖ + ε :=
norm_mk_lt x hε

lemma submodule.quotient.norm_mk_le (m : M) :
  ‖(submodule.quotient.mk m : M ⧸ S)‖ ≤ ‖m‖ :=
quotient_norm_mk_le S.to_add_subgroup m

instance submodule.quotient.normed_space (𝕜 : Type*) [normed_field 𝕜] [normed_space 𝕜 M]
  [has_smul 𝕜 R] [is_scalar_tower 𝕜 R M] : normed_space 𝕜 (M ⧸ S) :=
{ norm_smul_le := λ k x, le_of_forall_pos_le_add $ λ ε hε,
  begin
    have := (nhds_basis_ball.tendsto_iff nhds_basis_ball).mp
      ((@real.uniform_continuous_const_mul (‖k‖)).continuous.tendsto (‖x‖)) ε hε,
    simp only [mem_ball, exists_prop, dist, abs_sub_lt_iff] at this,
    rcases this with ⟨δ, hδ, h⟩,
    obtain ⟨a, rfl, ha⟩ := submodule.quotient.norm_mk_lt x hδ,
    specialize h (‖a‖) (⟨by linarith, by linarith [submodule.quotient.norm_mk_le S a]⟩),
    calc _ ≤ ‖k‖ * ‖a‖ : (quotient_norm_mk_le S.to_add_subgroup (k • a)).trans_eq (norm_smul k a)
    ...    ≤ _ : (sub_lt_iff_lt_add'.mp h.1).le
  end,
  .. submodule.quotient.module' S, }

end submodule

section ideal

variables {R : Type*} [semi_normed_comm_ring R] (I : ideal R)

lemma ideal.quotient.norm_mk_lt {I : ideal R} (x : R ⧸ I) {ε : ℝ} (hε : 0 < ε) :
  ∃ r : R, ideal.quotient.mk I r = x ∧ ‖r‖ < ‖x‖ + ε :=
norm_mk_lt x hε

lemma ideal.quotient.norm_mk_le (r : R) :
  ‖ideal.quotient.mk I r‖ ≤ ‖r‖ :=
quotient_norm_mk_le I.to_add_subgroup r

instance ideal.quotient.semi_normed_comm_ring : semi_normed_comm_ring (R ⧸ I) :=
{ mul_comm := mul_comm,
  norm_mul := λ x y, le_of_forall_pos_le_add $ λ ε hε,
  begin
    have := ((nhds_basis_ball.prod_nhds nhds_basis_ball).tendsto_iff nhds_basis_ball).mp
      (real.continuous_mul.tendsto (‖x‖, ‖y‖)) ε hε,
    simp only [set.mem_prod, mem_ball, and_imp, prod.forall, exists_prop, prod.exists] at this,
    rcases this with ⟨ε₁, ε₂, ⟨h₁, h₂⟩, h⟩,
    obtain ⟨⟨a, rfl, ha⟩, ⟨b, rfl, hb⟩⟩ :=
      ⟨ideal.quotient.norm_mk_lt x h₁, ideal.quotient.norm_mk_lt y h₂⟩,
    simp only [dist, abs_sub_lt_iff] at h,
    specialize h (‖a‖) (‖b‖) (⟨by linarith, by linarith [ideal.quotient.norm_mk_le I a]⟩)
      (⟨by linarith, by linarith [ideal.quotient.norm_mk_le I b]⟩),
    calc _ ≤ ‖a‖ * ‖b‖ : (ideal.quotient.norm_mk_le I (a * b)).trans (norm_mul_le a b)
    ...    ≤ _        : (sub_lt_iff_lt_add'.mp h.1).le
  end,
  .. submodule.quotient.seminormed_add_comm_group I }

instance ideal.quotient.normed_comm_ring [is_closed (I : set R)] :
  normed_comm_ring (R ⧸ I) :=
{ .. ideal.quotient.semi_normed_comm_ring I,
  .. submodule.quotient.normed_add_comm_group I }

variables (𝕜 : Type*) [normed_field 𝕜]

instance ideal.quotient.normed_algebra [normed_algebra 𝕜 R] :
  normed_algebra 𝕜 (R ⧸ I) :=
{ .. submodule.quotient.normed_space I 𝕜,
  .. ideal.quotient.algebra 𝕜 }

end ideal


import .prop_logic

/-
A logic is a "formal language" with
a mathematically defined syntax and a
mathematically defined semantics. The
syntax of a language defines the set
of legal expressions in the language
(sometimes called formula, well-formed
formula, sentences, etc). The semantics
then explains how to give a meaning to
each such expression.

In this unit, we formalize the syntax
and semantics of our first example of
a complete logic: a simple logic called
propositional logic.

The *syntactic* terms of propositional
logic again fall in three categories:
- there are two literal terms, which we
will call pTrue and pFalse
- there are variable terms
- and there are application terms, in
which propositional logic connectives
are applied to smaller terms to create
larger ones. These connectives are the
familiar connectives of Boolean algebra:
and (∧), or (∨), not (¬), and so forth.

Examples of propositional logic terms
thus include:
- pTrue             -- literal
- pFalse            -- literal
- and pTrue pFalse  -- application
- X                 -- variable
- Y                 -- variable
- Z                 -- variable
- X ∨ Y             -- application: or X Y
- (X ∨ Y) ∧ (X ∧ Z) -- etc.
- (X ∨ Y) ∧ (X ∧ pTrue)
- etc

The semantic domain of discourse, in which
such expressions are given meaning, is the
set of Boolean truth values, {true, false}.
The semantics of propositional logic assigns
a simple Boolean truth value to each such
propositional logic expression.

In this unit, we will define "eval" to be
a function that takes an expressions and
returns its meaning as a Boolean value.
(As we'll see shortly, the eval function
will have to take one more argument in
order to deal with variable expressions).

Here are the rules for how eval works:

LITERAL TERMS

To the literal, pTrue, the semantic
"evaluation" function assigns the truth
value, true. To pFalse, it assigns the
truth value false. In other words, we
define eval(pFalse) to be the bool, ff,
and eval (pTrue) to be the bool, tt.

VARIABLE TERMS

To evaluate a variable expression, such
as X, or to evaluate an expression with
several variables, such as X ∧ Y, we need
an addition piece of data: what Boolean
truth value each such variable has.
We call this data an *interpretation*.
We will represent it as a function, interp,
from variables to Boolean truth values.
The semantic meaning of the syntactic
variable term, X, is then interp(X).
I.e., eval(X) is defined as interp(X).

There are many possible interpretations
for a given (non-empty) set of variables.
Self-test: How many interpretations are
there for a single variable, X? How many
interpretations are possible for a set
of variables {X_i} of size n?

APPLICATION TERMS

Application terms are built inductively
by applying proposition logic connectives
to smaller terms. For example, if e1 and
e2 are terms (whether literal, variable,
or application), then so are (and e1 e2),
(or e1 e2), (not e1), etc.

Our intention is that the semantics of
such syntactic terms should reflect the
usual Boolean algebraic meaning of the
connectives. So, for example, if e1 and
e2 are expressions, then so is (and e1
e2), and we wish to evaluate this as
true if and only if both e1 and e2
evaluate to true.

We thus define eval to work recursively
on such expressions. We evaluate the truth
of e1 and of e2 and then apply the *bool*
and operator (as distinct from the and
logical connective) to the results to
determine the truth value of (and e1 e2).
-/

open prop_logic
open prop_logic.var
open prop_logic.unOp
open prop_logic.binOp
open prop_logic.pExp

/-
    **************
    *** SYNTAX ***
    **************
-/

-- Variables

#check mkVar
#check mkVar 0
#check mkVar 1
#check mkVar 2
#check mkVar 3

-- names for a few
def varX := mkVar 0
def varY := mkVar 1
def varZ := mkVar 2

-- Operators (connectives)
#check pNot     -- unary
#check pAnd     -- binary
#check pOr      -- binary

-- Expressions

-- Literal
#check litExp ff
#check litExp tt
#check pFalse
#check pTrue

-- Variable
#check varExp varX
#check varExp varY
def X : pExp:= varExp varX
def Y : pExp := varExp varY
def Z : pExp := varExp varZ
#check X
#check Y

-- Operator/application
#check unOpExp notOp pTrue
#check unOpExp notOp

-- with shorthands
#check pNot pTrue
#check pNot X
#check binOpExp andOp X Y
#check binOpExp andOp
#check pAnd X Y
#check pOr X Y

-- finally, logical expressions!
#check pTrue
#check ¬ pTrue
#check ¬ pFalse
#check X
#check ¬ X
#check Y
#check X ∧ Y
#check X ∨ Y
#check ¬ (X ∧ Y)
-- Will be equal to the line above
#check (unOpExp notOp) ((binOpExp andOp)
            (varExp (mkVar 0))
            (varExp (mkVar 1)))
#check ¬ (X ∧ Y) ∨ (¬ X ∨ ¬ Y)

/-
You have now defined the syntax of the
formal language, propositional logic!
You can now check syntactic correctness
of expressions.
-/

#check ¬ (X ∧ Y) ∨ (X ∨ Z) -- correct
#check ¬ (X ∧ Y) ∨ (X ∨ )  -- error
#check ¬ X ¬ Y             -- error
#check pTrue pFalse        -- error

/-
    *****************
    *** SEMANTICS ***
    *****************
-/

-- Interpretations

def allFalse : var → bool
| _ := ff

def allTrue : var → bool
| _ := tt

def anInterp: var → bool
  | (mkVar 0) := tt
  | (mkVar 1) := ff
  | (mkVar 2) := tt
  | (mkVar _) := ff

-- interpretation

#eval allFalse varX
#eval allTrue varX
#eval anInterp varX
#eval anInterp varY

-- Interpretation of operators

#check interpUnOp notOp
#eval (interpUnOp notOp) tt
#eval interpBinOp andOp tt ff
#eval interpBinOp andOp tt tt

-- evaluation of expressions

#eval pEval pTrue allTrue
#eval pEval pTrue allFalse
#eval pEval X allTrue
#eval pEval Y allFalse
#eval pEval X anInterp
#eval pEval Y anInterp
#eval pEval (X ∧ Y) allTrue
#eval pEval (X ∧ Y) allFalse
#eval pEval (X ∧ Y) anInterp
#eval pEval (X ∨ Y) anInterp
#eval pEval (X ∧ Z) anInterp
#eval pEval (¬ (X ∧ Z)) anInterp
#eval pEval (¬ (X ∧ Y) ∨ (¬ X ∨ ¬ Y)) anInterp
#eval pEval (¬ (X ∧ Y) ∨ (¬ X ∨ ¬ Y)) allTrue

/-
To formalize a semantics for our
realization of propositional logic,
we need to formally define what we
mean by an interpretation.

An interpretation in propositional
logic is a function from propositional
variables to corresponding (Boolean)
truth values. An interpretation tells
us what each variable "means" -- i.e.,
whether it means true, or false.

We now define a name for the type
of an interpretation (pVar → bool).
Then we present several examples of
interpretations.
-/

-- Semantics

/-
We now define a semantics for our
language in the form of a function
that, when given any expression in
our language *and* an interpretation
for the variables that might appear
in it, evaluates its truth value and
returns it as a result.

The definition is by cases, i.e.,
with one rule for each possible form
(constructor) of expression.

Note: Lean "overloads" logical
operator notations, such as ∧, ∨,
and ¬. Here they are applied not to
values of type Prop, but to values
of type bool, where they have their
usual means from Boolean algebra.
-/

/-
And now we have a formal language, with
a syntax, interpretations, and semantics.
Let's evaluate some of our expressions
under varying interpretations.
-/

/-
So there you have it: a complete
formal definition of the syntax,
interpretation, and semantics of
propositional logic, in Lean, with
a nice "surface syntax," to boot.
(Ok, it's complete except for the
definitions for the other logical
connectives. You will add some of
them in homework and on the exam.)
-/

/-
From here, we can define richer
functions, such as functions that
analyze expressions; and we can
even state and prove theorems
about our language.
-/

/-
Let's define a function that
returns the set of variables
in a given pExp. This will be
useful in the future.
-/

/-
We start by defining a recursive
helper function that adds all the
variables in given expression to
the given, often already non-empty,
set of variables.

Understand the type and purpose of
this function, then go on to read
the following main function. Study
its purpose, type, and implementation,
then come back for a deeper look at
how this function is implemented.
Learn to use functions knowing only
their type and purpose, ignoring, at
least at first, their implementation
details. Pratice mental abstracting.

We implement (prove) this recursive
function (type) by case analysis on
possible forms of the given pExp.
-/
/-
Main function: a non-recursive function
that passes an initially empty set of
variables to the helper function and
then gets back a set of all, and only,
the variables in the given expression.
-/
/-
Examples of its use
-/
#reduce vars_in_exp (X ∧ Y)
-- A predicate for set {X,Y}

/-
Another example
-/
#reduce vars_in_exp (X ∧ Z)

/-
EXERCISE: Write a function that when
given an expression, e, returns the
"nesting depth" of the expression. The
nesting depth of a literal or variable
expression is 1. The depth of a (not e)
expression is 1 + the depth of e. And
the depth of an (and e1 e2) expression
is 1 + the max of the depths of e1 and
e2. You can use the Lean-provided max
function in your answer.
-/

#reduce max 5 7
#reduce max 7 5

/-
We can also prove theorems about
our language in general. Here's a
proof that evaluation under a given
interpretation is "deterministic::
it always produces the same result.

This is really just a corollary of
the facts that (1) functions in Lean
are single valued and (2) we defined
the semantics of expressions with a
function. There's one and only one
answer for the value of any given
expression.
-/

theorem pEval_deterministic :
∀ e : pExp,
∀ i : pInterp,
∀ v1 v2 : bool,
v1 = pEval e i → v2 = pEval e i → v1 = v2 :=
begin
intros e i v1 v2 h_v1 h_v2,
rw h_v1,
rw h_v2,
end

/-
We can also prove theorems ("reason
about") particular expressions, or
certain classes of expressions, in
our language. For example, if X_exp
is any variable expression, then the
expression (X_exp ∧ (¬ X_exp)) is
false under any interpretation. We
can easily prove this proposition.
-/

theorem contra :
∀ V : pVar,
∀ i : pInterp,
pEval
    ((mk_var_pexp V) ∧ ¬ (mk_var_pexp V)) i = ff
:=
begin
intros X i,
simp [pEval],
-- case analysis on result of function!
cases (i X),
left, apply rfl,
right, apply rfl,
end

/-
Note that it is quantified over all
possible interpretations: over all
possible functions from pVar → bool.
Lean supports what is called higher
order predicate logic. Quantifying
over functions and relations is ok
in a higher-order predicate logic.
It is not allowed in the first-order
predicate logic of everyday math and
computer science. Here you can see
that it gives you great expressive
power to be able to quantify over
functions. It gives us a way to say,
"under any possible interpretation",
which is exactly what we need to be
able to say to define satisfiability,
validity, unsatisfiability, etc.
-/

/-
Exercise: Prove that for any
variable, V, the logical expression
(mk_var_exp V) ∨ (¬ (mk_var_exp V))
always evaluates to true.
-/

def valid (e : pExp) : Prop :=
    ∀ i : pInterp, pEval e i = tt

/-
An expression in propositional logic
is unsatisfiable if it does'ot evaluate
to true under any interpretation.
-/

def unsatisfiable (e : pExp) : Prop :=
    ∀ i, pEval e i = ff

/-
You could also have said there does not
exist an i that makes (pEval e i) = tt.
-/

/-
An interpretation that makes an
expression, e, evaluate to true,
is said to be a "model" of that
expression. Here's a predicate
asserting that i is a model of e.
-/

def isModel (i: pInterp) (e : pExp) :=
    pEval e i = tt

/-
An expression is said to be satisfiable
if there is at least one interpretation
under which it evaluates to true.
-/
def satisfiable (e : pExp) : Prop :=
    ∃ i, isModel i e

/-
Example: X ∧ ¬ X is unsatisfiable.
-/

example : unsatisfiable (X_exp ∧ (¬ (X_exp))) :=
begin
unfold unsatisfiable,
intro i,
rw pEval, -- you can do this
rw pEval, -- and do it again
cases (pEval X_exp i), -- cool!
trivial,
trivial,
end

/-
EXERCISE: Once you've extended
our logic with an or operator,
formulize and prove the proposition
that (our rendering of) X ∨ (¬ X)
is valid.

EXERCISE: Prove the proposition
that (X ∨ Y) ∧ Z is satisfiable.
Hint: You'll need a witness. There
is an element of search involved
in solving a problem like this.
-/

/-
EXERCISE: Write a SAT solver based
on what we've done here.
-/

-- m'th bit from right in binary rep of n
def mrbn: ℕ → ℕ → bool
| 0 n := n % 2 = 1
| (nat.succ m') n := mrbn m' (n/2)

/- smoke test
#reduce mrbn 0 15
#reduce mrbn 2 15
#reduce mrbn 2 15
#reduce mrbn 3 15
#reduce mrbn 4 15
#reduce mrbn 5 15
-/

/-
The mth canonical interpretation
among the 2^n-1 interpretations
for a set of variables of size n.

The values of the first n-indexed
variables in the mth interpretation
are determined by the bits in the
binary representation of m. The
leftmost bit gives the value for
the variable with index 0. Each
bit to the left gives the value of
the next indexed variable. All
subsequent values are ff. m thus
effectively enumerates the 2^n
interpretations on the n first
variables in the index set of all
variables.
-/

def mthInterpOf2toN (m n: ℕ) : pInterp :=
    if (m >= 2^n)
    then falseInterp
    else
    λ v : pVar,
        match v with
        | (pVar.mk i) :=
        if i >= n then
        ff
        else
        (mrbn i m)
        end

/-
Examples:
-/

#reduce pEval and_X_Y_exp (mthInterpOf2toN 3 3)

-- unincorporated

#reduce mthInterpOf2toN 3 5

def first_n_true_inter (n : ℕ) : pInterp :=
λ v,
    match v with
    | (pVar.mk n') := if n' < n then tt else ff
    end

def all_models (e : pExp) :=
    { m | isModel m e}

def sat_solve (e : pExp) : option pInterp :=
none


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

import data.nat.prime
import data.nat.totient
import algebra.periodic
import data.finset.locally_finite
import data.nat.count

/-!
# The Prime Counting Function

In this file we define the prime counting function: the function on natural numbers that returns
the number of primes less than or equal to its input.

## Main Results

The main definitions for this file are

- `nat.prime_counting`: The prime counting function π
- `nat.prime_counting'`: π(n - 1)

We then prove that these are monotone in `nat.monotone_prime_counting` and
`nat.monotone_prime_counting'`. The last main theorem `nat.prime_counting'_add_le` is an upper
bound on `π'` which arises by observing that all numbers greater than `k` and not coprime to `k`
are not prime, and so only at most `φ(k)/k` fraction of the numbers from `k` to `n` are prime.

## Notation

We use the standard notation `π` to represent the prime counting function (and `π'` to represent
the reindexed version).

-/

namespace nat
open finset

/--
A variant of the traditional prime counting function which gives the number of primes
*strictly* less than the input. More convenient for avoiding off-by-one errors.
-/
def prime_counting' : ℕ → ℕ := nat.count prime

/-- The prime counting function: Returns the number of primes less than or equal to the input. -/
def prime_counting (n : ℕ) : ℕ := prime_counting' (n + 1)

localized "notation `π` := nat.prime_counting" in nat
localized "notation `π'` := nat.prime_counting'" in nat

lemma monotone_prime_counting' : monotone prime_counting' := count_monotone prime

lemma monotone_prime_counting : monotone prime_counting :=
λ a b a_le_b, monotone_prime_counting' (add_le_add_right a_le_b 1)

/-- A linear upper bound on the size of the `prime_counting'` function -/
lemma prime_counting'_add_le {a k : ℕ} (h0 : 0 < a) (h1 : a < k) (n : ℕ) :
  π' (k + n) ≤ π' k + nat.totient a * (n / a + 1) :=
calc π' (k + n)
    ≤ ((range k).filter (prime)).card + ((Ico k (k + n)).filter (prime)).card :
        begin
          rw [prime_counting', count_eq_card_filter_range, range_eq_Ico,
              ←Ico_union_Ico_eq_Ico (zero_le k) (le_self_add), filter_union],
          apply card_union_le,
        end
... ≤ π' k + ((Ico k (k + n)).filter (prime)).card :
        by rw [prime_counting', count_eq_card_filter_range]
... ≤ π' k + ((Ico k (k + n)).filter (coprime a)).card :
        begin
          refine add_le_add_left (card_le_of_subset _) k.prime_counting',
          simp only [subset_iff, and_imp, mem_filter, mem_Ico],
          intros p succ_k_le_p p_lt_n p_prime,
          split,
          { exact ⟨succ_k_le_p, p_lt_n⟩, },
          { rw coprime_comm,
            exact coprime_of_lt_prime h0 (gt_of_ge_of_gt succ_k_le_p h1) p_prime, },
        end
... ≤ π' k + totient a * (n / a + 1) :
        begin
          rw [add_le_add_iff_left],
          exact Ico_filter_coprime_le k n h0,
        end

end nat


import topology.metric_space.basic

variables {X : Type*} [metric_space X]
variables x y z : X

#check dist_self
#check dist_self y
#check dist_comm
#check dist_comm y x
#check dist_triangle
#check dist_triangle x y z
#check two_mul
#check @le_trans
#check @div_le_div_of_le

-- BEGIN
example (x y : X) : 0 ≤ dist x y :=
begin
  have h := dist_triangle x y x,
  /- have h : dist x x ≤ dist x y + dist y x -/
  rw dist_comm y x at h,
  linarith [dist_self x],
end

example (x y : X) : 0 ≤ dist x y :=
begin
  have h := dist_triangle x y x,
  /- have h : dist x x ≤ dist x y + dist y x -/
  rw dist_comm y x at h,
  rw ← two_mul (dist x y) at h,
  rw dist_self at h,
  have h' : 0 / 2 ≤ (2 * dist x y) / 2 := div_le_div_of_le zero_le_two h,
  rw ← div_mul_eq_mul_div at h',
  norm_num at h',
  exact h',
end
-- END


import lib.m154

namespace m154
open nat
/-
# Implications

Ce fichier aborde l'étude du connecteur logique  `→` (implication, notée `⇒` sur papier).
Les exercices proposés, basés purement sur ce connecteur et les outils du fichier 01 sont un
peu artificiels. Il s'agit d'être patient, les exercices naturels arriveront dans le fichier
concernant le quantificateur universel.

Un énoncé `P → Q` se lit `si P alors Q`.
Cet énoncé permet de démontrer l'énoncé `Q` dès que on peut produire une preuve de `P`.
C'est donc une justification de `Q` sous l'hypothèse que `P` est vérifié.

Par exemple l'énoncé
`carre_pos {a : ℝ} : a > 0 → a^2 > 0`
affirme que si un nombre `a` est strictement positif alors son carré l'est aussi.
On dit que `a > 0` est la prémisse de l'implication et `a^2 > 0` sa conclusion.

On peut utiliser un tel énoncé pour démontrer la conclusion de l'implication en lui
fournissant une démonstration de la prémisse.
La commande correspondante est `On conclut par ... appliqué à ...,`.
Dans l'exemple  qui suit, l'hypothèse `ha` est une démonstration de la prémisse.
-/

-- Dans toute la suite, x, a, b, c et d désignent des nombres réels.
variables {x a b c d : ℝ}

example (ha : a > 0) : a^2 > 0:=
begin
  On conclut par carre_pos appliqué à ha,
end

/-
Entraînez-vous en utilisant le théorème
`non_zero_abs_pos {a : ℝ} : a ≠ 0 → |a| > 0`
-/

example (h : x ≠ 0) : |x| > 0:=
begin
  sorry
end

/-
Les implications permettent aussi de faire du « raisonnement vers l'arrière » :
si le but à montrer est `Q` et que l'on a une hypothèse ou un théorème `nom` de la
forme `P → Q`, alors on peut appliquer ce théorème pour transformer le but à prouver
en `P`.
La commande correspondante est `Par ... il suffit de montrer que ...,`.
Reprenons l'exemple du carré de cette façon.
-/

example (ha : a > 0) : a^2 > 0:=
begin
  Par carre_pos il suffit de montrer que a > 0,
  On conclut par ha,
end

/-
Bien sûr dans l'exemple ci-dessus on ne gagne rien à raisonner vers l'arrière.
Ce n'est intéressant que quand la prémisse n'est pas immédiatement disponible, comme
dans l'exemple suivant qui commence par un pas vers l'arrière pour passer
de `(a^2)^2` à `a^2` avant de conclure en appliquant vers l'avant le même résultat
pour `a` lui-même.
-/

example (ha : a > 0) : (a^2)^2 > 0:=
begin
  Par carre_pos il suffit de montrer que a^2 > 0,
  On conclut par carre_pos appliqué à ha,
end

/-
On peut aussi conserver un mode de raisonnement vers l'avant du début à la fin en
introduisant un énoncé intermédiaire. Pour cela, on utilise
`Fait nom : énoncé,`
Cela entraîne l'apparition d'un nouveau but à démontrer avant de reprendre le fil
de la démonstration principale avec `nom : énoncé` disponible comme résultat
supplémentaire. Dans l'exemple ci-dessous, le nom choisi est `F`.
-/

example (ha : a > 0) : (a^2)^2 > 0:=
begin
  Fait F : a^2 > 0,
    On conclut par carre_pos appliqué à ha,
  On conclut par carre_pos appliqué à F,
end

example (ha : a ≠ 0) : |a|^2 > 0:=
begin
  sorry
end

/-
Pour démontrer une implication `P → Q`, la commande `Supposons hyp,`
permet d'inclure `P` dans nos hypothèses sous le nom `hyp` et de remplacer le but
par `Q`.
-/

example : a > 0 → (a^2)^2 > 0 :=
begin
  Supposons ha : a > 0, -- Ici on introduit l'hypothèse
  Montrons que (a^2)^2 > 0, -- Cette ligne est optionelle car Lean sait où nous en sommes,
                            -- mais elle améliore la lisibilité pour nous.
  Fait F : a^2 > 0,
    On conclut par carre_pos appliqué à ha,
  On conclut par carre_pos appliqué à F,
end

/-
Dans la suite, on pourra utiliser les énoncés suivants qui font le lien
entre une comparaison générale de deux éléments `x ≤ y` et une comparaison
de leur différence à `0`.

`inferieur_diff_pos {x y : ℝ} : x ≤ y → 0 ≤ y - x`
`diff_pos_inferieur {x y : ℝ} : 0 ≤ y - x → x ≤ y`

`inferieur_diff_neg {x y : ℝ} : x ≤ y → x - y ≤ 0`
`diff_neg_inferieur {x y : ℝ} : x - y ≤ 0 → x ≤ y`

Voyons un exemple qui démontre une implication en utilisant deux implications connues
(`diff_pos_inferieur` et `inferieur_diff_pos`) et un calcul.
-/

lemma inferieur_add_gauche : a ≤ b → c + a ≤ c + b :=
begin
  Supposons hab : a ≤ b,
  Montrons que c + a ≤ c + b,
  Par diff_pos_inferieur il suffit de montrer que 0 ≤ (c+b) - (c+a),
  calc
    (c+b) - (c+a) = b - a : by On calcule
              ... ≥ 0     : by On conclut par inferieur_diff_pos appliqué à hab,
end

/- A vous de jouer ! -/

lemma inferieur_add_droite : a ≤ b →  a + c ≤ b + c :=
begin
  sorry
end

lemma inferieur_simpl_gauche : c + a ≤ c + b → a ≤ b :=
begin
  sorry
end

/-
On rencontre aussi des théorèmes ayant plusieurs hypothèses.
Par exemple les deux énoncés suivants donnent les règles de signes pour la multiplication

`pos_pos {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x*y`

`neg_neg {x y : ℝ} (hx : x ≤ 0) (hy : y ≤ 0) : 0 ≤ x*y`

Chacun de ces énoncés déduit la conclusion `0 ≤ x*y` de deux prémisses portant sur `x` et `y`.

L'application de ces théorèmes nécessite de justifier chacune des hypothèses, il y aura
donc autant de buts à montrer que d'hypothèses. La commande à utiliser est alors
`Par nom il suffit de montrer que [P, Q],`
où `P` et `Q` sont les prémisses à démontrer.
-/

example (hc : 0 ≤ c) (hab : a ≤ b) : 0 ≤ (b - a) * c :=
begin
  Par pos_pos il suffit de montrer que [0 ≤ b - a, 0 ≤ c],
    On conclut par inferieur_diff_pos appliqué à hab,
  On conclut par hc,
end

example (hc : c ≤ 0) (hab : b ≤ a) : 0 ≤ (b - a) * c :=
begin
  sorry
end

/-
Voyons comment insérer ces exemples comme faits intermédiaires dans des contextes plus
compliqués.
-/

lemma inferieur_mul_droite (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  Par diff_pos_inferieur il suffit de montrer que 0 ≤ b*c - a*c,
  Fait clef : 0 ≤ (b - a)*c,
    Par pos_pos il suffit de montrer que [0 ≤ b - a, 0 ≤ c],
      On conclut par inferieur_diff_pos appliqué à hab,
    On conclut par hc,
  calc
    b*c - a*c = (b - a)*c : by On calcule
          ... ≥ 0 : by On conclut par clef,
end

/-
La démonstration ci-dessus est un peu tortueuse. Nous allons la simplifier en
faisant travailler plus l'ordinateur. La commande `On applique` se charge de
comprendre quels sont les buts restants puis cherche chacun de ces buts parmi
les hypothèses, ne laissant à démontrer que ce qui nécessite un nouvel argument.
Dans l'exemple de base, les deux prémisses sont déjà des hypothèses et il ne
reste rien à faire.
-/

example (hc : 0 ≤ c) (hab : 0 ≤ b - a) : 0 ≤ (b - a) * c :=
begin
  On applique pos_pos,
end

/-
Dans l'exemple plus compliqué, on veut justifier `(b - a) * c ≥ 0` à partir
des hypothèses `hc : 0 ≤ c` et `hab : a ≤ b` donc il reste un peu de travail.
-/

example (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  Par diff_pos_inferieur il suffit de montrer que 0 ≤ b*c - a*c,
  calc
    b*c - a*c = (b - a)*c : by On calcule
          ... ≥ 0         : by { On applique pos_pos,
                                 On conclut par inferieur_diff_pos appliqué à hab }
end

/-
Adaptez cet exemple en utilisant `neg_neg` et `inferieur_diff_neg`.
-/

example (hc : c ≤ 0) (hab :  a ≤ b) : b*c ≤ a*c :=
begin
  sorry
end

/-
On peut aussi fournir les justifications de plusieurs prémisses en raisonnant
vers l'avant. La commande `On conclut par ...` peut aussi être complétée en fournissant un
une liste d'arguments, comme dans :
`On conclut par pos_pos appliqué à [hab', hc],`
de la démonstration suivante (où l'énoncé est toujours le même que `inferieur_mul_droite`).
-/
example (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  Fait hab' : 0 ≤ b - a,
    On conclut par inferieur_diff_pos appliqué à hab,
  Fait H : b*c - a*c ≥ 0,
    calc
      b*c - a*c = (b - a) * c : by On calcule
      ...       ≥ 0           : by On conclut par pos_pos appliqué à [hab', hc],
  On conclut par diff_pos_inferieur appliqué à H,
end

/-
Adoptez maintenant le style de la démonstration précédente pour montrer l'énoncé suivant.
-/

example (hc : c ≤ 0) (hab :  a ≤ b) : b*c ≤ a*c :=
begin
  sorry
end

/-
On peut se demander à quel connecteur logique correspondent tous ces énoncés ayant
deux prémisses et une conclusion. Il est possible de les voir comme des implications emboîtées.
L'énoncé `inferieur_mul_droite` peut se lire : « si `0 ≤ c` alors si `a ≤ b` alors `a*c ≤ b*c` ».

Vérifions que Lean y pense bien de cette façon.
-/

example : 0 ≤ c → (a ≤ b → a*c ≤ b*c) :=
begin
  On conclut par inferieur_mul_droite,
end

/-
Ce type d'implications emboitées est en fait si courant que les parenthèses de l'énoncé ci-dessus
ne sont pas nécessaires : par défaut, Lean interprète `P → Q → R` comme `P → (Q → R)`.

Nous verrons plus tard que l'on peut aussi utiliser le connecteur logique `et` pour
écrire de tels énoncés, mais cela se révèlera moins commode en pratique.
-/
end m154


/- Induction and Recursion -/

section ex1

/-
Use the equation compiler to define addition multiplication and exponentiation on
the natural numbers.
Then use the equation compiler to derive some of their basic properties.
-/
namespace Hidden
open Nat

def add : Nat → Nat → Nat
  | n, zero   => n
  | n, succ m => succ $ add n m

#print add

def mul : Nat → Nat → Nat
  | _, zero   => zero
  | n, succ m => add (mul n m) n

def pow : Nat → Nat → Nat
  | _, zero   => succ zero
  | n, succ m => mul (pow n m) n

theorem zero_add : ∀ m : Nat, add zero m = m
  | zero => by rfl
  | succ m' => sorry

end Hidden
end ex1

section ex2
namespace Hidden2
open List

def reverse {α : Type} : List α → List α
  | nil => nil
  | x :: xs => reverse xs ++ [x]

#eval reverse ([] : List Int)
#eval reverse [1,2,3]

end Hidden2
end ex2

section ex5

/-
Consider following type of arithmetic expressions
-/

inductive Expr where
  | const   : Nat → Expr
  | var     : Nat → Expr
  | plus    : Expr → Expr → Expr
  | times   : Expr → Expr → Expr
  deriving Repr

open Expr

def sampleExpr :=
  plus (times (var 0) (const 7)) (times (const 2) (var 1))

/-
Write a function that evaluates such an expression
-/

def eval (v : Nat → Nat) : Expr → Nat
  | const n     => n
  | var n       => v n
  | plus e₁ e₂  => eval v e₁ + eval v e₂
  | times e₁ e₂ => eval v e₁ * eval v e₂

def sampleVal : Nat → Nat
  | 0 => 5
  | 1 => 6
  | _ => 0

#eval eval sampleVal sampleExpr

/-
Implement "constant fustion", fuse, a procedure that simplifies subterms like 5 + 7 to 12
-/

def simpConst : Expr → Expr
  | plus (const n₁) (const n₂)    => const $ n₁ + n₂
  | times (const n₁) (const n₂)   => const $ n₁ * n₂
  | e                             => e

def fuse : Expr → Expr
  | plus e₁ e₂  => simpConst $ plus (fuse e₁) (fuse e₂)
  | times e₁ e₂ => simpConst $ times (fuse e₁) (fuse e₂)
  | e           => simpConst e

#eval fuse $ const 2
#eval fuse $ plus (const 2) (const 3)
#eval fuse $ plus (var 1) (const 2)
#eval fuse $ plus (times (const 2) (const 3)) (var 0)

theorem simpConst_eq (v : Nat → Nat)
        : ∀ e : Expr, eval v (simpConst e) = eval v e := by
  intro e
  cases e with
  | plus e₁ e₂  =>
    cases e₁ with
    | const n =>
      cases e₂ <;> rfl
    | _       => rfl
  | times e₁ e₂ =>
    cases e₁ with
    | const n =>
      cases e₂ <;> rfl
    | _       => rfl
  | _     => rfl

theorem fuse_eq (v : Nat → Nat)
  : ∀ e : Expr, eval v (fuse e) = eval v e := by
  intro e
  induction e with
  | const n => rfl
  | var n => rfl
  | plus e₁ e₂ ih₁ ih₂ =>
    -- show eval v (fuse (plus e1 e2)) = eval v (plus e₁ e₂) from
    calc
      eval v (fuse (plus e₁ e₂))
        = eval v (simpConst $ plus (fuse e₁) (fuse e₂)) := by rfl
      _ = eval v (plus (fuse e₁) (fuse e₂)) := by rw [simpConst_eq]
      _ = eval v (fuse e₁) + eval v (fuse e₂) := by rfl
      _ = eval v e₁ + eval v e₂ := by rw [ih₁, ih₂]
  | times e₁ e₂ ih₁ ih₂ =>
    -- show eval v (fuse (times e₁ e₂)) = eval v (times e₁ e₂) from
    calc
      eval v (fuse (times e₁ e₂))
        = eval v (simpConst $ times (fuse e₁) (fuse e₂)) := by rfl
      _ = eval v (times (fuse e₁) (fuse e₂)) := by rw [simpConst_eq]
      _ = eval v (fuse e₁) * eval v (fuse e₂) := by rfl
      _ = eval v e₁ * eval v e₂ := by rw [ih₁, ih₂]

/-
The lase two theorems show that the definitions preserve the value.
-/
end ex5


import .lovelib

/-! # LoVe Homework 11: Logical Foundations of Mathematics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (9 points): Multisets as a Quotient Type

A multiset (or bag) is a collection of elements that allows for multiple
(but finitely many) occurrences of its elements. For example, the multiset
`{2, 7}` is equal to the multiset `{7, 2}` but different from `{2, 7, 7}`.

Finite multisets can be defined as a quotient over lists. We start with the
type `list α` of finite lists and consider only the number of occurrences of
elements in the lists, ignoring the order in which elements occur. Following
this scheme, `[2, 7, 7]`, `[7, 2, 7]`, and `[7, 7, 2]` would be three equally
valid representations of the multiset `{2, 7, 7}`.

The `list.count` function returns the number of occurrences of an element in a
list. Since it uses equality on elements of type `α`, it requires `α` to belong
to the `decidable_eq` type class. For this reason, the definitions and lemmas
below all take `[decidable_eq α]` as type class argument.

1.1 (1 point). Provide the missing proof below. -/

@[instance] def multiset.rel (α : Type) [decidable_eq α] : setoid (list α) :=
{ r     := λas bs, ∀x, list.count x as = list.count x bs,
  iseqv :=
    begin
      repeat { apply and.intro },
      { intros as x,
        refl },
      { intros as bs h x,
        simp * },
      { intros as bs cs hab hbc x,
        simp * }
    end }

/-! 1.2 (1 point). Define the type of multisets as the quotient over the
relation `multiset.rel`. -/

def multiset (α : Type) [decidable_eq α] : Type :=
quotient (multiset.rel α)

/-! 1.3 (3 points). Now we have a type `multiset α` but no operations on it.
Basic operations on multisets include the empty multiset (`∅`), the singleton
multiset (`{x} `for any element `x`), and the sum of two multisets (`A ⊎ B` for
any multisets `A` and `B`). The sum should be defined so that the multiplicities
of elements are added; thus, `{2} ⊎ {2, 2} = {2, 2, 2}`.

Fill in the `sorry` placeholders below to implement the basic multiset
operations. -/

def multiset.empty {α : Type} [decidable_eq α] : multiset α :=
⟦[]⟧

def multiset.singleton {α : Type} [decidable_eq α] (a : α) : multiset α :=
⟦[a]⟧

def multiset.union {α : Type} [decidable_eq α] :
  multiset α → multiset α → multiset α :=
quotient.lift₂
  (λas bs, ⟦as ++ bs⟧)
  begin
    intros as bs as' bs' ha hb,
    apply quotient.sound,
    intro x,
    simp [ha x, hb x]
  end

/-! 1.4 (4 points). Prove that `multiset.union` is commutative and associative,
and has `multiset.empty` as identity element. -/

lemma multiset.union_comm {α : Type} [decidable_eq α] (A B : multiset α) :
  multiset.union A B = multiset.union B A :=
begin
  apply quotient.induction_on A,
  apply quotient.induction_on B,
  intros bs as,
  apply quotient.sound,
  intro x,
  simp [add_comm]
end

lemma multiset.union_assoc {α : Type} [decidable_eq α] (A B C : multiset α) :
  multiset.union (multiset.union A B) C =
  multiset.union A (multiset.union B C) :=
begin
  apply quotient.induction_on A,
  apply quotient.induction_on B,
  apply quotient.induction_on C,
  intros cs bs as,
  apply quotient.sound,
  intro x,
  simp
end

lemma multiset.union_iden_left {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union multiset.empty A = A :=
begin
  apply quotient.induction_on A,
  intro as,
  apply quotient.sound,
  intro x,
  simp
end

lemma multiset.union_iden_right {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union A multiset.empty = A :=
begin
  rw multiset.union_comm,
  rw multiset.union_iden_left
end

/-! ## Question 2 (2 bonus points): Nonempty Types

In the lecture, we saw the inductive predicate `nonempty` that states that a
type has at least one element: -/

#print nonempty

/-! The purpose of this question is to think about what would happen if all
types had at least one element. To investigate this, we introduce this fact as
an axiom as follows. Introducing axioms should be generally avoided or done
with great care, since they can easily lead to contradictions, as we will
see. -/

axiom Sort_nonempty (α : Sort _) :
  nonempty α

/-! This axiom gives us a lemma `Sort_nonempty` admitted with no proof. It
resembles a lemma proved by `sorry`, just without the warning. -/

#check Sort_nonempty

/-! 2.1 (1 bonus point). Prove that this axiom leads to a contradiction, i.e.,
lets us derive `false`. -/

lemma proof_of_false :
  false :=
classical.choice (Sort_nonempty false)

-- Alternative proof:
lemma proof_of_false' :
  false :=
begin
  cases' Sort_nonempty false with h,
  exact h
end

/-! 2.2 (1 bonus point). Prove that even the following weaker axiom leads to a
contradiction. Of course, you may not use the axiom or the lemma from 3.1.

Hint: Subtypes can help. -/

axiom Type_nonempty (α : Type _) :
  nonempty α

lemma proof_of_false₂ :
  false :=
begin
  let t : Type := {a : ℕ // false},
  have h : nonempty t :=
    Type_nonempty t,
  let x : t := classical.choice h,
  exact subtype.property x
end

-- Alternative proof:
lemma proof_of_false₂' :
  false :=
begin
  let t : Type := {a : ℕ // false},
  cases' Type_nonempty t with x,
  exact subtype.property x
end

end LoVe


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.group_power.lemmas

/-!  # Squares, even and odd elements

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

This file proves some general facts about squares, even and odd elements of semirings.

In the implementation, we define `is_square` and we let `even` be the notion transported by
`to_additive`.  The definition are therefore as follows:
```lean
is_square a ↔ ∃ r, a = r * r
even a ↔ ∃ r, a = r + r
```

Odd elements are not unified with a multiplicative notion.

## Future work

* TODO: Try to generalize further the typeclass assumptions on `is_square/even`.
  For instance, in some cases, there are `semiring` assumptions that I (DT) am not convinced are
  necessary.
* TODO: Consider moving the definition and lemmas about `odd` to a separate file.
* TODO: The "old" definition of `even a` asked for the existence of an element `c` such that
  `a = 2 * c`.  For this reason, several fixes introduce an extra `two_mul` or `← two_mul`.
  It might be the case that by making a careful choice of `simp` lemma, this can be avoided.
 -/

open mul_opposite
variables {F α β R : Type*}

section has_mul
variables [has_mul α]

/--  An element `a` of a type `α` with multiplication satisfies `is_square a` if `a = r * r`,
for some `r : α`. -/
@[to_additive
"An element `a` of a type `α` with addition satisfies `even a` if `a = r + r`,
for some `r : α`."]
def is_square (a : α) : Prop := ∃ r, a = r * r

@[simp, to_additive] lemma is_square_mul_self (m : α) : is_square (m * m) := ⟨m, rfl⟩

@[to_additive] lemma is_square_op_iff (a : α) : is_square (op a) ↔ is_square a :=
⟨λ ⟨c, hc⟩, ⟨unop c, by rw [← unop_mul, ← hc, unop_op]⟩, λ ⟨c, hc⟩, by simp [hc]⟩

end has_mul

@[simp, to_additive]
lemma is_square_one [mul_one_class α] : is_square (1 : α) := ⟨1, (mul_one _).symm⟩

@[to_additive]
lemma is_square.map [mul_one_class α] [mul_one_class β] [monoid_hom_class F α β] {m : α} (f : F) :
  is_square m → is_square (f m) :=
by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp⟩ }

section monoid
variables [monoid α] {n : ℕ} {a : α}

@[to_additive even_iff_exists_two_nsmul]
lemma is_square_iff_exists_sq (m : α) : is_square m ↔ ∃ c, m = c ^ 2 :=
by simp [is_square, pow_two]

alias is_square_iff_exists_sq ↔ is_square.exists_sq is_square_of_exists_sq

attribute [to_additive even.exists_two_nsmul "Alias of the forwards direction of
`even_iff_exists_two_nsmul`."] is_square.exists_sq

attribute [to_additive even_of_exists_two_nsmul "Alias of the backwards direction of
`even_iff_exists_two_nsmul`."] is_square_of_exists_sq

@[to_additive even.nsmul] lemma is_square.pow (n : ℕ) : is_square a → is_square (a ^ n) :=
by { rintro ⟨a, rfl⟩, exact ⟨a ^ n, (commute.refl _).mul_pow _⟩ }

@[simp, to_additive even.nsmul']
lemma even.is_square_pow : even n → ∀ a : α, is_square (a ^ n) :=
by { rintro ⟨n, rfl⟩ a, exact ⟨a ^ n, pow_add _ _ _⟩ }

@[simp, to_additive even_two_nsmul]
lemma is_square_sq (a : α) : is_square (a ^ 2) := ⟨a, pow_two _⟩

variables [has_distrib_neg α]

lemma even.neg_pow : even n → ∀ a : α, (-a) ^ n = a ^ n :=
by { rintro ⟨c, rfl⟩ a, simp_rw [←two_mul, pow_mul, neg_sq] }

lemma even.neg_one_pow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_pow, one_pow]

end monoid

@[to_additive] lemma is_square.mul [comm_semigroup α] {a b : α} :
  is_square a → is_square b → is_square (a * b) :=
by { rintro ⟨a, rfl⟩ ⟨b, rfl⟩, exact ⟨a * b, mul_mul_mul_comm _ _ _ _⟩ }

variables (α)

@[simp] lemma is_square_zero [mul_zero_class α] : is_square (0 : α) := ⟨0, (mul_zero _).symm⟩

variables {α}

section division_monoid
variables [division_monoid α] {a : α}

@[simp, to_additive] lemma is_square_inv : is_square a⁻¹ ↔ is_square a :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw [← is_square_op_iff, ← inv_inv a],
    exact h.map (mul_equiv.inv' α) },
  { exact ((is_square_op_iff a).mpr h).map (mul_equiv.inv' α).symm }
end

alias is_square_inv ↔ _ is_square.inv

attribute [to_additive] is_square.inv

@[to_additive even.zsmul] lemma is_square.zpow (n : ℤ) : is_square a → is_square (a ^ n) :=
by { rintro ⟨a, rfl⟩, exact ⟨a ^ n, (commute.refl _).mul_zpow _⟩ }

variables [has_distrib_neg α] {n : ℤ}

lemma even.neg_zpow : even n → ∀ a : α, (-a) ^ n = a ^ n :=
by { rintro ⟨c, rfl⟩ a, exact zpow_bit0_neg _ _ }

lemma even.neg_one_zpow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_zpow, one_zpow]

end division_monoid

lemma even_abs [subtraction_monoid α] [linear_order α] {a : α} : even (|a|) ↔ even a :=
by cases abs_choice a; simp only [h, even_neg]

@[to_additive]
lemma is_square.div [division_comm_monoid α] {a b : α} (ha : is_square a) (hb : is_square b) :
  is_square (a / b) :=
by { rw div_eq_mul_inv, exact ha.mul hb.inv }

@[simp, to_additive even.zsmul']
lemma even.is_square_zpow [group α] {n : ℤ} : even n → ∀ a : α, is_square (a ^ n) :=
by { rintro ⟨n, rfl⟩ a, exact ⟨a ^ n, zpow_add _ _ _⟩ }

-- `odd.tsub` requires `canonically_linear_ordered_semiring`, which we don't have
lemma even.tsub [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α]
  [contravariant_class α α (+) (≤)] {m n : α} (hm : even m) (hn : even n) : even (m - n) :=
begin
  obtain ⟨a, rfl⟩ := hm,
  obtain ⟨b, rfl⟩ := hn,
  refine ⟨a - b, _⟩,
  obtain h | h := le_total a b,
  { rw [tsub_eq_zero_of_le h, tsub_eq_zero_of_le (add_le_add h h), add_zero] },
  { exact (tsub_add_tsub_comm h h).symm }
end

lemma even_iff_exists_bit0 [has_add α] {a : α} : even a ↔ ∃ b, a = bit0 b := iff.rfl

alias even_iff_exists_bit0 ↔ even.exists_bit0 _

section semiring
variables [semiring α] [semiring β] {m n : α}

lemma even_iff_exists_two_mul (m : α) : even m ↔ ∃ c, m = 2 * c :=
by simp [even_iff_exists_two_nsmul]

lemma even_iff_two_dvd {a : α} : even a ↔ 2 ∣ a := by simp [even, has_dvd.dvd, two_mul]

alias even_iff_two_dvd ↔ even.two_dvd _

theorem even.trans_dvd (hm : even m) (hn : m ∣ n) : even n :=
even_iff_two_dvd.2 $ hm.two_dvd.trans hn

theorem has_dvd.dvd.even (hn : m ∣ n) (hm : even m) : even n :=
hm.trans_dvd hn

@[simp] lemma range_two_mul (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x) = {a | even a} :=
by { ext x, simp [eq_comm, two_mul, even] }

@[simp] lemma even_bit0 (a : α) : even (bit0 a) :=
⟨a, rfl⟩

@[simp] lemma even_two : even (2 : α) := ⟨1, rfl⟩

@[simp] lemma even.mul_left (hm : even m) (n) : even (n * m) :=
hm.map (add_monoid_hom.mul_left n)

@[simp] lemma even.mul_right (hm : even m) (n) : even (m * n) :=
hm.map (add_monoid_hom.mul_right n)

lemma even_two_mul (m : α) : even (2 * m) := ⟨m, two_mul _⟩

lemma even.pow_of_ne_zero (hm : even m) : ∀ {a : ℕ}, a ≠ 0 → even (m ^ a)
| 0       a0 := (a0 rfl).elim
| (a + 1) _  := by { rw pow_succ, exact hm.mul_right _ }

section with_odd

/-- An element `a` of a semiring is odd if there exists `k` such `a = 2*k + 1`. -/
def odd (a : α) : Prop := ∃ k, a = 2*k + 1

lemma odd_iff_exists_bit1 {a : α} : odd a ↔ ∃ b, a = bit1 b :=
exists_congr $ λ b, by { rw two_mul, refl }

alias odd_iff_exists_bit1 ↔ odd.exists_bit1 _

@[simp] lemma odd_bit1 (a : α) : odd (bit1 a) := odd_iff_exists_bit1.2 ⟨a, rfl⟩

@[simp] lemma range_two_mul_add_one (α : Type*) [semiring α] :
  set.range (λ x : α, 2 * x + 1) = {a | odd a} :=
by { ext x, simp [odd, eq_comm] }

lemma even.add_odd : even m → odd n → odd (m + n) :=
by { rintro ⟨m, rfl⟩ ⟨n, rfl⟩, exact ⟨m + n, by rw [mul_add, ← two_mul, add_assoc]⟩ }

lemma odd.add_even (hm : odd m) (hn : even n) : odd (m + n) :=
by { rw add_comm, exact hn.add_odd hm }

lemma odd.add_odd : odd m → odd n → even (m + n) :=
begin
  rintro ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨n + m + 1, _⟩,
  rw [two_mul, two_mul],
  ac_refl
end

@[simp] lemma odd_one : odd (1 : α) :=
⟨0, (zero_add _).symm.trans (congr_arg (+ (1 : α)) (mul_zero _).symm)⟩

@[simp] lemma odd_two_mul_add_one (m : α) : odd (2 * m + 1) := ⟨m, rfl⟩

lemma odd.map [ring_hom_class F α β] (f : F) : odd m → odd (f m) :=
by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp [two_mul]⟩ }

@[simp] lemma odd.mul : odd m → odd n → odd (m * n) :=
begin
  rintro ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨2 * m * n + n + m, _⟩,
  rw [mul_add, add_mul, mul_one, ← add_assoc, one_mul, mul_assoc, ← mul_add, ← mul_add, ← mul_assoc,
    ← nat.cast_two, ← nat.cast_comm],
end

lemma odd.pow (hm : odd m) : ∀ {a : ℕ}, odd (m ^ a)
| 0       := by { rw pow_zero, exact odd_one }
| (a + 1) := by { rw pow_succ, exact hm.mul odd.pow }

end with_odd
end semiring

section monoid
variables [monoid α] [has_distrib_neg α] {a : α} {n : ℕ}

lemma odd.neg_pow : odd n → ∀ a : α, (-a) ^ n = - a ^ n :=
by { rintro ⟨c, rfl⟩ a, simp_rw [pow_add, pow_mul, neg_sq, pow_one, mul_neg] }
lemma odd.neg_one_pow (h : odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_pow, one_pow]

end monoid

section canonically_ordered_comm_semiring

variables [canonically_ordered_comm_semiring α]

-- this holds more generally in a `canonically_ordered_add_monoid` if we refactor `odd` to use
-- either `2 • t` or `t + t` instead of `2 * t`.
lemma odd.pos [nontrivial α] {n : α} (hn : odd n) : 0 < n :=
begin
  obtain ⟨k, rfl⟩ := hn,
  rw [pos_iff_ne_zero, ne.def, add_eq_zero_iff, not_and'],
  exact λ h, (one_ne_zero h).elim
end

end canonically_ordered_comm_semiring

section ring
variables [ring α] {a b : α} {n : ℕ}

@[simp] lemma even_neg_two : even (- 2 : α) := by simp only [even_neg, even_two]

lemma odd.neg (hp : odd a) : odd (-a) :=
begin
  obtain ⟨k, hk⟩ := hp,
  use -(k + 1),
  rw [mul_neg, mul_add, neg_add, add_assoc, two_mul (1 : α), neg_add,
    neg_add_cancel_right, ←neg_add, hk],
end

@[simp] lemma odd_neg : odd (-a) ↔ odd a := ⟨λ h, neg_neg a ▸ h.neg, odd.neg⟩

@[simp] lemma odd_neg_one : odd (- 1 : α) := by simp

lemma odd.sub_even (ha : odd a) (hb : even b) : odd (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_even hb.neg }

lemma even.sub_odd (ha : even a) (hb : odd b) : odd (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_odd hb.neg }

lemma odd.sub_odd (ha : odd a) (hb : odd b) : even (a - b) :=
by { rw sub_eq_add_neg, exact ha.add_odd hb.neg }

lemma odd_abs [linear_order α] : odd (abs a) ↔ odd a :=
by cases abs_choice a with h h; simp only [h, odd_neg]

end ring

section powers
variables [linear_ordered_ring R] {a : R} {n : ℕ}

lemma even.pow_nonneg (hn : even n) (a : R) : 0 ≤ a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_nonneg a k

lemma even.pow_pos (hn : even n) (ha : a ≠ 0) : 0 < a ^ n :=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit0_pos ha k

lemma odd.pow_nonpos (hn : odd n) (ha : a ≤ 0) : a ^ n ≤ 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_nonpos_iff.mpr ha

lemma odd.pow_neg (hn : odd n) (ha : a < 0) : a ^ n < 0:=
by cases hn with k hk; simpa only [hk, two_mul] using pow_bit1_neg_iff.mpr ha

lemma odd.pow_nonneg_iff (hn : odd n) : 0 ≤ a ^ n ↔ 0 ≤ a :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ hn.pow_neg ha), λ ha, pow_nonneg ha n⟩

lemma odd.pow_nonpos_iff (hn : odd n) : a ^ n ≤ 0 ↔ a ≤ 0 :=
⟨λ h, le_of_not_lt (λ ha, h.not_lt $ pow_pos ha _), hn.pow_nonpos⟩

lemma odd.pow_pos_iff (hn : odd n) : 0 < a ^ n ↔ 0 < a :=
⟨λ h, lt_of_not_le (λ ha, h.not_le $ hn.pow_nonpos ha), λ ha, pow_pos ha n⟩

lemma odd.pow_neg_iff (hn : odd n) : a ^ n < 0 ↔ a < 0 :=
⟨λ h, lt_of_not_le (λ ha, h.not_le $ pow_nonneg ha _), hn.pow_neg⟩

lemma even.pow_pos_iff (hn : even n) (h₀ : 0 < n) : 0 < a ^ n ↔ a ≠ 0 :=
⟨λ h ha, by { rw [ha, zero_pow h₀] at h, exact lt_irrefl 0 h }, hn.pow_pos⟩

lemma even.pow_abs {p : ℕ} (hp : even p) (a : R) : |a| ^ p = a ^ p :=
begin
  rw [←abs_pow, abs_eq_self],
  exact hp.pow_nonneg _
end

@[simp] lemma pow_bit0_abs (a : R) (p : ℕ) : |a| ^ bit0 p = a ^ bit0 p := (even_bit0 _).pow_abs _

lemma odd.strict_mono_pow (hn : odd n) : strict_mono (λ a : R, a ^ n) :=
by cases hn with k hk; simpa only [hk, two_mul] using strict_mono_pow_bit1 _

end powers


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

! This file was ported from Lean 3 source module data.zmod.coprime
! leanprover-community/mathlib commit 4b4975cf92a1ffe2ddfeff6ff91b0c46a9162bf5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.ZMod.Basic
import Mathlib.RingTheory.Int.Basic

/-!
# Coprimality and vanishing

We show that for prime `p`, the image of an integer `a` in `ZMod p` vanishes if and only if
`a` and `p` are not coprime.
-/

namespace ZMod

/-- If `p` is a prime and `a` is an integer, then `a : ZMod p` is zero if and only if
`gcd a p ≠ 1`. -/
theorem eq_zero_iff_gcd_ne_one {a : ℤ} {p : ℕ} [pp : Fact p.Prime] :
    (a : ZMod p) = 0 ↔ a.gcd p ≠ 1 := by
  rw [Ne, Int.gcd_comm, Int.gcd_eq_one_iff_coprime,
    (Nat.prime_iff_prime_int.1 pp.1).coprime_iff_not_dvd, Classical.not_not,
    int_cast_zmod_eq_zero_iff_dvd]
#align zmod.eq_zero_iff_gcd_ne_one ZMod.eq_zero_iff_gcd_ne_one

/-- If an integer `a` and a prime `p` satisfy `gcd a p = 1`, then `a : ZMod p` is nonzero. -/
theorem ne_zero_of_gcd_eq_one {a : ℤ} {p : ℕ} (pp : p.Prime) (h : a.gcd p = 1) : (a : ZMod p) ≠ 0 :=
  mt (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mp (Classical.not_not.mpr h)
#align zmod.ne_zero_of_gcd_eq_one ZMod.ne_zero_of_gcd_eq_one

/-- If an integer `a` and a prime `p` satisfy `gcd a p ≠ 1`, then `a : ZMod p` is zero. -/
theorem eq_zero_of_gcd_ne_one {a : ℤ} {p : ℕ} (pp : p.Prime) (h : a.gcd p ≠ 1) : (a : ZMod p) = 0 :=
  (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mpr h
#align zmod.eq_zero_of_gcd_ne_one ZMod.eq_zero_of_gcd_ne_one

end ZMod


import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level2 -- hide
namespace mynat -- hide

/-
# Addition World

## Level 3: `succ_add`

Oh no! On the way to `add_comm`, a wild `succ_add` appears. `succ_add`
is the proof that `succ(a) + b = succ(a + b)` for `a` and `b` in your
natural number type. We need to prove this now, because we will need
to use this result in our proof that `a + b = b + a` in the next level.

NB: think about why computer scientists called this result `succ_add` .
There is a logic to all the names.

Note that if you want to be more precise about exactly where you want
to rewrite something like `add_succ` (the proof you already have),
you can do things like `rw add_succ (succ a)` or
`rw add_succ (succ a) d`, telling Lean explicitly what to use for
the input variables for the function `add_succ`. Indeed, `add_succ`
is a function -- it takes as input two variables `a` and `b` and outputs a proof
that `a + succ(b) = succ(a + b)`. The tactic `rw add_succ` just says to Lean "guess
what the variables are".
-/

/- Lemma
For all natural numbers $a, b$, we have
$$ \operatorname{succ}(a) + b = \operatorname{succ}(a + b). $$
-/
lemma succ_add (a b : mynat) : succ a + b = succ (a + b) :=
begin [nat_num_game]
  induction b with d hd,
  {
    refl
  },
  { rw add_succ,
    rw hd,
    rw add_succ,
    refl
  }
end

end mynat -- hide


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

! This file was ported from Lean 3 source module combinatorics.additive.energy
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Prod
import Mathlib.Data.Fintype.Prod

/-!
# Additive energy

This file defines the additive energy of two finsets of a group. This is a central quantity in
additive combinatorics.

## TODO

It's possibly interesting to have
`(s ×ˢ s) ×ᶠ t ×ᶠ t).filter (λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2)` (whose `card` is
`multiplicativeEnergy s t`) as a standalone definition.
-/

section

variable {α : Type _} [PartialOrder α] {x y : α}

end

variable {α : Type _} [DecidableEq α]

namespace Finset

section Mul

variable [Mul α] {s s₁ s₂ t t₁ t₂ : Finset α}
-- porting note: replaced `xˢ` by `xᶠ`
/-- The multiplicative energy of two finsets `s` and `t` in a group is the number of quadruples
`(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ * b₁ = a₂ * b₂`. -/
@[to_additive additiveEnergy
      "The additive energy of two finsets `s` and `t` in a group is the
      number of quadruples `(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ + b₁ = a₂ + b₂`."]
def multiplicativeEnergy (s t : Finset α) : ℕ :=
  (((s ×ᶠ s) ×ᶠ t ×ᶠ t).filter fun x : (α × α) × α × α => x.1.1 * x.2.1 = x.1.2 * x.2.2).card
#align finset.multiplicative_energy Finset.multiplicativeEnergy
#align finset.additive_energy Finset.additiveEnergy

@[to_additive additiveEnergy_mono]
theorem multiplicativeEnergy_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) :
    multiplicativeEnergy s₁ t₁ ≤ multiplicativeEnergy s₂ t₂ :=
  card_le_of_subset <|
    filter_subset_filter _ <|
      product_subset_product (product_subset_product hs hs) <| product_subset_product ht ht
#align finset.multiplicative_energy_mono Finset.multiplicativeEnergy_mono
#align finset.additive_energy_mono Finset.additiveEnergy_mono

@[to_additive additiveEnergy_mono_left]
theorem multiplicativeEnergy_mono_left (hs : s₁ ⊆ s₂) :
    multiplicativeEnergy s₁ t ≤ multiplicativeEnergy s₂ t :=
  multiplicativeEnergy_mono hs Subset.rfl
#align finset.multiplicative_energy_mono_left Finset.multiplicativeEnergy_mono_left
#align finset.additive_energy_mono_left Finset.additiveEnergy_mono_left

@[to_additive additiveEnergy_mono_right]
theorem multiplicativeEnergy_mono_right (ht : t₁ ⊆ t₂) :
    multiplicativeEnergy s t₁ ≤ multiplicativeEnergy s t₂ :=
  multiplicativeEnergy_mono Subset.rfl ht
#align finset.multiplicative_energy_mono_right Finset.multiplicativeEnergy_mono_right
#align finset.additive_energy_mono_right Finset.additiveEnergy_mono_right

@[to_additive le_additiveEnergy]
theorem le_multiplicativeEnergy : s.card * t.card ≤ multiplicativeEnergy s t := by
  rw [← card_product]
  refine'
    card_le_card_of_inj_on (@fun x => ((x.1, x.1), x.2, x.2)) (by
    -- porting note: changed this from a `simp` proof without `only` because of a timeout
      simp only [ ← and_imp, mem_product, and_imp, Prod.forall, mem_filter,
        and_self, and_true, imp_self, implies_true]) fun a _ b _ => _
  simp only [Prod.mk.inj_iff, and_self_iff, and_imp]
  exact Prod.ext
#align finset.le_multiplicative_energy Finset.le_multiplicativeEnergy
#align finset.le_additive_energy Finset.le_additiveEnergy

@[to_additive additiveEnergy_pos]
theorem multiplicativeEnergy_pos (hs : s.Nonempty) (ht : t.Nonempty) :
    0 < multiplicativeEnergy s t :=
  (mul_pos hs.card_pos ht.card_pos).trans_le le_multiplicativeEnergy
#align finset.multiplicative_energy_pos Finset.multiplicativeEnergy_pos
#align finset.additive_energy_pos Finset.additiveEnergy_pos

variable (s t)

@[to_additive (attr := simp) additiveEnergy_empty_left]
theorem multiplicativeEnergy_empty_left : multiplicativeEnergy ∅ t = 0 := by
  simp [multiplicativeEnergy]
#align finset.multiplicative_energy_empty_left Finset.multiplicativeEnergy_empty_left
#align finset.additive_energy_empty_left Finset.additiveEnergy_empty_left

@[to_additive (attr := simp) additiveEnergy_empty_right]
theorem multiplicativeEnergy_empty_right : multiplicativeEnergy s ∅ = 0 := by
  simp [multiplicativeEnergy]
#align finset.multiplicative_energy_empty_right Finset.multiplicativeEnergy_empty_right
#align finset.additive_energy_empty_right Finset.additiveEnergy_empty_right

variable {s t}

@[to_additive (attr := simp) additiveEnergy_pos_iff]
theorem multiplicativeEnergy_pos_iff : 0 < multiplicativeEnergy s t ↔ s.Nonempty ∧ t.Nonempty :=
  ⟨fun h =>
    of_not_not fun H => by
      simp_rw [not_and_or, not_nonempty_iff_eq_empty] at H
      obtain rfl | rfl := H <;> simp [Nat.not_lt_zero] at h,
    fun h => multiplicativeEnergy_pos h.1 h.2⟩
#align finset.multiplicative_energy_pos_iff Finset.multiplicativeEnergy_pos_iff
#align finset.additive_energy_pos_iff Finset.additiveEnergy_pos_iff

@[to_additive (attr := simp) additive_energy_eq_zero_iff]
theorem multiplicativeEnergy_eq_zero_iff : multiplicativeEnergy s t = 0 ↔ s = ∅ ∨ t = ∅ := by
  simp [← (Nat.zero_le _).not_gt_iff_eq, not_and_or, imp_iff_or_not, or_comm]
#align finset.multiplicative_energy_eq_zero_iff Finset.multiplicativeEnergy_eq_zero_iff
#align finset.additive_energy_eq_zero_iff Finset.additive_energy_eq_zero_iff

end Mul

section CommMonoid

variable [CommMonoid α]

@[to_additive additiveEnergy_comm]
theorem multiplicativeEnergy_comm (s t : Finset α) :
    multiplicativeEnergy s t = multiplicativeEnergy t s := by
  rw [multiplicativeEnergy, ← Finset.card_map (Equiv.prodComm _ _).toEmbedding, map_filter]
  simp [-Finset.card_map, eq_comm, multiplicativeEnergy, mul_comm, map_eq_image, Function.comp]
#align finset.multiplicative_energy_comm Finset.multiplicativeEnergy_comm
#align finset.additive_energy_comm Finset.additiveEnergy_comm

end CommMonoid

section CommGroup

variable [CommGroup α] [Fintype α] (s t : Finset α)

-- porting note: replaced `xˢ` by `xᶠ`
@[to_additive (attr := simp) additiveEnergy_univ_left]
theorem multiplicativeEnergy_univ_left :
    multiplicativeEnergy univ t = Fintype.card α * t.card ^ 2 := by
  simp only [multiplicativeEnergy, univ_product_univ, Fintype.card, sq, ← card_product]
  let f : α × α × α → (α × α) × α × α := fun x => ((x.1 * x.2.2, x.1 * x.2.1), x.2)
  have : (↑((univ : Finset α) ×ᶠ t ×ᶠ t) : Set (α × α × α)).InjOn f := by
    rintro ⟨a₁, b₁, c₁⟩ _ ⟨a₂, b₂, c₂⟩ h₂ h
    simp_rw [Prod.ext_iff] at h
    obtain ⟨h, rfl, rfl⟩ := h
    rw [mul_right_cancel h.1]
  rw [← card_image_of_injOn this]
  congr with a
  simp only [mem_filter, mem_product, mem_univ, true_and_iff, mem_image, exists_prop,
    Prod.exists]
  refine' ⟨fun h => ⟨a.1.1 * a.2.2⁻¹, _, _, h.1, by simp [mul_right_comm, h.2]⟩, _⟩
  rintro ⟨b, c, d, hcd, rfl⟩
  simpa [mul_right_comm]
#align finset.multiplicative_energy_univ_left Finset.multiplicativeEnergy_univ_left
#align finset.additive_energy_univ_left Finset.additiveEnergy_univ_left

@[to_additive (attr := simp) additiveEnergy_univ_right]
theorem multiplicativeEnergy_univ_right :
    multiplicativeEnergy s univ = Fintype.card α * s.card ^ 2 := by
  rw [multiplicativeEnergy_comm, multiplicativeEnergy_univ_left]
#align finset.multiplicative_energy_univ_right Finset.multiplicativeEnergy_univ_right
#align finset.additive_energy_univ_right Finset.additiveEnergy_univ_right

end CommGroup

end Finset


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers
import solutions.section02reals.sheet3 -- import the definition of `tends_to` from a previous sheet

-- you can maybe do this one now
theorem tends_to_neg {a : ℕ → ℝ} {t : ℝ} (ha : tends_to a t) :
  tends_to (λ n, - a n) (-t) :=
begin
  rw tends_to_def at *,
  have h : ∀ n, |a n - t| = | -a n - -t|,
  { intro n,
    rw abs_sub_comm,
    congr' 1,
    ring },
  simpa [h] using ha,
end

/-
`tends_to_add` is quite a challenge. In a few weeks' time I'll
show you a two-line proof using filters, but right now
as you're still learning I think it's important that you
try and suffer and struggle through the first principles proof.
BIG piece of advice: write down a complete maths proof first,
with all the details there. Then, once you know the maths
proof, try translating it into Lean. Note that a bunch
of the results we proved in sheet 4 will be helpful.
-/

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then `a(n) + b(n)`
tends to `t + u`. -/
theorem tends_to_add {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tends_to a t) (hb : tends_to b u) :
  tends_to (λ n, a n + b n) (t + u) :=
begin
  rw tends_to_def at *,
  -- let ε > 0 be arbitrary
  intros ε hε,
  --  There's a bound X such that if n≥X then a(n) is within ε/2 of t
  specialize ha (ε/2) (by linarith),
  cases ha with X hX,
  --  There's a bound Y such that if n≥Y then b(n) is within ε/2 of u
  obtain ⟨Y, hY⟩ := hb (ε/2) (by linarith),
  --  use max(X,Y),
  use max X Y,
  -- now say n ≥ max(X,Y)
  intros n hn,
  rw max_le_iff at hn,
  specialize hX n hn.1,
  specialize hY n hn.2,
  --  Then easy.
  rw abs_lt at *,
  split; -- semicolon means "do next tactic to all goals produced by this tactic"
  linarith,
end

/-- If `a(n)` tends to t and `b(n)` tends to `u` then `a(n) - b(n)`
tends to `t - u`. -/
theorem tends_to_sub {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tends_to a t) (hb : tends_to b u) :
  tends_to (λ n, a n - b n) (t - u) :=
begin
  simpa [sub_eq_add_neg] using tends_to_add ha (tends_to_neg hb),
end


-- Caracterizacion_de_maximo_comun_divisor_igual_al_primer_numero.lean
-- Caracterización de máximo común divisor igual al primer número.
-- José A. Alonso Jiménez
-- Sevilla, 25 de agosto de 2020
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si a y b son números naturales, entonces
--    a ∣ b ↔ gcd a b = a
-- ----------------------------------------------------------------------

import data.nat.gcd

open nat

variables (a b : ℕ)

-- 1ª demostración
-- ===============

example : a ∣ b ↔ gcd a b = a :=
begin
  have h1 : gcd a b ∣ a ∧ gcd a b ∣ b,
  { exact gcd_dvd a b, },
  split,
  { intro h2,
    apply dvd_antisymm h1.left,
    rw dvd_gcd_iff,
    exact ⟨dvd_refl a, h2⟩, },
  { intro h3,
    rw ← h3,
    exact h1.right, },
end

-- Comentarios:
-- + La orden (open nat) abre el es espacio de nombre de los naturales.
-- + La relación (a ∣ b) se verifica si a divide a b.
-- + (gcd a b) es el máximo común divisor de a y b.
-- + Si h es la conjunción (P ∧ Q), entonces h.letf es P y h.right es
--   Q.
-- + Se han usado los lemas
--   + dvd_refl : a ∣ a
--   + dvd_antisymm : a ∣ b → b ∣ a → a = b
--   + dvd_gcd_iff : c ∣ gcd a b ↔ c ∣ a ∧ c ∣ b
--   + gcd_dvd : gcd a b ∣ a ∧ gcd a b ∣ b

-- 2ª demostración
-- ===============

example : a ∣ b ↔ gcd a b = a :=
gcd_eq_left_iff_dvd

-- Comentario: Se ha usado el lema
-- + gcd_eq_left_iff_dvd : a ∣ b ↔ gcd a b = a


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 4 : "and" (`∧`)

We learn about how to manipulate `P ∧ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `cases`
* `split`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : P ∧ Q → P :=
begin
  intro hPaQ,
  cases hPaQ with hP hQ,
  exact hP,
end

example : P ∧ Q → Q :=
begin
  rintro ⟨hP, hQ⟩,
  assumption,
end

example : (P → Q → R) → (P ∧ Q → R) :=
begin
  rintro hPQR ⟨hP, hQ⟩,
  apply hPQR;
  assumption,
end

example : P → Q → P ∧ Q :=
begin
  intro hP,
  intro hQ,
  split,
  { exact hP },
  { exact hQ }
end

/-- `∧` is symmetric -/
example : P ∧ Q → Q ∧ P :=
begin
  rintro ⟨hP, hQ⟩,
  exact ⟨hQ, hP⟩,
end

example : P → P ∧ true :=
begin
  intro hP,
  split,
  { exact hP },
  { triv },
end

example : false → P ∧ false :=
begin
  intro h,
  exfalso,
  exact h,
end

/-- `∧` is transitive -/
example : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  rintro ⟨hP, hQ⟩ ⟨-, hR⟩,
  exact ⟨hP, hR⟩,
end

example : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  intros h hP hQ,
  apply h,
  split; assumption,
end


/-
Copyright (c) 2020 Heather Macbeth, Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Patrick Massot
-/
import algebra.order.archimedean
import group_theory.subgroup.basic

/-!
# Archimedean groups

This file proves a few facts about ordered groups which satisfy the `archimedean` property, that is:
`class archimedean (α) [ordered_add_comm_monoid α] : Prop :=`
`(arch : ∀ (x : α) {y}, 0 < y → ∃ n : ℕ, x ≤ n • y)`

They are placed here in a separate file (rather than incorporated as a continuation of
`algebra.order.archimedean`) because they rely on some imports from `group_theory` -- bundled
subgroups in particular.

The main result is `add_subgroup.cyclic_of_min`:  a subgroup of a decidable archimedean abelian
group is cyclic, if its set of positive elements has a minimal element.

This result is used in this file to deduce `int.subgroup_cyclic`, proving that every subgroup of `ℤ`
is cyclic.  (There are several other methods one could use to prove this fact, including more purely
algebraic methods, but none seem to exist in mathlib as of writing.  The closest is
`subgroup.is_cyclic`, but that has not been transferred to `add_subgroup`.)

The result is also used in `topology.instances.real` as an ingredient in the classification of
subgroups of `ℝ`.
-/

variables {G : Type*} [linear_ordered_add_comm_group G] [archimedean G]
open linear_ordered_add_comm_group

/-- Given a subgroup `H` of a decidable linearly ordered archimedean abelian group `G`, if there
exists a minimal element `a` of `H ∩ G_{>0}` then `H` is generated by `a`. -/
lemma add_subgroup.cyclic_of_min {H : add_subgroup G} {a : G}
  (ha : is_least {g : G | g ∈ H ∧ 0 < g} a) : H = add_subgroup.closure {a} :=
begin
  obtain ⟨⟨a_in, a_pos⟩, a_min⟩ := ha,
  refine le_antisymm _ (H.closure_le.mpr $ by simp [a_in]),
  intros g g_in,
  obtain ⟨k, ⟨nonneg, lt⟩, _⟩ : ∃! k, 0 ≤ g - k • a ∧ g - k • a < a :=
    exists_unique_zsmul_near_of_pos' a_pos g,
  have h_zero : g - k • a = 0,
  { by_contra h,
    have h : a ≤ g - k • a,
    { refine a_min ⟨_, _⟩,
      { exact add_subgroup.sub_mem H g_in (add_subgroup.zsmul_mem H a_in k) },
      { exact lt_of_le_of_ne nonneg (ne.symm h) } },
    have h' : ¬ (a ≤ g - k • a) := not_le.mpr lt,
    contradiction },
  simp [sub_eq_zero.mp h_zero, add_subgroup.mem_closure_singleton],
end

/-- Every subgroup of `ℤ` is cyclic. -/
lemma int.subgroup_cyclic (H : add_subgroup ℤ) : ∃ a, H = add_subgroup.closure {a} :=
begin
  cases add_subgroup.bot_or_exists_ne_zero H with h h,
  { use 0,
    rw h,
    exact add_subgroup.closure_singleton_zero.symm },
  let s := {g : ℤ | g ∈ H ∧ 0 < g},
  have h_bdd : ∀ g ∈ s, (0 : ℤ) ≤ g := λ _ h, le_of_lt h.2,
  obtain ⟨g₀, g₀_in, g₀_ne⟩ := h,
  obtain ⟨g₁, g₁_in, g₁_pos⟩ : ∃ g₁ : ℤ, g₁ ∈ H ∧ 0 < g₁,
  { cases lt_or_gt_of_ne g₀_ne with Hg₀ Hg₀,
    { exact ⟨-g₀, H.neg_mem g₀_in, neg_pos.mpr Hg₀⟩ },
    { exact ⟨g₀, g₀_in, Hg₀⟩ } },
  obtain ⟨a, ha, ha'⟩ := int.exists_least_of_bdd ⟨(0 : ℤ), h_bdd⟩ ⟨g₁, g₁_in, g₁_pos⟩,
  exact ⟨a, add_subgroup.cyclic_of_min ⟨ha, ha'⟩⟩,
end


import .love12_basic_mathematical_structures_demo

/-! # LoVe Exercise 12: Basic Mathematical Structures -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Type Classes

Recall the inductive type `btree` we introduced earlier: -/

#check btree

/-! The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

def btree.graft {α : Type} : btree α → btree α → btree α
| btree.empty        u := u
| (btree.node a l r) u := btree.node a (btree.graft l u) (btree.graft r u)

#reduce btree.graft (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

/-! 1.1. Prove the following two lemmas by structural induction on `t`. -/

lemma btree.graft_assoc {α : Type} (t u v : btree α) :
  btree.graft (btree.graft t u) v = btree.graft t (btree.graft u v) :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [btree.graft, ih_l, ih_r] }
end

lemma btree.graft_empty {α : Type} (t : btree α) :
  btree.graft t btree.empty = t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [btree.graft, ih_l, ih_r] }
end

/-! 1.2. Declare btree an instance of `add_monoid` using `graft` as addition
operator. -/

#print add_monoid

@[instance] def btree.add_monid {α : Type} : add_monoid (btree α) :=
{ add       := btree.graft,
  add_assoc := btree.graft_assoc,
  zero      := btree.empty,
  add_zero  := btree.graft_empty,
  zero_add  := by intro x; refl }

/-! 1.3. Explain why `btree` with `graft` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/-! No matter how we define `neg` (`-`), we will not be able to prove
`add_left_neg`, which amounts to the following property:

    `∀t, btree.graft (btree.neg t) t = btree.empty`

However, if `t` is a nonempty tree, `btree.graft _ t` cannot possibly be equal
to `btree.empty`, no matter what the first argument is. -/

/-! 1.4 (**optional**). Prove the following lemma illustrating why `btree` with
`graft` as addition does not constitute an `add_group`. -/

lemma btree.add_left_neg_counterexample :
  ∃x : btree ℕ, ∀y : btree ℕ, btree.graft y x ≠ btree.empty :=
begin
  apply exists.intro (btree.node 0 btree.empty btree.empty),
  intros y hy,
  cases' y,
  { cases' hy },
  { cases' hy }
end

/-! ## Question 2: Multisets and Finsets

Recall the following definitions from the lecture: -/

#check multiset.elems
#check finset.elems
#check list.elems

/-! 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hints:

* Perform structural induction on `t`.

* The `cc` tactic also works with set operations. -/

lemma multiset.elems_mirror (t : btree ℕ) :
  multiset.elems (mirror t) = multiset.elems t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    rw multiset.elems,
    rw mirror,
    rw ←ih_l,
    rw ←ih_r,
    rw multiset.elems,
    cc }
end

/-! 2.2. Prove that the finite set of nodes does not change when mirroring a
tree. -/

lemma finset.elems_mirror (t : btree ℕ) :
  finset.elems (mirror t) = finset.elems t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    rw finset.elems,
    rw mirror,
    rw ←ih_l,
    rw ←ih_r,
    rw finset.elems,
    cc }
end

/-! 2.3. Show that this does not hold for the list of nodes by providing a
tree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

If you define a suitable counterexample, the proof below will succeed. -/

def rotten_tree : btree ℕ :=
btree.node 0 (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

#eval list.elems rotten_tree
#eval list.elems (mirror rotten_tree)

lemma list.elems_mirror_counterexample :
  ∃t : btree ℕ, list.elems t ≠ list.elems (mirror t) :=
begin
  apply exists.intro rotten_tree,
  exact dec_trivial
end

end LoVe