/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Sébastien Gouëzel, Heather Macbeth
-/
import analysis.inner_product_space.projection
import analysis.normed_space.pi_Lp

/-!
# `L²` inner product space structure on finite products of inner product spaces

The `L²` norm on a finite product of inner product spaces is compatible with an inner product
$$
\langle x, y\rangle = \sum \langle x_i, y_i \rangle.
$$
This is recorded in this file as an inner product space instance on `pi_Lp 2`.

## Main definitions

- `euclidean_space 𝕜 n`: defined to be `pi_Lp 2 (n → 𝕜)` for any `fintype n`, i.e., the space
  from functions to `n` to `𝕜` with the `L²` norm. We register several instances on it (notably
  that it is a finite-dimensional inner product space).

- `orthonormal_basis 𝕜 ι`: defined to be an isometry to Euclidean space from a given
  finite-dimensional innner product space, `E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι`.

- `basis.to_orthonormal_basis`: constructs an `orthonormal_basis` for a finite-dimensional
  Euclidean space from a `basis` which is `orthonormal`.

- `linear_isometry_equiv.of_inner_product_space`: provides an arbitrary isometry to Euclidean space
  from a given finite-dimensional inner product space, induced by choosing an arbitrary basis.

- `complex.isometry_euclidean`: standard isometry from `ℂ` to `euclidean_space ℝ (fin 2)`

-/

open real set filter is_R_or_C
open_locale big_operators uniformity topological_space nnreal ennreal complex_conjugate direct_sum

noncomputable theory

variables {ι : Type*} {ι' : Type*}
variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [inner_product_space 𝕜 E]
variables {E' : Type*} [inner_product_space 𝕜 E']
variables {F : Type*} [inner_product_space ℝ F]
variables {F' : Type*} [inner_product_space ℝ F']
local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

/-
 If `ι` is a finite type and each space `f i`, `i : ι`, is an inner product space,
then `Π i, f i` is an inner product space as well. Since `Π i, f i` is endowed with the sup norm,
we use instead `pi_Lp 2 f` for the product space, which is endowed with the `L^2` norm.
-/
instance pi_Lp.inner_product_space {ι : Type*} [fintype ι] (f : ι → Type*)
  [Π i, inner_product_space 𝕜 (f i)] : inner_product_space 𝕜 (pi_Lp 2 f) :=
{ inner := λ x y, ∑ i, inner (x i) (y i),
  norm_sq_eq_inner :=
  begin
    intro x,
    have h₂ : 0 ≤ ∑ (i : ι), ∥x i∥ ^ (2 : ℝ) :=
      finset.sum_nonneg (λ j hj, rpow_nonneg_of_nonneg (norm_nonneg (x j)) 2),
    simp only [norm, add_monoid_hom.map_sum, ← norm_sq_eq_inner, one_div],
    rw [← rpow_nat_cast ((∑ (i : ι), ∥x i∥ ^ (2 : ℝ)) ^ (2 : ℝ)⁻¹) 2, ← rpow_mul h₂],
    norm_num,
  end,
  conj_sym :=
  begin
    intros x y,
    unfold inner,
    rw ring_hom.map_sum,
    apply finset.sum_congr rfl,
    rintros z -,
    apply inner_conj_sym,
  end,
  add_left := λ x y z,
    show ∑ i, inner (x i + y i) (z i) = ∑ i, inner (x i) (z i) + ∑ i, inner (y i) (z i),
    by simp only [inner_add_left, finset.sum_add_distrib],
  smul_left := λ x y r,
    show ∑ (i : ι), inner (r • x i) (y i) = (conj r) * ∑ i, inner (x i) (y i),
    by simp only [finset.mul_sum, inner_smul_left] }

@[simp] lemma pi_Lp.inner_apply {ι : Type*} [fintype ι] {f : ι → Type*}
  [Π i, inner_product_space 𝕜 (f i)] (x y : pi_Lp 2 f) :
  ⟪x, y⟫ = ∑ i, ⟪x i, y i⟫ :=
rfl

/-- The standard real/complex Euclidean space, functions on a finite type. For an `n`-dimensional
space use `euclidean_space 𝕜 (fin n)`. -/
@[reducible, nolint unused_arguments]
def euclidean_space (𝕜 : Type*) [is_R_or_C 𝕜]
  (n : Type*) [fintype n] : Type* := pi_Lp 2 (λ (i : n), 𝕜)

lemma euclidean_space.norm_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
  (x : euclidean_space 𝕜 n) : ∥x∥ = real.sqrt (∑ i, ∥x i∥ ^ 2) :=
pi_Lp.norm_eq_of_L2 x

lemma euclidean_space.nnnorm_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
  (x : euclidean_space 𝕜 n) : ∥x∥₊ = nnreal.sqrt (∑ i, ∥x i∥₊ ^ 2) :=
pi_Lp.nnnorm_eq_of_L2 x

lemma euclidean_space.dist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
  (x y : euclidean_space 𝕜 n) : dist x y = (∑ i, dist (x i) (y i) ^ 2).sqrt :=
(pi_Lp.dist_eq_of_L2 x y : _)

lemma euclidean_space.nndist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
  (x y : euclidean_space 𝕜 n) : nndist x y = (∑ i, nndist (x i) (y i) ^ 2).sqrt :=
(pi_Lp.nndist_eq_of_L2 x y : _)

lemma euclidean_space.edist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
  (x y : euclidean_space 𝕜 n) : edist x y = (∑ i, edist (x i) (y i) ^ 2) ^ (1 / 2 : ℝ) :=
(pi_Lp.edist_eq_of_L2 x y : _)

variables [fintype ι]

section
local attribute [reducible] pi_Lp

instance : finite_dimensional 𝕜 (euclidean_space 𝕜 ι) := by apply_instance
instance : inner_product_space 𝕜 (euclidean_space 𝕜 ι) := by apply_instance

@[simp] lemma finrank_euclidean_space :
  finite_dimensional.finrank 𝕜 (euclidean_space 𝕜 ι) = fintype.card ι := by simp

lemma finrank_euclidean_space_fin {n : ℕ} :
  finite_dimensional.finrank 𝕜 (euclidean_space 𝕜 (fin n)) = n := by simp

lemma euclidean_space.inner_eq_star_dot_product (x y : euclidean_space 𝕜 ι) :
  ⟪x, y⟫ = matrix.dot_product (star $ pi_Lp.equiv _ _ x) (pi_Lp.equiv _ _ y) := rfl

/-- A finite, mutually orthogonal family of subspaces of `E`, which span `E`, induce an isometry
from `E` to `pi_Lp 2` of the subspaces equipped with the `L2` inner product. -/
def direct_sum.is_internal.isometry_L2_of_orthogonal_family
  [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.is_internal V)
  (hV' : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) :
  E ≃ₗᵢ[𝕜] pi_Lp 2 (λ i, V i) :=
begin
  let e₁ := direct_sum.linear_equiv_fun_on_fintype 𝕜 ι (λ i, V i),
  let e₂ := linear_equiv.of_bijective (direct_sum.coe_linear_map V) hV.injective hV.surjective,
  refine (e₂.symm.trans e₁).isometry_of_inner _,
  suffices : ∀ v w, ⟪v, w⟫ = ⟪e₂ (e₁.symm v), e₂ (e₁.symm w)⟫,
  { intros v₀ w₀,
    convert this (e₁ (e₂.symm v₀)) (e₁ (e₂.symm w₀));
    simp only [linear_equiv.symm_apply_apply, linear_equiv.apply_symm_apply] },
  intros v w,
  transitivity ⟪(∑ i, (V i).subtypeₗᵢ (v i)), ∑ i, (V i).subtypeₗᵢ (w i)⟫,
  { simp only [sum_inner, hV'.inner_right_fintype, pi_Lp.inner_apply] },
  { congr; simp }
end

@[simp] lemma direct_sum.is_internal.isometry_L2_of_orthogonal_family_symm_apply
  [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.is_internal V)
  (hV' : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ))
  (w : pi_Lp 2 (λ i, V i)) :
  (hV.isometry_L2_of_orthogonal_family hV').symm w = ∑ i, (w i : E) :=
begin
  classical,
  let e₁ := direct_sum.linear_equiv_fun_on_fintype 𝕜 ι (λ i, V i),
  let e₂ := linear_equiv.of_bijective (direct_sum.coe_linear_map V) hV.injective hV.surjective,
  suffices : ∀ v : ⨁ i, V i, e₂ v = ∑ i, e₁ v i,
  { exact this (e₁.symm w) },
  intros v,
  simp [e₂, direct_sum.coe_linear_map, direct_sum.to_module, dfinsupp.sum_add_hom_apply]
end

end

/-- The vector given in euclidean space by being `1 : 𝕜` at coordinate `i : ι` and `0 : 𝕜` at
all other coordinates. -/
def euclidean_space.single [decidable_eq ι] (i : ι) (a : 𝕜) :
  euclidean_space 𝕜 ι :=
(pi_Lp.equiv _ _).symm (pi.single i a)

@[simp] lemma pi_Lp.equiv_single [decidable_eq ι] (i : ι) (a : 𝕜) :
  pi_Lp.equiv _ _ (euclidean_space.single i a) = pi.single i a := rfl

@[simp] lemma pi_Lp.equiv_symm_single [decidable_eq ι] (i : ι) (a : 𝕜) :
  (pi_Lp.equiv _ _).symm (pi.single i a) = euclidean_space.single i a := rfl

@[simp] theorem euclidean_space.single_apply [decidable_eq ι] (i : ι) (a : 𝕜) (j : ι) :
  (euclidean_space.single i a) j = ite (j = i) a 0 :=
by { rw [euclidean_space.single, pi_Lp.equiv_symm_apply, ← pi.single_apply i a j] }

lemma euclidean_space.inner_single_left [decidable_eq ι] (i : ι) (a : 𝕜) (v : euclidean_space 𝕜 ι) :
  ⟪euclidean_space.single i (a : 𝕜), v⟫ = conj a * (v i) :=
by simp [apply_ite conj]

lemma euclidean_space.inner_single_right [decidable_eq ι] (i : ι) (a : 𝕜)
  (v : euclidean_space 𝕜 ι) :
  ⟪v, euclidean_space.single i (a : 𝕜)⟫ =  a * conj (v i) :=
by simp [apply_ite conj, mul_comm]

variables (ι 𝕜 E)

/-- An orthonormal basis on E is an identification of `E` with its dimensional-matching
`euclidean_space 𝕜 ι`. -/
structure orthonormal_basis := of_repr :: (repr : E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι)

variables {ι 𝕜 E}

namespace orthonormal_basis

instance : inhabited (orthonormal_basis ι 𝕜 (euclidean_space 𝕜 ι)) :=
⟨of_repr (linear_isometry_equiv.refl 𝕜 (euclidean_space 𝕜 ι))⟩

/-- `b i` is the `i`th basis vector. -/
instance : has_coe_to_fun (orthonormal_basis ι 𝕜 E) (λ _, ι → E) :=
{ coe := λ b i, by classical; exact b.repr.symm (euclidean_space.single i (1 : 𝕜)) }

@[simp] protected lemma repr_symm_single [decidable_eq ι] (b : orthonormal_basis ι 𝕜 E) (i : ι) :
  b.repr.symm (euclidean_space.single i (1:𝕜)) = b i :=
by { classical, congr, simp, }

@[simp] protected lemma repr_self [decidable_eq ι] (b : orthonormal_basis ι 𝕜 E) (i : ι) :
  b.repr (b i) = euclidean_space.single i (1:𝕜) :=
by rw [← b.repr_symm_single i, linear_isometry_equiv.apply_symm_apply]

protected lemma repr_apply_apply (b : orthonormal_basis ι 𝕜 E) (v : E) (i : ι) :
  b.repr v i = ⟪b i, v⟫ :=
begin
  classical,
  rw [← b.repr.inner_map_map (b i) v, b.repr_self i, euclidean_space.inner_single_left],
  simp only [one_mul, eq_self_iff_true, map_one],
end

@[simp]
protected lemma orthonormal (b : orthonormal_basis ι 𝕜 E) : orthonormal 𝕜 b :=
begin
  classical,
  rw orthonormal_iff_ite,
  intros i j,
  rw [← b.repr.inner_map_map (b i) (b j), b.repr_self i, b.repr_self j],
  rw euclidean_space.inner_single_left,
  rw euclidean_space.single_apply,
  simp only [mul_boole, map_one],
end

/-- The `basis ι 𝕜 E` underlying the `orthonormal_basis` --/
protected def to_basis (b : orthonormal_basis ι 𝕜 E) : basis ι 𝕜 E :=
basis.of_equiv_fun b.repr.to_linear_equiv

@[simp] protected lemma coe_to_basis (b : orthonormal_basis ι 𝕜 E) :
  (⇑b.to_basis : ι → E) = ⇑b :=
begin
  change ⇑(basis.of_equiv_fun b.repr.to_linear_equiv) = b,
  ext j,
  rw basis.coe_of_equiv_fun,
  simp only [orthonormal_basis.repr_symm_single],
  congr,
end

@[simp] protected lemma coe_to_basis_repr (b : orthonormal_basis ι 𝕜 E) :
  b.to_basis.equiv_fun = b.repr.to_linear_equiv :=
begin
  change (basis.of_equiv_fun b.repr.to_linear_equiv).equiv_fun = b.repr.to_linear_equiv,
  ext x j,
  simp only [basis.of_equiv_fun_repr_apply, eq_self_iff_true,
    linear_isometry_equiv.coe_to_linear_equiv, basis.equiv_fun_apply],
end

protected lemma sum_repr_symm (b : orthonormal_basis ι 𝕜 E) (v : euclidean_space 𝕜 ι) :
  ∑ i , v i • b i = (b.repr.symm v) :=
by { classical, simpa using (b.to_basis.equiv_fun_symm_apply v).symm }

variable {v : ι → E}

/-- A basis that is orthonormal is an orthonormal basis. -/
def _root_.basis.to_orthonormal_basis (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) :
  orthonormal_basis ι 𝕜 E :=
orthonormal_basis.of_repr $
linear_equiv.isometry_of_inner v.equiv_fun
begin
  intros x y,
  let p : euclidean_space 𝕜 ι := v.equiv_fun x,
  let q : euclidean_space 𝕜 ι := v.equiv_fun y,
  have key : ⟪p, q⟫ = ⟪∑ i, p i • v i, ∑ i, q i • v i⟫,
  { simp [sum_inner, inner_smul_left, hv.inner_right_fintype] },
  convert key,
  { rw [← v.equiv_fun.symm_apply_apply x, v.equiv_fun_symm_apply] },
  { rw [← v.equiv_fun.symm_apply_apply y, v.equiv_fun_symm_apply] }
end

@[simp] lemma _root_.basis.coe_to_orthonormal_basis_repr (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) :
  ((v.to_orthonormal_basis hv).repr : E → euclidean_space 𝕜 ι) = v.equiv_fun :=
rfl

@[simp] lemma _root_.basis.coe_to_orthonormal_basis_repr_symm
  (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) :
  ((v.to_orthonormal_basis hv).repr.symm : euclidean_space 𝕜 ι → E) = v.equiv_fun.symm :=
rfl

@[simp] lemma _root_.basis.to_basis_to_orthonormal_basis (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) :
  (v.to_orthonormal_basis hv).to_basis = v :=
by simp [basis.to_orthonormal_basis, orthonormal_basis.to_basis]

@[simp] lemma _root_.basis.coe_to_orthonormal_basis (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) :
  (v.to_orthonormal_basis hv : ι → E) = (v : ι → E) :=
calc (v.to_orthonormal_basis hv : ι → E) = ((v.to_orthonormal_basis hv).to_basis : ι → E) :
  by { classical, rw orthonormal_basis.coe_to_basis }
... = (v : ι → E) : by simp

/-- An orthonormal set that spans is an orthonormal basis -/
protected def mk (hon : orthonormal 𝕜 v) (hsp: submodule.span 𝕜 (set.range v) = ⊤):
  orthonormal_basis ι 𝕜 E :=
(basis.mk (orthonormal.linear_independent hon) hsp).to_orthonormal_basis (by rwa basis.coe_mk)

@[simp]
protected lemma coe_mk (hon : orthonormal 𝕜 v) (hsp: submodule.span 𝕜 (set.range v) = ⊤) :
  ⇑(orthonormal_basis.mk hon hsp) = v :=
by classical; rw [orthonormal_basis.mk, _root_.basis.coe_to_orthonormal_basis, basis.coe_mk]

end orthonormal_basis

/-- If `f : E ≃ₗᵢ[𝕜] E'` is a linear isometry of inner product spaces then an orthonormal basis `v`
of `E` determines a linear isometry `e : E' ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι`. This result states that
`e` may be obtained either by transporting `v` to `E'` or by composing with the linear isometry
`E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι` provided by `v`. -/
@[simp] lemma basis.map_isometry_euclidean_of_orthonormal (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v)
  (f : E ≃ₗᵢ[𝕜] E') :
  ((v.map f.to_linear_equiv).to_orthonormal_basis (hv.map_linear_isometry_equiv f)).repr =
    f.symm.trans (v.to_orthonormal_basis hv).repr :=
linear_isometry_equiv.to_linear_equiv_injective $ v.map_equiv_fun _

/-- `ℂ` is isometric to `ℝ²` with the Euclidean inner product. -/
def complex.isometry_euclidean : ℂ ≃ₗᵢ[ℝ] (euclidean_space ℝ (fin 2)) :=
(complex.basis_one_I.to_orthonormal_basis
begin
  rw orthonormal_iff_ite,
  intros i, fin_cases i;
  intros j; fin_cases j;
  simp [real_inner_eq_re_inner]
end).repr

@[simp] lemma complex.isometry_euclidean_symm_apply (x : euclidean_space ℝ (fin 2)) :
  complex.isometry_euclidean.symm x = (x 0) + (x 1) * I :=
begin
  convert complex.basis_one_I.equiv_fun_symm_apply x,
  { simpa },
  { simp },
end

lemma complex.isometry_euclidean_proj_eq_self (z : ℂ) :
  ↑(complex.isometry_euclidean z 0) + ↑(complex.isometry_euclidean z 1) * (I : ℂ) = z :=
by rw [← complex.isometry_euclidean_symm_apply (complex.isometry_euclidean z),
  complex.isometry_euclidean.symm_apply_apply z]

@[simp] lemma complex.isometry_euclidean_apply_zero (z : ℂ) :
  complex.isometry_euclidean z 0 = z.re :=
by { conv_rhs { rw ← complex.isometry_euclidean_proj_eq_self z }, simp }

@[simp] lemma complex.isometry_euclidean_apply_one (z : ℂ) :
  complex.isometry_euclidean z 1 = z.im :=
by { conv_rhs { rw ← complex.isometry_euclidean_proj_eq_self z }, simp }

/-- The isometry between `ℂ` and a two-dimensional real inner product space given by a basis. -/
def complex.isometry_of_orthonormal {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) : ℂ ≃ₗᵢ[ℝ] F :=
complex.isometry_euclidean.trans (v.to_orthonormal_basis hv).repr.symm

@[simp] lemma complex.map_isometry_of_orthonormal {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v)
  (f : F ≃ₗᵢ[ℝ] F') :
  complex.isometry_of_orthonormal (hv.map_linear_isometry_equiv f) =
    (complex.isometry_of_orthonormal hv).trans f :=
by simp [complex.isometry_of_orthonormal, linear_isometry_equiv.trans_assoc]

lemma complex.isometry_of_orthonormal_symm_apply
  {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) (f : F) :
  (complex.isometry_of_orthonormal hv).symm f = (v.coord 0 f : ℂ) + (v.coord 1 f : ℂ) * I :=
by simp [complex.isometry_of_orthonormal]

lemma complex.isometry_of_orthonormal_apply
  {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) (z : ℂ) :
  complex.isometry_of_orthonormal hv z = z.re • v 0 + z.im • v 1 :=
by simp [complex.isometry_of_orthonormal, (dec_trivial : (finset.univ : finset (fin 2)) = {0, 1})]

open finite_dimensional

/-- Given a natural number `n` equal to the `finrank` of a finite-dimensional inner product space,
there exists an isometry from the space to `euclidean_space 𝕜 (fin n)`. -/
def linear_isometry_equiv.of_inner_product_space
  [finite_dimensional 𝕜 E] {n : ℕ} (hn : finrank 𝕜 E = n) :
  E ≃ₗᵢ[𝕜] (euclidean_space 𝕜 (fin n)) :=
((fin_std_orthonormal_basis hn).to_orthonormal_basis
  (fin_std_orthonormal_basis_orthonormal hn)).repr

local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ

/-- Given a natural number `n` one less than the `finrank` of a finite-dimensional inner product
space, there exists an isometry from the orthogonal complement of a nonzero singleton to
`euclidean_space 𝕜 (fin n)`. -/
def linear_isometry_equiv.from_orthogonal_span_singleton
  (n : ℕ) [fact (finrank 𝕜 E = n + 1)] {v : E} (hv : v ≠ 0) :
  (𝕜 ∙ v)ᗮ ≃ₗᵢ[𝕜] (euclidean_space 𝕜 (fin n)) :=
linear_isometry_equiv.of_inner_product_space (finrank_orthogonal_span_singleton hv)

section linear_isometry

variables {V : Type*} [inner_product_space 𝕜 V] [finite_dimensional 𝕜 V]

variables {S : submodule 𝕜 V} {L : S →ₗᵢ[𝕜] V}

open finite_dimensional

/-- Let `S` be a subspace of a finite-dimensional complex inner product space `V`.  A linear
isometry mapping `S` into `V` can be extended to a full isometry of `V`.

TODO:  The case when `S` is a finite-dimensional subspace of an infinite-dimensional `V`.-/
noncomputable def linear_isometry.extend (L : S →ₗᵢ[𝕜] V): V →ₗᵢ[𝕜] V :=
begin
  -- Build an isometry from Sᗮ to L(S)ᗮ through euclidean_space
  let d := finrank 𝕜 Sᗮ,
  have dim_S_perp : finrank 𝕜 Sᗮ = d := rfl,
  let LS := L.to_linear_map.range,
  have E : Sᗮ ≃ₗᵢ[𝕜] LSᗮ,
  { have dim_LS_perp : finrank 𝕜 LSᗮ = d,
    calc  finrank 𝕜 LSᗮ = finrank 𝕜 V - finrank 𝕜 LS : by simp only
        [← LS.finrank_add_finrank_orthogonal, add_tsub_cancel_left]
      ...               = finrank 𝕜 V - finrank 𝕜 S : by simp only
        [linear_map.finrank_range_of_inj L.injective]
      ...               = finrank 𝕜 Sᗮ : by simp only
        [← S.finrank_add_finrank_orthogonal, add_tsub_cancel_left]
      ...               = d : dim_S_perp,
    let BS := ((fin_std_orthonormal_basis dim_S_perp).to_orthonormal_basis
      (fin_std_orthonormal_basis_orthonormal dim_S_perp)),
    let BLS := ((fin_std_orthonormal_basis dim_LS_perp).to_orthonormal_basis
      (fin_std_orthonormal_basis_orthonormal dim_LS_perp)),
    exact BS.repr.trans BLS.repr.symm },
  let L3 := (LS)ᗮ.subtypeₗᵢ.comp E.to_linear_isometry,
  -- Project onto S and Sᗮ
  haveI : complete_space S := finite_dimensional.complete 𝕜 S,
  haveI : complete_space V := finite_dimensional.complete 𝕜 V,
  let p1 := (orthogonal_projection S).to_linear_map,
  let p2 := (orthogonal_projection Sᗮ).to_linear_map,
  -- Build a linear map from the isometries on S and Sᗮ
  let M := L.to_linear_map.comp p1 + L3.to_linear_map.comp p2,
  -- Prove that M is an isometry
  have M_norm_map : ∀ (x : V), ∥M x∥ = ∥x∥,
  { intro x,
    -- Apply M to the orthogonal decomposition of x
    have Mx_decomp : M x = L (p1 x) + L3 (p2 x),
    { simp only [linear_map.add_apply, linear_map.comp_apply, linear_map.comp_apply,
      linear_isometry.coe_to_linear_map]},
    -- Mx_decomp is the orthogonal decomposition of M x
    have Mx_orth : ⟪ L (p1 x), L3 (p2 x) ⟫ = 0,
    { have Lp1x : L (p1 x) ∈ L.to_linear_map.range := L.to_linear_map.mem_range_self (p1 x),
      have Lp2x : L3 (p2 x) ∈ (L.to_linear_map.range)ᗮ,
      { simp only [L3, linear_isometry.coe_comp, function.comp_app, submodule.coe_subtypeₗᵢ,
          ← submodule.range_subtype (LSᗮ)],
        apply linear_map.mem_range_self},
      apply submodule.inner_right_of_mem_orthogonal Lp1x Lp2x},
    -- Apply the Pythagorean theorem and simplify
    rw [← sq_eq_sq (norm_nonneg _) (norm_nonneg _), norm_sq_eq_add_norm_sq_projection x S],
    simp only [sq, Mx_decomp],
    rw norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero (L (p1 x)) (L3 (p2 x)) Mx_orth,
    simp only [linear_isometry.norm_map, p1, p2, continuous_linear_map.to_linear_map_eq_coe,
      add_left_inj, mul_eq_mul_left_iff, norm_eq_zero, true_or, eq_self_iff_true,
      continuous_linear_map.coe_coe, submodule.coe_norm, submodule.coe_eq_zero] },
  exact { to_linear_map := M, norm_map' := M_norm_map },
end

lemma linear_isometry.extend_apply (L : S →ₗᵢ[𝕜] V) (s : S):
  L.extend s = L s :=
begin
  haveI : complete_space S := finite_dimensional.complete 𝕜 S,
  simp only [linear_isometry.extend, continuous_linear_map.to_linear_map_eq_coe,
    ←linear_isometry.coe_to_linear_map],
  simp only [add_right_eq_self, linear_isometry.coe_to_linear_map,
    linear_isometry_equiv.coe_to_linear_isometry, linear_isometry.coe_comp, function.comp_app,
    orthogonal_projection_mem_subspace_eq_self, linear_map.coe_comp, continuous_linear_map.coe_coe,
    submodule.coe_subtype, linear_map.add_apply, submodule.coe_eq_zero,
    linear_isometry_equiv.map_eq_zero_iff, submodule.coe_subtypeₗᵢ,
    orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
    submodule.orthogonal_orthogonal, submodule.coe_mem],
end

end linear_isometry

section matrix

open_locale matrix

variables {n m : ℕ}

local notation `⟪`x`, `y`⟫ₘ` := @inner 𝕜 (euclidean_space 𝕜 (fin m)) _ x y
local notation `⟪`x`, `y`⟫ₙ` := @inner 𝕜 (euclidean_space 𝕜 (fin n)) _ x y

/-- The inner product of a row of A and a row of B is an entry of B ⬝ Aᴴ. -/
lemma inner_matrix_row_row (A B : matrix (fin n) (fin m) 𝕜) (i j : (fin n)) :
  ⟪A i, B j⟫ₘ = (B ⬝ Aᴴ) j i := by {simp only [inner, matrix.mul_apply, star_ring_end_apply,
    matrix.conj_transpose_apply,mul_comm]}

/-- The inner product of a column of A and a column of B is an entry of Aᴴ ⬝ B -/
lemma inner_matrix_col_col (A B : matrix (fin n) (fin m) 𝕜) (i j : (fin m)) :
  ⟪Aᵀ i, Bᵀ j⟫ₙ = (Aᴴ ⬝ B) i j := rfl

end matrix


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov
-/
import data.set.pointwise

/-!
# Torsors of additive group actions

This file defines torsors of additive group actions.

## Notations

The group elements are referred to as acting on points.  This file
defines the notation `+ᵥ` for adding a group element to a point and
`-ᵥ` for subtracting two points to produce a group element.

## Implementation notes

Affine spaces are the motivating example of torsors of additive group actions. It may be appropriate
to refactor in terms of the general definition of group actions, via `to_additive`, when there is a
use for multiplicative torsors (currently mathlib only develops the theory of group actions for
multiplicative group actions).

## Notations

* `v +ᵥ p` is a notation for `has_vadd.vadd`, the left action of an additive monoid;

* `p₁ -ᵥ p₂` is a notation for `has_vsub.vsub`, difference between two points in an additive torsor
  as an element of the corresponding additive group;

## References

* https://en.wikipedia.org/wiki/Principal_homogeneous_space
* https://en.wikipedia.org/wiki/Affine_space

-/

/-- An `add_torsor G P` gives a structure to the nonempty type `P`,
acted on by an `add_group G` with a transitive and free action given
by the `+ᵥ` operation and a corresponding subtraction given by the
`-ᵥ` operation. In the case of a vector space, it is an affine
space. -/
class add_torsor (G : out_param Type*) (P : Type*) [out_param $ add_group G]
  extends add_action G P, has_vsub G P :=
[nonempty : nonempty P]
(vsub_vadd' : ∀ (p1 p2 : P), (p1 -ᵥ p2 : G) +ᵥ p2 = p1)
(vadd_vsub' : ∀ (g : G) (p : P), g +ᵥ p -ᵥ p = g)

attribute [instance, priority 100, nolint dangerous_instance] add_torsor.nonempty
attribute [nolint dangerous_instance] add_torsor.to_has_vsub

/-- An `add_group G` is a torsor for itself. -/
@[nolint instance_priority]
instance add_group_is_add_torsor (G : Type*) [add_group G] :
  add_torsor G G :=
{ vsub := has_sub.sub,
  vsub_vadd' := sub_add_cancel,
  vadd_vsub' := add_sub_cancel }

/-- Simplify subtraction for a torsor for an `add_group G` over
itself. -/
@[simp] lemma vsub_eq_sub {G : Type*} [add_group G] (g1 g2 : G) : g1 -ᵥ g2 = g1 - g2 :=
rfl

section general

variables {G : Type*} {P : Type*} [add_group G] [T : add_torsor G P]
include T

/-- Adding the result of subtracting from another point produces that
point. -/
@[simp] lemma vsub_vadd (p1 p2 : P) : p1 -ᵥ p2 +ᵥ p2 = p1 :=
add_torsor.vsub_vadd' p1 p2

/-- Adding a group element then subtracting the original point
produces that group element. -/
@[simp] lemma vadd_vsub (g : G) (p : P) : g +ᵥ p -ᵥ p = g :=
add_torsor.vadd_vsub' g p

/-- If the same point added to two group elements produces equal
results, those group elements are equal. -/
lemma vadd_right_cancel {g1 g2 : G} (p : P) (h : g1 +ᵥ p = g2 +ᵥ p) : g1 = g2 :=
by rw [←vadd_vsub g1, h, vadd_vsub]

@[simp] lemma vadd_right_cancel_iff {g1 g2 : G} (p : P) :  g1 +ᵥ p = g2 +ᵥ p ↔ g1 = g2 :=
⟨vadd_right_cancel p, λ h, h ▸ rfl⟩

/-- Adding a group element to the point `p` is an injective
function. -/
lemma vadd_right_injective (p : P) : function.injective ((+ᵥ p) : G → P) :=
λ g1 g2, vadd_right_cancel p

/-- Adding a group element to a point, then subtracting another point,
produces the same result as subtracting the points then adding the
group element. -/
lemma vadd_vsub_assoc (g : G) (p1 p2 : P) : g +ᵥ p1 -ᵥ p2 = g + (p1 -ᵥ p2) :=
begin
  apply vadd_right_cancel p2,
  rw [vsub_vadd, add_vadd, vsub_vadd]
end

/-- Subtracting a point from itself produces 0. -/
@[simp] lemma vsub_self (p : P) : p -ᵥ p = (0 : G) :=
by rw [←zero_add (p -ᵥ p), ←vadd_vsub_assoc, vadd_vsub]

/-- If subtracting two points produces 0, they are equal. -/
lemma eq_of_vsub_eq_zero {p1 p2 : P} (h : p1 -ᵥ p2 = (0 : G)) : p1 = p2 :=
by rw [←vsub_vadd p1 p2, h, zero_vadd]

/-- Subtracting two points produces 0 if and only if they are
equal. -/
@[simp] lemma vsub_eq_zero_iff_eq {p1 p2 : P} : p1 -ᵥ p2 = (0 : G) ↔ p1 = p2 :=
iff.intro eq_of_vsub_eq_zero (λ h, h ▸ vsub_self _)

/-- Cancellation adding the results of two subtractions. -/
@[simp] lemma vsub_add_vsub_cancel (p1 p2 p3 : P) : p1 -ᵥ p2 + (p2 -ᵥ p3) = (p1 -ᵥ p3) :=
begin
  apply vadd_right_cancel p3,
  rw [add_vadd, vsub_vadd, vsub_vadd, vsub_vadd]
end

/-- Subtracting two points in the reverse order produces the negation
of subtracting them. -/
@[simp] lemma neg_vsub_eq_vsub_rev (p1 p2 : P) : -(p1 -ᵥ p2) = (p2 -ᵥ p1) :=
begin
  refine neg_eq_of_add_eq_zero (vadd_right_cancel p1 _),
  rw [vsub_add_vsub_cancel, vsub_self],
end

/-- Subtracting the result of adding a group element produces the same result
as subtracting the points and subtracting that group element. -/
lemma vsub_vadd_eq_vsub_sub (p1 p2 : P) (g : G) : p1 -ᵥ (g +ᵥ p2) = (p1 -ᵥ p2) - g :=
by rw [←add_right_inj (p2 -ᵥ p1 : G), vsub_add_vsub_cancel, ←neg_vsub_eq_vsub_rev, vadd_vsub,
       ←add_sub_assoc, ←neg_vsub_eq_vsub_rev, neg_add_self, zero_sub]

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_right (p1 p2 p3 : P) :
  (p1 -ᵥ p3) - (p2 -ᵥ p3) = (p1 -ᵥ p2) :=
by rw [←vsub_vadd_eq_vsub_sub, vsub_vadd]

/-- Convert between an equality with adding a group element to a point
and an equality of a subtraction of two points with a group
element. -/
lemma eq_vadd_iff_vsub_eq (p1 : P) (g : G) (p2 : P) : p1 = g +ᵥ p2 ↔ p1 -ᵥ p2 = g :=
⟨λ h, h.symm ▸ vadd_vsub _ _, λ h, h ▸ (vsub_vadd _ _).symm⟩

lemma vadd_eq_vadd_iff_neg_add_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ - v₁ + v₂ = p₁ -ᵥ p₂ :=
by rw [eq_vadd_iff_vsub_eq, vadd_vsub_assoc, ← add_right_inj (-v₁), neg_add_cancel_left, eq_comm]

namespace set
open_locale pointwise

@[simp] lemma singleton_vsub_self (p : P) : ({p} : set P) -ᵥ {p} = {(0:G)} :=
by rw [set.singleton_vsub_singleton, vsub_self]

end set

@[simp] lemma vadd_vsub_vadd_cancel_right (v₁ v₂ : G) (p : P) :
  (v₁ +ᵥ p) -ᵥ (v₂ +ᵥ p) = v₁ - v₂ :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, vsub_self, add_zero]

/-- If the same point subtracted from two points produces equal
results, those points are equal. -/
lemma vsub_left_cancel {p1 p2 p : P} (h : p1 -ᵥ p = p2 -ᵥ p) : p1 = p2 :=
by rwa [←sub_eq_zero, vsub_sub_vsub_cancel_right, vsub_eq_zero_iff_eq] at h

/-- The same point subtracted from two points produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_left_cancel_iff {p1 p2 p : P} : (p1 -ᵥ p) = p2 -ᵥ p ↔ p1 = p2 :=
⟨vsub_left_cancel, λ h, h ▸ rfl⟩

/-- Subtracting the point `p` is an injective function. -/
lemma vsub_left_injective (p : P) : function.injective ((-ᵥ p) : P → G) :=
λ p2 p3, vsub_left_cancel

/-- If subtracting two points from the same point produces equal
results, those points are equal. -/
lemma vsub_right_cancel {p1 p2 p : P} (h : p -ᵥ p1 = p -ᵥ p2) : p1 = p2 :=
begin
  refine vadd_left_cancel (p -ᵥ p2) _,
  rw [vsub_vadd, ← h, vsub_vadd]
end

/-- Subtracting two points from the same point produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_right_cancel_iff {p1 p2 p : P} : p -ᵥ p1 = p -ᵥ p2 ↔ p1 = p2 :=
⟨vsub_right_cancel, λ h, h ▸ rfl⟩

/-- Subtracting a point from the point `p` is an injective
function. -/
lemma vsub_right_injective (p : P) : function.injective ((-ᵥ) p : P → G) :=
λ p2 p3, vsub_right_cancel

end general

section comm

variables {G : Type*} {P : Type*} [add_comm_group G] [add_torsor G P]

include G

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_left (p1 p2 p3 : P) :
  (p3 -ᵥ p2) - (p3 -ᵥ p1) = (p1 -ᵥ p2) :=
by rw [sub_eq_add_neg, neg_vsub_eq_vsub_rev, add_comm, vsub_add_vsub_cancel]

@[simp] lemma vadd_vsub_vadd_cancel_left (v : G) (p1 p2 : P) :
  (v +ᵥ p1) -ᵥ (v +ᵥ p2) = p1 -ᵥ p2 :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_sub_cancel']

lemma vsub_vadd_comm (p1 p2 p3 : P) : (p1 -ᵥ p2 : G) +ᵥ p3 = p3 -ᵥ p2 +ᵥ p1 :=
begin
  rw [←@vsub_eq_zero_iff_eq G, vadd_vsub_assoc, vsub_vadd_eq_vsub_sub],
  simp
end

lemma vadd_eq_vadd_iff_sub_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂ :=
by rw [vadd_eq_vadd_iff_neg_add_eq_vsub, neg_add_eq_sub]

lemma vsub_sub_vsub_comm (p₁ p₂ p₃ p₄ : P) :
  (p₁ -ᵥ p₂) - (p₃ -ᵥ p₄) = (p₁ -ᵥ p₃) - (p₂ -ᵥ p₄) :=
by rw [← vsub_vadd_eq_vsub_sub, vsub_vadd_comm, vsub_vadd_eq_vsub_sub]

end comm

namespace prod

variables {G : Type*} {P : Type*} {G' : Type*} {P' : Type*} [add_group G] [add_group G']
  [add_torsor G P] [add_torsor G' P']

instance : add_torsor (G × G') (P × P') :=
{ vadd := λ v p, (v.1 +ᵥ p.1, v.2 +ᵥ p.2),
  zero_vadd := λ p, by simp,
  add_vadd := by simp [add_vadd],
  vsub := λ p₁ p₂, (p₁.1 -ᵥ p₂.1, p₁.2 -ᵥ p₂.2),
  nonempty := prod.nonempty,
  vsub_vadd' := λ p₁ p₂, show (p₁.1 -ᵥ p₂.1 +ᵥ p₂.1, _) = p₁, by simp,
  vadd_vsub' := λ v p, show (v.1 +ᵥ p.1 -ᵥ p.1, v.2 +ᵥ p.2 -ᵥ p.2)  =v, by simp }

@[simp] lemma fst_vadd (v : G × G') (p : P × P') : (v +ᵥ p).1 = v.1 +ᵥ p.1 := rfl
@[simp] lemma snd_vadd (v : G × G') (p : P × P') : (v +ᵥ p).2 = v.2 +ᵥ p.2 := rfl
@[simp] lemma mk_vadd_mk (v : G) (v' : G') (p : P) (p' : P') :
  (v, v') +ᵥ (p, p') = (v +ᵥ p, v' +ᵥ p') := rfl

@[simp] lemma fst_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').1 = p₁.1 -ᵥ p₂.1 := rfl
@[simp] lemma snd_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').2 = p₁.2 -ᵥ p₂.2 := rfl
@[simp] lemma mk_vsub_mk (p₁ p₂ : P) (p₁' p₂' : P') :
  ((p₁, p₁') -ᵥ (p₂, p₂') : G × G') = (p₁ -ᵥ p₂, p₁' -ᵥ p₂') := rfl

end prod

namespace pi

universes u v w
variables {I : Type u} {fg : I → Type v} [∀ i, add_group (fg i)] {fp : I → Type w}

open add_action add_torsor

/-- A product of `add_torsor`s is an `add_torsor`. -/
instance [T : ∀ i, add_torsor (fg i) (fp i)] : add_torsor (Π i, fg i) (Π i, fp i) :=
{ vadd := λ g p, λ i, g i +ᵥ p i,
  zero_vadd := λ p, funext $ λ i, zero_vadd (fg i) (p i),
  add_vadd := λ g₁ g₂ p, funext $ λ i, add_vadd (g₁ i) (g₂ i) (p i),
  vsub := λ p₁ p₂, λ i, p₁ i -ᵥ p₂ i,
  nonempty := ⟨λ i, classical.choice (T i).nonempty⟩,
  vsub_vadd' := λ p₁ p₂, funext $ λ i, vsub_vadd (p₁ i) (p₂ i),
  vadd_vsub' := λ g p, funext $ λ i, vadd_vsub (g i) (p i) }

end pi

namespace equiv

variables {G : Type*} {P : Type*} [add_group G] [add_torsor G P]

include G

/-- `v ↦ v +ᵥ p` as an equivalence. -/
def vadd_const (p : P) : G ≃ P :=
{ to_fun := λ v, v +ᵥ p,
  inv_fun := λ p', p' -ᵥ p,
  left_inv := λ v, vadd_vsub _ _,
  right_inv := λ p', vsub_vadd _ _ }

@[simp] lemma coe_vadd_const (p : P) : ⇑(vadd_const p) = λ v, v+ᵥ p := rfl

@[simp] lemma coe_vadd_const_symm (p : P) : ⇑(vadd_const p).symm = λ p', p' -ᵥ p := rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P) : P ≃ G :=
{ to_fun := (-ᵥ) p,
  inv_fun := λ v, -v +ᵥ p,
  left_inv := λ p', by simp,
  right_inv := λ v, by simp [vsub_vadd_eq_vsub_sub] }

@[simp] lemma coe_const_vsub (p : P) : ⇑(const_vsub p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P) : ⇑(const_vsub p).symm = λ v, -v +ᵥ p := rfl

variables (P)

/-- The permutation given by `p ↦ v +ᵥ p`. -/
def const_vadd (v : G) : equiv.perm P :=
{ to_fun := (+ᵥ) v,
  inv_fun := (+ᵥ) (-v),
  left_inv := λ p, by simp [vadd_vadd],
  right_inv := λ p, by simp [vadd_vadd] }

@[simp] lemma coe_const_vadd (v : G) : ⇑(const_vadd P v) = (+ᵥ) v := rfl

variable (G)

@[simp] lemma const_vadd_zero : const_vadd P (0:G) = 1 := ext $ zero_vadd G

variable {G}

@[simp] lemma const_vadd_add (v₁ v₂ : G) :
  const_vadd P (v₁ + v₂) = const_vadd P v₁ * const_vadd P v₂ :=
ext $ add_vadd v₁ v₂

/-- `equiv.const_vadd` as a homomorphism from `multiplicative G` to `equiv.perm P` -/
def const_vadd_hom : multiplicative G →* equiv.perm P :=
{ to_fun := λ v, const_vadd P v.to_add,
  map_one' := const_vadd_zero G P,
  map_mul' := const_vadd_add P }

variable {P}

open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P) : perm P := (const_vsub x).trans (vadd_const x)

lemma point_reflection_apply (x y : P) : point_reflection x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P) : (point_reflection x).symm = point_reflection x :=
ext $ by simp [point_reflection]

@[simp] lemma point_reflection_self (x : P) : point_reflection x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P) : involutive (point_reflection x : P → P) :=
λ y, (equiv.apply_eq_iff_eq_symm_apply _).2 $ by rw point_reflection_symm

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P} (h : injective (bit0 : G → G)) :
  point_reflection x y = y ↔ y = x :=
by rw [point_reflection_apply, eq_comm, eq_vadd_iff_vsub_eq, ← neg_vsub_eq_vsub_rev,
  neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero, h.eq_iff, vsub_eq_zero_iff_eq, eq_comm]

omit G

lemma injective_point_reflection_left_of_injective_bit0 {G P : Type*} [add_comm_group G]
  [add_torsor G P] (h : injective (bit0 : G → G)) (y : P) :
  injective (λ x : P, point_reflection x y) :=
λ x₁ x₂ (hy : point_reflection x₁ y = point_reflection x₂ y),
  by rwa [point_reflection_apply, point_reflection_apply, vadd_eq_vadd_iff_sub_eq_vsub,
    vsub_sub_vsub_cancel_right, ← neg_vsub_eq_vsub_rev, neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero,
    h.eq_iff, vsub_eq_zero_iff_eq] at hy

end equiv

lemma add_torsor.subsingleton_iff (G P : Type*) [add_group G] [add_torsor G P] :
  subsingleton G ↔ subsingleton P :=
begin
  inhabit P,
  exact (equiv.vadd_const default).subsingleton_congr,
end


import game.world3.level9 -- hide
import mynat.pow -- new import
namespace mynat -- hide

/- Axiom : pow_zero (a : mynat) :
a ^ 0 = 1
-/

/- Axiom : pow_succ (a b : mynat) :
a ^ succ(b) = a ^ b * a
-/

/-

# Power World

A new world with seven levels. And a new import!
This import gives you the power to make powers of your
natural numbers. It is defined by recursion, just like addition and multiplication.
Here are the two new axioms:

  * `pow_zero (a : mynat) : a ^ 0 = 1`
  * `pow_succ (a b : mynat) : a ^ succ(b) = a ^ b * a`

The power function has various relations to addition and multiplication.
If you have gone through levels 1--6 of addition world and levels 1--9 of
multiplication world, you should have no trouble with this world:
The usual tactics `induction`, `rw` and `refl` should see you through.
You might want to fiddle with the
drop-down menus on the left so you can see which theorems of Power World
you have proved at any given time. Addition and multiplication -- we
have a solid API for them now, i.e. if you need something about addition
or multiplication, it's probably already in the library we have built.
Collectibles are indication that we are proving the right things.

The levels in this world were designed by Sian Carey, a UROP student
at Imperial College London, funded by a Mary Lister McCammon Fellowship,
in the summer of 2019. Thanks Sian!

## Level 1: `zero_pow_zero`
-/

/- Lemma
$0 ^ 0 = 1$.
-/
lemma zero_pow_zero : (0 : mynat) ^ (0 : mynat) = 1 :=
begin [nat_num_game]
  rw pow_zero,
  refl,

end

end mynat -- hide


/-
Copyright (c) 2022 Matej Penciak. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Matej Penciak, Moritz Doll, Fabien Clery

! This file was ported from Lean 3 source module linear_algebra.symplectic_group
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse

/-!
# The Symplectic Group

This file defines the symplectic group and proves elementary properties.

## Main Definitions

`matrix.J`: the canonical `2n × 2n` skew-symmetric matrix
`symplectic_group`: the group of symplectic matrices

## TODO
* Every symplectic matrix has determinant 1.
* For `n = 1` the symplectic group coincides with the special linear group.
-/

open Matrix

variable {l R : Type _}

namespace Matrix

variable (l) [DecidableEq l] (R) [CommRing R]

section JMatrixLemmas

/-- The matrix defining the canonical skew-symmetric bilinear form. -/
def j : Matrix (Sum l l) (Sum l l) R :=
  Matrix.fromBlocks 0 (-1) 1 0
#align matrix.J Matrix.j

@[simp]
theorem j_transpose : (j l R)ᵀ = -j l R :=
  by
  rw [J, from_blocks_transpose, ← neg_one_smul R (from_blocks _ _ _ _), from_blocks_smul,
    Matrix.transpose_zero, Matrix.transpose_one, transpose_neg]
  simp [from_blocks]
#align matrix.J_transpose Matrix.j_transpose

variable [Fintype l]

theorem j_squared : j l R ⬝ j l R = -1 :=
  by
  rw [J, from_blocks_multiply]
  simp only [Matrix.zero_mul, Matrix.neg_mul, zero_add, neg_zero, Matrix.one_mul, add_zero]
  rw [← neg_zero, ← Matrix.fromBlocks_neg, ← from_blocks_one]
#align matrix.J_squared Matrix.j_squared

theorem j_inv : (j l R)⁻¹ = -j l R :=
  by
  refine' Matrix.inv_eq_right_inv _
  rw [Matrix.mul_neg, J_squared]
  exact neg_neg 1
#align matrix.J_inv Matrix.j_inv

theorem j_det_mul_j_det : det (j l R) * det (j l R) = 1 :=
  by
  rw [← det_mul, J_squared]
  rw [← one_smul R (-1 : Matrix _ _ R)]
  rw [smul_neg, ← neg_smul, det_smul]
  simp only [Fintype.card_sum, det_one, mul_one]
  apply Even.neg_one_pow
  exact even_add_self _
#align matrix.J_det_mul_J_det Matrix.j_det_mul_j_det

theorem isUnit_det_j : IsUnit (det (j l R)) :=
  isUnit_iff_exists_inv.mpr ⟨det (j l R), j_det_mul_j_det _ _⟩
#align matrix.is_unit_det_J Matrix.isUnit_det_j

end JMatrixLemmas

variable [Fintype l]

/-- The group of symplectic matrices over a ring `R`. -/
def symplecticGroup : Submonoid (Matrix (Sum l l) (Sum l l) R)
    where
  carrier := { A | A ⬝ j l R ⬝ Aᵀ = j l R }
  mul_mem' := by
    intro a b ha hb
    simp only [mul_eq_mul, Set.mem_setOf_eq, transpose_mul] at *
    rw [← Matrix.mul_assoc, a.mul_assoc, a.mul_assoc, hb]
    exact ha
  one_mem' := by simp
#align matrix.symplectic_group Matrix.symplecticGroup

end Matrix

namespace SymplecticGroup

variable {l} {R} [DecidableEq l] [Fintype l] [CommRing R]

open Matrix

theorem mem_iff {A : Matrix (Sum l l) (Sum l l) R} :
    A ∈ symplecticGroup l R ↔ A ⬝ j l R ⬝ Aᵀ = j l R := by simp [symplectic_group]
#align symplectic_group.mem_iff SymplecticGroup.mem_iff

instance coeMatrix : Coe (symplecticGroup l R) (Matrix (Sum l l) (Sum l l) R) := by infer_instance
#align symplectic_group.coe_matrix SymplecticGroup.coeMatrix

section SymplecticJ

variable (l) (R)

theorem j_mem : j l R ∈ symplecticGroup l R :=
  by
  rw [mem_iff, J, from_blocks_multiply, from_blocks_transpose, from_blocks_multiply]
  simp
#align symplectic_group.J_mem SymplecticGroup.j_mem

/-- The canonical skew-symmetric matrix as an element in the symplectic group. -/
def symJ : symplecticGroup l R :=
  ⟨j l R, j_mem l R⟩
#align symplectic_group.sym_J SymplecticGroup.symJ

variable {l} {R}

@[simp]
theorem coe_j : ↑(symJ l R) = j l R :=
  rfl
#align symplectic_group.coe_J SymplecticGroup.coe_j

end SymplecticJ

variable {R} {A : Matrix (Sum l l) (Sum l l) R}

theorem neg_mem (h : A ∈ symplecticGroup l R) : -A ∈ symplecticGroup l R :=
  by
  rw [mem_iff] at h⊢
  simp [h]
#align symplectic_group.neg_mem SymplecticGroup.neg_mem

theorem symplectic_det (hA : A ∈ symplecticGroup l R) : IsUnit <| det A :=
  by
  rw [isUnit_iff_exists_inv]
  use A.det
  refine' (is_unit_det_J l R).mul_left_cancel _
  rw [mul_one]
  rw [mem_iff] at hA
  apply_fun det  at hA
  simp only [det_mul, det_transpose] at hA
  rw [mul_comm A.det, mul_assoc] at hA
  exact hA
#align symplectic_group.symplectic_det SymplecticGroup.symplectic_det

theorem transpose_mem (hA : A ∈ symplecticGroup l R) : Aᵀ ∈ symplecticGroup l R :=
  by
  rw [mem_iff] at hA⊢
  rw [transpose_transpose]
  have huA := symplectic_det hA
  have huAT : IsUnit Aᵀ.det := by
    rw [Matrix.det_transpose]
    exact huA
  calc
    Aᵀ ⬝ J l R ⬝ A = (-Aᵀ) ⬝ (J l R)⁻¹ ⬝ A := by
      rw [J_inv]
      simp
    _ = (-Aᵀ) ⬝ (A ⬝ J l R ⬝ Aᵀ)⁻¹ ⬝ A := by rw [hA]
    _ = (-Aᵀ ⬝ (Aᵀ⁻¹ ⬝ (J l R)⁻¹)) ⬝ A⁻¹ ⬝ A := by
      simp only [Matrix.mul_inv_rev, Matrix.mul_assoc, Matrix.neg_mul]
    _ = -(J l R)⁻¹ := by
      rw [mul_nonsing_inv_cancel_left _ _ huAT, nonsing_inv_mul_cancel_right _ _ huA]
    _ = J l R := by simp [J_inv]

#align symplectic_group.transpose_mem SymplecticGroup.transpose_mem

@[simp]
theorem transpose_mem_iff : Aᵀ ∈ symplecticGroup l R ↔ A ∈ symplecticGroup l R :=
  ⟨fun hA => by simpa using transpose_mem hA, transpose_mem⟩
#align symplectic_group.transpose_mem_iff SymplecticGroup.transpose_mem_iff

theorem mem_iff' : A ∈ symplecticGroup l R ↔ Aᵀ ⬝ j l R ⬝ A = j l R := by
  rw [← transpose_mem_iff, mem_iff, transpose_transpose]
#align symplectic_group.mem_iff' SymplecticGroup.mem_iff'

instance : Inv (symplecticGroup l R)
    where inv A :=
    ⟨(-j l R) ⬝ (A : Matrix (Sum l l) (Sum l l) R)ᵀ ⬝ j l R,
      mul_mem (mul_mem (neg_mem <| j_mem _ _) <| transpose_mem A.2) <| j_mem _ _⟩

theorem coe_inv (A : symplecticGroup l R) : (↑A⁻¹ : Matrix _ _ _) = (-j l R) ⬝ (↑A)ᵀ ⬝ j l R :=
  rfl
#align symplectic_group.coe_inv SymplecticGroup.coe_inv

theorem inv_left_mul_aux (hA : A ∈ symplecticGroup l R) : -j l R ⬝ Aᵀ ⬝ j l R ⬝ A = 1 :=
  calc
    -j l R ⬝ Aᵀ ⬝ j l R ⬝ A = (-j l R) ⬝ (Aᵀ ⬝ j l R ⬝ A) := by
      simp only [Matrix.mul_assoc, Matrix.neg_mul]
    _ = (-j l R) ⬝ j l R := by
      rw [mem_iff'] at hA
      rw [hA]
    _ = (-1 : R) • j l R ⬝ j l R := by simp only [Matrix.neg_mul, neg_smul, one_smul]
    _ = (-1 : R) • -1 := by rw [J_squared]
    _ = 1 := by simp only [neg_smul_neg, one_smul]

#align symplectic_group.inv_left_mul_aux SymplecticGroup.inv_left_mul_aux

theorem coe_inv' (A : symplecticGroup l R) : (↑A⁻¹ : Matrix (Sum l l) (Sum l l) R) = A⁻¹ :=
  by
  refine' (coe_inv A).trans (inv_eq_left_inv _).symm
  simp [inv_left_mul_aux, coe_inv]
#align symplectic_group.coe_inv' SymplecticGroup.coe_inv'

theorem inv_eq_symplectic_inv (A : Matrix (Sum l l) (Sum l l) R) (hA : A ∈ symplecticGroup l R) :
    A⁻¹ = (-j l R) ⬝ Aᵀ ⬝ j l R :=
  inv_eq_left_inv (by simp only [Matrix.neg_mul, inv_left_mul_aux hA])
#align symplectic_group.inv_eq_symplectic_inv SymplecticGroup.inv_eq_symplectic_inv

instance : Group (symplecticGroup l R) :=
  { SymplecticGroup.hasInv, Submonoid.toMonoid _ with
    mul_left_inv := fun A => by
      apply Subtype.ext
      simp only [Submonoid.coe_one, Submonoid.coe_mul, Matrix.neg_mul, coe_inv]
      rw [Matrix.mul_eq_mul, Matrix.neg_mul]
      exact inv_left_mul_aux A.2 }

end SymplecticGroup


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Borel (measurable) space -- the smallest σ-algebra generated by open sets

It would be nice to encode this in the topological space type class, i.e. each topological space
carries a measurable space, the Borel space. This would be similar how each uniform space carries a
topological space. The idea is to allow definitional equality for product instances.
We would like to have definitional equality for

  borel t₁ × borel t₂ = borel (t₁ × t₂)

Unfortunately, this only holds if t₁ and t₂ are second-countable topologies.
-/
import analysis.measure_theory.measurable_space analysis.real

open classical set lattice real
local attribute [instance] prop_decidable

universes u v w x y
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} {ι : Sort y} {s t u : set α}

namespace measure_theory
open measurable_space topological_space

@[instance] def borel (α : Type u) [topological_space α] : measurable_space α :=
generate_from {s : set α | is_open s}

lemma borel_eq_generate_from_of_subbasis {s : set (set α)}
  [t : topological_space α] [second_countable_topology α] (hs : t = generate_from s) :
  borel α = generate_from s :=
le_antisymm
  (generate_from_le $ assume u (hu : t.is_open u),
    begin
      rw [hs] at hu,
      induction hu,
      case generate_open.basic : u hu
      { exact generate_measurable.basic u hu },
      case generate_open.univ
      { exact @is_measurable_univ α (generate_from s) },
      case generate_open.inter : s₁ s₂ _ _ hs₁ hs₂
      { exact @is_measurable.inter α (generate_from s) _ _ hs₁ hs₂ },
      case generate_open.sUnion : f hf ih {
        rcases is_open_sUnion_countable _ f (by rwa hs) with ⟨v, hv, vf, vu⟩,
        rw ← vu,
        exact @is_measurable.sUnion α (generate_from s) _ hv
          (λ x xv, ih _ (vf xv)) }
    end)
  (generate_from_le $ assume u hu, generate_measurable.basic _ $
    show t.is_open u, by rw [hs]; exact generate_open.basic _ hu)

lemma borel_comap {f : α → β} {t : topological_space β} :
  @borel α (t.induced f) = (@borel β t).comap f :=
calc @borel α (t.induced f) =
    measurable_space.generate_from (preimage f '' {s | is_open s }) :
      congr_arg measurable_space.generate_from $ set.ext $ assume s : set α,
      show (t.induced f).is_open s ↔ s ∈ preimage f '' {s | is_open s},
        by simp [topological_space.induced, set.image, eq_comm]; refl
  ... = (@borel β t).comap f : comap_generate_from.symm

section
variables [topological_space α]

lemma is_measurable_of_is_open : is_open s → is_measurable s := generate_measurable.basic s

lemma is_measurable_interior : is_measurable (interior s) :=
is_measurable_of_is_open is_open_interior

lemma is_measurable_of_is_closed (h : is_closed s) : is_measurable s :=
is_measurable.compl_iff.1 $ is_measurable_of_is_open h

lemma is_measurable_closure : is_measurable (closure s) :=
is_measurable_of_is_closed is_closed_closure

lemma measurable_of_continuous [topological_space β] {f : α → β} (h : continuous f) : measurable f :=
measurable_generate_from $ assume t ht, is_measurable_of_is_open $ h t ht

lemma borel_prod_le [topological_space β] :
  prod.measurable_space ≤ borel (α × β) :=
sup_le
  (comap_le_iff_le_map.mpr $ measurable_of_continuous continuous_fst)
  (comap_le_iff_le_map.mpr $ measurable_of_continuous continuous_snd)

lemma borel_prod [second_countable_topology α] [topological_space β] [second_countable_topology β] :
  prod.measurable_space = borel (α × β) :=
let ⟨a, ha₁, ha₂, ha₃, ha₄, ha₅⟩ := @is_open_generated_countable_inter α _ _ in
let ⟨b, hb₁, hb₂, hb₃, hb₄, hb₅⟩ := @is_open_generated_countable_inter β _ _ in
le_antisymm borel_prod_le begin
    have : prod.topological_space = generate_from {g | ∃u∈a, ∃v∈b, g = set.prod u v},
    { rw [ha₅, hb₅], exact prod_generate_from_generate_from_eq ha₄ hb₄ },
    rw [borel_eq_generate_from_of_subbasis this],
    exact generate_from_le (assume p ⟨u, hu, v, hv, eq⟩,
      have hu : is_open u, by rw [ha₅]; exact generate_open.basic _ hu,
      have hv : is_open v, by rw [hb₅]; exact generate_open.basic _ hv,
      eq.symm ▸ is_measurable_set_prod (is_measurable_of_is_open hu) (is_measurable_of_is_open hv))
end

lemma measurable_of_continuous2
  [topological_space α] [second_countable_topology α]
  [topological_space β] [second_countable_topology β]
  [topological_space γ] [measurable_space δ] {f : δ → α} {g : δ → β} {c : α → β → γ}
  (h : continuous (λp:α×β, c p.1 p.2)) (hf : measurable f) (hg : measurable g) :
  measurable (λa, c (f a) (g a)) :=
show measurable ((λp:α×β, c p.1 p.2) ∘ (λa, (f a, g a))),
begin
  apply measurable.comp,
  { rw ← borel_prod,
    exact measurable_prod_mk hf hg },
  { exact measurable_of_continuous h }
end

lemma measurable_add
  [add_monoid α] [topological_add_monoid α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a + g a) :=
measurable_of_continuous2 continuous_add'

lemma measurable_neg
  [add_group α] [topological_add_group α] [measurable_space β] {f : β → α}
  (hf : measurable f) : measurable (λa, - f a) :=
hf.comp (measurable_of_continuous continuous_neg')

lemma measurable_sub
  [add_group α] [topological_add_group α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a - g a) :=
measurable_of_continuous2 continuous_sub'

lemma measurable_mul
  [monoid α] [topological_monoid α] [second_countable_topology α] [measurable_space β]
  {f : β → α} {g : β → α} : measurable f → measurable g → measurable (λa, f a * g a) :=
measurable_of_continuous2 continuous_mul'

section ordered_topology
variables [linear_order α] [topological_space α] [ordered_topology α] {a b c : α}

lemma is_measurable_Ioo : is_measurable (Ioo a b) := is_measurable_of_is_open is_open_Ioo

lemma is_measurable_Iio : is_measurable (Iio a) := is_measurable_of_is_open is_open_Iio

lemma is_measurable_Ico : is_measurable (Ico a b) :=
(is_measurable_of_is_closed $ is_closed_le continuous_const continuous_id).inter
  is_measurable_Iio

end ordered_topology

end

end measure_theory

namespace real
open measure_theory measurable_space

lemma borel_eq_generate_from_Ioo_rat :
  borel ℝ = generate_from (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
borel_eq_generate_from_of_subbasis is_topological_basis_Ioo_rat.2.2

lemma borel_eq_generate_from_Iio_rat :
  borel ℝ = generate_from (⋃a:ℚ, {Iio a}) :=
begin
  let g, swap,
  apply le_antisymm (_ : _ ≤ g) (measurable_space.generate_from_le (λ t, _)),
  { rw borel_eq_generate_from_Ioo_rat,
    refine generate_from_le (λ t, _),
    simp only [mem_Union], rintro ⟨a, b, h, rfl|⟨⟨⟩⟩⟩,
    rw (set.ext (λ x, _) : Ioo (a:ℝ) b = (⋃c>a, - Iio c) ∩ Iio b),
    { have hg : ∀q:ℚ, g.is_measurable (Iio q) :=
        λ q, generate_measurable.basic _ (by simp; exact ⟨_, rfl⟩),
      refine @is_measurable.inter _ g _ _ _ (hg _),
      refine @is_measurable.bUnion _ _ g _ _ (countable_encodable _) (λ c h, _),
      exact @is_measurable.compl _ _ g (hg _) },
    { simp [Ioo, Iio],
      refine and_congr _ iff.rfl,
      exact ⟨λ h,
        let ⟨c, ac, cx⟩ := exists_rat_btwn h in
        ⟨c, rat.cast_lt.1 ac, le_of_lt cx⟩,
       λ ⟨c, ac, cx⟩, lt_of_lt_of_le (rat.cast_lt.2 ac) cx⟩ } },
  { simp, rintro r rfl,
    exact is_measurable_of_is_open (is_open_gt' _) }
end

end real


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en los retículos se verifica que
--     (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z)
-- ----------------------------------------------------------------------

import order.lattice

variables {α : Type*} [lattice α]
variables x y z : α

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

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
begin
  have h1 : (x ⊓ y) ⊓ z ≤ x ⊓ (y ⊓ z),
    { have h1a : (x ⊓ y) ⊓ z ≤ x, calc
        (x ⊓ y) ⊓ z ≤ x ⊓ y : by exact inf_le_left
                ... ≤ x     : by exact inf_le_left,
      have h1b : (x ⊓ y) ⊓ z ≤ y ⊓ z,
        { have h1b1 : (x ⊓ y) ⊓ z ≤ y, calc
            (x ⊓ y) ⊓ z ≤ x ⊓ y : by exact inf_le_left
                    ... ≤ y     : by exact inf_le_right,
          have h1b2 : (x ⊓ y) ⊓ z ≤ z,
            by exact inf_le_right,
          show (x ⊓ y) ⊓ z ≤ y ⊓ z,
            by exact le_inf h1b1 h1b2, },
      show (x ⊓ y) ⊓ z ≤ x ⊓ (y ⊓ z),
        by exact le_inf h1a h1b, },
  have h2 : x ⊓ (y ⊓ z) ≤ (x ⊓ y) ⊓ z,
    { have h2a : x ⊓ (y ⊓ z) ≤ x ⊓ y,
        { have h2a1 : x ⊓ (y ⊓ z) ≤ x,
            by exact inf_le_left,
          have h2a2 : x ⊓ (y ⊓ z) ≤ y, calc
            x ⊓ (y ⊓ z) ≤ y ⊓ z : by exact inf_le_right
                    ... ≤ y     : by exact inf_le_left,
          show x ⊓ (y ⊓ z) ≤ x ⊓ y,
            by exact le_inf h2a1 h2a2, },
      have h2b : x ⊓ (y ⊓ z) ≤ z, calc
        x ⊓ (y ⊓ z) ≤ y ⊓ z : by exact inf_le_right
                ... ≤ z     : by exact inf_le_right,
      show x ⊓ (y ⊓ z) ≤ (x ⊓ y) ⊓ z,
        by exact le_inf h2a h2b, },
  show (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z),
    by exact le_antisymm h1 h2,
end

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

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
begin
  apply le_antisymm,
  { apply le_inf,
    { apply inf_le_of_left_le inf_le_left, },
    { apply le_inf (inf_le_of_left_le inf_le_right) inf_le_right}},
  {apply le_inf,
    { apply le_inf inf_le_left (inf_le_of_right_le inf_le_left), },
    { apply inf_le_of_right_le inf_le_right, },},
end

-- Su desarrollo es
--
-- ⊢ x ⊓ y ⊓ z = x ⊓ (y ⊓ z)
--    apply le_antisymm,
-- ⊢ x ⊓ y ⊓ z ≤ x ⊓ (y ⊓ z)
-- |   { apply le_inf,
-- | ⊢ x ⊓ y ⊓ z ≤ x
-- | |     { apply inf_le_left_of_le inf_le_left },
-- | ⊢ x ⊓ y ⊓ z ≤ y ⊓ z
-- | |     { apply le_inf (inf_le_left_of_le inf_le_right) inf_le_right}},
-- ⊢ x ⊓ (y ⊓ z) ≤ x ⊓ y ⊓ z
-- |   {apply le_inf,
-- | ⊢ x ⊓ (y ⊓ z) ≤ x ⊓ y
-- | |     { apply le_inf inf_le_left (inf_le_right_of_le inf_le_left)},
-- | ⊢ x ⊓ (y ⊓ z) ≤ z
--      { apply inf_le_right_of_le inf_le_right, },},
-- no goals

-- 3ª demostración
-- ===============

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
le_antisymm
  (le_inf
    (inf_le_of_left_le inf_le_left)
    (le_inf (inf_le_of_left_le inf_le_right) inf_le_right))
  (le_inf
    (le_inf inf_le_left (inf_le_of_right_le inf_le_left))
    (inf_le_of_right_le inf_le_right))

-- 4ª demostración
-- ===============

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
-- by library_search
inf_assoc

-- 5ª demostración
-- ===============

example : (x ⊓ y) ⊓ z = x ⊓ (y ⊓ z) :=
-- by hint
by finish


import tactic

-- Use the definition of an irreducible element.
def prime (n: ℕ) : Prop := 1 ≠ n ∧ ∀ a b, a * b = n → a = 1 ∨ b = 1
def composite (n : ℕ) : Prop := ¬ prime n

-- 3.1 Products of primes

def constructive_composite (n: ℕ) : Prop :=
  2 ≤ n → ∃ a b,
    a * b = n ∧
    a < n ∧ b < n ∧
    2 ≤ a ∧ 2 ≤ b

lemma constructive_composite_of_composite {n: ℕ} (hcomp: composite n)
  : constructive_composite n :=
begin
  intro two_le_n,
  unfold composite prime at hcomp,
  push_neg at hcomp,
  obtain ⟨a, b, ⟨prod, a_ne_1, b_ne_1⟩⟩ := hcomp (by linarith),
  have h₁ : 2 ≤ a,
  { cases a,
    { linarith },
    { cases a,
      { exfalso, exact a_ne_1 rfl },
      { refine nat.succ_le_succ _,
        refine nat.succ_le_succ _,
        linarith, } } },
  have h₂ : 2 ≤ b,
  { cases b,
    { linarith },
    { cases b,
      { exfalso, exact b_ne_1 rfl, },
      { refine nat.succ_le_succ _,
        refine nat.succ_le_succ _,
        linarith, } } },
  have a_lt_n : a < n,
  { rw ← prod,
    rw lt_mul_iff_one_lt_right; linarith },
  have b_lt_n : b < n,
  { rw ← prod,
    rw lt_mul_iff_one_lt_left; linarith },
  refine ⟨a, b, ⟨prod, a_lt_n, b_lt_n, h₁, h₂⟩⟩
end

lemma prod_primes (n: ℕ) (hn: 2 ≤ n) :
  ∃ ps: multiset ℕ,
  (∀ p ∈ ps, prime p) ∧ ps.prod = n :=
begin
  revert hn,
  refine nat.strong_induction_on n _,
  clear n,
  intros n hyp hn,
  by_cases hprime: prime n,
  { refine ⟨[n], _⟩,
    split,
    { intros p hp,
      simp at hp,
      rw hp,
      exact hprime, },
    { simp } },
  { obtain ⟨a, ⟨b, ⟨hprod, ha, hb, ha2, hb2⟩⟩⟩ :=
      (constructive_composite_of_composite hprime) hn,
    obtain ⟨ps₁, ⟨hps₁_prime, hps₁_prod⟩⟩ := hyp a ha ha2,
    obtain ⟨ps₂, ⟨hps₂_prime, hps₂_prod⟩⟩ := hyp b hb hb2,
    refine ⟨ps₁ + ps₂, _⟩,
    split,
    { intros p hp,
      simp at hp,
      cases hp,
      { exact hps₁_prime p hp },
      { exact hps₂_prime p hp } },
    { rw multiset.prod_add,
      rw hps₁_prod,
      rwa hps₂_prod } }
end

-- 3.2 Infinite primes

def primes : set ℕ := {x | prime x}

lemma zero_composite : composite 0 :=
begin
  intro h,
  have := (or_self _).1 (h.2 0 0 (by linarith)),
  exact nat.zero_ne_one this
end

lemma one_composite : composite 1 :=
begin
  intro h,
  exact h.1 rfl,
end

lemma two_prime : prime 2 :=
begin
  split,
  { simp },
  { intros a b h,
    cases a,
    { simp at h,
      contradiction, },
    cases b,
      { simp at h,
        contradiction },
    cases a,
    { left,
      refl },
    { right,
      rw nat.succ_mul at h,
      rw nat.succ_mul at h,
      rw nat.succ_eq_add_one at *,
      have : a * (b + 1) + b + b = 0 := by linarith,
      rw add_eq_zero_iff at this,
      rw this.right, } }
end

lemma two_le_prime {n: ℕ} (h: prime n) : 2 ≤ n :=
begin
  cases n,
  { exfalso,
    exact zero_composite h, },
  { cases n,
    { exfalso,
      exact one_composite h, },
    { refine nat.succ_le_succ _,
      refine nat.succ_le_succ _,
      exact zero_le _, } }
end

lemma infinite_primes : set.infinite primes :=
begin
  intro hfinite,
  obtain ⟨all_ps, h⟩ := hfinite.exists_finset,
  let P := all_ps.val.prod + 1,
  have two_le_P : 2 ≤ P,
  { refine nat.succ_le_succ _,
    rw nat.one_le_iff_ne_zero,
    by_contradiction hzero,
    rw multiset.prod_eq_zero_iff at hzero,
    have := (h 0).1 hzero,
    exact zero_composite this },
  obtain ⟨ps, all_prime, prod⟩ := prod_primes P two_le_P,
  have : ∀ p, prime p → p ∉ ps,
  { intros p,
    contrapose!,
    intro p_mem,
    exfalso,
    have := multiset.dvd_prod p_mem,
    rw prod at this,
    -- Technically we've not done division yet.
    -- This is a pretty elementary argument, however.
    have mod_eq_zero : P % p = 0,
    { rwa nat.mod_eq_zero_of_dvd },
    have : all_ps.val.prod % p = 0,
    { rw nat.mod_eq_zero_of_dvd,
      apply multiset.dvd_prod,
      exact (h p).2 (all_prime p p_mem), },
    have mod_eq_one : P % p = 1,
    { rw nat.add_mod,
      rw this,
      simp,
      obtain ⟨p₁, hp₁⟩ := nat.le.dest (two_le_prime (all_prime p p_mem)),
      rw ← hp₁,
      ring_nf },
    rw mod_eq_one at mod_eq_zero,
    exact one_ne_zero mod_eq_zero },
  have : ∃ p, p ∈ ps,
  { cases multiset.empty_or_exists_mem ps with hempty hmem,
    { exfalso,
      rw hempty at prod,
      simp at prod,
      change 2 ≤ all_ps.val.prod + 1 at two_le_P,
      rw prod at two_le_P,
      linarith },
    assumption },
  obtain ⟨p, hp⟩ := this,
  exact this p (all_prime p hp) hp,
end


/- LoVe Exercise 9: Hoare Logic -/

import .love09_hoare_logic_demo

namespace LoVe

/- Question 1: Program Verification -/

section GAUSS

/- The following WHILE program is intended to compute the Gaussian sum up to
`n`, leaving the result in `r`. -/

def GAUSS : program :=
assign "r" (λs, 0) ;;
while (λs, s "n" ≠ 0)
  (assign "r" (λs, s "r" + s "n") ;;
   assign "n" (λs, s "n" - 1))

/- The summation function: -/

def sum_upto : ℕ → ℕ
| 0       := 0
| (n + 1) := n + 1 + sum_upto n

/- 1.1. Prove the correctness of `GAUSS`, using `vcg`. The main challenge is to
figure out which invariant to use for the while loop. The invariant should
capture both the work that has been done already (the intermediate result) and
the work that remains to be done. -/

lemma GAUSS_correct (n : ℕ) :
  {* λs, s "n" = n *} GAUSS {* λs, s "r" = sum_upto n *} :=
sorry

end GAUSS

section MUL

/- The following WHILE program is intended to compute the product of `n` and
`m`, leaving the result in `r`. -/

def MUL : program :=
assign "r" (λs, 0) ;;
while (λs, s "n" ≠ 0)
  (assign "r" (λs, s "r" + s "m") ;;
   assign "n" (λs, s "n" - 1))

/- 1.2 Prove the correctness of `MUL`, using `vcg`.

Hint: If a variable `x` does not change in a program, it might be useful to
record this in the invariant, by adding a conjunct `s "x" = x`. -/

lemma MUL_correct (n m : ℕ) :
  {* λs, s "n" = n ∧ s "m" = m *} MUL {* λs, s "r" = n * m *} :=
sorry

end MUL

/- Question 2: Hoare Triples for Total Correctness -/

def total_hoare (P : state → Prop) (p : program) (Q : state → Prop) : Prop :=
∀s, P s → ∃t, (p, s) ⟹ t ∧ Q t

notation `[* ` P : 1 ` *] ` p : 1 ` [* ` Q : 1 ` *]` := total_hoare P p Q

namespace total_hoare

variables {P P' P₁ P₂ P₃ Q Q' : state → Prop} {x : string}
variables {S S₀ S₁ S₂ : program}
variables {b : state → Prop} {a : state → ℕ} {s s₀ s₁ s₂ t u : state}

/- 2.1. Prove the consequence rule. -/

lemma consequence (h : [* P *] S [* Q *]) (hp : ∀s, P' s → P s)
    (hq : ∀s, Q s → Q' s) :
  [* P' *] S [* Q' *] :=
sorry

/- 2.2. Prove the rule for `skip`. -/

lemma skip_intro :
  [* P *] skip [* P *] :=
sorry

/- 2.3. Prove the rule for `assign`. -/

lemma assign_intro (P : state → Prop) :
  [* λs, P (s{x ↦ a s}) *] assign x a [* P *] :=
sorry

/- 2.4. Prove the rule for `seq`. -/

lemma seq_intro (h₁ : [* P₁ *] S₁ [* P₂ *])
    (h₂ : [* P₂ *] S₂ [* P₃ *]) :
  [* P₁ *] S₁ ;; S₂ [* P₃ *] :=
sorry

/- 2.5 **optional**. Prove the rule for `ite`. This requires `b s ∨ ¬ b s`.
`classical.em (b s)` provides a proof, even when `b` is not decidable. -/

lemma ite_intro (h₁ : [* λs, P s ∧ b s *] S₁ [* Q *])
  (h₂ : [* λs, P s ∧ ¬ b s *] S₂ [* Q *]) :
  [* P *] ite b S₁ S₂ [* Q *] :=
sorry

/- 2.6 **optional**. Try to prove the rule for `while`.

Before we prove our final goal, we introduce an auxiliary proof. This proof
requires well-founded induction. When using `while_intro.aux` as induction
hypothesis we recommend to do it directly after proving that the argument is
less than `n`:

    have ih : ∃u, (while c p, t) ⟹ u ∧ I u ∧ ¬ c u :=
      have M < n := …,
        -- necessary for Lean to figure out the well-founded induction
      while_intro.aux M …,

Similar to `ite`, this requires `c s ∨ ¬ c s`. `classical.em (c s)` provides a
proof. -/

lemma while_intro.aux
  (I : state → Prop)
  (V : state → ℕ)
  (h_inv : ∀n, [* λs, I s ∧ b s ∧ V s = n *] S [* λs, I s ∧ V s < n *]) :
  ∀n s, V s = n → I s → ∃t, (while b S, s) ⟹ t ∧ I t ∧ ¬ b t
| n s V_eq hs :=
sorry

lemma while_intro
  (I : state → Prop)   -- invariant in the loop
  (V : state → ℕ)      -- variant in the loop body (a.k.a. termination measure)
  (h_inv : ∀n, [* λs, I s ∧ b s ∧ V s = n *] S [* λs, I s ∧ V s < n *]) :
  [* I *] while b S [* λs, I s ∧ ¬ b s *] :=
sorry

end total_hoare

end LoVe


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.zmod.defs
import set_theory.cardinal.basic

/-!
# Finite Cardinality Functions

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

## Main Definitions

* `nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `nat.card α = 0`.
* `part_enat.card α` is the cardinality of `α` as an extended natural number
  (`part ℕ` implementation). If `α` is infinite, `part_enat.card α = ⊤`.
-/

open cardinal
noncomputable theory
open_locale big_operators

variables {α β : Type*}

namespace nat

/-- `nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `nat.card α = 0`. -/
protected def card (α : Type*) : ℕ := (mk α).to_nat

@[simp]
lemma card_eq_fintype_card [fintype α] : nat.card α = fintype.card α := mk_to_nat_eq_card

@[simp]
lemma card_eq_zero_of_infinite [infinite α] : nat.card α = 0 := mk_to_nat_of_infinite

lemma finite_of_card_ne_zero (h : nat.card α ≠ 0) : finite α :=
not_infinite_iff_finite.mp $ h ∘ @nat.card_eq_zero_of_infinite α

lemma card_congr (f : α ≃ β) : nat.card α = nat.card β :=
cardinal.to_nat_congr f

lemma card_eq_of_bijective (f : α → β) (hf : function.bijective f) : nat.card α = nat.card β :=
card_congr (equiv.of_bijective f hf)

lemma card_eq_of_equiv_fin {α : Type*} {n : ℕ}
  (f : α ≃ fin n) : nat.card α = n :=
by simpa using card_congr f

/-- If the cardinality is positive, that means it is a finite type, so there is
an equivalence between `α` and `fin (nat.card α)`. See also `finite.equiv_fin`. -/
def equiv_fin_of_card_pos {α : Type*} (h : nat.card α ≠ 0) :
  α ≃ fin (nat.card α) :=
begin
  casesI fintype_or_infinite α,
  { simpa using fintype.equiv_fin α },
  { simpa using h },
end

lemma card_of_subsingleton (a : α) [subsingleton α] : nat.card α = 1 :=
begin
  letI := fintype.of_subsingleton a,
  rw [card_eq_fintype_card, fintype.card_of_subsingleton a]
end

@[simp] lemma card_unique [unique α] : nat.card α = 1 :=
card_of_subsingleton default

lemma card_eq_one_iff_unique : nat.card α = 1 ↔ subsingleton α ∧ nonempty α :=
cardinal.to_nat_eq_one_iff_unique

lemma card_eq_two_iff : nat.card α = 2 ↔ ∃ x y : α, x ≠ y ∧ {x, y} = @set.univ α :=
(to_nat_eq_iff two_ne_zero).trans $ iff.trans (by rw [nat.cast_two]) mk_eq_two_iff

lemma card_eq_two_iff' (x : α) : nat.card α = 2 ↔ ∃! y, y ≠ x :=
(to_nat_eq_iff two_ne_zero).trans $ iff.trans (by rw [nat.cast_two]) (mk_eq_two_iff' x)

theorem card_of_is_empty [is_empty α] : nat.card α = 0 := by simp

@[simp] lemma card_prod (α β : Type*) : nat.card (α × β) = nat.card α * nat.card β :=
by simp only [nat.card, mk_prod, to_nat_mul, to_nat_lift]

@[simp] lemma card_ulift (α : Type*) : nat.card (ulift α) = nat.card α :=
card_congr equiv.ulift

@[simp] lemma card_plift (α : Type*) : nat.card (plift α) = nat.card α :=
card_congr equiv.plift

lemma card_pi {β : α → Type*} [fintype α] : nat.card (Π a, β a) = ∏ a, nat.card (β a) :=
by simp_rw [nat.card, mk_pi, prod_eq_of_fintype, to_nat_lift, to_nat_finset_prod]

lemma card_fun [finite α] : nat.card (α → β) = nat.card β ^ nat.card α :=
begin
  haveI := fintype.of_finite α,
  rw [nat.card_pi, finset.prod_const, finset.card_univ, ←nat.card_eq_fintype_card],
end

@[simp] lemma card_zmod (n : ℕ) : nat.card (zmod n) = n :=
begin
  cases n,
  { exact nat.card_eq_zero_of_infinite },
  { rw [nat.card_eq_fintype_card, zmod.card] },
end

end nat

namespace part_enat

/-- `part_enat.card α` is the cardinality of `α` as an extended natural number.
  If `α` is infinite, `part_enat.card α = ⊤`. -/
def card (α : Type*) : part_enat := (mk α).to_part_enat

@[simp]
lemma card_eq_coe_fintype_card [fintype α] : card α = fintype.card α := mk_to_part_enat_eq_coe_card

@[simp]
lemma card_eq_top_of_infinite [infinite α] : card α = ⊤ := mk_to_part_enat_of_infinite

end part_enat


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

-/
import data.nat.sqrt
import data.nat.gcd
import algebra.group_power
import tactic.wlog
import tactic.norm_num

/-!
# Prime numbers

This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisors are `p` and `1`.

## Important declarations

All the following declarations exist in the namespace `nat`.

- `prime`: the predicate that expresses that a natural number `p` is prime
- `primes`: the subtype of natural numbers that are prime
- `min_fac n`: the minimal prime factor of a natural number `n ≠ 1`
- `exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers
- `factors n`: the prime factorization of `n`
- `factors_unique`: uniqueness of the prime factorisation

-/

open bool subtype
open_locale nat

namespace nat

/-- `prime p` means that `p` is a prime number, that is, a natural number
  at least 2 whose only divisors are `p` and `1`. -/
@[pp_nodot]
def prime (p : ℕ) := 2 ≤ p ∧ ∀ m ∣ p, m = 1 ∨ m = p

theorem prime.two_le {p : ℕ} : prime p → 2 ≤ p := and.left

theorem prime.one_lt {p : ℕ} : prime p → 1 < p := prime.two_le

instance prime.one_lt' (p : ℕ) [hp : _root_.fact p.prime] : _root_.fact (1 < p) := ⟨hp.1.one_lt⟩

lemma prime.ne_one {p : ℕ} (hp : p.prime) : p ≠ 1 :=
ne.symm $ ne_of_lt hp.one_lt

theorem prime_def_lt {p : ℕ} : prime p ↔ 2 ≤ p ∧ ∀ m < p, m ∣ p → m = 1 :=
and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h l d, (h d).resolve_right (ne_of_lt l),
 λ h d, (decidable.lt_or_eq_of_le $
   le_of_dvd (le_of_succ_le p2) d).imp_left (λ l, h l d)⟩

theorem prime_def_lt' {p : ℕ} : prime p ↔ 2 ≤ p ∧ ∀ m, 2 ≤ m → m < p → ¬ m ∣ p :=
prime_def_lt.trans $ and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h m2 l d, not_lt_of_ge m2 ((h l d).symm ▸ dec_trivial),
λ h l d, begin
  rcases m with _|_|m,
  { rw eq_zero_of_zero_dvd d at p2, revert p2, exact dec_trivial },
  { refl },
  { exact (h dec_trivial l).elim d }
end⟩

theorem prime_def_le_sqrt {p : ℕ} : prime p ↔ 2 ≤ p ∧
  ∀ m, 2 ≤ m → m ≤ sqrt p → ¬ m ∣ p :=
prime_def_lt'.trans $ and_congr_right $ λ p2,
⟨λ a m m2 l, a m m2 $ lt_of_le_of_lt l $ sqrt_lt_self p2,
 λ a, have ∀ {m k}, m ≤ k → 1 < m → p ≠ m * k, from
  λ m k mk m1 e, a m m1
    (le_sqrt.2 (e.symm ▸ mul_le_mul_left m mk)) ⟨k, e⟩,
  λ m m2 l ⟨k, e⟩, begin
    cases (le_total m k) with mk km,
    { exact this mk m2 e },
    { rw [mul_comm] at e,
      refine this km (lt_of_mul_lt_mul_right _ (zero_le m)) e,
      rwa [one_mul, ← e] }
  end⟩

section

/--
  This instance is slower than the instance `decidable_prime` defined below,
  but has the advantage that it works in the kernel for small values.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
local attribute [instance]
def decidable_prime_1 (p : ℕ) : decidable (prime p) :=
decidable_of_iff' _ prime_def_lt'

lemma prime.ne_zero {n : ℕ} (h : prime n) : n ≠ 0 :=
by { rintro rfl, revert h, dec_trivial }

theorem prime.pos {p : ℕ} (pp : prime p) : 0 < p :=
lt_of_succ_lt pp.one_lt

theorem not_prime_zero : ¬ prime 0 := by simp [prime]

theorem not_prime_one : ¬ prime 1 := by simp [prime]

theorem prime_two : prime 2 := dec_trivial

end

theorem prime.pred_pos {p : ℕ} (pp : prime p) : 0 < pred p :=
lt_pred_iff.2 pp.one_lt

theorem succ_pred_prime {p : ℕ} (pp : prime p) : succ (pred p) = p :=
succ_pred_eq_of_pos pp.pos

theorem dvd_prime {p m : ℕ} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p :=
⟨λ d, pp.2 m d, λ h, h.elim (λ e, e.symm ▸ one_dvd _) (λ e, e.symm ▸ dvd_refl _)⟩

theorem dvd_prime_two_le {p m : ℕ} (pp : prime p) (H : 2 ≤ m) : m ∣ p ↔ m = p :=
(dvd_prime pp).trans $ or_iff_right_of_imp $ not.elim $ ne_of_gt H

theorem prime_dvd_prime_iff_eq {p q : ℕ} (pp : p.prime) (qp : q.prime) : p ∣ q ↔ p = q :=
dvd_prime_two_le qp (prime.two_le pp)

theorem prime.not_dvd_one {p : ℕ} (pp : prime p) : ¬ p ∣ 1
| d := (not_le_of_gt pp.one_lt) $ le_of_dvd dec_trivial d

theorem not_prime_mul {a b : ℕ} (a1 : 1 < a) (b1 : 1 < b) : ¬ prime (a * b) :=
λ h, ne_of_lt (nat.mul_lt_mul_of_pos_left b1 (lt_of_succ_lt a1)) $
by simpa using (dvd_prime_two_le h a1).1 (dvd_mul_right _ _)

lemma not_prime_mul' {a b n : ℕ} (h : a * b = n) (h₁ : 1 < a) (h₂ : 1 < b) : ¬ prime n :=
by { rw ← h, exact not_prime_mul h₁ h₂ }

section min_fac
  private lemma min_fac_lemma (n k : ℕ) (h : ¬ n < k * k) :
    sqrt n - k < sqrt n + 2 - k :=
  (nat.sub_lt_sub_right_iff $ le_sqrt.2 $ le_of_not_gt h).2 $
  nat.lt_add_of_pos_right dec_trivial

  /-- If `n < k * k`, then `min_fac_aux n k = n`, if `k | n`, then `min_fac_aux n k = k`.
    Otherwise, `min_fac_aux n k = min_fac_aux n (k+2)` using well-founded recursion.
    If `n` is odd and `1 < n`, then then `min_fac_aux n 3` is the smallest prime factor of `n`. -/
  def min_fac_aux (n : ℕ) : ℕ → ℕ | k :=
  if h : n < k * k then n else
  if k ∣ n then k else
  have _, from min_fac_lemma n k h,
  min_fac_aux (k + 2)
  using_well_founded {rel_tac :=
    λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

  /-- Returns the smallest prime factor of `n ≠ 1`. -/
  def min_fac : ℕ → ℕ
  | 0 := 2
  | 1 := 1
  | (n+2) := if 2 ∣ n then 2 else min_fac_aux (n + 2) 3

  @[simp] theorem min_fac_zero : min_fac 0 = 2 := rfl
  @[simp] theorem min_fac_one : min_fac 1 = 1 := rfl

  theorem min_fac_eq : ∀ n, min_fac n = if 2 ∣ n then 2 else min_fac_aux n 3
  | 0     := by simp
  | 1     := by simp [show 2≠1, from dec_trivial]; rw min_fac_aux; refl
  | (n+2) :=
    have 2 ∣ n + 2 ↔ 2 ∣ n, from
      (nat.dvd_add_iff_left (by refl)).symm,
    by simp [min_fac, this]; congr

  private def min_fac_prop (n k : ℕ) :=
    2 ≤ k ∧ k ∣ n ∧ ∀ m, 2 ≤ m → m ∣ n → k ≤ m

  theorem min_fac_aux_has_prop {n : ℕ} (n2 : 2 ≤ n) (nd2 : ¬ 2 ∣ n) :
    ∀ k i, k = 2*i+3 → (∀ m, 2 ≤ m → m ∣ n → k ≤ m) → min_fac_prop n (min_fac_aux n k)
  | k := λ i e a, begin
    rw min_fac_aux,
    by_cases h : n < k*k; simp [h],
    { have pp : prime n :=
        prime_def_le_sqrt.2 ⟨n2, λ m m2 l d,
          not_lt_of_ge l $ lt_of_lt_of_le (sqrt_lt.2 h) (a m m2 d)⟩,
      from ⟨n2, dvd_refl _, λ m m2 d, le_of_eq
        ((dvd_prime_two_le pp m2).1 d).symm⟩ },
    have k2 : 2 ≤ k, { subst e, exact dec_trivial },
    by_cases dk : k ∣ n; simp [dk],
    { exact ⟨k2, dk, a⟩ },
    { refine have _, from min_fac_lemma n k h,
        min_fac_aux_has_prop (k+2) (i+1)
          (by simp [e, left_distrib]) (λ m m2 d, _),
      cases nat.eq_or_lt_of_le (a m m2 d) with me ml,
      { subst me, contradiction },
      apply (nat.eq_or_lt_of_le ml).resolve_left, intro me,
      rw [← me, e] at d, change 2 * (i + 2) ∣ n at d,
      have := dvd_of_mul_right_dvd d, contradiction }
  end
  using_well_founded {rel_tac :=
    λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

  theorem min_fac_has_prop {n : ℕ} (n1 : n ≠ 1) :
    min_fac_prop n (min_fac n) :=
  begin
    by_cases n0 : n = 0, {simp [n0, min_fac_prop, ge]},
    have n2 : 2 ≤ n, { revert n0 n1, rcases n with _|_|_; exact dec_trivial },
    simp [min_fac_eq],
    by_cases d2 : 2 ∣ n; simp [d2],
    { exact ⟨le_refl _, d2, λ k k2 d, k2⟩ },
    { refine min_fac_aux_has_prop n2 d2 3 0 rfl
        (λ m m2 d, (nat.eq_or_lt_of_le m2).resolve_left (mt _ d2)),
      exact λ e, e.symm ▸ d }
  end

  theorem min_fac_dvd (n : ℕ) : min_fac n ∣ n :=
  if n1 : n = 1 then by simp [n1] else (min_fac_has_prop n1).2.1

  theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) :=
  let ⟨f2, fd, a⟩ := min_fac_has_prop n1 in
  prime_def_lt'.2 ⟨f2, λ m m2 l d, not_le_of_gt l (a m m2 (dvd_trans d fd))⟩

  theorem min_fac_le_of_dvd {n : ℕ} : ∀ {m : ℕ}, 2 ≤ m → m ∣ n → min_fac n ≤ m :=
  by by_cases n1 : n = 1;
    [exact λ m m2 d, n1.symm ▸ le_trans dec_trivial m2,
     exact (min_fac_has_prop n1).2.2]

  theorem min_fac_pos (n : ℕ) : 0 < min_fac n :=
  by by_cases n1 : n = 1;
     [exact n1.symm ▸ dec_trivial, exact (min_fac_prime n1).pos]

  theorem min_fac_le {n : ℕ} (H : 0 < n) : min_fac n ≤ n :=
  le_of_dvd H (min_fac_dvd n)

  theorem prime_def_min_fac {p : ℕ} : prime p ↔ 2 ≤ p ∧ min_fac p = p :=
  ⟨λ pp, ⟨pp.two_le,
    let ⟨f2, fd, a⟩ := min_fac_has_prop $ ne_of_gt pp.one_lt in
    ((dvd_prime pp).1 fd).resolve_left (ne_of_gt f2)⟩,
   λ ⟨p2, e⟩, e ▸ min_fac_prime (ne_of_gt p2)⟩

  /--
  This instance is faster in the virtual machine than `decidable_prime_1`,
  but slower in the kernel.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
  instance decidable_prime (p : ℕ) : decidable (prime p) :=
  decidable_of_iff' _ prime_def_min_fac

  theorem not_prime_iff_min_fac_lt {n : ℕ} (n2 : 2 ≤ n) : ¬ prime n ↔ min_fac n < n :=
  (not_congr $ prime_def_min_fac.trans $ and_iff_right n2).trans $
    (lt_iff_le_and_ne.trans $ and_iff_right $ min_fac_le $ le_of_succ_le n2).symm

  lemma min_fac_le_div {n : ℕ} (pos : 0 < n) (np : ¬ prime n) : min_fac n ≤ n / min_fac n :=
  match min_fac_dvd n with
  | ⟨0, h0⟩     := absurd pos $ by rw [h0, mul_zero]; exact dec_trivial
  | ⟨1, h1⟩     :=
    begin
      rw mul_one at h1,
      rw [prime_def_min_fac, not_and_distrib, ← h1, eq_self_iff_true, not_true, or_false,
        not_le] at np,
      rw [le_antisymm (le_of_lt_succ np) (succ_le_of_lt pos), min_fac_one, nat.div_one]
    end
  | ⟨(x+2), hx⟩ :=
    begin
      conv_rhs { congr, rw hx },
      rw [nat.mul_div_cancel_left _ (min_fac_pos _)],
      exact min_fac_le_of_dvd dec_trivial ⟨min_fac n, by rwa mul_comm⟩
    end
  end

  /--
  The square of the smallest prime factor of a composite number `n` is at most `n`.
  -/
  lemma min_fac_sq_le_self {n : ℕ} (w : 0 < n) (h : ¬ prime n) : (min_fac n)^2 ≤ n :=
  have t : (min_fac n) ≤ (n/min_fac n) := min_fac_le_div w h,
  calc
  (min_fac n)^2 = (min_fac n) * (min_fac n)   : sq (min_fac n)
            ... ≤ (n/min_fac n) * (min_fac n) : mul_le_mul_right (min_fac n) t
            ... ≤ n                           : div_mul_le_self n (min_fac n)

  @[simp]
  lemma min_fac_eq_one_iff {n : ℕ} : min_fac n = 1 ↔ n = 1 :=
  begin
    split,
    { intro h,
      by_contradiction hn,
      have := min_fac_prime hn,
      rw h at this,
      exact not_prime_one this, },
    { rintro rfl, refl, }
  end

  @[simp]
  lemma min_fac_eq_two_iff (n : ℕ) : min_fac n = 2 ↔ 2 ∣ n :=
  begin
    split,
    { intro h,
      convert min_fac_dvd _,
      rw h, },
    { intro h,
      have ub := min_fac_le_of_dvd (le_refl 2) h,
      have lb := min_fac_pos n,
      -- If `interval_cases` and `norm_num` were already available here,
      -- this would be easy and pleasant.
      -- But they aren't, so it isn't.
      cases h : n.min_fac with m,
      { rw h at lb, cases lb, },
      { cases m with m,
        { simp at h, subst h, cases h with n h, cases n; cases h, },
        { cases m with m,
          { refl, },
          { rw h at ub,
            cases ub with _ ub, cases ub with _ ub, cases ub, } } } }
  end

end min_fac

theorem exists_dvd_of_not_prime {n : ℕ} (n2 : 2 ≤ n) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ m ≠ 1 ∧ m ≠ n :=
⟨min_fac n, min_fac_dvd _, ne_of_gt (min_fac_prime (ne_of_gt n2)).one_lt,
  ne_of_lt $ (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : 2 ≤ n) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ 2 ≤ m ∧ m < n :=
⟨min_fac n, min_fac_dvd _, (min_fac_prime (ne_of_gt n2)).two_le,
  (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_prime_and_dvd {n : ℕ} (n2 : 2 ≤ n) : ∃ p, prime p ∧ p ∣ n :=
⟨min_fac n, min_fac_prime (ne_of_gt n2), min_fac_dvd _⟩

/-- Euclid's theorem. There exist infinitely many prime numbers.
Here given in the form: for every `n`, there exists a prime number `p ≥ n`. -/
theorem exists_infinite_primes (n : ℕ) : ∃ p, n ≤ p ∧ prime p :=
let p := min_fac (n! + 1) in
have f1 : n! + 1 ≠ 1, from ne_of_gt $ succ_lt_succ $ factorial_pos _,
have pp : prime p, from min_fac_prime f1,
have np : n ≤ p, from le_of_not_ge $ λ h,
  have h₁ : p ∣ n!, from dvd_factorial (min_fac_pos _) h,
  have h₂ : p ∣ 1, from (nat.dvd_add_iff_right h₁).2 (min_fac_dvd _),
  pp.not_dvd_one h₂,
⟨p, np, pp⟩

lemma prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 :=
(nat.mod_two_eq_zero_or_one p).elim
  (λ h, or.inl ((hp.2 2 (dvd_of_mod_eq_zero h)).resolve_left dec_trivial).symm)
  or.inr

theorem coprime_of_dvd {m n : ℕ} (H : ∀ k, prime k → k ∣ m → ¬ k ∣ n) : coprime m n :=
begin
  cases eq_zero_or_pos (gcd m n) with g0 g1,
  { rw [eq_zero_of_gcd_eq_zero_left g0, eq_zero_of_gcd_eq_zero_right g0] at H,
    exfalso,
    exact H 2 prime_two (dvd_zero _) (dvd_zero _) },
  apply eq.symm,
  change 1 ≤ _ at g1,
  apply (lt_or_eq_of_le g1).resolve_left,
  intro g2,
  obtain ⟨p, hp, hpdvd⟩ := exists_prime_and_dvd g2,
  apply H p hp; apply dvd_trans hpdvd,
  { exact gcd_dvd_left _ _ },
  { exact gcd_dvd_right _ _ }
end

theorem coprime_of_dvd' {m n : ℕ} (H : ∀ k, prime k → k ∣ m → k ∣ n → k ∣ 1) : coprime m n :=
coprime_of_dvd $ λk kp km kn, not_le_of_gt kp.one_lt $ le_of_dvd zero_lt_one $ H k kp km kn

theorem factors_lemma {k} : (k+2) / min_fac (k+2) < k+2 :=
div_lt_self dec_trivial (min_fac_prime dec_trivial).one_lt

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → list ℕ
| 0 := []
| 1 := []
| n@(k+2) :=
  let m := min_fac n in have n / m < n := factors_lemma,
  m :: factors (n / m)

@[simp] lemma factors_zero : factors 0 = [] := by rw factors
@[simp] lemma factors_one : factors 1 = [] := by rw factors

lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p
| 0       := by simp
| 1       := by simp
| n@(k+2) := λ p h,
  let m := min_fac n in have n / m < n := factors_lemma,
  have h₁ : p = m ∨ p ∈ (factors (n / m)) :=
    (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h),
  or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial)
    prime_of_mem_factors

lemma prod_factors : ∀ {n}, 0 < n → list.prod (factors n) = n
| 0       := by simp
| 1       := by simp
| n@(k+2) := λ h,
  let m := min_fac n in have n / m < n := factors_lemma,
  show (factors n).prod = n, from
  have h₁ : 0 < n / m :=
    nat.pos_of_ne_zero $ λ h,
    have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h,
    by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this,
  by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)]

lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] :=
begin
  have : p = (p - 2) + 2 := (nat.sub_eq_iff_eq_add hp.1).mp rfl,
  rw [this, nat.factors],
  simp only [eq.symm this],
  have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2,
  split,
  { exact this, },
  { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], },
end

/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
lemma factors_add_two (n : ℕ) :
  factors (n+2) = (min_fac (n+2)) :: (factors ((n+2) / (min_fac (n+2)))) :=
by rw factors

@[simp]
lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 :=
begin
  split; intro h,
  { rcases n with (_ | _ | n),
    { exact or.inl rfl },
    { exact or.inr rfl },
    { rw factors at h, injection h }, },
  { rcases h with (rfl | rfl),
    { exact factors_zero },
    { exact factors_one }, }
end

theorem prime.coprime_iff_not_dvd {p n : ℕ} (pp : prime p) : coprime p n ↔ ¬ p ∣ n :=
⟨λ co d, pp.not_dvd_one $ co.dvd_of_dvd_mul_left (by simp [d]),
 λ nd, coprime_of_dvd $ λ m m2 mp, ((prime_dvd_prime_iff_eq m2 pp).1 mp).symm ▸ nd⟩

theorem prime.dvd_iff_not_coprime {p n : ℕ} (pp : prime p) : p ∣ n ↔ ¬ coprime p n :=
iff_not_comm.2 pp.coprime_iff_not_dvd

theorem prime.not_coprime_iff_dvd {m n : ℕ} :
  ¬ coprime m n ↔ ∃p, prime p ∧ p ∣ m ∧ p ∣ n :=
begin
  apply iff.intro,
  { intro h,
    exact ⟨min_fac (gcd m n), min_fac_prime h,
      (dvd.trans (min_fac_dvd (gcd m n)) (gcd_dvd_left m n)),
      (dvd.trans (min_fac_dvd (gcd m n)) (gcd_dvd_right m n))⟩ },
  { intro h,
    cases h with p hp,
    apply nat.not_coprime_of_dvd_of_dvd (prime.one_lt hp.1) hp.2.1 hp.2.2 }
end

theorem prime.dvd_mul {p m n : ℕ} (pp : prime p) : p ∣ m * n ↔ p ∣ m ∨ p ∣ n :=
⟨λ H, or_iff_not_imp_left.2 $ λ h,
  (pp.coprime_iff_not_dvd.2 h).dvd_of_dvd_mul_left H,
 or.rec (λ h, dvd_mul_of_dvd_left h _) (λ h, dvd_mul_of_dvd_right h _)⟩

theorem prime.not_dvd_mul {p m n : ℕ} (pp : prime p)
  (Hm : ¬ p ∣ m) (Hn : ¬ p ∣ n) : ¬ p ∣ m * n :=
mt pp.dvd_mul.1 $ by simp [Hm, Hn]

theorem prime.dvd_of_dvd_pow {p m n : ℕ} (pp : prime p) (h : p ∣ m^n) : p ∣ m :=
by induction n with n IH;
   [exact pp.not_dvd_one.elim h,
    by { rw pow_succ at h, exact (pp.dvd_mul.1 h).elim id IH } ]

lemma prime.pow_not_prime {x n : ℕ} (hn : 2 ≤ n) : ¬ (x ^ n).prime :=
λ hp, (hp.2 x $ dvd_trans ⟨x, sq _⟩ (pow_dvd_pow _ hn)).elim
  (λ hx1, hp.ne_one $ hx1.symm ▸ one_pow _)
  (λ hxn, lt_irrefl x $ calc x = x ^ 1 : (pow_one _).symm
     ... < x ^ n : nat.pow_right_strict_mono (hxn.symm ▸ hp.two_le) hn
     ... = x : hxn.symm)

lemma prime.mul_eq_prime_sq_iff {x y p : ℕ} (hp : p.prime) (hx : x ≠ 1) (hy : y ≠ 1) :
  x * y = p ^ 2 ↔ x = p ∧ y = p :=
⟨λ h, have pdvdxy : p ∣ x * y, by rw h; simp [sq],
begin
  wlog := hp.dvd_mul.1 pdvdxy using x y,
  cases case with a ha,
  have hap : a ∣ p, from ⟨y, by rwa [ha, sq,
        mul_assoc, nat.mul_right_inj hp.pos, eq_comm] at h⟩,
  exact ((nat.dvd_prime hp).1 hap).elim
    (λ _, by clear_aux_decl; simp [*, sq, nat.mul_right_inj hp.pos] at *
      {contextual := tt})
    (λ _, by clear_aux_decl; simp [*, sq, mul_comm, mul_assoc,
      nat.mul_right_inj hp.pos, nat.mul_right_eq_self_iff hp.pos] at *
      {contextual := tt})
end,
λ ⟨h₁, h₂⟩, h₁.symm ▸ h₂.symm ▸ (sq _).symm⟩

lemma prime.dvd_factorial : ∀ {n p : ℕ} (hp : prime p), p ∣ n! ↔ p ≤ n
| 0 p hp := iff_of_false hp.not_dvd_one (not_le_of_lt hp.pos)
| (n+1) p hp := begin
  rw [factorial_succ, hp.dvd_mul, prime.dvd_factorial hp],
  exact ⟨λ h, h.elim (le_of_dvd (succ_pos _)) le_succ_of_le,
    λ h, (_root_.lt_or_eq_of_le h).elim (or.inr ∘ le_of_lt_succ)
      (λ h, or.inl $ by rw h)⟩
end

theorem prime.coprime_pow_of_not_dvd {p m a : ℕ} (pp : prime p) (h : ¬ p ∣ a) : coprime a (p^m) :=
(pp.coprime_iff_not_dvd.2 h).symm.pow_right _

theorem coprime_primes {p q : ℕ} (pp : prime p) (pq : prime q) : coprime p q ↔ p ≠ q :=
pp.coprime_iff_not_dvd.trans $ not_congr $ dvd_prime_two_le pq pp.two_le

theorem coprime_pow_primes {p q : ℕ} (n m : ℕ) (pp : prime p) (pq : prime q) (h : p ≠ q) :
  coprime (p^n) (q^m) :=
((coprime_primes pp pq).2 h).pow _ _

theorem coprime_or_dvd_of_prime {p} (pp : prime p) (i : ℕ) : coprime p i ∨ p ∣ i :=
by rw [pp.dvd_iff_not_coprime]; apply em

theorem dvd_prime_pow {p : ℕ} (pp : prime p) {m i : ℕ} : i ∣ (p^m) ↔ ∃ k ≤ m, i = p^k :=
begin
  induction m with m IH generalizing i, {simp [pow_succ, le_zero_iff] at *},
  by_cases p ∣ i,
  { cases h with a e, subst e,
    rw [pow_succ, nat.mul_dvd_mul_iff_left pp.pos, IH],
    split; intro h; rcases h with ⟨k, h, e⟩,
    { exact ⟨succ k, succ_le_succ h, by rw [e, pow_succ]; refl⟩ },
    cases k with k,
    { apply pp.not_dvd_one.elim,
      simp at e, rw ← e, apply dvd_mul_right },
    { refine ⟨k, le_of_succ_le_succ h, _⟩,
      rwa [mul_comm, pow_succ', nat.mul_left_inj pp.pos] at e } },
  { split; intro d,
    { rw (pp.coprime_pow_of_not_dvd h).eq_one_of_dvd d,
      exact ⟨0, zero_le _, rfl⟩ },
    { rcases d with ⟨k, l, e⟩,
      rw e, exact pow_dvd_pow _ l } }
end

/--
If `p` is prime,
and `a` doesn't divide `p^k`, but `a` does divide `p^(k+1)`
then `a = p^(k+1)`.
-/
lemma eq_prime_pow_of_dvd_least_prime_pow
  {a p k : ℕ} (pp : prime p) (h₁ : ¬(a ∣ p^k)) (h₂ : a ∣ p^(k+1)) :
  a = p^(k+1) :=
begin
  obtain ⟨l, ⟨h, rfl⟩⟩ := (dvd_prime_pow pp).1 h₂,
  congr,
  exact le_antisymm h (not_le.1 ((not_congr (pow_dvd_pow_iff_le_right (prime.one_lt pp))).1 h₁)),
end

section
open list

lemma mem_list_primes_of_dvd_prod {p : ℕ} (hp : prime p) :
  ∀ {l : list ℕ}, (∀ p ∈ l, prime p) → p ∣ prod l → p ∈ l
| []       := λ h₁ h₂, absurd h₂ (prime.not_dvd_one hp)
| (q :: l) := λ h₁ h₂,
  have h₃ : p ∣ q * prod l := @prod_cons _ _ l q ▸ h₂,
  have hq : prime q := h₁ q (mem_cons_self _ _),
  or.cases_on ((prime.dvd_mul hp).1 h₃)
    (λ h, by rw [prime.dvd_iff_not_coprime hp, coprime_primes hp hq, ne.def, not_not] at h;
      exact h ▸ mem_cons_self _ _)
    (λ h, have hl : ∀ p ∈ l, prime p := λ p hlp, h₁ p ((mem_cons_iff _ _ _).2 (or.inr hlp)),
    (mem_cons_iff _ _ _).2 (or.inr (mem_list_primes_of_dvd_prod hl h)))

lemma mem_factors_iff_dvd {n p : ℕ} (hn : 0 < n) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
⟨λ h, prod_factors hn ▸ list.dvd_prod h,
 λ h, mem_list_primes_of_dvd_prod hp (@prime_of_mem_factors n) ((prod_factors hn).symm ▸ h)⟩

lemma mem_factors {n p} (hn : 0 < n) : p ∈ factors n ↔ prime p ∧ p ∣ n :=
⟨λ h, ⟨prime_of_mem_factors h, (mem_factors_iff_dvd hn $ prime_of_mem_factors h).mp h⟩,
 λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩

lemma perm_of_prod_eq_prod : ∀ {l₁ l₂ : list ℕ}, prod l₁ = prod l₂ →
  (∀ p ∈ l₁, prime p) → (∀ p ∈ l₂, prime p) → l₁ ~ l₂
| []        []        _  _  _  := perm.nil
| []        (a :: l)  h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil ℕ _ ▸ h₁.symm ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₃ a (mem_cons_self _ _)))
| (a :: l)  []        h₁ h₂ h₃ :=
  have ha : a ∣ 1 := @prod_nil ℕ _ ▸ h₁ ▸ (@prod_cons _ _ l a).symm ▸ dvd_mul_right _ _,
  absurd ha (prime.not_dvd_one (h₂ a (mem_cons_self _ _)))
| (a :: l₁) (b :: l₂) h hl₁ hl₂ :=
  have hl₁' : ∀ p ∈ l₁, prime p := λ p hp, hl₁ p (mem_cons_of_mem _ hp),
  have hl₂' : ∀ p ∈ (b :: l₂).erase a, prime p := λ p hp, hl₂ p (mem_of_mem_erase hp),
  have ha : a ∈ (b :: l₂) := mem_list_primes_of_dvd_prod (hl₁ a (mem_cons_self _ _)) hl₂
    (h ▸ by rw prod_cons; exact dvd_mul_right _ _),
  have hb : b :: l₂ ~ a :: (b :: l₂).erase a := perm_cons_erase ha,
  have hl : prod l₁ = prod ((b :: l₂).erase a) :=
  (nat.mul_right_inj (prime.pos (hl₁ a (mem_cons_self _ _)))).1 $
    by rwa [← prod_cons, ← prod_cons, ← hb.prod_eq],
  perm.trans ((perm_of_prod_eq_prod hl hl₁' hl₂').cons _) hb.symm

lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) :
  l ~ factors n :=
have hn : 0 < n := nat.pos_of_ne_zero $ λ h, begin
  rw h at *, clear h,
  induction l with a l hi,
  { exact absurd h₁ dec_trivial },
  { rw prod_cons at h₁,
    exact nat.mul_ne_zero (ne_of_lt (prime.pos (h₂ a (mem_cons_self _ _)))).symm
      (hi (λ p hp, h₂ p (mem_cons_of_mem _ hp))) h₁ }
end,
perm_of_prod_eq_prod (by rwa prod_factors hn) h₂ (@prime_of_mem_factors _)

end

lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m n k l : ℕ}
      (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k+l+1) ∣ m*n) :
      p ^ (k+1) ∣ m ∨ p ^ (l+1) ∣ n :=
have hpd : p^(k+l)*p ∣ m*n, by rwa pow_succ' at hpmn,
have hpd2 : p ∣ (m*n) / p ^ (k+l), from dvd_div_of_mul_dvd hpd,
have hpd3 : p ∣ (m*n) / (p^k * p^l), by simpa [pow_add] using hpd2,
have hpd4 : p ∣ (m / p^k) * (n / p^l), by simpa [nat.div_mul_div hpm hpn] using hpd3,
have hpd5 : p ∣ (m / p^k) ∨ p ∣ (n / p^l), from (prime.dvd_mul p_prime).1 hpd4,
suffices p^k*p ∣ m ∨ p^l*p ∣ n, by rwa [pow_succ', pow_succ'],
  hpd5.elim
    (assume : p ∣ m / p ^ k, or.inl $ mul_dvd_of_dvd_div hpm this)
    (assume : p ∣ n / p ^ l, or.inr $ mul_dvd_of_dvd_div hpn this)

/-- The type of prime numbers -/
def primes := {p : ℕ // p.prime}

namespace primes

instance : has_repr nat.primes := ⟨λ p, repr p.val⟩
instance inhabited_primes : inhabited primes := ⟨⟨2, prime_two⟩⟩

instance coe_nat : has_coe nat.primes ℕ := ⟨subtype.val⟩

theorem coe_nat_inj (p q : nat.primes) : (p : ℕ) = (q : ℕ) → p = q :=
λ h, subtype.eq h

end primes

instance monoid.prime_pow {α : Type*} [monoid α] : has_pow α primes := ⟨λ x p, x^p.val⟩

end nat

/-! ### Primality prover -/

namespace tactic
namespace norm_num
open norm_num

lemma is_prime_helper (n : ℕ)
  (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
nat.prime_def_min_fac.2 ⟨h₁, h₂⟩

lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 :=
by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]]

/-- A predicate representing partial progress in a proof of `min_fac`. -/
def min_fac_helper (n k : ℕ) : Prop :=
0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)

theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n :=
pos_iff_ne_zero.2 $ λ e,
by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2

lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k :=
by rw bit0_eq_two_mul; exact λ e, absurd
  ((nat.dvd_add_iff_right (by simp [bit0_eq_two_mul n])).2
    (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _)))
  (by norm_num)

lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 :=
begin
  refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩,
  refine @lt_of_le_of_ne ℕ _ _ _ (nat.min_fac_pos _) _,
  intro e,
  have := nat.min_fac_prime _,
  { rw ← e at this, exact nat.not_prime_one this },
  { exact ne_of_gt (nat.bit1_lt h) }
end

lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k')
  (np : nat.min_fac (bit1 n) ≠ bit1 k)
  (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  rw ← e,
  refine ⟨nat.succ_pos _,
    (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _)
      min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩,
  { rw add_right_comm, exact h.2 },
  { rw add_right_comm, exact np.symm }
end

lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k')
  (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  refine min_fac_helper_1 e _ h,
  intro e₁, rw ← e₁ at np,
  exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos)
end

lemma min_fac_helper_3 (n k k' c : ℕ) (e : k + 1 = k')
  (nc : bit1 n % bit1 k = c) (c0 : 0 < c)
  (h : min_fac_helper n k) : min_fac_helper n k' :=
begin
  refine min_fac_helper_1 e _ h,
  refine mt _ (ne_of_gt c0), intro e₁,
  rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁],
  apply nat.min_fac_dvd
end

lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 n % bit1 k = 0)
  (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k :=
by rw ← nat.dvd_iff_mod_eq_zero at hd; exact
le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2

lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k')
  (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n :=
begin
  refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2
    ⟨nat.bit1_lt h.n_pos, _⟩)).2,
  rw ← e at hd,
  intros m m2 hm md,
  have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm),
  rw nat.le_sqrt at this,
  exact not_le_of_lt hd this
end

/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/
meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr :=
do let e₁ := reflect d₁,
  c ← mk_instance_cache `(nat),
  (c, p₁) ← prove_lt_nat c `(1) e₁,
  let d₂ := n / d₁, let e₂ := reflect d₂,
  (c, e', p) ← prove_mul_nat c e₁ e₂,
  guard (e' =ₐ e),
  (c, p₂) ← prove_lt_nat c `(1) e₂,
  return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂]

/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`,
  returns `(c, ⊢ min_fac a1 = c)`. -/
meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) :
  instance_cache → expr → expr → tactic (instance_cache × expr × expr)
| ic b p := do
  k ← b.to_nat,
  let k1 := bit1 k,
  let b1 := `(bit1:ℕ→ℕ).mk_app [b],
  if n1 < k1*k1 then do
    (ic, e', p₁) ← prove_mul_nat ic b1 b1,
    (ic, p₂) ← prove_lt_nat ic a1 e',
    return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p])
  else let d := k1.min_fac in
  if to_bool (d < k1) then do
    let k' := k+1, let e' := reflect k',
    (ic, p₁) ← prove_succ ic b e',
    p₂ ← prove_non_prime b1 k1 d,
    prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p]
  else do
    let nc := n1 % k1,
    (ic, c, pc) ← prove_div_mod ic a1 b1 tt,
    if nc = 0 then
      return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p])
    else do
      (ic, p₀) ← prove_pos ic c,
      let k' := k+1, let e' := reflect k',
      (ic, p₁) ← prove_succ ic b e',
      prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p]

/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/
meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
match match_numeral e with
| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero))
| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one))
| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e])
| match_numeral_result.bit1 e := do
  n ← e.to_nat,
  c ← mk_instance_cache `(nat),
  (c, p) ← prove_pos c e,
  let a1 := `(bit1:ℕ→ℕ).mk_app [e],
  prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p])
| _ := failed
end

/-- Evaluates the `prime` and `min_fac` functions. -/
@[norm_num] meta def eval_prime : expr → tactic (expr × expr)
| `(nat.prime %%e) := do
  n ← e.to_nat,
  match n with
  | 0 := false_intro `(nat.not_prime_zero)
  | 1 := false_intro `(nat.not_prime_one)
  | _ := let d₁ := n.min_fac in
    if d₁ < n then prove_non_prime e n d₁ >>= false_intro
    else do
      let e₁ := reflect d₁,
      c ← mk_instance_cache `(nat),
      (c, p₁) ← prove_lt_nat c `(1) e₁,
      (c, e₁, p) ← prove_min_fac c e,
      true_intro $ `(is_prime_helper).mk_app [e, p₁, p]
  end
| `(nat.min_fac %%e) := do
  ic ← mk_instance_cache `(ℕ),
  prod.snd <$> prove_min_fac ic e
| _ := failed

end norm_num
end tactic

namespace nat

theorem prime_three : prime 3 := by norm_num

end nat


-- Union_con_la_imagen_inversa.lean
-- Unión con la imagen inversa
-- José A. Alonso Jiménez
-- Sevilla, 22 de junio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v)
-- ----------------------------------------------------------------------

import data.set.basic

open set

variables {α : Type*} {β : Type*}
variable  f : α → β
variable  s : set α
variable  v : set β

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

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  intros x hx,
  rw mem_preimage,
  cases hx with xs xv,
  { apply mem_union_left,
    apply mem_image_of_mem,
    exact xs, },
  { apply mem_union_right,
    rw ← mem_preimage,
    exact xv, },
end

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

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  intros x hx,
  cases hx with xs xv,
  { apply mem_union_left,
    apply mem_image_of_mem,
    exact xs, },
  { apply mem_union_right,
    exact xv, },
end

-- 3ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  rintros x (xs | xv),
  { left,
    exact mem_image_of_mem f xs, },
  { right,
    exact xv, },
end

-- 4ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  rintros x (xs | xv),
  { exact or.inl (mem_image_of_mem f xs), },
  { exact or.inr xv, },
end

-- 5ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  intros x h,
  exact or.elim h (λ xs, or.inl (mem_image_of_mem f xs)) or.inr,
end

-- 6ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
λ x h, or.elim h (λ xs, or.inl (mem_image_of_mem f xs)) or.inr

-- 7ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
begin
  rintros x (xs | xv),
  { show f x ∈ f '' s ∪ v,
    use [x, xs, rfl] },
  { show f x ∈ f '' s ∪ v,
    right,
    apply xv },
end

-- 8ª demostración
-- ===============

example : s ∪ f ⁻¹' v ⊆ f ⁻¹' (f '' s ∪ v) :=
union_preimage_subset s v f