/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.finset.basic
import data.multiset.nat_antidiagonal

/-!
# Antidiagonals in ℕ × ℕ as finsets

This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines files `data.list.nat_antidiagonal` and `data.multiset.nat_antidiagonal`.
-/

namespace finset
namespace nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
⟨multiset.nat.antidiagonal n, multiset.nat.nodup_antidiagonal n⟩

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_def, multiset.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n + 1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by simp [antidiagonal]

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = insert (0, n + 1) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) :=
begin
  apply eq_of_veq,
  rw [insert_val_of_not_mem, map_val],
  {apply multiset.nat.antidiagonal_succ},
  { intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩,
    simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2,
    apply nat.succ_ne_zero a h2.1, }
end

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_map, mem_antidiagonal, prod.exists],
  rw add_comm,
  split,
  { rintro ⟨b, c, ⟨rfl, rfl⟩⟩,
    simp },
  { rintro rfl,
    use [a.snd, a.fst],
    simp }
end

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
lemma antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
  (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst :=
begin
  refine ⟨congr_arg prod.fst, (λ h, prod.ext h ((add_right_inj q.fst).mp _))⟩,
  rw mem_antidiagonal at hp hq,
  rw [hq, ← h, hp],
end

lemma antidiagonal.fst_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.1 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.2,
  rwa [mem_antidiagonal, eq_comm] at hlk
end

lemma antidiagonal.snd_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.2 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.1,
  rwa [mem_antidiagonal, eq_comm, add_comm] at hlk
end

section equiv_prod

/-- The disjoint union of antidiagonals `Σ (n : ℕ), antidiagonal n` is equivalent to the product
    `ℕ × ℕ`. This is such an equivalence, obtained by mapping `(n, (k, l))` to `(k, l)`. -/
@[simps] def sigma_antidiagonal_equiv_prod : (Σ (n : ℕ), antidiagonal n) ≃ ℕ × ℕ :=
{ to_fun := λ x, x.2,
  inv_fun := λ x, ⟨x.1 + x.2, x, mem_antidiagonal.mpr rfl⟩,
  left_inv :=
    begin
      rintros ⟨n, ⟨k, l⟩, h⟩,
      rw mem_antidiagonal at h,
      exact sigma.subtype_ext h rfl,
    end,
  right_inv := λ x, rfl }

end equiv_prod

end nat

end finset


-- * Level 1
example (P Q : Prop) (p : P) (q : Q) : P ∧ Q :=

begin

split,
exact p,
exact q

end

-- * Level 2

lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P :=

begin

intro h,
cases h with p q,
split,
exact q,
exact p
end

-- * Level 3
lemma and_trans (P Q R : Prop) : P ∧ Q → Q ∧ R → P ∧ R :=

begin

intros h q,
cases h,
cases q,
split,
exact h_left,
exact q_right

end
-- * Level 4
lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=

begin
intros h g,
cases h with hpq hqp,
cases g with gpr grp,
split,
intro p,
exact gpr(hpq(p)),
intro r,
exact hqp(grp(r))
end
-- * Level 5

lemma iff_trans2 (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=

begin
intros h g,
cases h with hpq hqp,
cases g with gpr grp,
split,
intro p,
exact gpr(hpq(p)),
intro r,
exact hqp(grp(r))

end
-- * Level 6
example (P Q : Prop) : Q → (P ∨ Q) :=

begin
intro g,
right,
exact g
end

-- * Level 7

lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P :=

begin

intro h,
cases h with p q,
right,
exact p,
left,
exact q

end

-- * Level 8
lemma and_or_distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=

begin
split,
intro h,
cases h with hp hqor,
cases hqor with q r,
left,
split,
exact hp,
exact q,
right,
split,
exact hp,
exact r,

intro g,
split,
cases g with pq pr,
cases pq with p q,
exact p,
cases pr with p r,
exact p,
cases g with pq pr,
left,
cases pq with p q,
exact q,
right,
cases pr with p r,
exact r

end
-- * Level 9
import tactic.tauto

lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q :=

begin

intro h,
exfalso,
cases h with p p2,
apply p2,
exact p

end

-- * Level 10
import tactic.tauto
local attribute [instance, priority 10] classical.prop_decidable -- we are mathematicians
lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=

begin

by_cases p : P; by_cases q : Q,
repeat {cc}

end


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

/-!
# Hilbert sum of a family of inner product spaces

Given a family `(G : ι → Type*) [Π i, inner_product_space 𝕜 (G i)]` of inner product spaces, this
file equips `lp G 2` with an inner product space structure, where `lp G 2` consists of those
dependent functions `f : Π i, G i` for which `∑' i, ‖f i‖ ^ 2`, the sum of the norms-squared, is
summable.  This construction is sometimes called the *Hilbert sum* of the family `G`.  By choosing
`G` to be `ι → 𝕜`, the Hilbert space `ℓ²(ι, 𝕜)` may be seen as a special case of this construction.

We also define a *predicate* `is_hilbert_sum 𝕜 G V`, where `V : Π i, G i →ₗᵢ[𝕜] E`, expressing that
`V` is an `orthogonal_family` and that the associated map `lp G 2 →ₗᵢ[𝕜] E` is surjective.

## Main definitions

* `orthogonal_family.linear_isometry`: Given a Hilbert space `E`, a family `G` of inner product
  spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with
  mutually-orthogonal images, there is an induced isometric embedding of the Hilbert sum of `G`
  into `E`.

* `is_hilbert_sum`: Given a Hilbert space `E`, a family `G` of inner product
  spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E`,
  `is_hilbert_sum 𝕜 G V` means that `V` is an `orthogonal_family` and that the above
  linear isometry is surjective.

* `is_hilbert_sum.linear_isometry_equiv`: If a Hilbert space `E` is a Hilbert sum of the
  inner product spaces `G i` with respect to the family `V : Π i, G i →ₗᵢ[𝕜] E`, then the
  corresponding `orthogonal_family.linear_isometry` can be upgraded to a `linear_isometry_equiv`.

* `hilbert_basis`: We define a *Hilbert basis* of a Hilbert space `E` to be a structure whose single
  field `hilbert_basis.repr` is an isometric isomorphism of `E` with `ℓ²(ι, 𝕜)` (i.e., the Hilbert
  sum of `ι` copies of `𝕜`).  This parallels the definition of `basis`, in `linear_algebra.basis`,
  as an isomorphism of an `R`-module with `ι →₀ R`.

* `hilbert_basis.has_coe_to_fun`: More conventionally a Hilbert basis is thought of as a family
  `ι → E` of vectors in `E` satisfying certain properties (orthonormality, completeness).  We obtain
  this interpretation of a Hilbert basis `b` by defining `⇑b`, of type `ι → E`, to be the image
  under `b.repr` of `lp.single 2 i (1:𝕜)`.  This parallels the definition `basis.has_coe_to_fun` in
  `linear_algebra.basis`.

* `hilbert_basis.mk`: Make a Hilbert basis of `E` from an orthonormal family `v : ι → E` of vectors
  in `E` whose span is dense.  This parallels the definition `basis.mk` in `linear_algebra.basis`.

* `hilbert_basis.mk_of_orthogonal_eq_bot`: Make a Hilbert basis of `E` from an orthonormal family
  `v : ι → E` of vectors in `E` whose span has trivial orthogonal complement.

## Main results

* `lp.inner_product_space`: Construction of the inner product space instance on the Hilbert sum
  `lp G 2`.  Note that from the file `analysis.normed_space.lp_space`, the space `lp G 2` already
  held a normed space instance (`lp.normed_space`), and if each `G i` is a Hilbert space (i.e.,
  complete), then `lp G 2` was already known to be complete (`lp.complete_space`).  So the work
  here is to define the inner product and show it is compatible.

* `orthogonal_family.range_linear_isometry`: Given a family `G` of inner product spaces and a family
  `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with mutually-orthogonal
  images, the image of the embedding `orthogonal_family.linear_isometry` of the Hilbert sum of `G`
  into `E` is the closure of the span of the images of the `G i`.

* `hilbert_basis.repr_apply_apply`: Given a Hilbert basis `b` of `E`, the entry `b.repr x i` of
  `x`'s representation in `ℓ²(ι, 𝕜)` is the inner product `⟪b i, x⟫`.

* `hilbert_basis.has_sum_repr`: Given a Hilbert basis `b` of `E`, a vector `x` in `E` can be
  expressed as the "infinite linear combination" `∑' i, b.repr x i • b i` of the basis vectors
  `b i`, with coefficients given by the entries `b.repr x i` of `x`'s representation in `ℓ²(ι, 𝕜)`.

* `exists_hilbert_basis`: A Hilbert space admits a Hilbert basis.

## Keywords

Hilbert space, Hilbert sum, l2, Hilbert basis, unitary equivalence, isometric isomorphism
-/

open is_R_or_C submodule filter
open_locale big_operators nnreal ennreal classical complex_conjugate topology

noncomputable theory

variables {ι : Type*}
variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*}
variables [normed_add_comm_group E] [inner_product_space 𝕜 E] [cplt : complete_space E]
variables {G : ι → Type*} [Π i, normed_add_comm_group (G i)] [Π i, inner_product_space 𝕜 (G i)]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

notation `ℓ²(`ι`, `𝕜`)` := lp (λ i : ι, 𝕜) 2

/-! ### Inner product space structure on `lp G 2` -/

namespace lp

lemma summable_inner (f g : lp G 2) : summable (λ i, ⟪f i, g i⟫) :=
begin
  -- Apply the Direct Comparison Test, comparing with ∑' i, ‖f i‖ * ‖g i‖ (summable by Hölder)
  refine summable_of_norm_bounded (λ i, ‖f i‖ * ‖g i‖) (lp.summable_mul _ f g) _,
  { rw real.is_conjugate_exponent_iff; norm_num },
  intros i,
  -- Then apply Cauchy-Schwarz pointwise
  exact norm_inner_le_norm _ _,
end

instance : inner_product_space 𝕜 (lp G 2) :=
{ inner := λ f g, ∑' i, ⟪f i, g i⟫,
  norm_sq_eq_inner := λ f, begin
    calc ‖f‖ ^ 2 = ‖f‖ ^ (2:ℝ≥0∞).to_real : by norm_cast
    ... = ∑' i, ‖f i‖ ^ (2:ℝ≥0∞).to_real : lp.norm_rpow_eq_tsum _ f
    ... = ∑' i, ‖f i‖ ^ 2 : by norm_cast
    ... = ∑' i, re ⟪f i, f i⟫ : by simp only [@norm_sq_eq_inner 𝕜]
    ... = re (∑' i, ⟪f i, f i⟫) : (is_R_or_C.re_clm.map_tsum _).symm
    ... = _ : by congr,
    { norm_num },
    { exact summable_inner f f },
  end,
  conj_symm := λ f g, begin
    calc conj _ = conj ∑' i, ⟪g i, f i⟫ : by congr
    ... = ∑' i, conj ⟪g i, f i⟫ : is_R_or_C.conj_cle.map_tsum
    ... = ∑' i, ⟪f i, g i⟫ : by simp only [inner_conj_symm]
    ... = _ : by congr,
  end,
  add_left := λ f₁ f₂ g, begin
    calc _ = ∑' i, ⟪(f₁ + f₂) i, g i⟫ : _
    ... = ∑' i, (⟪f₁ i, g i⟫ + ⟪f₂ i, g i⟫) :
          by simp only [inner_add_left, pi.add_apply, coe_fn_add]
    ... = (∑' i, ⟪f₁ i, g i⟫) + ∑' i, ⟪f₂ i, g i⟫ : tsum_add _ _
    ... = _ : by congr,
    { congr, },
    { exact summable_inner f₁ g },
    { exact summable_inner f₂ g }
  end,
  smul_left := λ f g c, begin
    calc _ = ∑' i, ⟪c • f i, g i⟫ : _
    ... = ∑' i, conj c * ⟪f i, g i⟫ : by simp only [inner_smul_left]
    ... = conj c * ∑' i, ⟪f i, g i⟫ : tsum_mul_left
    ... = _ : _,
    { simp only [coe_fn_smul, pi.smul_apply] },
    { congr },
  end,
  .. lp.normed_space }

lemma inner_eq_tsum (f g : lp G 2) : ⟪f, g⟫ = ∑' i, ⟪f i, g i⟫ := rfl

lemma has_sum_inner (f g : lp G 2) : has_sum (λ i, ⟪f i, g i⟫) ⟪f, g⟫ :=
(summable_inner f g).has_sum

lemma inner_single_left (i : ι) (a : G i) (f : lp G 2) : ⟪lp.single 2 i a, f⟫ = ⟪a, f i⟫ :=
begin
  refine (has_sum_inner (lp.single 2 i a) f).unique _,
  convert has_sum_ite_eq i ⟪a, f i⟫,
  ext j,
  rw lp.single_apply,
  split_ifs,
  { subst h },
  { simp }
end

lemma inner_single_right (i : ι) (a : G i) (f : lp G 2) : ⟪f, lp.single 2 i a⟫ = ⟪f i, a⟫ :=
by simpa [inner_conj_symm] using congr_arg conj (@inner_single_left _ 𝕜 _ _ _ _ i a f)

end lp

/-! ### Identification of a general Hilbert space `E` with a Hilbert sum -/

namespace orthogonal_family
variables {V : Π i, G i →ₗᵢ[𝕜] E} (hV : orthogonal_family 𝕜 G V)

include cplt hV

protected lemma summable_of_lp (f : lp G 2) : summable (λ i, V i (f i)) :=
begin
  rw hV.summable_iff_norm_sq_summable,
  convert (lp.mem_ℓp f).summable _,
  { norm_cast },
  { norm_num }
end

/-- A mutually orthogonal family of subspaces of `E` induce a linear isometry from `lp 2` of the
subspaces into `E`. -/
protected def linear_isometry : lp G 2 →ₗᵢ[𝕜] E :=
{ to_fun := λ f, ∑' i, V i (f i),
  map_add' := λ f g, by simp only [tsum_add (hV.summable_of_lp f) (hV.summable_of_lp g),
    lp.coe_fn_add, pi.add_apply, linear_isometry.map_add],
  map_smul' := λ c f, by simpa only [linear_isometry.map_smul, pi.smul_apply, lp.coe_fn_smul]
    using tsum_const_smul c (hV.summable_of_lp f),
  norm_map' := λ f, begin
    classical, -- needed for lattice instance on `finset ι`, for `filter.at_top_ne_bot`
    have H : 0 < (2:ℝ≥0∞).to_real := by norm_num,
    suffices : ‖∑' (i : ι), V i (f i)‖ ^ ((2:ℝ≥0∞).to_real) = ‖f‖ ^ ((2:ℝ≥0∞).to_real),
    { exact real.rpow_left_inj_on H.ne' (norm_nonneg _) (norm_nonneg _) this },
    refine tendsto_nhds_unique  _ (lp.has_sum_norm H f),
    convert (hV.summable_of_lp f).has_sum.norm.rpow_const (or.inr H.le),
    ext s,
    exact_mod_cast (hV.norm_sum f s).symm,
  end }

protected lemma linear_isometry_apply (f : lp G 2) :
  hV.linear_isometry f = ∑' i, V i (f i) :=
rfl

protected lemma has_sum_linear_isometry (f : lp G 2) :
  has_sum (λ i, V i (f i)) (hV.linear_isometry f) :=
(hV.summable_of_lp f).has_sum

@[simp] protected lemma linear_isometry_apply_single {i : ι} (x : G i) :
  hV.linear_isometry (lp.single 2 i x) = V i x :=
begin
  rw [hV.linear_isometry_apply, ← tsum_ite_eq i (V i x)],
  congr,
  ext j,
  rw [lp.single_apply],
  split_ifs,
  { subst h },
  { simp }
end

@[simp] protected

/-- The canonical linear isometry from the `lp 2` of a mutually orthogonal family of subspaces of
`E` into E, has range the closure of the span of the subspaces. -/
protected lemma range_linear_isometry [Π i, complete_space (G i)] :
  hV.linear_isometry.to_linear_map.range = (⨆ i, (V i).to_linear_map.range).topological_closure :=
begin
  refine le_antisymm _ _,
  { rintros x ⟨f, rfl⟩,
    refine mem_closure_of_tendsto (hV.has_sum_linear_isometry f) (eventually_of_forall _),
    intros s,
    rw set_like.mem_coe,
    refine sum_mem _,
    intros i hi,
    refine mem_supr_of_mem i _,
    exact linear_map.mem_range_self _ (f i) },
  { apply topological_closure_minimal,
    { refine supr_le _,
      rintros i x ⟨x, rfl⟩,
      use lp.single 2 i x,
      exact hV.linear_isometry_apply_single x },
    exact hV.linear_isometry.isometry.uniform_inducing.is_complete_range.is_closed }
end

end orthogonal_family

section is_hilbert_sum

variables (𝕜 G) (V : Π i, G i →ₗᵢ[𝕜] E) (F : ι → submodule 𝕜 E)
include cplt

/-- Given a family of Hilbert spaces `G : ι → Type*`, a Hilbert sum of `G` consists of a Hilbert
space `E` and an orthogonal family `V : Π i, G i →ₗᵢ[𝕜] E` such that the induced isometry
`Φ : lp G 2 → E` is surjective.

Keeping in mind that `lp G 2` is "the" external Hilbert sum of `G : ι → Type*`, this is analogous
to `direct_sum.is_internal`, except that we don't express it in terms of actual submodules. -/
@[protect_proj] structure is_hilbert_sum : Prop := of_surjective ::
(orthogonal_family : orthogonal_family 𝕜 G V)
(surjective_isometry : function.surjective (orthogonal_family.linear_isometry))

variables {𝕜 G V}

/-- If `V : Π i, G i →ₗᵢ[𝕜] E` is an orthogonal family such that the supremum of the ranges of
`V i` is dense, then `(E, V)` is a Hilbert sum of `G`. -/
lemma is_hilbert_sum.mk [Π i, complete_space $ G i]
  (hVortho : orthogonal_family 𝕜 G V)
  (hVtotal : ⊤ ≤ (⨆ i, (V i).to_linear_map.range).topological_closure) :
  is_hilbert_sum 𝕜 G V :=
{ orthogonal_family := hVortho,
  surjective_isometry :=
  begin
    rw [←linear_isometry.coe_to_linear_map],
    exact linear_map.range_eq_top.mp (eq_top_iff.mpr $
      hVtotal.trans_eq hVortho.range_linear_isometry.symm)
  end }

/-- This is `orthogonal_family.is_hilbert_sum` in the case of actual inclusions from subspaces. -/
lemma is_hilbert_sum.mk_internal [Π i, complete_space $ F i]
  (hFortho : orthogonal_family 𝕜 (λ i, F i) (λ i, (F i).subtypeₗᵢ))
  (hFtotal : ⊤ ≤ (⨆ i, (F i)).topological_closure) :
  is_hilbert_sum 𝕜 (λ i, F i) (λ i, (F i).subtypeₗᵢ) :=
is_hilbert_sum.mk hFortho (by simpa [subtypeₗᵢ_to_linear_map, range_subtype] using hFtotal)

/-- *A* Hilbert sum `(E, V)` of `G` is canonically isomorphic to *the* Hilbert sum of `G`,
i.e `lp G 2`.

Note that this goes in the opposite direction from `orthogonal_family.linear_isometry`. -/
noncomputable def is_hilbert_sum.linear_isometry_equiv (hV : is_hilbert_sum 𝕜 G V) :
  E ≃ₗᵢ[𝕜] lp G 2 :=
linear_isometry_equiv.symm $
linear_isometry_equiv.of_surjective
hV.orthogonal_family.linear_isometry hV.surjective_isometry

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`. -/
protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply
  (hV : is_hilbert_sum 𝕜 G V) (w : lp G 2) :
  hV.linear_isometry_equiv.symm w = ∑' i, V i (w i) :=
by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.linear_isometry_apply]

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`, and this
sum indeed converges. -/
protected lemma is_hilbert_sum.has_sum_linear_isometry_equiv_symm
  (hV : is_hilbert_sum 𝕜 G V) (w : lp G 2) :
  has_sum (λ i, V i (w i)) (hV.linear_isometry_equiv.symm w) :=
by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.has_sum_linear_isometry]

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, an "elementary basis vector" in `lp G 2` supported at `i : ι` is the image of the
associated element in `E`. -/
@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply_single
  (hV : is_hilbert_sum 𝕜 G V) {i : ι} (x : G i) :
  hV.linear_isometry_equiv.symm (lp.single 2 i x) = V i x :=
by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.linear_isometry_apply_single]

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply_dfinsupp_sum_single
  (hV : is_hilbert_sum 𝕜 G V) (W₀ : Π₀ (i : ι), G i) :
  hV.linear_isometry_equiv.symm (W₀.sum (lp.single 2)) = (W₀.sum (λ i, V i)) :=
by simp [is_hilbert_sum.linear_isometry_equiv,
  orthogonal_family.linear_isometry_apply_dfinsupp_sum_single]

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_apply_dfinsupp_sum_single
  (hV : is_hilbert_sum 𝕜 G V) (W₀ : Π₀ (i : ι), G i) :
  (hV.linear_isometry_equiv (W₀.sum (λ i, V i)) : Π i, G i) = W₀ :=
begin
  rw ← hV.linear_isometry_equiv_symm_apply_dfinsupp_sum_single,
  rw linear_isometry_equiv.apply_symm_apply,
  ext i,
  simp [dfinsupp.sum, lp.single_apply] {contextual := tt},
end

/-- Given a total orthonormal family `v : ι → E`, `E` is a Hilbert sum of `λ i : ι, 𝕜` relative to
the family of linear isometries `λ i, λ k, k • v i`. -/
lemma orthonormal.is_hilbert_sum {v : ι → E} (hv : orthonormal 𝕜 v)
  (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) :
  is_hilbert_sum 𝕜 (λ i : ι, 𝕜) (λ i, linear_isometry.to_span_singleton 𝕜 E (hv.1 i)) :=
is_hilbert_sum.mk hv.orthogonal_family
begin
  convert hsp,
  simp [← linear_map.span_singleton_eq_range, ← submodule.span_Union],
end

lemma submodule.is_hilbert_sum_orthogonal (K : submodule 𝕜 E) [hK : complete_space K] :
  is_hilbert_sum 𝕜 (λ b, ↥(cond b K Kᗮ)) (λ b, (cond b K Kᗮ).subtypeₗᵢ) :=
begin
  haveI : Π b, complete_space ↥(cond b K Kᗮ),
  { intro b,
    cases b;
    exact orthogonal.complete_space K <|> assumption },
  refine is_hilbert_sum.mk_internal _ K.orthogonal_family_self _,
  refine le_trans _ (submodule.le_topological_closure _),
  rw [supr_bool_eq, cond, cond],
  refine codisjoint.top_le _,
  exact submodule.is_compl_orthogonal_of_complete_space.codisjoint
end

end is_hilbert_sum

/-! ### Hilbert bases -/

section
variables (ι) (𝕜) (E)

/-- A Hilbert basis on `ι` for an inner product space `E` is an identification of `E` with the `lp`
space `ℓ²(ι, 𝕜)`. -/
structure hilbert_basis := of_repr :: (repr : E ≃ₗᵢ[𝕜] ℓ²(ι, 𝕜))

end

namespace hilbert_basis

instance {ι : Type*} : inhabited (hilbert_basis ι 𝕜 ℓ²(ι, 𝕜)) :=
⟨of_repr (linear_isometry_equiv.refl 𝕜 _)⟩

/-- `b i` is the `i`th basis vector. -/
instance : has_coe_to_fun (hilbert_basis ι 𝕜 E) (λ _, ι → E) :=
{ coe := λ b i, b.repr.symm (lp.single 2 i (1:𝕜)) }

@[simp] protected lemma repr_symm_single (b : hilbert_basis ι 𝕜 E) (i : ι) :
  b.repr.symm (lp.single 2 i (1:𝕜)) = b i :=
rfl

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

protected lemma repr_apply_apply (b : hilbert_basis ι 𝕜 E) (v : E) (i : ι) :
  b.repr v i = ⟪b i, v⟫ :=
begin
  rw [← b.repr.inner_map_map (b i) v, b.repr_self, lp.inner_single_left],
  simp,
end

@[simp] protected lemma orthonormal (b : hilbert_basis ι 𝕜 E) : orthonormal 𝕜 b :=
begin
  rw orthonormal_iff_ite,
  intros i j,
  rw [← b.repr.inner_map_map (b i) (b j), b.repr_self, b.repr_self, lp.inner_single_left,
    lp.single_apply],
  simp,
end

protected lemma has_sum_repr_symm (b : hilbert_basis ι 𝕜 E) (f : ℓ²(ι, 𝕜)) :
  has_sum (λ i, f i • b i) (b.repr.symm f) :=
begin
  suffices H : (λ (i : ι), f i • b i) =
    (λ (b_1 : ι), (b.repr.symm.to_continuous_linear_equiv) ((λ (i : ι), lp.single 2 i (f i)) b_1)),
  { rw H,
    have : has_sum (λ (i : ι), lp.single 2 i (f i)) f := lp.has_sum_single ennreal.two_ne_top f,
    exact (↑(b.repr.symm.to_continuous_linear_equiv) : ℓ²(ι, 𝕜) →L[𝕜] E).has_sum this },
  ext i,
  apply b.repr.injective,
  letI : normed_space 𝕜 ↥(lp (λ i : ι, 𝕜) 2) := by apply_instance,
  have : lp.single 2 i (f i * 1) = f i • lp.single 2 i 1 := lp.single_smul 2 i (1:𝕜) (f i),
  rw mul_one at this,
  rw [linear_isometry_equiv.map_smul, b.repr_self, ← this,
    linear_isometry_equiv.coe_to_continuous_linear_equiv],
  exact (b.repr.apply_symm_apply (lp.single 2 i (f i))).symm,
end

protected lemma has_sum_repr (b : hilbert_basis ι 𝕜 E) (x : E) :
  has_sum (λ i, b.repr x i • b i) x :=
by simpa using b.has_sum_repr_symm (b.repr x)

@[simp] protected lemma dense_span (b : hilbert_basis ι 𝕜 E) :
  (span 𝕜 (set.range b)).topological_closure = ⊤ :=
begin
  classical,
  rw eq_top_iff,
  rintros x -,
  refine mem_closure_of_tendsto (b.has_sum_repr x) (eventually_of_forall _),
  intros s,
  simp only [set_like.mem_coe],
  refine sum_mem _,
  rintros i -,
  refine smul_mem _ _ _,
  exact subset_span ⟨i, rfl⟩
end

protected lemma has_sum_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) :
  has_sum (λ i, ⟪x, b i⟫ * ⟪b i, y⟫) ⟪x, y⟫ :=
begin
  convert (b.has_sum_repr y).mapL (innerSL _ x),
  ext i,
  rw [innerSL_apply, b.repr_apply_apply, inner_smul_right, mul_comm]
end

protected lemma summable_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) :
  summable (λ i, ⟪x, b i⟫ * ⟪b i, y⟫) :=
(b.has_sum_inner_mul_inner x y).summable

protected lemma tsum_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) :
  ∑' i, ⟪x, b i⟫ * ⟪b i, y⟫ = ⟪x, y⟫ :=
(b.has_sum_inner_mul_inner x y).tsum_eq

-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with
-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022).
/-- A finite Hilbert basis is an orthonormal basis. -/
protected def to_orthonormal_basis [fintype ι] (b : hilbert_basis ι 𝕜 E) :
  orthonormal_basis ι 𝕜 E :=
orthonormal_basis.mk b.orthonormal
begin
  refine eq.ge _,
  have := (span 𝕜 (finset.univ.image b : set E)).closed_of_finite_dimensional,
  simpa only [finset.coe_image, finset.coe_univ, set.image_univ, hilbert_basis.dense_span] using
    this.submodule_topological_closure_eq.symm
end

@[simp] lemma coe_to_orthonormal_basis [fintype ι] (b : hilbert_basis ι 𝕜 E) :
  (b.to_orthonormal_basis : ι → E) = b :=
orthonormal_basis.coe_mk _ _

protected lemma has_sum_orthogonal_projection {U : submodule 𝕜 E}
  [complete_space U] (b : hilbert_basis ι 𝕜 U) (x : E) :
  has_sum (λ i, ⟪(b i : E), x⟫ • b i) (orthogonal_projection U x) :=
by simpa only [b.repr_apply_apply, inner_orthogonal_projection_eq_of_mem_left]
  using b.has_sum_repr (orthogonal_projection U x)

lemma finite_spans_dense (b : hilbert_basis ι 𝕜 E) :
  (⨆ J : finset ι, span 𝕜 (J.image b : set E)).topological_closure = ⊤ :=
eq_top_iff.mpr $ b.dense_span.ge.trans
begin
  simp_rw [← submodule.span_Union],
  exact topological_closure_mono (span_mono $ set.range_subset_iff.mpr $
    λ i, set.mem_Union_of_mem {i} $ finset.mem_coe.mpr $ finset.mem_image_of_mem _ $
    finset.mem_singleton_self i)
end

variables {v : ι → E} (hv : orthonormal 𝕜 v)
include hv cplt

/-- An orthonormal family of vectors whose span is dense in the whole module is a Hilbert basis. -/
protected def mk (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) :
  hilbert_basis ι 𝕜 E :=
hilbert_basis.of_repr $
(hv.is_hilbert_sum hsp).linear_isometry_equiv

lemma _root_.orthonormal.linear_isometry_equiv_symm_apply_single_one (h i) :
  (hv.is_hilbert_sum h).linear_isometry_equiv.symm (lp.single 2 i 1) = v i :=
by rw [is_hilbert_sum.linear_isometry_equiv_symm_apply_single,
  linear_isometry.to_span_singleton_apply, one_smul]

@[simp] protected lemma coe_mk (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) :
  ⇑(hilbert_basis.mk hv hsp) = v :=
by apply (funext $ orthonormal.linear_isometry_equiv_symm_apply_single_one hv hsp)

/-- An orthonormal family of vectors whose span has trivial orthogonal complement is a Hilbert
basis. -/
protected def mk_of_orthogonal_eq_bot (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : hilbert_basis ι 𝕜 E :=
hilbert_basis.mk hv
(by rw [← orthogonal_orthogonal_eq_closure, ← eq_top_iff, orthogonal_eq_top_iff, hsp])

@[simp] protected lemma coe_of_orthogonal_eq_bot_mk (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) :
  ⇑(hilbert_basis.mk_of_orthogonal_eq_bot hv hsp) = v :=
hilbert_basis.coe_mk hv _

omit hv

-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with
-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022).
/-- An orthonormal basis is an Hilbert basis. -/
protected def _root_.orthonormal_basis.to_hilbert_basis [fintype ι] (b : orthonormal_basis ι 𝕜 E) :
  hilbert_basis ι 𝕜 E :=
hilbert_basis.mk b.orthonormal $
by simpa only [← orthonormal_basis.coe_to_basis, b.to_basis.span_eq, eq_top_iff]
  using @subset_closure E _ _

@[simp] lemma _root_.orthonormal_basis.coe_to_hilbert_basis [fintype ι]
  (b : orthonormal_basis ι 𝕜 E) : (b.to_hilbert_basis : ι → E) = b :=
hilbert_basis.coe_mk _ _

/-- A Hilbert space admits a Hilbert basis extending a given orthonormal subset. -/
lemma _root_.orthonormal.exists_hilbert_basis_extension
  {s : set E} (hs : orthonormal 𝕜 (coe : s → E)) :
  ∃ (w : set E) (b : hilbert_basis w 𝕜 E), s ⊆ w ∧ ⇑b = (coe : w → E) :=
let ⟨w, hws, hw_ortho, hw_max⟩ := exists_maximal_orthonormal hs in
⟨ w,
  hilbert_basis.mk_of_orthogonal_eq_bot hw_ortho
    (by simpa [maximal_orthonormal_iff_orthogonal_complement_eq_bot hw_ortho] using hw_max),
  hws,
  hilbert_basis.coe_of_orthogonal_eq_bot_mk _ _ ⟩

variables (𝕜 E)

/-- A Hilbert space admits a Hilbert basis. -/
lemma _root_.exists_hilbert_basis :
  ∃ (w : set E) (b : hilbert_basis w 𝕜 E), ⇑b = (coe : w → E) :=
let ⟨w, hw, hw', hw''⟩ := (orthonormal_empty 𝕜 E).exists_hilbert_basis_extension in ⟨w, hw, hw''⟩

end hilbert_basis


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

import linear_algebra.free_module.finite.rank

/-!
# Rank of matrices

The rank of a matrix `A` is defined to be the rank of range of the linear map corresponding to `A`.
This definition does not depend on the choice of basis, see `matrix.rank_eq_finrank_range_to_lin`.

## Main declarations

* `matrix.rank`: the rank of a matrix

## TODO

* Show that `matrix.rank` is equal to the row-rank and column-rank
* Generalize away from fields

-/

open_locale matrix

namespace matrix

open finite_dimensional

variables {m n o K : Type*} [m_fin : fintype m] [fintype n] [fintype o]
variables [decidable_eq n] [decidable_eq o] [field K]
variables (A : matrix m n K)

/-- The rank of a matrix is the rank of its image. -/
noncomputable def rank : ℕ := finrank K A.to_lin'.range

@[simp] lemma rank_one : rank (1 : matrix n n K) = fintype.card n :=
by rw [rank, to_lin'_one, linear_map.range_id, finrank_top, module.free.finrank_pi]

@[simp] lemma rank_zero : rank (0 : matrix n n K) = 0 :=
by rw [rank, linear_equiv.map_zero, linear_map.range_zero, finrank_bot]

lemma rank_le_card_width : A.rank ≤ fintype.card n :=
begin
  convert le_of_add_le_left (A.to_lin'.finrank_range_add_finrank_ker).le,
  exact (module.free.finrank_pi K).symm,
end

lemma rank_le_width {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ n :=
A.rank_le_card_width.trans $ (fintype.card_fin n).le

lemma rank_mul_le (B : matrix n o K) : (A ⬝ B).rank ≤ A.rank :=
begin
  refine linear_map.finrank_le_finrank_of_injective (submodule.of_le_injective _),
  rw [to_lin'_mul],
  exact linear_map.range_comp_le_range _ _,
end

lemma rank_unit (A : (matrix n n K)ˣ) :
  (A : matrix n n K).rank = fintype.card n :=
begin
  refine le_antisymm (rank_le_card_width A) _,
  have := rank_mul_le (A : matrix n n K) (↑A⁻¹ : matrix n n K),
  rwa [← mul_eq_mul, ← units.coe_mul, mul_inv_self, units.coe_one, rank_one] at this,
end

lemma rank_of_is_unit (A : matrix n n K) (h : is_unit A) :
  A.rank = fintype.card n :=
by { obtain ⟨A, rfl⟩ := h, exact rank_unit A }

include m_fin

lemma rank_eq_finrank_range_to_lin
  {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂]
  [module K M₁] [module K M₂] (v₁ : basis m K M₁) (v₂ : basis n K M₂) :
  A.rank = finrank K (to_lin v₂ v₁ A).range :=
begin
  let e₁ := (pi.basis_fun K m).equiv v₁ (equiv.refl _),
  let e₂ := (pi.basis_fun K n).equiv v₂ (equiv.refl _),
  have range_e₂ : (e₂ : (n → K) →ₗ[K] M₂).range = ⊤,
  { rw linear_map.range_eq_top, exact e₂.surjective },
  refine linear_equiv.finrank_eq (e₁.of_submodules _ _ _),
  rw [← linear_map.range_comp, ← linear_map.range_comp_of_range_eq_top (to_lin v₂ v₁ A) range_e₂],
  congr' 1,
  apply linear_map.pi_ext', rintro i, apply linear_map.ext_ring,
  have aux₁ := to_lin_self (pi.basis_fun K n) (pi.basis_fun K m) A i,
  have aux₂ := basis.equiv_apply (pi.basis_fun K n) i v₂,
  rw [to_lin_eq_to_lin'] at aux₁,
  rw [pi.basis_fun_apply, linear_map.coe_std_basis] at aux₁ aux₂,
  simp only [linear_map.comp_apply, e₁, e₂, linear_equiv.coe_coe, equiv.refl_apply, aux₁, aux₂,
    linear_map.coe_single, to_lin_self, linear_equiv.map_sum, linear_equiv.map_smul,
    basis.equiv_apply],
end

lemma rank_le_card_height : A.rank ≤ fintype.card m :=
(submodule.finrank_le _).trans (module.free.finrank_pi K).le

omit m_fin

lemma rank_le_height {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ m :=
A.rank_le_card_height.trans $ (fintype.card_fin m).le

end matrix


-- Suma de desigualdades (en Lean)
-- ===============================

-- Demostrar si a, b, c y d son números reales tales que
-- a ≤ b y c ≤ d, entonces a + c ≤ b + d.

import data.real.basic

variables (a b c d : ℝ)

-- 1ª demostración
example
  (hab : a ≤ b)
  (hcd : c ≤ d)
  : a + c ≤ b + d :=
begin
  calc
    a + c ≤ b + c : add_le_add_right hab c
    ...   ≤ b + d : add_le_add_left hcd b,
end

-- 2ª demostración
example
  (hab : a ≤ b)
  (hcd : c ≤ d)
  : a + c ≤ b + d :=
begin
  have h1 : a + c ≤ b + c :=
    add_le_add_right hab c,
  have h2 : b + c ≤ b + d :=
    add_le_add_left hcd b,
  show a + c ≤ b + d,
    from le_trans h1 h2,
end

-- 3ª demostración
example
  (hab : a ≤ b)
  (hcd : c ≤ d)
  : a + c ≤ b + d :=
add_le_add hab hcd

-- 4ª demostración
example
  (hab : a ≤ b)
  (hcd : c ≤ d)
  : a + c ≤ b + d :=
by linarith


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Michael Howes

The functor Grp → Ab which is the left adjoint
of the forgetful functor Ab → Grp.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.quotient_group
import Mathlib.tactic.group
import Mathlib.PostPort

universes u v

namespace Mathlib

-- let G be a group

/-- The commutator subgroup of a group G is the normal subgroup
  generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹` -/
def commutator (G : Type u) [group G] : subgroup G :=
  subgroup.normal_closure (set_of fun (x : G) => ∃ (p : G), ∃ (q : G), p * q * (p⁻¹) * (q⁻¹) = x)

/-- The abelianization of G is the quotient of G by its commutator subgroup -/
def abelianization (G : Type u) [group G] :=
  quotient_group.quotient (commutator G)

namespace abelianization

protected instance comm_group (G : Type u) [group G] : comm_group (abelianization G) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

protected instance inhabited (G : Type u) [group G] : Inhabited (abelianization G) :=
  { default := 1 }

/-- `of` is the canonical projection from G to its abelianization. -/
def of {G : Type u} [group G] : G →* abelianization G :=
  monoid_hom.mk quotient_group.mk sorry sorry

-- so far -- built Gᵃᵇ and proved it's an abelian group.

-- defined `of : G → Gᵃᵇ`

-- let A be an abelian group and let f be a group hom from G to A

theorem commutator_subset_ker {G : Type u} [group G] {A : Type v} [comm_group A] (f : G →* A) : commutator G ≤ monoid_hom.ker f := sorry

/-- If `f : G → A` is a group homomorphism to an abelian group, then `lift f` is the unique map from
  the abelianization of a `G` to `A` that factors through `f`. -/
def lift {G : Type u} [group G] {A : Type v} [comm_group A] (f : G →* A) : abelianization G →* A :=
  quotient_group.lift (commutator G) f sorry

@[simp] theorem lift.of {G : Type u} [group G] {A : Type v} [comm_group A] (f : G →* A) (x : G) : coe_fn (lift f) (coe_fn of x) = coe_fn f x :=
  rfl

theorem lift.unique {G : Type u} [group G] {A : Type v} [comm_group A] (f : G →* A) (φ : abelianization G →* A) (hφ : ∀ (x : G), coe_fn φ (coe_fn of x) = coe_fn f x) {x : abelianization G} : coe_fn φ x = coe_fn (lift f) x :=
  quotient_group.induction_on x hφ

/-- See note [partially-applied ext lemmas]. -/
theorem hom_ext {G : Type u} [group G] {A : Type v} [monoid A] (φ : abelianization G →* A) (ψ : abelianization G →* A) (h : monoid_hom.comp φ of = monoid_hom.comp ψ of) : φ = ψ := sorry


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen, Kevin Lacker
-/
import tactic.ring

/-!
# Identities

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

This file contains some "named" commutative ring identities.
-/

variables {R : Type*} [comm_ring R]
{a b x₁ x₂ x₃ x₄ x₅ x₆ x₇ x₈ y₁ y₂ y₃ y₄ y₅ y₆ y₇ y₈ n : R}

/--
Brahmagupta-Fibonacci identity or Diophantus identity, see
<https://en.wikipedia.org/wiki/Brahmagupta%E2%80%93Fibonacci_identity>.

This sign choice here corresponds to the signs obtained by multiplying two complex numbers.
-/
theorem sq_add_sq_mul_sq_add_sq :
  (x₁^2 + x₂^2) * (y₁^2 + y₂^2) = (x₁*y₁ - x₂*y₂)^2 + (x₁*y₂ + x₂*y₁)^2 :=
by ring

/--
Brahmagupta's identity, see <https://en.wikipedia.org/wiki/Brahmagupta%27s_identity>
-/
theorem sq_add_mul_sq_mul_sq_add_mul_sq :
  (x₁^2 + n*x₂^2) * (y₁^2 + n*y₂^2) = (x₁*y₁ - n*x₂*y₂)^2 + n*(x₁*y₂ + x₂*y₁)^2 :=
by ring

/--
Sophie Germain's identity, see <https://www.cut-the-knot.org/blue/SophieGermainIdentity.shtml>.
-/
theorem pow_four_add_four_mul_pow_four : a^4 + 4*b^4 = ((a - b)^2 + b^2) * ((a + b)^2 + b^2) :=
by ring

/--
Sophie Germain's identity, see <https://www.cut-the-knot.org/blue/SophieGermainIdentity.shtml>.
-/
theorem pow_four_add_four_mul_pow_four' :
  a^4 + 4*b^4 = (a^2 - 2*a*b + 2*b^2) * (a^2 + 2*a*b + 2*b^2) :=
by ring

/--
Euler's four-square identity, see <https://en.wikipedia.org/wiki/Euler%27s_four-square_identity>.

This sign choice here corresponds to the signs obtained by multiplying two quaternions.
-/
theorem sum_four_sq_mul_sum_four_sq : (x₁^2 + x₂^2 + x₃^2 + x₄^2) * (y₁^2 + y₂^2 + y₃^2 + y₄^2) =
  (x₁*y₁ - x₂*y₂ - x₃*y₃ - x₄*y₄)^2 + (x₁*y₂ + x₂*y₁ + x₃*y₄ - x₄*y₃)^2 +
  (x₁*y₃ - x₂*y₄ + x₃*y₁ + x₄*y₂)^2 + (x₁*y₄ + x₂*y₃ - x₃*y₂ + x₄*y₁)^2 :=
by ring

/--
Degen's eight squares identity, see <https://en.wikipedia.org/wiki/Degen%27s_eight-square_identity>.

This sign choice here corresponds to the signs obtained by multiplying two octonions.
-/
theorem sum_eight_sq_mul_sum_eight_sq : (x₁^2 + x₂^2 + x₃^2 + x₄^2 + x₅^2 + x₆^2 + x₇^2 + x₈^2) *
  (y₁^2 + y₂^2 + y₃^2 + y₄^2 + y₅^2 + y₆^2 + y₇^2 + y₈^2) =
  (x₁*y₁ - x₂*y₂ - x₃*y₃ - x₄*y₄ - x₅*y₅ - x₆*y₆ - x₇*y₇ - x₈*y₈)^2 +
  (x₁*y₂ + x₂*y₁ + x₃*y₄ - x₄*y₃ + x₅*y₆ - x₆*y₅ - x₇*y₈ + x₈*y₇)^2 +
  (x₁*y₃ - x₂*y₄ + x₃*y₁ + x₄*y₂ + x₅*y₇ + x₆*y₈ - x₇*y₅ - x₈*y₆)^2 +
  (x₁*y₄ + x₂*y₃ - x₃*y₂ + x₄*y₁ + x₅*y₈ - x₆*y₇ + x₇*y₆ - x₈*y₅)^2 +
  (x₁*y₅ - x₂*y₆ - x₃*y₇ - x₄*y₈ + x₅*y₁ + x₆*y₂ + x₇*y₃ + x₈*y₄)^2 +
  (x₁*y₆ + x₂*y₅ - x₃*y₈ + x₄*y₇ - x₅*y₂ + x₆*y₁ - x₇*y₄ + x₈*y₃)^2 +
  (x₁*y₇ + x₂*y₈ + x₃*y₅ - x₄*y₆ - x₅*y₃ + x₆*y₄ + x₇*y₁ - x₈*y₂)^2 +
  (x₁*y₈ - x₂*y₇ + x₃*y₆ + x₄*y₅ - x₅*y₄ - x₆*y₃ + x₇*y₂ + x₈*y₁)^2 :=
by ring


-- BOTH:
import algebra.ring
import data.real.basic
import tactic

/- TEXT:
.. _proving_identities_in_algebraic_structures:

Proving Identities in Algebraic Structures
------------------------------------------

.. index:: ring (algebraic structure)

Mathematically, a ring consists of a collection of objects,
:math:`R`, operations :math:`+` :math:`\times`, and constants :math:`0`
and :math:`1`, and an operation :math:`x \mapsto -x` such that:

* :math:`R` with :math:`+` is an *abelian group*, with :math:`0`
  as the additive identity and negation as inverse.
* Multiplication is associative with identity :math:`1`,
  and multiplication distributes over addition.

In Lean, the collection of objects is represented as a *type*, ``R``.
The ring axioms are as follows:
TEXT. -/
section
-- QUOTE:
variables (R : Type*) [ring R]

#check (add_assoc : ∀ a b c : R, a + b + c = a + (b + c))
#check (add_comm : ∀ a b : R, a + b = b + a)
#check (zero_add : ∀ a : R, 0 + a = a)
#check (add_left_neg : ∀ a : R, -a + a = 0)
#check (mul_assoc : ∀ a b c : R, a * b * c = a * (b * c))
#check (mul_one : ∀ a : R, a * 1 = a)
#check (one_mul : ∀ a : R, 1 * a = a)
#check (mul_add : ∀ a b c : R, a * (b + c) = a * b + a * c)
#check (add_mul : ∀ a b c : R, (a + b) * c = a * c + b * c)
-- QUOTE.
end

/- TEXT:
You will learn more about the square brackets in the first line later,
but for the time being,
suffice it to say that the declaration gives us a type, ``R``,
and a ring structure on ``R``.
Lean then allows us to use generic ring notation with elements of ``R``,
and to make use of a library of theorems about rings.

The names of some of the theorems should look familiar:
they are exactly the ones we used to calculate with the real numbers
in the last section.
Lean is good not only for proving things about concrete mathematical
structures like the natural numbers and the integers,
but also for proving things about abstract structures,
characterized axiomatically, like rings.
Moreover, Lean supports *generic reasoning* about
both abstract and concrete structures,
and can be trained to recognized appropriate instances.
So any theorem about rings can be applied to concrete rings
like the integers, ``ℤ``, the rational numbers,  ``ℚ``,
and the complex numbers ``ℂ``.
It can also be applied to any instance of an abstract
structure that extends rings,
such as any *ordered ring* or any *field*.

.. index:: commutative ring

Not all important properties of the real numbers hold in an
arbitrary ring, however.
For example, multiplication on the real numbers
is commutative,
but that does not hold in general.
If you have taken a course in linear algebra,
you will recognize that, for every :math:`n`,
the :math:`n` by :math:`n` matrices of real numbers
form a ring in which commutativity usually fails. If we declare ``R`` to be a
*commutative* ring, in fact, all the theorems
in the last section continue to hold when we replace
``ℝ`` by ``R``.
TEXT. -/
section
-- QUOTE:
variables (R : Type*) [comm_ring R]
variables a b c d : R

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

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

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

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

/- TEXT:
We leave it to you to check that all the other proofs go through unchanged.

The goal of this section is to strengthen the skills
you have developed in the last section
and apply them to reasoning axiomatically about rings.
We will start with the axioms listed above,
and use them to derive other facts.
Most of the facts we prove are already in ``mathlib``.
We will give the versions we prove the same names
to help you learn the contents of the library
as well as the naming conventions.

.. index:: namespace, open, command ; open

Lean provides an organizational mechanism similar
to those used in programming languages:
when a definition or theorem ``foo`` is introduced in a *namespace*
``bar``, its full name is ``bar.foo``.
The command ``open bar`` later *opens* the namespace,
which allows us to use the shorter name ``foo``.
To avoid errors due to name clashes,
in the next example we put our versions of the library
theorems in a new namespace called ``my_ring.``

The next example shows that we do not need ``add_zero`` or ``add_right_neg``
as ring axioms, because they follow from the other axioms.
TEXT. -/
-- QUOTE:
namespace my_ring
variables {R : Type*} [ring R]

theorem add_zero (a : R) : a + 0 = a :=
by rw [add_comm, zero_add]

theorem add_right_neg (a : R) : a + -a = 0 :=
by rw [add_comm, add_left_neg]

#check @my_ring.add_zero
#check @add_zero

end my_ring
-- QUOTE.

/- TEXT:
The net effect is that we can temporarily reprove a theorem in the library,
and then go on using the library version after that.
But don't cheat!
In the exercises that follow, take care to use only the
general facts about rings that we have proved earlier in this section.

(If you are paying careful attention, you may have noticed that we
changed the round brackets in ``(R : Type*)`` for
curly brackets in ``{R : Type*}``.
This declares ``R`` to be an *implicit argument*.
We will explain what this means in a moment,
but don't worry about it in the meanwhile.)

Here is a useful theorem:
TEXT. -/
-- BOTH:
namespace my_ring
variables {R : Type*} [ring R]

-- EXAMPLES:
-- QUOTE:
theorem neg_add_cancel_left (a b : R) : -a + (a + b) = b :=
by rw [←add_assoc, add_left_neg, zero_add]
-- QUOTE.

/- TEXT:
Prove the companion version:
TEXT. -/
/- Prove these: -/

-- QUOTE:
theorem add_neg_cancel_right (a b : R) : (a + b) + -b = a :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem add_neg_cancel_rightαα (a b : R) : (a + b) + -b = a :=
by rw [add_assoc, add_right_neg, add_zero]

/- TEXT:
Use these to prove the following:
TEXT. -/
-- QUOTE:
theorem add_left_cancel {a b c : R} (h : a + b = a + c) : b = c :=
sorry

theorem add_right_cancel {a b c : R} (h : a + b = c + b) : a = c :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem add_left_cancelαα {a b c : R} (h : a + b = a + c) : b = c :=
by rw [←neg_add_cancel_left a b, h, neg_add_cancel_left]

theorem add_right_cancelαα {a b c : R} (h : a + b = c + b) : a = c :=
by rw [←add_neg_cancel_right a b, h, add_neg_cancel_right]

/- TEXT:
With enough planning, you can do each of them with three rewrites.

.. index:: implicit argument

We can now explain the use of the curly braces.
Imagine you are in a situation where you have ``a``, ``b``, and ``c``
in your context,
as well as a hypothesis ``h : a + b = a + c``,
and you would like to draw the conclusion ``b = c``.
In Lean, you can apply a theorem to hypotheses and facts just
the same way that you can apply them to objects,
so you might think that ``add_left_cancel a b c h`` is a
proof of the fact ``b = c``.
But notice that explicitly writing ``a``, ``b``, and ``c``
is redundant, because the hypothesis ``h`` makes it clear that
those are the objects we have in mind.
In this case, typing a few extra characters is not onerous,
but if we wanted to apply ``add_left_cancel`` to more complicated expressions,
writing them would be tedious.
In cases like these,
Lean allows us to mark arguments as *implicit*,
meaning that they are supposed to be left out and inferred by other means,
such as later arguments and hypotheses.
The curly brackets in ``{a b c : R}`` do exactly that.
So, given the statement of the theorem above,
the correct expression is simply ``add_left_cancel h``.

To illustrate, let us show that ``a * 0 = 0``
follows from the ring axioms.
TEXT. -/
-- QUOTE:
theorem mul_zero (a : R) : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
  { rw [←mul_add, add_zero, add_zero] },
  rw add_left_cancel h
end
-- QUOTE.

/- TEXT:
.. index:: have, tactics ; have

We have used a new trick!
If you step through the proof,
you can see what is going on.
The ``have`` tactic introduces a new goal,
``a * 0 + a * 0 = a * 0 + 0``,
with the same context as the original goal.
In the next line, we could have omitted the curly brackets,
which serve as an inner ``begin ... end`` pair.
Using them promotes a modular style of proof:
the part of the proof inside the brackets establishes the goal
that was introduced by the ``have``.
After that, we are back to proving the original goal,
except a new hypothesis ``h`` has been added:
having proved it, we are now free to use it.
At this point, the goal is exactly the result of ``add_left_cancel h``.
We could equally well have closed the proof with
``apply add_left_cancel h`` or ``exact add_left_cancel h``.

Remember that multiplication is not assumed to be commutative,
so the following theorem also requires some work.
TEXT. -/
-- QUOTE:
theorem zero_mul (a : R) : 0 * a = 0 :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem zero_mulαα (a : R) : 0 * a = 0 :=
begin
  have h : 0 * a + 0 * a = 0 * a + 0,
  { rw [←add_mul, add_zero, add_zero] },
  rw add_left_cancel h
end

/- TEXT:
By now, you should also be able replace each ``sorry`` in the next
exercise with a proof,
still using only facts about rings that we have
established in this section.
TEXT. -/
-- QUOTE:
theorem neg_eq_of_add_eq_zero {a b : R} (h : a + b = 0) : -a = b :=
sorry

theorem eq_neg_of_add_eq_zero {a b : R} (h : a + b = 0) : a = -b :=
sorry

theorem neg_zero : (-0 : R) = 0 :=
begin
  apply neg_eq_of_add_eq_zero,
  rw add_zero
end

theorem neg_neg (a : R) : -(-a) = a :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem neg_eq_of_add_eq_zeroαα {a b : R} (h : a + b = 0) : -a = b :=
by rw [←neg_add_cancel_left a b, h, add_zero]

theorem eq_neg_of_add_eq_zeroαα {a b : R} (h : a + b = 0) : a = -b :=
begin
  symmetry,
  apply neg_eq_of_add_eq_zero,
  rw [add_comm, h]
end

theorem neg_zeroαα : (-0 : R) = 0 :=
begin
  apply neg_eq_of_add_eq_zero,
  rw add_zero
end

theorem neg_negαα (a : R) : -(-a) = a :=
begin
  apply neg_eq_of_add_eq_zero,
  rw add_left_neg
end

-- BOTH:
end my_ring

/- TEXT:
We had to use the annotation ``(-0 : R)`` instead of ``0`` in the third theorem
because without specifying ``R``
it is impossible for Lean to infer which ``0`` we have in mind,
and by default it would be interpreted as a natural number.

In Lean, subtraction in a ring is provably equal to
addition of the additive inverse.
TEXT. -/
/- Examples. -/

section
variables {R : Type*} [ring R]

-- QUOTE:
example (a b : R) : a - b = a + -b :=
sub_eq_add_neg a b
-- QUOTE.

end

/- TEXT:
On the real numbers, it is *defined* that way:
TEXT. -/
-- QUOTE:
example (a b : ℝ) : a - b = a + -b :=
rfl

example (a b : ℝ) : a - b = a + -b :=
by reflexivity
-- QUOTE.

/- TEXT:
.. index:: rfl, reflexivity, tactics ; refl and reflexivity, definitional equality

The proof term ``rfl`` is short for ``reflexivity``.
Presenting it as a proof of ``a - b = a + -b`` forces Lean
to unfold the definition and recognize both sides as being the same.
The ``reflexivity`` tactic, which can be abbreviated as ``refl``,
does the same.
This is an instance of what is known as a *definitional equality*
in Lean's underlying logic.
This means that not only can one rewrite with ``sub_eq_add_neg``
to replace ``a - b = a + -b``,
but in some contexts, when dealing with the real numbers,
you can use the two sides of the equation interchangeably.
For example, you now have enough information to prove the theorem
``self_sub`` from the last section:
TEXT. -/
-- BOTH:
namespace my_ring

variables {R : Type*} [ring R]

-- EXAMPLES:
-- QUOTE:
theorem self_sub (a : R) : a - a = 0 :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem self_subαα (a : R) : a - a = 0 :=
by rw [sub_eq_add_neg, add_right_neg]

/- TEXT:
Show that you can prove this using ``rw``,
but if you replace the arbitrary ring ``R`` by
the real numbers, you can also prove it
using either ``apply`` or ``exact``.

For another example of definitional equality,
Lean knows that ``1 + 1 = 2`` holds in any ring.
With a bit of effort,
you can use that to prove the theorem ``two_mul`` from
the last section:
TEXT. -/
-- QUOTE:
lemma one_add_one_eq_two : 1 + 1 = (2 : R) :=
by refl

theorem two_mul (a : R) : 2 * a = a + a :=
sorry
-- QUOTE.

-- SOLUTIONS:
lemma one_add_one_eq_twoαα : 1 + 1 = (2 : R) :=
by refl

theorem two_mulαα (a : R) : 2 * a = a + a :=
by rw [←one_add_one_eq_two, add_mul, one_mul]

-- BOTH:
end my_ring

/- TEXT:
.. index:: group (algebraic structure)

We close this section by noting that some of the facts about
addition and negation that we established above do not
need the full strength of the ring axioms, or even
commutativity of addition. The weaker notion of a *group*
can be axiomatized as follows:
TEXT. -/
section
-- QUOTE:
variables (A : Type*) [add_group A]

#check (add_assoc : ∀ a b c : A, a + b + c = a + (b + c))
#check (zero_add : ∀ a : A, 0 + a = a)
#check (add_left_neg : ∀ a : A, -a + a = 0)
-- QUOTE.
end

/- TEXT:
It is conventional to use additive notation when
the group operation is commutative,
and multiplicative notation otherwise.
So Lean defines a multiplicative version as well as the
additive version (and also their abelian variants,
``add_comm_group`` and ``comm_group``).
TEXT. -/
-- BOTH:
section
-- QUOTE:
variables {G : Type*} [group G]

-- EXAMPLES:
#check (mul_assoc : ∀ a b c : G, a * b * c = a * (b * c))
#check (one_mul : ∀ a : G, 1 * a = a)
#check (mul_left_inv : ∀ a : G, a⁻¹ * a = 1)
-- QUOTE.

/- TEXT:
If you are feeling cocky, try proving the following facts about
groups, using only these axioms.
You will need to prove a number of helper lemmas along the way.
The proofs we have carried out in this section provide some hints.
TEXT. -/
-- BOTH:
namespace my_group

-- EXAMPLES:
-- QUOTE:
theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
sorry

theorem mul_one (a : G) : a * 1 = a :=
sorry

theorem mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a ⁻¹ :=
sorry
-- QUOTE.

-- SOLUTIONS:
theorem mul_right_invαα (a : G) : a * a⁻¹ = 1 :=
begin
  have h : (a * a⁻¹)⁻¹ * ((a * a⁻¹) * (a * a⁻¹)) = 1,
  { rw [mul_assoc, ←mul_assoc a⁻¹ a, mul_left_inv, one_mul, mul_left_inv] },
  rw [←h, ←mul_assoc, mul_left_inv, one_mul]
end

theorem mul_oneαα (a : G) : a * 1 = a :=
by rw [←mul_left_inv a, ←mul_assoc, mul_right_inv, one_mul]

theorem mul_inv_revαα (a b : G) : (a * b)⁻¹ = b⁻¹ * a ⁻¹ :=
by rw [←one_mul (b⁻¹ * a⁻¹), ←mul_left_inv (a * b), mul_assoc, mul_assoc,
        ←mul_assoc b b⁻¹, mul_right_inv, one_mul, mul_right_inv, mul_one]

-- BOTH:
end my_group
end

/- TEXT:
.. index:: group (tactic), tactics ; group, tactics ; noncomm_ring, tactics ; abel

Explicitly invoking those lemmas is tedious, so mathlib provides
tactics similar to `ring` in order to cover most uses: `group`
is for non-commutative multiplicative groups, `abel` for abelian
additive groups, and `noncomm_ring` for non-commutative groups.
It may seem odd that the algebraic structures are called
`ring` and `comm_ring` while the tactics are named
`noncomm_ring` and `ring`. This is partly for historical reasons,
but also for the convenience of using a shorter name for the
tactic that deals with commutative rings, since it is used more often.
TEXT. -/


/-
CS 2102 F19, Homework #8, Predicate Logic & Proofs.
-/

namespace hw8

/-
#1. Equality and proofs of equality.
-/

/-
A. [10 points] Fill in the blank.

When we say that the binary equality relation,
=, on objects of any type, α, is reflexive, we
mean that for any value, a, of type, α, _______.

ANSWER:  a = a
-/

/-
B. [10 points]
Complete the following definition in Lean
to formalize the proposition that 1 equals
1.
-/

def one_eq_one : Prop :=
    -- ANSWER
    1 = 1

/-
C. [10 points]
Give an English language proof of the
proposition that 1 = 1 by completing the
following incomplete proof.

To obtain a proof of 1 = 1 we apply the ________
property of the ________ relation to the specific
value, _________.

ANSWER:  reflexive, equals, 1
-/

/-
D. [10 points]
Give a formal proof of this proposition
by completing the following definition.
-/

def proof_that_one_eq_one : one_eq_one :=
    -- ANSWER
    begin
        apply eq.refl 1,
    end

/- [10 points]
E. Complete the following test case to produce
an example that suggests (correctly) that Lean
will accept a proof that two *different terms* are
equal as long as they reduce to the same value.
-/

-- ANSWER: Give a proposition and proof in Lean

def two_plus_two_eq_four : Prop := 2+2 = 4

def proof_two_plus_two_eq_four : two_plus_two_eq_four :=
    begin
        apply eq.refl 4,
    end

-- ANSWER Does eq.refl work as suggested? _____

/-
#2. Predicates and Properties

A predicate is a parameterized proposition. By
applying a predicate to different arguments, we get
different propositions. Such a propopsition can
be said to be "about" the argument to which it was
applied.

We interpret such a proposition as asserting that
its argument has a *property* of interest. If the
proposition has a proof (is true), the object does
have the asserted property, and if the proposition
is not true, the object doesn't have that property.

In the  following set of problems, we will take the
property of a natural number "being even" as a case
in point.

In natural language, we will say that a natural
number, n, is even if and only if (1) it is zero,
or, (2) it is two more than another even number.

Think about this inductive definition. Why does it
cover all possible cases -- an infinitude of cases?
(No need for an answer here.)
-/

/-

A. [10 points]

We have accepted as *axioms* in our definition
of evennness that zero is even and that any number
that is two more than another even number is even.
These are the only axioms you may use in giving a
proof that four is even. Give a natural language
proof now. Hint, start by saying the following:

Proof: To prove that four is even, *it will suffice*
to show that 2 is even, because if two is even then,
given that 4 is two more than two, if two is even
then so is four, by rule (2). Now all that remains
to be proved is that _______________.

Give the rest of your natural language proof here,
and be sure to indicate which of the two rules you
are applying at each step in your reasoning.

ANSWER: zero is even and (2 + 0 = 2) → even 2

-/

/-
B. [10 points]

We formalize a predicate, such as is_even, as a
family of "inductive propositions" given by a
function from argument values to propositions.
Such an inductive definition thus has the type,
α → Prop, where α is the type of argument to
which the predicate is applied.

Please see the first line of the definition of
is_even that follows for an example.

Having specified the *type* of a predicate, in
this case from ℕ → Prop, we then define the set
of constructors to define the logical rules that
can be used to construct proofs of any such
proposition.

These rules are the (formal) axioms that can be
used to construct proofs. The first one (below)
states that the term, pf_zero_is_even, is to be
accepted as a proof of is_even 0 (which is how
we write the application of a predicate to a value
to obtain a proposition, here that "0 is even").

The second constructor/axiom/rule provides a way
to build a proof of (is_even 2+n) by applying the
constructor to any n along with a proof that that
particular n is even. (Yes: the ∀ specifies the
first argument to pf_even_plus_two_is_even. This
is necessary to give the argument a name, here n,
so that that name can be used in defining the rest
of the constructor's type).
-/

inductive is_even : ℕ → Prop
| pf_zero_is_even : (is_even 0)
| pf_even_plus_two_is_even :
    ∀ (n : ℕ), is_even n → is_even (nat.succ (nat.succ n))

/-
Give formal proofs for each of the following
propositions. (Notice how we obtain different
propositions by applying the predicate, is_even,
to different argument values. This is what we
mean when we say that a predicate defines a
family of propositions.)
-/

open is_even

theorem zero_even   : is_even 0 :=
    -- ANSWER
    begin
        apply pf_zero_is_even,
    end

/-
In this case, give a proof term without using
a begin/end proof script.
-/
theorem two_even    : is_even 2 :=
    -- ANSWER
    pf_even_plus_two_is_even 0 zero_even

/-
In this case, give a proof using a begin/end
proof script.
-/
theorem eight_even  : is_even 8 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,
    apply pf_zero_is_even,
end

/-
C. [10 points]

Formally specify a predicate, is_odd, on the
natural numbers.  You can reason about any
natural number being odd using two rules, just
as for being even. Once you've defined your
predicate (an inductive family of proposition,
just like is_even), formally state and prove
the following propositions (however you wish).

- 1 is odd
- 7 is odd

-/

inductive is_odd : ℕ → Prop
| one_odd : is_odd 1
| two_plus_odd : ∀(n : ℕ), is_odd n → is_odd (nat.succ (nat.succ n))

-- ANSWER

open is_odd

-- ANSWER
example : is_odd 7 :=
    begin
        apply two_plus_odd,
        apply two_plus_odd,
        apply two_plus_odd,
        apply one_odd,
    end

-- ANSWER

/-
Introducing an important concept. In the preceding
problems, we've seen that we can think of a predicate
with one argument as defining a property objects, such
as the property of being even. Now we shift perspective
from the concept of a property, per se, to the concept
of "the set of objects that have a given property." The
set of objects that have the is_even property, for
example, could be written as

    evens = {0, 2, 4, 6, 8, 10, ...}

or more formally as

    evens = { n : ℕ | is_even n}

The elements of these sets are all, and only,
the values that "satisfy" the is_even predicate.
A value satisfies its predicate if, when plugged
in, the resulting proposition has a proof (and so
is true). The key conclusion is that a predicate
with a single argument defines a *set*, namely
the set of all and only those objects that have
that property.
-/

/-
#4. Predicates and binary relations

Mathematicians define *binary relations* as sets
of ordered pairs. For example, the equality relation
on natural numbers comprises the set of of all pairs
of natural numbers such that the first and second
elements are the same. We could write this set like
this:

    equals = { (0,0), (1,1), (2,2), ...},

or like this:

    equals = { (m : ℕ, n : ℕ) | m = n }

We formalize binary relations as predicates with
*two* arguments. The type of such a predicate in
Lean is thus α → β → Prop, where α and β are the
types of the arguments.

In our example, we have a two-place predicate that
defines the set of ordered pairs of natural numbers
where the two elements of each pair are co-equal.

Study and understand the following specification
of this binary relation. Look at the construtor,
mk, in particular: it says that you can construct
a proof that a pair of values, n and m, is in our
id_nat_relation if you have a proof of n = m. (In
other words, it suffices to show that n = m using
Lean's built in equality relation to construct a
proof that (n, m) is in our id_nat_relation.)
-/

inductive id_nat_relation : ℕ → ℕ → Prop
| mk : ∀ (n m : ℕ), n = m → id_nat_relation n m

/-
A. [10 points]

Give a formal proof that id_nat_relation contains
the pair, (3, 3). Do it by completing the following
proof. Think carefully about the third argument: you
need a *value* of what type here? What do we call a
value of a logical type?
-/

theorem three_three_in_id : id_nat_relation 3 3 :=
    -- ANSWER (apply a constructor, of course)
    id_nat_relation.mk 3 3 (eq.refl 3)

/-
B. [10 points]

Explain in just a few words why it is not
possible to prove that (3,5) is in this relation.
-/

-- ANSWER
/-
    it will never be true that 3=5
-/

/-
EXTRA CREDIT.
-/

/-
Here's a definition of what it means for a
relation to be reflexive.
-/

def reflexive {α : Type} (r : α → α → Prop) :=
    ∀ (a : α), r a a

/-
A. Formally state and prove that id_nat_relation
is reflexive. Hint: use a script and start it
with "assume (a : ℕ)". Remember that to prove a ∀
proposition, we *assume* that we're given some
arbitrary but specific value of the given type,
then we prove the rest of the proposition about
it. But because we didn't say anything about
the element we picked, we can conclude that the
statement must be true of any element of the type.
-/

-- ANSWER

theorem id_nat_refl : reflexive id_nat_relation :=
begin
    unfold reflexive,
    assume (a : ℕ),
    apply id_nat_relation.mk,
    apply eq.refl a,
end

/-
B. [Double extra credit.]

Formally define what we mean by a relation being
symmetric and transitive, in the style of the above
definition of reflexive, and formally state and show
that our id_nat_reflexive relation is also symmetric
and transitive.
-/

def symmetric {α : Type} (r : α → α → Prop) :=
    ∀(a b: α), r a b → r b a

def transitive {α : Type} (r : α → α → Prop) :=
    ∀(a b c : α), (r a b ∧ r b c) → r a c

end hw8


import tactic
import data.real.basic
import number_theory.padics
import data.int.gcd

/-!
## Exercises about numbers and casts
-/

/-!
## First exercises
These first examples are just to get you comfortable with
`norm_num`, `norm_cast`, and friends.
-/

example : 12345 < 67890 :=
begin
  norm_num,
end

example {α : Type} [linear_ordered_field α] : 123 + 45 < 67890/3 :=
begin
  norm_num,
end

example : nat.prime 17 :=
begin
  norm_num,
end

-- prove either this or its negation!
example : ¬ 7/3 > 2 :=
begin
  norm_num,
end

example (x : ℝ) (hx : x < 50*50) : x < 25*100 :=
begin
  norm_num at *,
  assumption,
end

example (x : ℤ) (hx : (x : ℝ) < 25*100) : x < 25*100 :=
begin
  norm_cast at *,
  assumption,
end

example (x : ℤ) (hx : (x : ℝ) < 2500) : x < 25*100 :=
begin
  norm_cast at *,
  norm_num,
  assumption,
end

example (p q r : ℕ) (h : r < p - q) (hpq : q ≤ p) : (r : ℝ) < p - q :=
begin
  norm_cast at *,
  from h,
end

example (p q r : ℕ) (hr : r < p + 2 - p) : (r : ℤ) < 5 :=
begin
  norm_cast at *,
  simp at hr,
  from lt_trans hr (by norm_num : 2 < 5),
end

/-!
## Exercise 2
This comes from the development of the p-adic numbers.
`norm_cast` is very useful here, since we need to talk about values in
ℕ, ℤ, ℚ, ℚ_p, and ℤ_p.
We've done some work to get you started. You might look for the lemmas:
-/

open padic_val_rat

#check zpow_le_of_le
#check zpow_nonneg
#check of_int_multiplicity

example {p n : ℕ} (hp : p.prime) {z : ℤ} (hd : ↑(p^n) ∣ z) : padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
begin
  -- This lemma will be useful later in the proof.
  -- Ignore the "inst" argument; just use `apply aux_lemma` when you need it!
  -- Note that we haven't finished it. Fill in that final sorry.
  have aux_lemma : ∀ inst, (n : ℤ) ≤ (multiplicity ↑p z).get inst,
  { intro,
    norm_cast,
    rw [← enat.coe_le_coe, enat.coe_get],
    apply multiplicity.le_multiplicity_of_pow_dvd,
    norm_cast, from hd, },

  unfold padic_norm, split_ifs with hz hz,
  { apply zpow_nonneg,
    norm_cast,
    apply zero_le,},
  { apply zpow_le_of_le,
    norm_cast, apply le_trans, from (by norm_num : 1 ≤ 2),
    apply nat.prime.two_le hp,
    apply neg_le_neg, rw of_int_multiplicity,
    apply aux_lemma,
    from nat.prime.ne_one hp,
    norm_cast at hz,
    }
end

/-!
## Exercise 3
This seems like a very natural way to write the theorem
"If `a` and `b` are coprime, then there are coefficients `u` and `v` such that `u*a + v*b = 1`."
But I've made a mistake! What did I do wrong? Correct the statement of the theorem and prove it.
I've started you off with a lemma that will be useful.
You might find the `specialize` tactic to be handy as well:
if you have `h : ∀ (x y : T), R x y` and `a, b : T` in the context, then
`specialize h a b` will change the type of `h` to `R a b`.
-/

example (a b : ℕ) (h : nat.coprime a b) : ∃ u v : ℤ, u * a + v * b = 1 :=
begin
  have := nat.gcd_eq_gcd_ab,
  specialize this a b,
  unfold nat.coprime at h,
  rw h at this,
  norm_cast at this,
  use [a.gcd_a b, a.gcd_b b],
  rw this, ring,
end

/-!
## Exercise 4
We did an example together that was similar to this.
This one takes a bit more arithmetic work.
To save you some time, here are some lemmas that may be useful!
(You may not need all of them, depending on how you approach it.)
Remember you can also use `library_search` to try to find useful lemmas.
A hint: you might find it helpful to do this once you've introduced `n`.
```
have n_pos: 0 < n,
{ ... }
```
-/

#check sub_le_iff_le_add
#check add_le_add_iff_left
#check div_le_iff
#check mul_one_div_cancel
#check mul_le_mul_left

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

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

-- n ≥ ⌈1 / ε⌉₊

example : seq_limit (λ n : ℕ, (n+1)/n) 1 :=
begin
  intros ε epos,
  dsimp,
  use nat.ceil (1 / ε),
  intros n nge,

  have npos : 0 < n,
    apply lt_of_lt_of_le,
    show 0 < ⌈1 / ε⌉₊,
      rw nat.lt_ceil,
      apply div_pos,
      norm_num, from epos,
    from nge,
  have : (0 : ℝ) ≤ (n + 1) / n - 1,
    norm_cast,
    norm_num,
    rw le_div_iff,
    norm_num, norm_cast, from npos,

  simp [abs_of_nonneg this], norm_cast,
  rw div_le_iff, simp [add_mul, add_comm _ (n : ℝ)],
  calc
    1 = ε * (1 / ε) : by { field_simp; rw div_self; from ne_of_gt epos, }
    ... ≤ ε * nat.ceil (1 / ε) :
      by { apply mul_le_mul, apply le_refl, apply nat.le_ceil,
          apply le_of_lt, apply div_pos, norm_num, from epos, from le_of_lt epos, }
    ... ≤ ε * n :
      by { apply mul_le_mul, apply le_refl, norm_cast, from nge,
          norm_cast, apply nat.zero_le, from le_of_lt epos, },
  norm_cast,
  from npos,
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.big_operators.order
import tactic
import data.nat.prime

/-!
# Divisor finsets

This file defines sets of divisors of a natural number. This is particularly useful as background
for defining Dirichlet convolution.

## Main Definitions
Let `n : ℕ`. All of the following definitions are in the `nat` namespace:
 * `divisors n` is the `finset` of natural numbers that divide `n`.
 * `proper_divisors n` is the `finset` of natural numbers that divide `n`, other than `n`.
 * `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
 * `perfect n` is true when `n` is positive and the sum of `proper_divisors n` is `n`.

## Implementation details
 * `divisors 0`, `proper_divisors 0`, and `divisors_antidiagonal 0` are defined to be `∅`.

## Tags
divisors, perfect numbers

-/

open_locale classical
open_locale big_operators
open finset

namespace nat
variable (n : ℕ)

/-- `divisors n` is the `finset` of divisors of `n`. As a special case, `divisors 0 = ∅`. -/
def divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 (n + 1))

/-- `proper_divisors n` is the `finset` of divisors of `n`, other than `n`.
  As a special case, `proper_divisors 0 = ∅`. -/
def proper_divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 n)

/-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
  As a special case, `divisors_antidiagonal 0 = ∅`. -/
def divisors_antidiagonal : finset (ℕ × ℕ) :=
((finset.Ico 1 (n + 1)).product (finset.Ico 1 (n + 1))).filter (λ x, x.fst * x.snd = n)

variable {n}

lemma proper_divisors.not_self_mem : ¬ n ∈ proper_divisors n :=
begin
  rw proper_divisors,
  simp,
end

@[simp]
lemma mem_proper_divisors {m : ℕ} : n ∈ proper_divisors m ↔ n ∣ m ∧ n < m :=
begin
  rw [proper_divisors, finset.mem_filter, finset.Ico.mem, and_comm],
  apply and_congr_right,
  rw and_iff_right_iff_imp,
  intros hdvd hlt,
  apply nat.pos_of_ne_zero _,
  rintro rfl,
  rw zero_dvd_iff.1 hdvd at hlt,
  apply lt_irrefl 0 hlt,
end

lemma divisors_eq_proper_divisors_insert_self_of_pos (h : 0 < n):
  divisors n = has_insert.insert n (proper_divisors n) :=
by rw [divisors, proper_divisors, finset.Ico.succ_top h, finset.filter_insert, if_pos (dvd_refl n)]

@[simp]
lemma mem_divisors {m : ℕ} :
  n ∈ divisors m ↔ (n ∣ m ∧ m ≠ 0) :=
begin
  cases m,
  { simp [divisors] },
  simp only [divisors, finset.Ico.mem, ne.def, finset.mem_filter, succ_ne_zero, and_true,
             and_iff_right_iff_imp, not_false_iff],
  intro hdvd,
  split,
  { apply nat.pos_of_ne_zero,
    rintro rfl,
    apply nat.succ_ne_zero,
    rwa zero_dvd_iff at hdvd },
  { rw nat.lt_succ_iff,
    apply nat.le_of_dvd (nat.succ_pos m) hdvd }
end

lemma dvd_of_mem_divisors {m : ℕ} (h : n ∈ divisors m) : n ∣ m :=
begin
  cases m,
  { apply dvd_zero },
  { simp [mem_divisors.1 h], }
end

@[simp]
lemma mem_divisors_antidiagonal {x : ℕ × ℕ} :
  x ∈ divisors_antidiagonal n ↔ x.fst * x.snd = n ∧ n ≠ 0 :=
begin
  simp only [divisors_antidiagonal, finset.Ico.mem, ne.def, finset.mem_filter, finset.mem_product],
  rw and_comm,
  apply and_congr_right,
  rintro rfl,
  split; intro h,
  { contrapose! h, simp [h], },
  { rw [nat.lt_add_one_iff, nat.lt_add_one_iff],
    rw [mul_eq_zero, decidable.not_or_iff_and_not] at h,
    simp only [succ_le_of_lt (nat.pos_of_ne_zero h.1), succ_le_of_lt (nat.pos_of_ne_zero h.2),
               true_and],
    exact ⟨le_mul_of_pos_right (nat.pos_of_ne_zero h.2),
      le_mul_of_pos_left (nat.pos_of_ne_zero h.1)⟩ }
end

variable {n}

lemma divisor_le {m : ℕ}:
n ∈ divisors m → n ≤ m :=
begin
  cases m,
  { simp },
  simp only [mem_divisors, m.succ_ne_zero, and_true, ne.def, not_false_iff],
  exact nat.le_of_dvd (nat.succ_pos m),
end

lemma divisors_subset_of_dvd {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) : divisors m ⊆ divisors n :=
finset.subset_iff.2 $ λ x hx, nat.mem_divisors.mpr (⟨dvd.trans (nat.mem_divisors.mp hx).1 h, hzero⟩)

lemma divisors_subset_proper_divisors {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) (hdiff : m ≠ n) :
  divisors m ⊆ proper_divisors n :=
begin
  apply finset.subset_iff.2,
  intros x hx,
  exact nat.mem_proper_divisors.2 (⟨dvd.trans (nat.mem_divisors.1 hx).1 h,
    lt_of_le_of_lt (divisor_le hx) (lt_of_le_of_ne (divisor_le (nat.mem_divisors.2
    ⟨h, hzero⟩)) hdiff)⟩)
end

@[simp]
lemma divisors_zero : divisors 0 = ∅ := by { ext, simp }

@[simp]
lemma proper_divisors_zero : proper_divisors 0 = ∅ := by { ext, simp }

lemma proper_divisors_subset_divisors : proper_divisors n ⊆ divisors n :=
begin
  cases n,
  { simp },
  rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _)],
  apply subset_insert,
end

@[simp]
lemma divisors_one : divisors 1 = {1} := by { ext, simp }

@[simp]
lemma proper_divisors_one : proper_divisors 1 = ∅ :=
begin
  ext,
  simp only [finset.not_mem_empty, nat.dvd_one, not_and, not_lt, mem_proper_divisors, iff_false],
  apply ge_of_eq,
end

lemma pos_of_mem_divisors {m : ℕ} (h : m ∈ n.divisors) : 0 < m :=
begin
  cases m,
  { rw [mem_divisors, zero_dvd_iff] at h,
    rcases h with ⟨rfl, h⟩,
    exfalso,
    apply h rfl },
  apply nat.succ_pos,
end

lemma pos_of_mem_proper_divisors {m : ℕ} (h : m ∈ n.proper_divisors) : 0 < m :=
pos_of_mem_divisors (proper_divisors_subset_divisors h)

lemma one_mem_proper_divisors_iff_one_lt :
  1 ∈ n.proper_divisors ↔ 1 < n :=
by rw [mem_proper_divisors, and_iff_right (one_dvd _)]

@[simp]
lemma divisors_antidiagonal_zero : divisors_antidiagonal 0 = ∅ := by { ext, simp }

@[simp]
lemma divisors_antidiagonal_one : divisors_antidiagonal 1 = {(1,1)} :=
by { ext, simp [nat.mul_eq_one_iff, prod.ext_iff], }

lemma swap_mem_divisors_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.swap ∈ divisors_antidiagonal n :=
begin
  rw [mem_divisors_antidiagonal, mul_comm] at h,
  simp [h.1, h.2],
end

lemma snd_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.snd ∈ divisors n :=
begin
  rw mem_divisors_antidiagonal at h,
  simp [dvd.intro_left _ h.1, h.2],
end

@[simp]
lemma map_swap_divisors_antidiagonal :
  (divisors_antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩
  = divisors_antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_divisors_antidiagonal, finset.mem_map, function.embedding.coe_fn_mk,
             ne.def, prod.swap_prod_mk, prod.exists],
  split,
  { rintros ⟨x, y, ⟨⟨rfl, h⟩, rfl⟩⟩,
    simp [mul_comm, h], },
  { rintros ⟨rfl, h⟩,
    use [a.snd, a.fst],
    rw mul_comm,
    simp [h] }
end

lemma sum_divisors_eq_sum_proper_divisors_add_self :
∑ i in divisors n, i = ∑ i in proper_divisors n, i + n :=
begin
  cases n,
  { simp },
  { rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _),
        finset.sum_insert (proper_divisors.not_self_mem), add_comm] }
end

/-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
  is positive. -/
def perfect (n : ℕ) : Prop := (∑ i in proper_divisors n, i = n) ∧ 0 < n

theorem perfect_iff_sum_proper_divisors (h : 0 < n) :
  perfect n ↔ ∑ i in proper_divisors n, i = n := and_iff_left h

theorem perfect_iff_sum_divisors_eq_two_mul (h : 0 < n) :
  perfect n ↔ ∑ i in divisors n, i = 2 * n :=
begin
  rw [perfect_iff_sum_proper_divisors h, sum_divisors_eq_sum_proper_divisors_add_self, two_mul],
  split; intro h,
  { rw h },
  { apply add_right_cancel h }
end

lemma mem_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) {x : ℕ} :
  x ∈ divisors (p ^ k) ↔ ∃ (j : ℕ) (H : j ≤ k), x = p ^ j :=
by rw [mem_divisors, nat.dvd_prime_pow pp, and_iff_left (ne_of_gt (pow_pos pp.pos k))]

lemma prime.divisors {p : ℕ} (pp : p.prime) :
  divisors p = {1, p} :=
begin
  ext,
  simp only [pp.ne_zero, and_true, ne.def, not_false_iff, finset.mem_insert,
    finset.mem_singleton, mem_divisors],
  refine ⟨pp.2 a, λ h, _⟩,
  rcases h; subst h,
  apply one_dvd,
end

lemma prime.proper_divisors {p : ℕ} (pp : p.prime) :
  proper_divisors p = {1} :=
by rw [← erase_insert (proper_divisors.not_self_mem),
    ← divisors_eq_proper_divisors_insert_self_of_pos pp.pos,
    pp.divisors, insert_singleton_comm, erase_insert (λ con, pp.ne_one (mem_singleton.1 con))]

lemma divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
  divisors (p ^ k) = (finset.range (k + 1)).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
by { ext, simp [mem_divisors_prime_pow, pp, nat.lt_succ_iff, @eq_comm _ a] }

lemma eq_proper_divisors_of_subset_of_sum_eq_sum {s : finset ℕ} (hsub : s ⊆ n.proper_divisors) :
  ∑ x in s, x = ∑ x in n.proper_divisors, x → s = n.proper_divisors :=
begin
  cases n,
  { rw [proper_divisors_zero, subset_empty] at hsub,
    simp [hsub] },
  classical,
  rw [← sum_sdiff hsub],
  intros h,
  apply subset.antisymm hsub,
  rw [← sdiff_eq_empty_iff_subset],
  contrapose h,
  rw [← ne.def, ← nonempty_iff_ne_empty] at h,
  apply ne_of_lt,
  rw [← zero_add (∑ x in s, x), ← add_assoc, add_zero],
  apply add_lt_add_right,
  have hlt := sum_lt_sum_of_nonempty h (λ x hx, pos_of_mem_proper_divisors (sdiff_subset _ _ hx)),
  simp only [sum_const_zero] at hlt,
  apply hlt
end

lemma sum_proper_divisors_dvd (h : ∑ x in n.proper_divisors, x ∣ n) :
  (∑ x in n.proper_divisors, x = 1) ∨ (∑ x in n.proper_divisors, x = n) :=
begin
  cases n,
  { simp },
  cases n,
  { contrapose! h,
    simp, },
  rw or_iff_not_imp_right,
  intro ne_n,
  have hlt : ∑ x in n.succ.succ.proper_divisors, x < n.succ.succ :=
    lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h) ne_n,
  symmetry,
  rw [← mem_singleton, eq_proper_divisors_of_subset_of_sum_eq_sum (singleton_subset_iff.2
        (mem_proper_divisors.2 ⟨h, hlt⟩)) sum_singleton, mem_proper_divisors],
  refine ⟨one_dvd _, nat.succ_lt_succ (nat.succ_pos _)⟩,
end

@[simp]
lemma prime.sum_proper_divisors {α : Type*} [add_comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∑ x in p.proper_divisors, f x = f 1 :=
by simp [h.proper_divisors]

@[simp]
lemma prime.sum_divisors {α : Type*} [add_comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∑ x in p.divisors, f x = f p + f 1 :=
by rw [divisors_eq_proper_divisors_insert_self_of_pos h.pos,
       sum_insert proper_divisors.not_self_mem, h.sum_proper_divisors]

lemma proper_divisors_eq_singleton_one_iff_prime :
  n.proper_divisors = {1} ↔ n.prime :=
⟨λ h, begin
  have h1 := mem_singleton.2 rfl,
  rw [← h, mem_proper_divisors] at h1,
  refine ⟨h1.2, _⟩,
  intros m hdvd,
  rw [← mem_singleton, ← h, mem_proper_divisors],
  cases lt_or_eq_of_le (nat.le_of_dvd (lt_trans (nat.succ_pos _) h1.2) hdvd),
  { left,
    exact ⟨hdvd, h_1⟩ },
  { right,
    exact h_1 }
end, prime.proper_divisors⟩

lemma sum_proper_divisors_eq_one_iff_prime :
  ∑ x in n.proper_divisors, x = 1 ↔ n.prime :=
begin
  cases n,
  { simp [nat.not_prime_zero] },
  cases n,
  { simp [nat.not_prime_one] },
  rw [← proper_divisors_eq_singleton_one_iff_prime],
  refine ⟨λ h, _, λ h, h.symm ▸ sum_singleton⟩,
  rw [@eq_comm (finset ℕ) _ _],
  apply eq_proper_divisors_of_subset_of_sum_eq_sum
    (singleton_subset_iff.2 (one_mem_proper_divisors_iff_one_lt.2 (succ_lt_succ (nat.succ_pos _))))
    (eq.trans sum_singleton h.symm)
end

@[simp]
lemma prod_divisors_prime {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in p.divisors, f x = f p * f 1 :=
@prime.sum_divisors (additive α) _ _ _ h

@[simp]
lemma sum_divisors_prime_pow {α : Type*} [add_comm_monoid α] {k p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∑ x in (p ^ k).divisors, f x = ∑ x in range (k + 1), f (p ^ x) :=
by simp [h, divisors_prime_pow]

@[simp]
lemma prod_divisors_prime_pow {α : Type*} [comm_monoid α] {k p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in (p ^ k).divisors, f x = ∏ x in range (k + 1), f (p ^ x) :=
@sum_divisors_prime_pow (additive α) _ _ _ _ h

@[simp]
lemma filter_dvd_eq_divisors {n : ℕ} (h : n ≠ 0) :
  finset.filter (λ (x : ℕ), x ∣ n) (finset.range (n : ℕ).succ) = (n : ℕ).divisors :=
begin
  apply finset.ext,
  simp only [h, mem_filter, and_true, and_iff_right_iff_imp, cast_id, mem_range, ne.def,
  not_false_iff, mem_divisors],
  intros a ha,
  exact nat.lt_succ_of_le (nat.divisor_le (nat.mem_divisors.2 ⟨ha, h⟩))
end

end nat


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

/-!
# Orientations of real inner product spaces.

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

## Main definitions

* `orthonormal_basis.adjust_to_orientation` takes an orthonormal basis and an orientation, and
  returns an orthonormal basis with that orientation: either the original orthonormal basis, or one
  constructed by negating a single (arbitrary) basis vector.
* `orientation.fin_orthonormal_basis` is an orthonormal basis, indexed by `fin n`, with the given
  orientation.
* `orientation.volume_form` is a nonvanishing top-dimensional alternating form on an oriented real
  inner product space, uniquely defined by compatibility with the orientation and inner product
  structure.

## Main theorems

* `orientation.volume_form_apply_le` states that the result of applying the volume form to a set of
  `n` vectors, where `n` is the dimension the inner product space, is bounded by the product of the
  lengths of the vectors.
* `orientation.abs_volume_form_apply_of_pairwise_orthogonal` states that the result of applying the
  volume form to a set of `n` orthogonal vectors, where `n` is the dimension the inner product
  space, is equal up to sign to the product of the lengths of the vectors.

-/

noncomputable theory

variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E]

open finite_dimensional
open_locale big_operators real_inner_product_space

namespace orthonormal_basis
variables {ι : Type*} [fintype ι] [decidable_eq ι] [ne : nonempty ι] (e f : orthonormal_basis ι ℝ E)
  (x : orientation ℝ E ι)

/-- The change-of-basis matrix between two orthonormal bases with the same orientation has
determinant 1. -/
lemma det_to_matrix_orthonormal_basis_of_same_orientation
  (h : e.to_basis.orientation = f.to_basis.orientation) :
  e.to_basis.det f = 1 :=
begin
  apply (e.det_to_matrix_orthonormal_basis_real f).resolve_right,
  have : 0 < e.to_basis.det f,
  { rw e.to_basis.orientation_eq_iff_det_pos at h,
    simpa using h },
  linarith,
end

/-- The change-of-basis matrix between two orthonormal bases with the opposite orientations has
determinant -1. -/
lemma det_to_matrix_orthonormal_basis_of_opposite_orientation
  (h : e.to_basis.orientation ≠ f.to_basis.orientation) :
  e.to_basis.det f = -1 :=
begin
  contrapose! h,
  simp [e.to_basis.orientation_eq_iff_det_pos,
    (e.det_to_matrix_orthonormal_basis_real f).resolve_right h],
end

variables {e f}

/-- Two orthonormal bases with the same orientation determine the same "determinant" top-dimensional
form on `E`, and conversely. -/
lemma same_orientation_iff_det_eq_det :
  e.to_basis.det = f.to_basis.det ↔ e.to_basis.orientation = f.to_basis.orientation :=
begin
  split,
  { intros h,
    dsimp [basis.orientation],
    congr' },
  { intros h,
    rw e.to_basis.det.eq_smul_basis_det f.to_basis,
    simp [e.det_to_matrix_orthonormal_basis_of_same_orientation f h], },
end

variables (e f)

/-- Two orthonormal bases with opposite orientations determine opposite "determinant"
top-dimensional forms on `E`. -/
lemma det_eq_neg_det_of_opposite_orientation
  (h : e.to_basis.orientation ≠ f.to_basis.orientation) :
  e.to_basis.det = -f.to_basis.det :=
begin
  rw e.to_basis.det.eq_smul_basis_det f.to_basis,
  simp [e.det_to_matrix_orthonormal_basis_of_opposite_orientation f h],
end

section adjust_to_orientation
include ne

/-- `orthonormal_basis.adjust_to_orientation`, applied to an orthonormal basis, preserves the
property of orthonormality. -/
lemma orthonormal_adjust_to_orientation : orthonormal ℝ (e.to_basis.adjust_to_orientation x) :=
begin
  apply e.orthonormal.orthonormal_of_forall_eq_or_eq_neg,
  simpa using e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x
end

/-- Given an orthonormal basis and an orientation, return an orthonormal basis giving that
orientation: either the original basis, or one constructed by negating a single (arbitrary) basis
vector. -/
def adjust_to_orientation : orthonormal_basis ι ℝ E :=
(e.to_basis.adjust_to_orientation x).to_orthonormal_basis (e.orthonormal_adjust_to_orientation x)

lemma to_basis_adjust_to_orientation :
  (e.adjust_to_orientation x).to_basis = e.to_basis.adjust_to_orientation x :=
(e.to_basis.adjust_to_orientation x).to_basis_to_orthonormal_basis _

/-- `adjust_to_orientation` gives an orthonormal basis with the required orientation. -/
@[simp] lemma orientation_adjust_to_orientation :
  (e.adjust_to_orientation x).to_basis.orientation = x :=
begin
  rw e.to_basis_adjust_to_orientation,
  exact e.to_basis.orientation_adjust_to_orientation x,
end

/-- Every basis vector from `adjust_to_orientation` is either that from the original basis or its
negation. -/
lemma adjust_to_orientation_apply_eq_or_eq_neg (i : ι) :
  e.adjust_to_orientation x i = e i ∨ e.adjust_to_orientation x i = -(e i) :=
by simpa [← e.to_basis_adjust_to_orientation]
  using e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x i

lemma det_adjust_to_orientation :
  (e.adjust_to_orientation x).to_basis.det = e.to_basis.det
  ∨ (e.adjust_to_orientation x).to_basis.det = -e.to_basis.det :=
by simpa using e.to_basis.det_adjust_to_orientation x

lemma abs_det_adjust_to_orientation (v : ι → E) :
  |(e.adjust_to_orientation x).to_basis.det v| = |e.to_basis.det v| :=
by simp [to_basis_adjust_to_orientation]

end adjust_to_orientation

end orthonormal_basis

namespace orientation
variables {n : ℕ}

open orthonormal_basis

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

/-- `orientation.fin_orthonormal_basis` gives a basis with the required orientation. -/
@[simp] lemma fin_orthonormal_basis_orientation (hn : 0 < n)
  (h : finrank ℝ E = n) (x : orientation ℝ E (fin n)) :
  (x.fin_orthonormal_basis hn h).to_basis.orientation = x :=
begin
  haveI := fin.pos_iff_nonempty.1 hn,
  haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E),
  exact ((std_orthonormal_basis _ _).reindex $ fin_congr h).orientation_adjust_to_orientation x
end

section volume_form
variables [_i : fact (finrank ℝ E = n)] (o : orientation ℝ E (fin n))

include _i o

/-- The volume form on an oriented real inner product space, a nonvanishing top-dimensional
alternating form uniquely defined by compatibility with the orientation and inner product structure.
-/
@[irreducible] def volume_form : alternating_map ℝ E ℝ (fin n) :=
begin
  classical,
  unfreezingI { cases n },
  { let opos : alternating_map ℝ E ℝ (fin 0) := alternating_map.const_of_is_empty ℝ E (1:ℝ),
    exact o.eq_or_eq_neg_of_is_empty.by_cases (λ _, opos) (λ _, -opos) },
  { exact (o.fin_orthonormal_basis n.succ_pos _i.out).to_basis.det }
end

omit _i o

@[simp] lemma volume_form_zero_pos [_i : fact (finrank ℝ E = 0)] :
  orientation.volume_form (positive_orientation : orientation ℝ E (fin 0))
  = alternating_map.const_linear_equiv_of_is_empty 1 :=
by simp [volume_form, or.by_cases, if_pos]

lemma volume_form_zero_neg [_i : fact (finrank ℝ E = 0)] :
  orientation.volume_form (-positive_orientation : orientation ℝ E (fin 0))
  = - alternating_map.const_linear_equiv_of_is_empty 1 :=
begin
  dsimp [volume_form, or.by_cases, positive_orientation],
  apply if_neg,
  rw [ray_eq_iff, same_ray_comm],
  intros h,
  simpa using
    congr_arg alternating_map.const_linear_equiv_of_is_empty.symm (eq_zero_of_same_ray_self_neg h),
end

include _i o

/-- The volume form on an oriented real inner product space can be evaluated as the determinant with
respect to any orthonormal basis of the space compatible with the orientation. -/
lemma volume_form_robust (b : orthonormal_basis (fin n) ℝ E) (hb : b.to_basis.orientation = o) :
  o.volume_form = b.to_basis.det :=
begin
  unfreezingI { cases n },
  { classical,
    have : o = positive_orientation := hb.symm.trans b.to_basis.orientation_is_empty,
    simp [volume_form, or.by_cases, dif_pos this] },
  { dsimp [volume_form],
    rw [same_orientation_iff_det_eq_det, hb],
    exact o.fin_orthonormal_basis_orientation _ _ },
end

/-- The volume form on an oriented real inner product space can be evaluated as the determinant with
respect to any orthonormal basis of the space compatible with the orientation. -/
lemma volume_form_robust_neg (b : orthonormal_basis (fin n) ℝ E)
  (hb : b.to_basis.orientation ≠ o) :
  o.volume_form = - b.to_basis.det :=
begin
  unfreezingI { cases n },
  { classical,
    have : positive_orientation ≠ o := by rwa b.to_basis.orientation_is_empty at hb,
    simp [volume_form, or.by_cases, dif_neg this.symm] },
  let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _),
  dsimp [volume_form],
  apply e.det_eq_neg_det_of_opposite_orientation b,
  convert hb.symm,
  exact o.fin_orthonormal_basis_orientation _ _,
end

@[simp] lemma volume_form_neg_orientation : (-o).volume_form = - o.volume_form :=
begin
  unfreezingI { cases n },
  { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp [volume_form_zero_neg] },
  let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _),
  have h₁ : e.to_basis.orientation = o := o.fin_orthonormal_basis_orientation _ _,
  have h₂ : e.to_basis.orientation ≠ -o,
  { symmetry,
    rw [e.to_basis.orientation_ne_iff_eq_neg, h₁] },
  rw [o.volume_form_robust e h₁, (-o).volume_form_robust_neg e h₂],
end

lemma volume_form_robust' (b : orthonormal_basis (fin n) ℝ E) (v : fin n → E) :
  |o.volume_form v| = |b.to_basis.det v| :=
begin
  unfreezingI { cases n },
  { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp },
  { rw [o.volume_form_robust (b.adjust_to_orientation o) (b.orientation_adjust_to_orientation o),
      b.abs_det_adjust_to_orientation] },
end

/-- Let `v` be an indexed family of `n` vectors in an oriented `n`-dimensional real inner
product space `E`. The output of the volume form of `E` when evaluated on `v` is bounded in absolute
value by the product of the norms of the vectors `v i`. -/
lemma abs_volume_form_apply_le (v : fin n → E) : |o.volume_form v| ≤ ∏ i : fin n, ‖v i‖ :=
begin
  unfreezingI { cases n },
  { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp },
  haveI : finite_dimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n,
  have : finrank ℝ E = fintype.card (fin n.succ) := by simpa using _i.out,
  let b : orthonormal_basis (fin n.succ) ℝ E := gram_schmidt_orthonormal_basis this v,
  have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gram_schmidt_orthonormal_basis_det this v,
  rw [o.volume_form_robust' b, hb, finset.abs_prod],
  apply finset.prod_le_prod,
  { intros i hi,
    positivity },
  intros i hi,
  convert abs_real_inner_le_norm (b i) (v i),
  simp [b.orthonormal.1 i],
end

lemma volume_form_apply_le (v : fin n → E) : o.volume_form v ≤ ∏ i : fin n, ‖v i‖ :=
(le_abs_self _).trans (o.abs_volume_form_apply_le v)

/-- Let `v` be an indexed family of `n` orthogonal vectors in an oriented `n`-dimensional
real inner product space `E`. The output of the volume form of `E` when evaluated on `v` is, up to
sign, the product of the norms of the vectors `v i`. -/
lemma abs_volume_form_apply_of_pairwise_orthogonal
  {v : fin n → E} (hv : pairwise (λ i j, ⟪v i, v j⟫ = 0)) :
  |o.volume_form v| = ∏ i : fin n, ‖v i‖ :=
begin
  unfreezingI { cases n },
  { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp },
  haveI : finite_dimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n,
  have hdim : finrank ℝ E = fintype.card (fin n.succ) := by simpa using _i.out,
  let b : orthonormal_basis (fin n.succ) ℝ E := gram_schmidt_orthonormal_basis hdim v,
  have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gram_schmidt_orthonormal_basis_det hdim v,
  rw [o.volume_form_robust' b, hb, finset.abs_prod],
  by_cases h : ∃ i, v i = 0,
  obtain ⟨i, hi⟩ := h,
  { rw [finset.prod_eq_zero (finset.mem_univ i), finset.prod_eq_zero (finset.mem_univ i)];
    simp [hi] },
  push_neg at h,
  congr,
  ext i,
  have hb : b i = ‖v i‖⁻¹ • v i := gram_schmidt_orthonormal_basis_apply_of_orthogonal hdim hv (h i),
  simp only [hb, inner_smul_left, real_inner_self_eq_norm_mul_norm, is_R_or_C.conj_to_real],
  rw abs_of_nonneg,
  { have : ‖v i‖ ≠ 0 := by simpa using h i,
    field_simp },
  { positivity },
end

/-- The output of the volume form of an oriented real inner product space `E` when evaluated on an
orthonormal basis is ±1. -/
lemma abs_volume_form_apply_of_orthonormal (v : orthonormal_basis (fin n) ℝ E) :
  |o.volume_form v| = 1 :=
by simpa [o.volume_form_robust' v v] using congr_arg abs v.to_basis.det_self

lemma volume_form_map {F : Type*}
  [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = n)]
  (φ : E ≃ₗᵢ[ℝ] F) (x : fin n → F) :
  (orientation.map (fin n) φ.to_linear_equiv o).volume_form x = o.volume_form (φ.symm ∘ x) :=
begin
  unfreezingI { cases n },
  { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp },
  let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _),
  have he : e.to_basis.orientation = o :=
    (o.fin_orthonormal_basis_orientation n.succ_pos (fact.out _)),
  have heφ : (e.map φ).to_basis.orientation = orientation.map (fin n.succ) φ.to_linear_equiv o,
  { rw ← he,
    exact (e.to_basis.orientation_map φ.to_linear_equiv) },
  rw (orientation.map (fin n.succ) φ.to_linear_equiv o).volume_form_robust (e.map φ) heφ,
  rw o.volume_form_robust e he,
  simp,
end

/-- The volume form is invariant under pullback by a positively-oriented isometric automorphism. -/
lemma volume_form_comp_linear_isometry_equiv (φ : E ≃ₗᵢ[ℝ] E)
  (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) (x : fin n → E) :
  o.volume_form (φ ∘ x) = o.volume_form x :=
begin
  convert o.volume_form_map φ (φ ∘ x),
  { symmetry,
    rwa ← o.map_eq_iff_det_pos φ.to_linear_equiv at hφ,
    rw [_i.out, fintype.card_fin] },
  { ext,
    simp }
end

end volume_form

end orientation