/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import dynamics.ergodic.measure_preserving
import measure_theory.measure.regular
import measure_theory.group.measurable_equiv
import measure_theory.measure.open_pos
import measure_theory.group.action
import measure_theory.constructions.prod
import topology.continuous_function.cocompact_map

/-!
# Measures on Groups

We develop some properties of measures on (topological) groups

* We define properties on measures: measures that are left or right invariant w.r.t. multiplication.
* We define the measure `μ.inv : A ↦ μ(A⁻¹)` and show that it is right invariant iff
  `μ` is left invariant.
* We define a class `is_haar_measure μ`, requiring that the measure `μ` is left-invariant, finite
  on compact sets, and positive on open sets.

We also give analogues of all these notions in the additive world.
-/

noncomputable theory

open_locale nnreal ennreal pointwise big_operators topology
open has_inv set function measure_theory.measure filter

variables {𝕜 G H : Type*} [measurable_space G] [measurable_space H]

namespace measure_theory
namespace measure

/-- A measure `μ` on a measurable additive group is left invariant
  if the measure of left translations of a set are equal to the measure of the set itself. -/
class is_add_left_invariant [has_add G] (μ : measure G) : Prop :=
(map_add_left_eq_self : ∀ g : G, map ((+) g) μ = μ)

/-- A measure `μ` on a measurable group is left invariant
  if the measure of left translations of a set are equal to the measure of the set itself. -/
@[to_additive] class is_mul_left_invariant [has_mul G] (μ : measure G) : Prop :=
(map_mul_left_eq_self : ∀ g : G, map ((*) g) μ = μ)

/-- A measure `μ` on a measurable additive group is right invariant
  if the measure of right translations of a set are equal to the measure of the set itself. -/
class is_add_right_invariant [has_add G] (μ : measure G) : Prop :=
(map_add_right_eq_self : ∀ g : G, map (+ g) μ = μ)

/-- A measure `μ` on a measurable group is right invariant
  if the measure of right translations of a set are equal to the measure of the set itself. -/
@[to_additive] class is_mul_right_invariant [has_mul G] (μ : measure G) : Prop :=
(map_mul_right_eq_self : ∀ g : G, map (* g) μ = μ)

end measure
open measure

section mul

variables [has_mul G] {μ : measure G}

@[to_additive]
lemma map_mul_left_eq_self (μ : measure G) [is_mul_left_invariant μ] (g : G) : map ((*) g) μ = μ :=
is_mul_left_invariant.map_mul_left_eq_self g

@[to_additive]
lemma map_mul_right_eq_self (μ : measure G) [is_mul_right_invariant μ] (g : G) : map (* g) μ = μ :=
is_mul_right_invariant.map_mul_right_eq_self g

@[to_additive measure_theory.is_add_left_invariant_smul]
instance is_mul_left_invariant_smul [is_mul_left_invariant μ] (c : ℝ≥0∞) :
  is_mul_left_invariant (c • μ) :=
⟨λ g, by rw [measure.map_smul, map_mul_left_eq_self]⟩

@[to_additive measure_theory.is_add_right_invariant_smul]
instance is_mul_right_invariant_smul [is_mul_right_invariant μ] (c : ℝ≥0∞) :
  is_mul_right_invariant (c • μ) :=
⟨λ g, by rw [measure.map_smul, map_mul_right_eq_self]⟩

@[to_additive measure_theory.is_add_left_invariant_smul_nnreal]
instance is_mul_left_invariant_smul_nnreal [is_mul_left_invariant μ] (c : ℝ≥0) :
  is_mul_left_invariant (c • μ) :=
measure_theory.is_mul_left_invariant_smul (c : ℝ≥0∞)

@[to_additive measure_theory.is_add_right_invariant_smul_nnreal]
instance is_mul_right_invariant_smul_nnreal [is_mul_right_invariant μ] (c : ℝ≥0) :
  is_mul_right_invariant (c • μ) :=
measure_theory.is_mul_right_invariant_smul (c : ℝ≥0∞)

section has_measurable_mul

variables [has_measurable_mul G]

@[to_additive]
lemma measure_preserving_mul_left (μ : measure G) [is_mul_left_invariant μ] (g : G) :
  measure_preserving ((*) g) μ μ :=
⟨measurable_const_mul g, map_mul_left_eq_self μ g⟩

@[to_additive]
lemma measure_preserving.mul_left (μ : measure G) [is_mul_left_invariant μ] (g : G)
  {X : Type*} [measurable_space X] {μ' : measure X} {f : X → G} (hf : measure_preserving f μ' μ) :
  measure_preserving (λ x, g * f x) μ' μ :=
(measure_preserving_mul_left μ g).comp hf

@[to_additive]
lemma measure_preserving_mul_right (μ : measure G) [is_mul_right_invariant μ] (g : G) :
  measure_preserving (* g) μ μ :=
⟨measurable_mul_const g, map_mul_right_eq_self μ g⟩

@[to_additive]
lemma measure_preserving.mul_right (μ : measure G) [is_mul_right_invariant μ] (g : G)
  {X : Type*} [measurable_space X] {μ' : measure X} {f : X → G} (hf : measure_preserving f μ' μ) :
  measure_preserving (λ x, f x * g) μ' μ :=
(measure_preserving_mul_right μ g).comp hf

@[to_additive]
instance is_mul_left_invariant.smul_invariant_measure [is_mul_left_invariant μ] :
  smul_invariant_measure G G μ :=
⟨λ x s hs, (measure_preserving_mul_left μ x).measure_preimage hs⟩

@[to_additive]
instance is_mul_right_invariant.to_smul_invariant_measure_op [μ.is_mul_right_invariant] :
  smul_invariant_measure Gᵐᵒᵖ G μ :=
⟨λ x s hs, (measure_preserving_mul_right μ (mul_opposite.unop x)).measure_preimage hs⟩

@[to_additive]
instance subgroup.smul_invariant_measure
  {G α : Type*} [group G] [mul_action G α] [measurable_space α]
  {μ : measure α} [smul_invariant_measure G α μ] (H : subgroup G) :
  smul_invariant_measure H α μ :=
⟨λ y s hs, by convert smul_invariant_measure.measure_preimage_smul μ (y : G) hs⟩

/-- An alternative way to prove that `μ` is left invariant under multiplication. -/
@[to_additive /-" An alternative way to prove that `μ` is left invariant under addition. "-/]
lemma forall_measure_preimage_mul_iff (μ : measure G) :
  (∀ (g : G) (A : set G), measurable_set A → μ ((λ h, g * h) ⁻¹' A) = μ A) ↔
  is_mul_left_invariant μ :=
begin
  transitivity ∀ g, map ((*) g) μ = μ,
  { simp_rw [measure.ext_iff],
    refine forall_congr (λ g, forall_congr $ λ A, forall_congr $ λ hA, _),
    rw [map_apply (measurable_const_mul g) hA] },
  exact ⟨λ h, ⟨h⟩, λ h, h.1⟩
end

/-- An alternative way to prove that `μ` is right invariant under multiplication. -/
@[to_additive /-" An alternative way to prove that `μ` is right invariant under addition. "-/]
lemma forall_measure_preimage_mul_right_iff (μ : measure G) :
  (∀ (g : G) (A : set G), measurable_set A → μ ((λ h, h * g) ⁻¹' A) = μ A) ↔
  is_mul_right_invariant μ :=
begin
  transitivity ∀ g, map (* g) μ = μ,
  { simp_rw [measure.ext_iff],
    refine forall_congr (λ g, forall_congr $ λ A, forall_congr $ λ hA, _),
    rw [map_apply (measurable_mul_const g) hA] },
  exact ⟨λ h, ⟨h⟩, λ h, h.1⟩
end

@[to_additive]
instance [is_mul_left_invariant μ] [sigma_finite μ] {H : Type*} [has_mul H]
  {mH : measurable_space H} {ν : measure H} [has_measurable_mul H]
  [is_mul_left_invariant ν] [sigma_finite ν] :
  is_mul_left_invariant (μ.prod ν) :=
begin
  constructor,
  rintros ⟨g, h⟩,
  change map (prod.map ((*) g) ((*) h)) (μ.prod ν) = μ.prod ν,
  rw [← map_prod_map _ _ (measurable_const_mul g) (measurable_const_mul h),
    map_mul_left_eq_self μ g, map_mul_left_eq_self ν h],
  { rw map_mul_left_eq_self μ g, apply_instance },
  { rw map_mul_left_eq_self ν h, apply_instance },
end

@[to_additive]
instance [is_mul_right_invariant μ] [sigma_finite μ] {H : Type*} [has_mul H]
  {mH : measurable_space H} {ν : measure H} [has_measurable_mul H]
  [is_mul_right_invariant ν] [sigma_finite ν] :
  is_mul_right_invariant (μ.prod ν) :=
begin
  constructor,
  rintros ⟨g, h⟩,
  change map (prod.map (* g) (* h)) (μ.prod ν) = μ.prod ν,
  rw [← map_prod_map _ _ (measurable_mul_const g) (measurable_mul_const h),
    map_mul_right_eq_self μ g, map_mul_right_eq_self ν h],
  { rw map_mul_right_eq_self μ g, apply_instance },
  { rw map_mul_right_eq_self ν h, apply_instance },
end

@[to_additive]
lemma is_mul_left_invariant_map {H : Type*}
  [measurable_space H] [has_mul H] [has_measurable_mul H]
  [is_mul_left_invariant μ]
  (f : G →ₙ* H) (hf : measurable f) (h_surj : surjective f) :
  is_mul_left_invariant (measure.map f μ) :=
begin
  refine ⟨λ h, _⟩,
  rw map_map (measurable_const_mul _) hf,
  obtain ⟨g, rfl⟩ := h_surj h,
  conv_rhs { rw ← map_mul_left_eq_self μ g },
  rw map_map hf (measurable_const_mul _),
  congr' 2,
  ext y,
  simp only [comp_app, map_mul],
end

end has_measurable_mul

end mul

section div_inv_monoid
variables [div_inv_monoid G]

@[to_additive]
lemma map_div_right_eq_self (μ : measure G) [is_mul_right_invariant μ] (g : G) :
  map (/ g) μ = μ :=
by simp_rw [div_eq_mul_inv, map_mul_right_eq_self μ g⁻¹]

end div_inv_monoid

section group
variables [group G] [has_measurable_mul G]

@[to_additive]
lemma measure_preserving_div_right (μ : measure G) [is_mul_right_invariant μ]
  (g : G) : measure_preserving (/ g) μ μ :=
by simp_rw [div_eq_mul_inv, measure_preserving_mul_right μ g⁻¹]

/-- We shorten this from `measure_preimage_mul_left`, since left invariant is the preferred option
  for measures in this formalization. -/
@[simp, to_additive "We shorten this from `measure_preimage_add_left`, since left invariant is the
preferred option for measures in this formalization."]
lemma measure_preimage_mul (μ : measure G) [is_mul_left_invariant μ] (g : G) (A : set G) :
  μ ((λ h, g * h) ⁻¹' A) = μ A :=
calc μ ((λ h, g * h) ⁻¹' A) = map (λ h, g * h) μ A :
  ((measurable_equiv.mul_left g).map_apply A).symm
... = μ A : by rw map_mul_left_eq_self μ g

@[simp, to_additive]
lemma measure_preimage_mul_right (μ : measure G) [is_mul_right_invariant μ] (g : G) (A : set G) :
  μ ((λ h, h * g) ⁻¹' A) = μ A :=
calc μ ((λ h, h * g) ⁻¹' A) = map (λ h, h * g) μ A :
  ((measurable_equiv.mul_right g).map_apply A).symm
... = μ A : by rw map_mul_right_eq_self μ g

@[to_additive]
lemma map_mul_left_ae (μ : measure G) [is_mul_left_invariant μ] (x : G) :
  filter.map (λ h, x * h) μ.ae = μ.ae :=
((measurable_equiv.mul_left x).map_ae μ).trans $ congr_arg ae $ map_mul_left_eq_self μ x

@[to_additive]
lemma map_mul_right_ae (μ : measure G) [is_mul_right_invariant μ] (x : G) :
  filter.map (λ h, h * x) μ.ae = μ.ae :=
((measurable_equiv.mul_right x).map_ae μ).trans $ congr_arg ae $ map_mul_right_eq_self μ x

@[to_additive]
lemma map_div_right_ae (μ : measure G) [is_mul_right_invariant μ] (x : G) :
  filter.map (λ t, t / x) μ.ae = μ.ae :=
((measurable_equiv.div_right x).map_ae μ).trans $ congr_arg ae $ map_div_right_eq_self μ x

@[to_additive]
lemma eventually_mul_left_iff (μ : measure G) [is_mul_left_invariant μ] (t : G) {p : G → Prop} :
  (∀ᵐ x ∂μ, p (t * x)) ↔ ∀ᵐ x ∂μ, p x :=
by { conv_rhs { rw [filter.eventually, ← map_mul_left_ae μ t] }, refl }

@[to_additive]
lemma eventually_mul_right_iff (μ : measure G) [is_mul_right_invariant μ] (t : G) {p : G → Prop} :
  (∀ᵐ x ∂μ, p (x * t)) ↔ ∀ᵐ x ∂μ, p x :=
by { conv_rhs { rw [filter.eventually, ← map_mul_right_ae μ t] }, refl }

@[to_additive]
lemma eventually_div_right_iff (μ : measure G) [is_mul_right_invariant μ] (t : G) {p : G → Prop} :
  (∀ᵐ x ∂μ, p (x / t)) ↔ ∀ᵐ x ∂μ, p x :=
by { conv_rhs { rw [filter.eventually, ← map_div_right_ae μ t] }, refl }

end group

namespace measure

/-- The measure `A ↦ μ (A⁻¹)`, where `A⁻¹` is the pointwise inverse of `A`. -/
@[to_additive "The measure `A ↦ μ (- A)`, where `- A` is the pointwise negation of `A`."]
protected def inv [has_inv G] (μ : measure G) : measure G :=
measure.map inv μ

/-- A measure is invariant under negation if `- μ = μ`. Equivalently, this means that for all
measurable `A` we have `μ (- A) = μ A`, where `- A` is the pointwise negation of `A`. -/
class is_neg_invariant [has_neg G] (μ : measure G) : Prop :=
(neg_eq_self : μ.neg = μ)

/-- A measure is invariant under inversion if `μ⁻¹ = μ`. Equivalently, this means that for all
measurable `A` we have `μ (A⁻¹) = μ A`, where `A⁻¹` is the pointwise inverse of `A`. -/
@[to_additive] class is_inv_invariant [has_inv G] (μ : measure G) : Prop :=
(inv_eq_self : μ.inv = μ)

section inv

variables [has_inv G]

@[simp, to_additive]
lemma inv_eq_self (μ : measure G) [is_inv_invariant μ] : μ.inv = μ :=
is_inv_invariant.inv_eq_self

@[simp, to_additive]
lemma map_inv_eq_self (μ : measure G) [is_inv_invariant μ] : map has_inv.inv μ = μ :=
is_inv_invariant.inv_eq_self

variables [has_measurable_inv G]

@[to_additive]
lemma measure_preserving_inv (μ : measure G) [is_inv_invariant μ] :
  measure_preserving has_inv.inv μ μ :=
⟨measurable_inv, map_inv_eq_self μ⟩

end inv

section has_involutive_inv

variables [has_involutive_inv G] [has_measurable_inv G]

@[simp, to_additive]
lemma inv_apply (μ : measure G) (s : set G) : μ.inv s = μ s⁻¹ :=
(measurable_equiv.inv G).map_apply s

@[simp, to_additive]
protected lemma inv_inv (μ : measure G) : μ.inv.inv = μ :=
(measurable_equiv.inv G).map_symm_map

@[simp, to_additive]
lemma measure_inv (μ : measure G) [is_inv_invariant μ] (A : set G) : μ A⁻¹ = μ A :=
by rw [← inv_apply, inv_eq_self]

@[to_additive]
lemma measure_preimage_inv (μ : measure G) [is_inv_invariant μ] (A : set G) :
  μ (has_inv.inv ⁻¹' A) = μ A :=
μ.measure_inv A

@[to_additive]
instance (μ : measure G) [sigma_finite μ] : sigma_finite μ.inv :=
(measurable_equiv.inv G).sigma_finite_map ‹_›

end has_involutive_inv

section division_monoid
variables [division_monoid G] [has_measurable_mul G] [has_measurable_inv G] {μ : measure G}

@[to_additive]
instance [is_mul_left_invariant μ] : is_mul_right_invariant μ.inv :=
begin
  constructor,
  intro g,
  conv_rhs { rw [← map_mul_left_eq_self μ g⁻¹] },
  simp_rw [measure.inv, map_map (measurable_mul_const g) measurable_inv,
    map_map measurable_inv (measurable_const_mul g⁻¹), function.comp, mul_inv_rev, inv_inv]
end

@[to_additive]
instance [is_mul_right_invariant μ] : is_mul_left_invariant μ.inv :=
begin
  constructor,
  intro g,
  conv_rhs { rw [← map_mul_right_eq_self μ g⁻¹] },
  simp_rw [measure.inv, map_map (measurable_const_mul g) measurable_inv,
    map_map measurable_inv (measurable_mul_const g⁻¹), function.comp, mul_inv_rev, inv_inv]
end

@[to_additive]
lemma measure_preserving_div_left (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ]
  (g : G) : measure_preserving (λ t, g / t) μ μ :=
begin
  simp_rw [div_eq_mul_inv],
  exact (measure_preserving_mul_left μ g).comp (measure_preserving_inv μ)
end

@[to_additive]
lemma map_div_left_eq_self (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
  map (λ t, g / t) μ = μ :=
(measure_preserving_div_left μ g).map_eq

@[to_additive]
lemma measure_preserving_mul_right_inv (μ : measure G)
  [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
  measure_preserving (λ t, (g * t)⁻¹) μ μ :=
(measure_preserving_inv μ).comp $ measure_preserving_mul_left μ g

@[to_additive]
lemma map_mul_right_inv_eq_self (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ]
  (g : G) : map (λ t, (g * t)⁻¹) μ = μ :=
(measure_preserving_mul_right_inv μ g).map_eq

end division_monoid

section group
variables [group G] [has_measurable_mul G] [has_measurable_inv G] {μ : measure G}

@[to_additive]
lemma map_div_left_ae (μ : measure G) [is_mul_left_invariant μ] [is_inv_invariant μ] (x : G) :
  filter.map (λ t, x / t) μ.ae = μ.ae :=
((measurable_equiv.div_left x).map_ae μ).trans $ congr_arg ae $ map_div_left_eq_self μ x

end group

end measure

section topological_group

variables [topological_space G] [borel_space G] {μ : measure G} [group G]

@[to_additive]
instance measure.regular.inv [has_continuous_inv G] [t2_space G] [regular μ] : regular μ.inv :=
regular.map (homeomorph.inv G)

variables [topological_group G]

@[to_additive]
lemma regular_inv_iff [t2_space G] : μ.inv.regular ↔ μ.regular :=
begin
  split,
  { introI h, rw ← μ.inv_inv, exact measure.regular.inv },
  { introI h, exact measure.regular.inv }
end

variables [is_mul_left_invariant μ]

/-- If a left-invariant measure gives positive mass to a compact set, then it gives positive mass to
any open set. -/
@[to_additive "If a left-invariant measure gives positive mass to a compact set, then it gives
positive mass to any open set."]
lemma is_open_pos_measure_of_mul_left_invariant_of_compact
  (K : set G) (hK : is_compact K) (h : μ K ≠ 0) :
  is_open_pos_measure μ :=
begin
  refine ⟨λ U hU hne, _⟩,
  contrapose! h,
  rw ← nonpos_iff_eq_zero,
  rw ← hU.interior_eq at hne,
  obtain ⟨t, hKt⟩ : ∃ (t : finset G), K ⊆ ⋃ (g : G) (H : g ∈ t), (λ (h : G), g * h) ⁻¹' U :=
    compact_covered_by_mul_left_translates hK hne,
  calc μ K ≤ μ (⋃ (g : G) (H : g ∈ t), (λ (h : G), g * h) ⁻¹' U) : measure_mono hKt
  ... ≤ ∑ g in t, μ ((λ (h : G), g * h) ⁻¹' U) : measure_bUnion_finset_le _ _
  ... = 0 : by simp [measure_preimage_mul, h]
end

/-- A nonzero left-invariant regular measure gives positive mass to any open set. -/
@[to_additive "A nonzero left-invariant regular measure gives positive mass to any open set."]
lemma is_open_pos_measure_of_mul_left_invariant_of_regular [regular μ] (h₀ : μ ≠ 0) :
  is_open_pos_measure μ :=
let ⟨K, hK, h2K⟩ := regular.exists_compact_not_null.mpr h₀
in is_open_pos_measure_of_mul_left_invariant_of_compact K hK h2K

@[to_additive]
lemma null_iff_of_is_mul_left_invariant [regular μ]
  {s : set G} (hs : is_open s) :
  μ s = 0 ↔ s = ∅ ∨ μ = 0 :=
begin
  by_cases h3μ : μ = 0, { simp [h3μ] },
  { haveI := is_open_pos_measure_of_mul_left_invariant_of_regular h3μ,
    simp only [h3μ, or_false, hs.measure_eq_zero_iff μ] },
end

@[to_additive]
lemma measure_ne_zero_iff_nonempty_of_is_mul_left_invariant [regular μ]
  (hμ : μ ≠ 0) {s : set G} (hs : is_open s) :
  μ s ≠ 0 ↔ s.nonempty :=
by simpa [null_iff_of_is_mul_left_invariant hs, hμ] using nonempty_iff_ne_empty.symm

@[to_additive]
lemma measure_pos_iff_nonempty_of_is_mul_left_invariant [regular μ]
  (h3μ : μ ≠ 0) {s : set G} (hs : is_open s) :
  0 < μ s ↔ s.nonempty :=
pos_iff_ne_zero.trans $ measure_ne_zero_iff_nonempty_of_is_mul_left_invariant h3μ hs

/-- If a left-invariant measure gives finite mass to a nonempty open set, then it gives finite mass
to any compact set. -/
@[to_additive "If a left-invariant measure gives finite mass to a nonempty open set, then it gives
finite mass to any compact set."]
lemma measure_lt_top_of_is_compact_of_is_mul_left_invariant
  (U : set G) (hU : is_open U) (h'U : U.nonempty) (h : μ U ≠ ∞) {K : set G} (hK : is_compact K) :
  μ K < ∞ :=
begin
  rw ← hU.interior_eq at h'U,
  obtain ⟨t, hKt⟩ : ∃ (t : finset G), K ⊆ ⋃ (g : G) (H : g ∈ t), (λ (h : G), g * h) ⁻¹' U :=
    compact_covered_by_mul_left_translates hK h'U,
  calc μ K ≤ μ (⋃ (g : G) (H : g ∈ t), (λ (h : G), g * h) ⁻¹' U) : measure_mono hKt
  ... ≤ ∑ g in t, μ ((λ (h : G), g * h) ⁻¹' U) : measure_bUnion_finset_le _ _
  ... = finset.card t * μ U : by simp only [measure_preimage_mul, finset.sum_const, nsmul_eq_mul]
  ... < ∞ : ennreal.mul_lt_top (ennreal.nat_ne_top _) h
end

/-- If a left-invariant measure gives finite mass to a set with nonempty interior, then
it gives finite mass to any compact set. -/
@[to_additive "If a left-invariant measure gives finite mass to a set with nonempty interior, then
it gives finite mass to any compact set."]
lemma measure_lt_top_of_is_compact_of_is_mul_left_invariant'
  {U : set G} (hU : (interior U).nonempty) (h : μ U ≠ ∞) {K : set G} (hK : is_compact K) :
  μ K < ∞ :=
measure_lt_top_of_is_compact_of_is_mul_left_invariant (interior U) is_open_interior hU
  ((measure_mono (interior_subset)).trans_lt (lt_top_iff_ne_top.2 h)).ne hK

/-- In a noncompact locally compact group, a left-invariant measure which is positive
on open sets has infinite mass. -/
@[simp, to_additive "In a noncompact locally compact additive group, a left-invariant measure which
is positive on open sets has infinite mass."]
lemma measure_univ_of_is_mul_left_invariant [locally_compact_space G] [noncompact_space G]
  (μ : measure G) [is_open_pos_measure μ] [μ.is_mul_left_invariant] :
  μ univ = ∞ :=
begin
  /- Consider a closed compact set `K` with nonempty interior. For any compact set `L`, one may
  find `g = g (L)` such that `L` is disjoint from `g • K`. Iterating this, one finds
  infinitely many translates of `K` which are disjoint from each other. As they all have the
  same positive mass, it follows that the space has infinite measure. -/
  obtain ⟨K, hK, Kclosed, Kint⟩ : ∃ (K : set G), is_compact K ∧ is_closed K ∧ (1 : G) ∈ interior K,
  { rcases local_is_compact_is_closed_nhds_of_group (is_open_univ.mem_nhds (mem_univ (1 : G)))
      with ⟨K, hK⟩,
    exact ⟨K, hK.1, hK.2.1, hK.2.2.2⟩, },
  have K_pos : 0 < μ K, from measure_pos_of_nonempty_interior _ ⟨_, Kint⟩,
  have A : ∀ (L : set G), is_compact L → ∃ (g : G), disjoint L (g • K),
    from λ L hL, exists_disjoint_smul_of_is_compact hL hK,
  choose! g hg using A,
  set L : ℕ → set G := λ n, (λ T, T ∪ (g T • K))^[n] K with hL,
  have Lcompact : ∀ n, is_compact (L n),
  { assume n,
    induction n with n IH,
    { exact hK },
    { simp_rw [hL, iterate_succ'],
      apply is_compact.union IH (hK.smul (g (L n))) } },
  have Lclosed : ∀ n, is_closed (L n),
  { assume n,
    induction n with n IH,
    { exact Kclosed },
    { simp_rw [hL, iterate_succ'],
      apply is_closed.union IH (Kclosed.smul (g (L n))) } },
  have M : ∀ n, μ (L n) = (n + 1 : ℕ) * μ K,
  { assume n,
    induction n with n IH,
    { simp only [L, one_mul, algebra_map.coe_one, iterate_zero, id.def] },
    { calc μ (L (n + 1)) = μ (L n) + μ (g (L n) • K) :
        begin
          simp_rw [hL, iterate_succ'],
          exact measure_union' (hg _ (Lcompact _)) (Lclosed _).measurable_set
        end
      ... = ((n + 1) + 1 : ℕ) * μ K :
        by simp only [IH, measure_smul, add_mul, nat.cast_add, algebra_map.coe_one, one_mul] } },
  have N : tendsto (λ n, μ (L n)) at_top (𝓝 (∞ * μ K)),
  { simp_rw [M],
    apply ennreal.tendsto.mul_const _ (or.inl ennreal.top_ne_zero),
    exact ennreal.tendsto_nat_nhds_top.comp (tendsto_add_at_top_nat _) },
  simp only [ennreal.top_mul, K_pos.ne', if_false] at N,
  apply top_le_iff.1,
  exact le_of_tendsto' N (λ n, measure_mono (subset_univ _)),
end

end topological_group

section comm_semigroup

variables [comm_semigroup G]

/-- In an abelian group every left invariant measure is also right-invariant.
  We don't declare the converse as an instance, since that would loop type-class inference, and
  we use `is_mul_left_invariant` as the default hypothesis in abelian groups. -/
@[priority 100, to_additive is_add_left_invariant.is_add_right_invariant "In an abelian additive
group every left invariant measure is also right-invariant. We don't declare the converse as an
instance, since that would loop type-class inference, and we use `is_add_left_invariant` as the
default hypothesis in abelian groups."]
instance is_mul_left_invariant.is_mul_right_invariant {μ : measure G} [is_mul_left_invariant μ] :
  is_mul_right_invariant μ :=
⟨λ g, by simp_rw [mul_comm, map_mul_left_eq_self]⟩

end comm_semigroup

section haar

namespace measure

/-- A measure on an additive group is an additive Haar measure if it is left-invariant, and gives
finite mass to compact sets and positive mass to open sets. -/
class is_add_haar_measure {G : Type*} [add_group G] [topological_space G] [measurable_space G]
  (μ : measure G)
  extends is_finite_measure_on_compacts μ, is_add_left_invariant μ, is_open_pos_measure μ : Prop

/-- A measure on a group is a Haar measure if it is left-invariant, and gives finite mass to compact
sets and positive mass to open sets. -/
@[to_additive]
class is_haar_measure {G : Type*} [group G] [topological_space G] [measurable_space G]
  (μ : measure G)
  extends is_finite_measure_on_compacts μ, is_mul_left_invariant μ, is_open_pos_measure μ : Prop

/-- Record that a Haar measure on a locally compact space is locally finite. This is needed as the
fact that a measure which is finite on compacts is locally finite is not registered as an instance,
to avoid an instance loop.

See Note [lower instance priority]. -/

@[priority 100, to_additive "Record that an additive Haar measure on a locally compact space is
locally finite. This is needed as the fact that a measure which is finite on compacts is locally
finite is not registered as an instance, to avoid an instance loop.

See Note [lower instance priority]"]
instance is_locally_finite_measure_of_is_haar_measure {G : Type*}
  [group G] [measurable_space G] [topological_space G] [locally_compact_space G]
  (μ : measure G) [is_haar_measure μ] :
  is_locally_finite_measure μ :=
is_locally_finite_measure_of_is_finite_measure_on_compacts

section

variables [group G] [topological_space G] (μ : measure G) [is_haar_measure μ]

@[simp, to_additive]
lemma haar_singleton [topological_group G] [borel_space G] (g : G) :
  μ {g} = μ {(1 : G)} :=
begin
  convert measure_preimage_mul μ (g⁻¹) _,
  simp only [mul_one, preimage_mul_left_singleton, inv_inv],
end

@[to_additive measure_theory.measure.is_add_haar_measure.smul]
lemma is_haar_measure.smul {c : ℝ≥0∞} (cpos : c ≠ 0) (ctop : c ≠ ∞) :
  is_haar_measure (c • μ) :=
{ lt_top_of_is_compact := λ K hK, ennreal.mul_lt_top ctop hK.measure_lt_top.ne,
  to_is_open_pos_measure := is_open_pos_measure_smul μ cpos }

/-- If a left-invariant measure gives positive mass to some compact set with nonempty interior, then
it is a Haar measure. -/
@[to_additive "If a left-invariant measure gives positive mass to some compact set with nonempty
interior, then it is an additive Haar measure."]
lemma is_haar_measure_of_is_compact_nonempty_interior [topological_group G] [borel_space G]
  (μ : measure G) [is_mul_left_invariant μ]
  (K : set G) (hK : is_compact K) (h'K : (interior K).nonempty) (h : μ K ≠ 0) (h' : μ K ≠ ∞) :
  is_haar_measure μ :=
{ lt_top_of_is_compact :=
    λ L hL, measure_lt_top_of_is_compact_of_is_mul_left_invariant' h'K h' hL,
  to_is_open_pos_measure := is_open_pos_measure_of_mul_left_invariant_of_compact K hK h }

/-- The image of a Haar measure under a continuous surjective proper group homomorphism is again
a Haar measure. See also `mul_equiv.is_haar_measure_map`. -/
@[to_additive "The image of an additive Haar measure under a continuous surjective proper additive
group homomorphism is again an additive Haar measure. See also
`add_equiv.is_add_haar_measure_map`."]
lemma is_haar_measure_map [borel_space G] [topological_group G] {H : Type*} [group H]
  [topological_space H] [measurable_space H] [borel_space H] [t2_space H] [topological_group H]
  (f : G →* H) (hf : continuous f) (h_surj : surjective f)
  (h_prop : tendsto f (cocompact G) (cocompact H)) :
  is_haar_measure (measure.map f μ) :=
{ to_is_mul_left_invariant := is_mul_left_invariant_map f.to_mul_hom hf.measurable h_surj,
  lt_top_of_is_compact := begin
    assume K hK,
    rw map_apply hf.measurable hK.measurable_set,
    exact is_compact.measure_lt_top
      ((⟨⟨f, hf⟩, h_prop⟩ : cocompact_map G H).is_compact_preimage hK),
  end,
  to_is_open_pos_measure := hf.is_open_pos_measure_map h_surj }

/-- A convenience wrapper for `measure_theory.measure.is_haar_measure_map`. -/
@[to_additive "A convenience wrapper for `measure_theory.measure.is_add_haar_measure_map`."]
lemma _root_.mul_equiv.is_haar_measure_map
  [borel_space G] [topological_group G] {H : Type*} [group H]
  [topological_space H] [measurable_space H] [borel_space H] [t2_space H] [topological_group H]
  (e : G ≃* H) (he : continuous e) (hesymm : continuous e.symm) :
  is_haar_measure (measure.map e μ) :=
is_haar_measure_map μ (e : G →* H) he e.surjective
  ({ .. e } : G ≃ₜ H).to_cocompact_map.cocompact_tendsto'

/-- A Haar measure on a σ-compact space is σ-finite.

See Note [lower instance priority] -/
@[priority 100, to_additive "A Haar measure on a σ-compact space is σ-finite.

See Note [lower instance priority]"]
instance is_haar_measure.sigma_finite [sigma_compact_space G] : sigma_finite μ :=
⟨⟨{ set := compact_covering G,
  set_mem := λ n, mem_univ _,
  finite := λ n, is_compact.measure_lt_top $ is_compact_compact_covering G n,
  spanning := Union_compact_covering G }⟩⟩

@[to_additive]
instance {G : Type*} [group G] [topological_space G] {mG : measurable_space G}
  {H : Type*} [group H] [topological_space H] {mH : measurable_space H}
  (μ : measure G) (ν : measure H) [is_haar_measure μ] [is_haar_measure ν]
  [sigma_finite μ] [sigma_finite ν]
  [has_measurable_mul G] [has_measurable_mul H] :
  is_haar_measure (μ.prod ν) := {}

/-- If the neutral element of a group is not isolated, then a Haar measure on this group has
no atoms.

The additive version of this instance applies in particular to show that an additive Haar measure on
a nontrivial finite-dimensional real vector space has no atom. -/
@[priority 100, to_additive "If the zero element of an additive group is not isolated, then an
additive Haar measure on this group has no atoms.

This applies in particular to show that an additive Haar measure on a nontrivial finite-dimensional
real vector space has no atom."]
instance is_haar_measure.has_no_atoms [topological_group G] [borel_space G]
  [t1_space G] [locally_compact_space G] [(𝓝[≠] (1 : G)).ne_bot]
  (μ : measure G) [μ.is_haar_measure] :
  has_no_atoms μ :=
begin
  suffices H : μ {(1 : G)} ≤ 0, by { constructor, simp [le_bot_iff.1 H] },
  obtain ⟨K, K_compact, K_int⟩ : ∃ (K : set G), is_compact K ∧ (1 : G) ∈ interior K,
  { rcases exists_compact_subset is_open_univ (mem_univ (1 : G)) with ⟨K, hK⟩,
    exact ⟨K, hK.1, hK.2.1⟩ },
  have K_inf : set.infinite K := infinite_of_mem_nhds (1 : G) (mem_interior_iff_mem_nhds.1 K_int),
  have μKlt : μ K ≠ ∞ := K_compact.measure_lt_top.ne,
  have I : ∀ (n : ℕ), μ {(1 : G)} ≤ μ K / n,
  { assume n,
    obtain ⟨t, tK, tn⟩ : ∃ (t : finset G), ↑t ⊆ K ∧ t.card = n := K_inf.exists_subset_card_eq n,
    have A : μ t ≤ μ K := measure_mono tK,
    have B : μ t = n * μ {(1 : G)},
    { rw ← bUnion_of_singleton ↑t,
      change μ (⋃ (x ∈ t), {x}) = n * μ {1},
      rw @measure_bUnion_finset G G _ μ t (λ i, {i}),
      { simp only [tn, finset.sum_const, nsmul_eq_mul, haar_singleton] },
      { assume x hx y hy xy,
        simp only [on_fun, xy.symm, mem_singleton_iff, not_false_iff, disjoint_singleton_right] },
      { assume b hb, exact measurable_set_singleton b } },
    rw B at A,
    rwa [ennreal.le_div_iff_mul_le _ (or.inr μKlt), mul_comm],
    right,
    apply (measure_pos_of_nonempty_interior μ ⟨_, K_int⟩).ne' },
  have J : tendsto (λ (n : ℕ),  μ K / n) at_top (𝓝 (μ K / ∞)) :=
    ennreal.tendsto.const_div ennreal.tendsto_nat_nhds_top (or.inr μKlt),
  simp only [ennreal.div_top] at J,
  exact ge_of_tendsto' J I,
end

/- The above instance applies in particular to show that an additive Haar measure on a nontrivial
finite-dimensional real vector space has no atom. -/
example {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [nontrivial E]
  [finite_dimensional ℝ E] [measurable_space E] [borel_space E] (μ : measure E)
  [is_add_haar_measure μ] :
  has_no_atoms μ := by apply_instance

end

variables [nontrivially_normed_field 𝕜] [topological_space G] [topological_space H]
  [add_comm_group G] [add_comm_group H] [topological_add_group G] [topological_add_group H]
  [module 𝕜 G] [module 𝕜 H] (μ : measure G) [is_add_haar_measure μ] [borel_space G] [borel_space H]
  [t2_space H]

instance map_continuous_linear_equiv.is_add_haar_measure (e : G ≃L[𝕜] H) :
  is_add_haar_measure (μ.map e) :=
e.to_add_equiv.is_add_haar_measure_map _ e.continuous e.symm.continuous

variables [complete_space 𝕜] [t2_space G] [finite_dimensional 𝕜 G] [has_continuous_smul 𝕜 G]
  [has_continuous_smul 𝕜 H]

instance map_linear_equiv.is_add_haar_measure (e : G ≃ₗ[𝕜] H) : is_add_haar_measure (μ.map e) :=
map_continuous_linear_equiv.is_add_haar_measure _ e.to_continuous_linear_equiv

end measure
end haar

end measure_theory


syntax:max "fn " ident "=>" term : term
syntax:(lead+1) "function " ident "=>" term : term

macro_rules
  | `(fn $x:ident => $b) => `(fun $x:ident => $b)
  | `(function $x:ident => $b) => `(fun $x:ident => $b)

#check id fn x => x + 1
#check id function x => x + 1

macro "addPrec" : prec => `(65)
macro "mulPrec" : prec => `(70)

infix:addPrec " +' " => Nat.add
infix:mulPrec " *' " => Nat.mul

#eval 10 +' 2 *' 3

theorem ex1 : 10 +' 2 *' 3 = 16 :=
  rfl

theorem ex2 : 10 + 2 * 3 = 16 :=
  rfl

infix:(addPrec-1) " *'' " => Nat.mul

theorem ex3 : 10 +' 2 *'' 3 = 36 :=
  rfl


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison
-/
import topology.algebra.ring.basic
import topology.algebra.group_with_zero
import topology.local_extr
import field_theory.subfield

/-!
# Topological fields

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

A topological division ring is a topological ring whose inversion function is continuous at every
non-zero element.

-/

variables {K : Type*} [division_ring K] [topological_space K]

/-- Left-multiplication by a nonzero element of a topological division ring is proper, i.e.,
inverse images of compact sets are compact. -/
lemma filter.tendsto_cocompact_mul_left₀ [has_continuous_mul K] {a : K} (ha : a ≠ 0) :
  filter.tendsto (λ x : K, a * x) (filter.cocompact K) (filter.cocompact K) :=
filter.tendsto_cocompact_mul_left (inv_mul_cancel ha)

/-- Right-multiplication by a nonzero element of a topological division ring is proper, i.e.,
inverse images of compact sets are compact. -/
lemma filter.tendsto_cocompact_mul_right₀ [has_continuous_mul K] {a : K} (ha : a ≠ 0) :
  filter.tendsto (λ x : K, x * a) (filter.cocompact K) (filter.cocompact K) :=
filter.tendsto_cocompact_mul_right (mul_inv_cancel ha)

variables (K)

/-- A topological division ring is a division ring with a topology where all operations are
    continuous, including inversion. -/
class topological_division_ring extends topological_ring K, has_continuous_inv₀ K : Prop

section subfield

variables {α : Type*} [field α] [topological_space α] [topological_division_ring α]

/-- The (topological-space) closure of a subfield of a topological field is
itself a subfield. -/
def subfield.topological_closure (K : subfield α) : subfield α :=
{ carrier := closure (K : set α),
  inv_mem' := λ x hx,
  begin
    rcases eq_or_ne x 0 with (rfl | h),
    { rwa [inv_zero] },
    { rw [← inv_coe_set, ← set.image_inv],
      exact mem_closure_image (continuous_at_inv₀ h) hx },
  end,
  ..K.to_subring.topological_closure, }

lemma subfield.le_topological_closure (s : subfield α) :
  s ≤ s.topological_closure := subset_closure

lemma subfield.is_closed_topological_closure (s : subfield α) :
  is_closed (s.topological_closure : set α) := is_closed_closure

lemma subfield.topological_closure_minimal
  (s : subfield α) {t : subfield α} (h : s ≤ t) (ht : is_closed (t : set α)) :
  s.topological_closure ≤ t := closure_minimal h ht

end subfield

section affine_homeomorph
/-!
This section is about affine homeomorphisms from a topological field `𝕜` to itself.
Technically it does not require `𝕜` to be a topological field, a topological ring that
happens to be a field is enough.
-/
variables {𝕜 : Type*} [field 𝕜] [topological_space 𝕜] [topological_ring 𝕜]

/--
The map `λ x, a * x + b`, as a homeomorphism from `𝕜` (a topological field) to itself, when `a ≠ 0`.
-/
@[simps]
def affine_homeomorph (a b : 𝕜) (h : a ≠ 0) : 𝕜 ≃ₜ 𝕜 :=
{ to_fun := λ x, a * x + b,
  inv_fun := λ y, (y - b) / a,
  left_inv := λ x, by { simp only [add_sub_cancel], exact mul_div_cancel_left x h, },
  right_inv := λ y, by { simp [mul_div_cancel' _ h], }, }

end affine_homeomorph

section local_extr

variables {α β : Type*} [topological_space α] [linear_ordered_semifield β] {a : α}
open_locale topology

lemma is_local_min.inv {f : α → β} {a : α} (h1 : is_local_min f a) (h2 : ∀ᶠ z in 𝓝 a, 0 < f z) :
  is_local_max f⁻¹ a :=
by filter_upwards [h1, h2] with z h3 h4 using (inv_le_inv h4 h2.self_of_nhds).mpr h3

end local_extr

section preconnected
/-! Some results about functions on preconnected sets valued in a ring or field with a topology. -/

open set
variables {α 𝕜 : Type*} {f g : α → 𝕜} {S : set α}
  [topological_space α] [topological_space 𝕜] [t1_space 𝕜]

/-- If `f` is a function `α → 𝕜` which is continuous on a preconnected set `S`, and
`f ^ 2 = 1` on `S`, then either `f = 1` on `S`, or `f = -1` on `S`. -/
lemma is_preconnected.eq_one_or_eq_neg_one_of_sq_eq [ring 𝕜] [no_zero_divisors 𝕜]
  (hS : is_preconnected S) (hf : continuous_on f S) (hsq : eq_on (f ^ 2) 1 S) :
  (eq_on f 1 S) ∨ (eq_on f (-1) S) :=
begin
  simp_rw [eq_on, pi.one_apply, pi.pow_apply, sq_eq_one_iff] at hsq,
  -- First deal with crazy case where `S` is empty.
  by_cases hSe : ∀ (x:α), x ∉ S,
  { left, intros x hx,
    exfalso, exact hSe x hx, },
  push_neg at hSe,
  choose y hy using hSe,
  suffices : ∀ (x:α), x ∈ S → f x = f y,
  { rcases (hsq hy),
    { left, intros z hz, rw [pi.one_apply z, ←h], exact this z hz, },
    { right, intros z hz, rw [pi.neg_apply, pi.one_apply, ←h], exact this z hz, } },
  refine λ x hx, hS.constant_of_maps_to hf (λ z hz, _) hx hy,
  show f z ∈ ({-1, 1} : set 𝕜),
  { exact mem_insert_iff.mpr (hsq hz).symm,  },
  exact discrete_of_t1_of_finite,
end

/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then either `f = g` or `f = -g` on
`S`. -/
lemma is_preconnected.eq_or_eq_neg_of_sq_eq [field 𝕜] [has_continuous_inv₀ 𝕜] [has_continuous_mul 𝕜]
  (hS : is_preconnected S) (hf : continuous_on f S) (hg : continuous_on g S)
  (hsq : eq_on (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x:α}, x ∈ S → g x ≠ 0) :
  (eq_on f g S) ∨ (eq_on f (-g) S) :=
begin
  rcases hS.eq_one_or_eq_neg_one_of_sq_eq (hf.div hg (λ z hz, hg_ne hz)) (λ x hx, _) with h | h,
  { refine or.inl (λ x hx, _),
    rw ←div_eq_one_iff_eq (hg_ne hx),
    exact h hx },
  { refine or.inr (λ x hx, _),
    specialize h hx,
    rwa [pi.div_apply, pi.neg_apply, pi.one_apply, div_eq_iff (hg_ne hx), neg_one_mul] at h,  },
  { rw [pi.one_apply, div_pow, pi.div_apply, hsq hx, div_self],
    exact pow_ne_zero _ (hg_ne hx) },
end

/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then as soon as `f = g` holds at
one point of `S` it holds for all points. -/
lemma is_preconnected.eq_of_sq_eq [field 𝕜] [has_continuous_inv₀ 𝕜] [has_continuous_mul 𝕜]
  (hS : is_preconnected S) (hf : continuous_on f S) (hg : continuous_on g S)
  (hsq : eq_on (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x:α}, x ∈ S → g x ≠ 0)
  {y : α} (hy : y ∈ S) (hy' : f y = g y) : eq_on f g S :=
λ x hx, begin
  rcases hS.eq_or_eq_neg_of_sq_eq hf hg @hsq @hg_ne with h | h,
  { exact h hx },
  { rw [h hy, eq_comm, ←sub_eq_zero, sub_eq_add_neg, pi.neg_apply,
      neg_neg, ←mul_two, mul_eq_zero] at hy',
    cases hy', -- need to handle case of `char 𝕜 = 2` separately
    { exfalso, exact hg_ne hy hy' },
    { rw [h hx, pi.neg_apply, eq_comm, ←sub_eq_zero, sub_eq_add_neg, neg_neg,
       ←mul_two, hy', mul_zero], } },
end

end preconnected


import number_theory.zsqrtd.basic
import data.complex.basic
import ring_theory.principal_ideal_domain
import number_theory.legendre_symbol.quadratic_reciprocity

open zsqrtd complex real

noncomputable theory

@[reducible] def gaussian_int2 : Type := zsqrtd (-2)

local notation `ℤ[√-2]` := gaussian_int2

namespace gaussian_int2

instance : has_repr ℤ[√-2] := ⟨λ x, "⟨" ++ repr x.re ++ ", " ++ repr x.im ++ "⟩"⟩

instance : comm_ring ℤ[√-2] := zsqrtd.comm_ring

section

/-- The embedding of the Gaussian integers into the complex numbers, as a ring homomorphism. -/
def to_complex : ℤ[√-2] →+* ℂ :=
begin
  refine zsqrtd.lift ⟨I*sqrt(2), _⟩,
  rw [← mul_assoc, ← mul_comm I (I * ↑(sqrt 2)), ← mul_assoc, I_mul_I],
  simp,
  rw ← sq,
  norm_cast,
  rw sq_sqrt,
  norm_num,
end

end

instance : has_coe (ℤ[√-2]) ℂ := ⟨to_complex⟩

lemma to_complex_def (x : ℤ[√-2]) : (x : ℂ) = x.re + x.im * I * sqrt(2) :=
begin
  rw [mul_assoc],
  refl,
end

lemma to_complex_def' (x y : ℤ) : ((⟨x, y⟩ : ℤ[√-2]) : ℂ) = x + y * I * sqrt(2) := by simp [to_complex_def]

lemma to_complex_def₂ (x : ℤ[√-2]) : (x : ℂ) = ⟨x.re, x.im * sqrt 2⟩ :=
by apply complex.ext; simp [to_complex_def]

@[simp] lemma to_real_re (x : ℤ[√-2]) : ((x.re : ℤ) : ℝ) = (x : ℂ).re :=
by simp [to_complex_def]

@[simp] lemma to_real_im (x : ℤ[√-2]) : ((x.im : ℤ) * sqrt 2 : ℝ) = (x : ℂ).im :=
by rw [to_complex_def₂]

@[simp] lemma to_complex_re (x y : ℤ) : ((⟨x, y⟩ : ℤ[√-2]) : ℂ).re = x := by simp [to_complex_def]

@[simp] lemma to_complex_im (x y : ℤ) : ((⟨x, y⟩ : ℤ[√-2]) : ℂ).im = y * sqrt 2 :=by simp [to_complex_def]

@[simp] lemma to_complex_add (x y : ℤ[√-2]) : ((x + y : ℤ[√-2]) : ℂ) = x + y := by exact to_complex.map_add _ _
@[simp] lemma to_complex_mul (x y : ℤ[√-2]) : ((x * y : ℤ[√-2]) : ℂ) = x * y := by exact to_complex.map_mul _ _
@[simp] lemma to_complex_one : ((1 : ℤ[√-2]) : ℂ) = 1 := by exact to_complex.map_one
@[simp] lemma to_complex_zero : ((0 : ℤ[√-2]) : ℂ) = 0 := by exact to_complex.map_zero
@[simp] lemma to_complex_neg (x : ℤ[√-2]) : ((-x : ℤ[√-2]) : ℂ) = -x := by exact to_complex.map_neg _
@[simp] lemma to_complex_sub (x y : ℤ[√-2]) : ((x - y : ℤ[√-2]) : ℂ) = x - y := by exact to_complex.map_sub _ _

@[simp] lemma to_complex_inj {x y : ℤ[√-2]} : (x : ℂ) = y ↔ x = y :=
 by cases x; cases y; simp [to_complex_def₂]

@[simp] lemma to_complex_eq_zero {x : ℤ[√-2]} : (x : ℂ) = 0 ↔ x = 0 :=
 by rw [← to_complex_zero, to_complex_inj]

@[simp] lemma nat_cast_real_norm (x : ℤ[√-2]) : (x.norm : ℝ)= (x : ℂ).norm_sq :=
begin
  rw [norm, norm_sq],
  simp,
  rw [← to_real_im],
  ring_nf,
  finish,
end

@[simp] lemma nat_cast_complex_norm (x : ℤ[√-2]) : (x.norm : ℂ) = (x : ℂ).norm_sq :=
begin
  cases x; rw [norm, norm_sq];
  norm_cast,
  simp,
  rw ← mul_comm (sqrt 2) ↑x_im,
  rw ← mul_assoc,
  rw ← mul_comm ↑x_im (sqrt 2),
  rw mul_assoc ↑x_im (sqrt 2) (sqrt 2),
  norm_num,
  ring_nf,
  finish,
end

lemma norm_nonneg (x : ℤ[√-2]) : 0 ≤ norm x := by refine norm_nonneg (by norm_num) _

@[simp] lemma norm_eq_zero {x : ℤ[√-2]} : norm x = 0 ↔ x = 0 := by rw [← @int.cast_inj ℝ _ _ _]; simp

lemma norm_pos {x : ℤ[√-2]} : 0 < norm x ↔ x ≠ 0 := by rw [lt_iff_le_and_ne, ne.def, eq_comm, norm_eq_zero]; simp [norm_nonneg]

@[simp] lemma coe_nat_abs_norm (x : ℤ[√-2]) : (x.norm.nat_abs : ℤ) =x.norm := by refine int.nat_abs_of_nonneg (norm_nonneg _)

@[simp] lemma nat_cast_nat_abs_norm {α : Type*} [ring α]
   (x : ℤ[√-2]) : (x.norm.nat_abs : α) = x.norm :=
 by rw [← int.cast_coe_nat, coe_nat_abs_norm]

 lemma nat_abs_norm_eq (x : ℤ[√-2]) : x.norm.nat_abs =
   x.re.nat_abs * x.re.nat_abs + 2 * x.im.nat_abs * x.im.nat_abs :=
  begin
    simp [norm],
    apply int.coe_nat_inj,
    nth_rewrite 1 [mul_assoc],
    nth_rewrite 0 [mul_assoc],
    simp,
    refine int.nat_abs_of_nonneg _,
    refine add_nonneg _ _,
    { exact mul_self_nonneg _ },
    { refine mul_nonneg _ _,
      { norm_num },
      { exact mul_self_nonneg _ } }
  end

protected def div (x y : ℤ[√-2]) : ℤ[√-2] :=
let n := (rat.of_int (norm y))⁻¹ in let c := y.conj in
⟨round (rat.of_int (x * c).re * n : ℚ),
round (rat.of_int (x * c).im * n : ℚ)⟩

instance : has_div ℤ[√-2] := ⟨gaussian_int2.div⟩

lemma div_def (x y : ℤ[√-2]) : x / y = ⟨round ((x * conj y).re / norm y : ℚ),
  round ((x * conj y).im / norm y : ℚ)⟩ :=
show zsqrtd.mk _ _ = _, by simp [rat.of_int_eq_mk, rat.mk_eq_div, div_eq_mul_inv]

lemma to_complex_div_re (x y : ℤ[√-2]) : ((x / y : ℤ[√-2]) : ℂ).re = round ((x / y : ℂ).re) :=
begin
  rw [div_def, ← @rat.round_cast ℝ _ _];
  simp [-rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul],
  congr' 1,
  congr' 1,
  rw [← mul_assoc, ← mul_assoc, ← mul_assoc],
  congr' 1,
  rw [← to_real_im, ← to_real_im],
  rw [← mul_assoc, mul_comm (↑(x.im) * sqrt 2 * ↑(y.im)) (sqrt 2), ← mul_assoc, ← mul_assoc, mul_comm (sqrt 2 * ↑(x.im)) (sqrt 2), ← mul_assoc],
  simp,
end

lemma to_complex_div_im (x y : ℤ[√-2]) : ((x / y : ℤ[√-2]) : ℂ).im = round ((x / y : ℂ).im / sqrt 2) * sqrt 2 :=
begin
  rw [div_def, ← @rat.round_cast ℝ _ _, ← @rat.round_cast ℝ _ _];
  simp [mul_assoc, div_eq_mul_inv, mul_add, add_mul],
  have h1 : ((x : ℤ[√-2]) : ℂ).im = ((x : ℤ[√-2]).im : ℝ) * sqrt(2), rw to_complex_def₂,
  have h2 : ((y : ℤ[√-2]) : ℂ).im = ((y : ℤ[√-2]).im : ℝ) * sqrt(2), rw to_complex_def₂,
  rw [h1, h2],
  rw mul_comm (((y : ℂ)).norm_sq)⁻¹ (sqrt 2)⁻¹,
  nth_rewrite_rhs 0 mul_assoc,
  nth_rewrite_rhs 4 ← mul_assoc,
  nth_rewrite_rhs 3 ← mul_assoc,
  rw mul_comm (y : ℂ).re (sqrt 2)⁻¹,
  nth_rewrite_rhs 2 ← mul_assoc,
  nth_rewrite_rhs 2 ← mul_assoc,
  rw mul_assoc (x.im : ℝ) (sqrt 2) (sqrt 2)⁻¹,

  norm_num,
  rw mul_assoc,
end

lemma norm_sq_div_sub_div_lt_one (x y : ℤ[√-2]) :
  ((x / y : ℂ) - ((x / y : ℤ[√-2]) : ℂ)).norm_sq < 1 :=
begin
calc ((x / y : ℂ) - ((x / y : ℤ[√-2]) : ℂ)).norm_sq =
    ((x / y : ℂ).re - ((x / y : ℤ[√-2]) : ℂ).re +
    ((x / y : ℂ).im - ((x / y : ℤ[√-2]) : ℂ).im) * I : ℂ).norm_sq :
      congr_arg _ $ by apply complex.ext;
      simp
... = ((x / y : ℂ).re - ((x / y : ℤ[√-2]) : ℂ).re)^2 + ((x / y : ℂ).im - ((x / y : ℤ[√-2]) : ℂ).im)^2 :
      by norm_cast; rw norm_sq_add_mul_I
... <= 1/4 + 1/2 :
      _
... < 1 :
      by norm_num,

  have h1 : (1/4 : ℝ) = (1/2)^2, by norm_num,
  have h2 : (1/2 : ℝ) = (sqrt(2)/2)^2, by norm_num,
  have h3 : 0 < |sqrt(2 : ℝ)|, by norm_num,
  have h4 : |(1/2 : ℝ)| = 1/2,
  { refine abs_of_pos _,
    norm_num },
  refine add_le_add _ _,
  { rw [to_complex_div_re, h1, sq_le_sq, h4],
    apply abs_sub_round },
  { rw [to_complex_div_im, h2, sq_le_sq],
    have sqrt2pos : 0 < sqrt 2, by norm_num,
    have : |(x / y : ℂ).im / sqrt 2 - round((x / y : ℂ).im / sqrt 2) | ≤ 1/2,
    apply abs_sub_round,
    rw [← mul_le_mul_right h3, ← _root_.abs_mul, sub_mul] at this,
    convert this,
    { simp },
    { rw [← h4, ← _root_.abs_mul],
      congr' 1,
      rw [one_div, div_eq_mul_inv, mul_comm] } }
end

protected def mod (x y : ℤ[√-2]) : ℤ[√-2] := x - y * (x / y)

instance : has_mod ℤ[√-2] := ⟨gaussian_int2.mod⟩

lemma mod_def (x y : ℤ[√-2]) : x % y = x - y * (x / y) := rfl

lemma norm_mod_lt (x : ℤ[√-2]) {y : ℤ[√-2]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
have (y : ℂ) ≠ 0, by rwa [ne.def, ← to_complex_zero, to_complex_inj],
(@int.cast_lt ℝ _ _ _ _).1 $
  calc ↑(norm (x % y)) = (x - y * (x / y : ℤ[√-2]) : ℂ).norm_sq : by simp [mod_def]
  ... = (y : ℂ).norm_sq * (((x / y) - (x / y : ℤ[√-2])) : ℂ).norm_sq :
    by rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
  ... < (y : ℂ).norm_sq * 1 : mul_lt_mul_of_pos_left (norm_sq_div_sub_div_lt_one _ _)
    (norm_sq_pos.2 this)
  ... = norm y : by simp

lemma nat_abs_norm_mod_lt (x : ℤ[√-2]) {y : ℤ[√-2]} (hy : y ≠ 0) :
  (x % y).norm.nat_abs < y.norm.nat_abs :=
int.coe_nat_lt.1 (by simp [-int.coe_nat_lt, norm_mod_lt x hy])

lemma norm_le_norm_mul_left (x : ℤ[√-2]) {y : ℤ[√-2]} (hy : y ≠ 0) :
  (norm x).nat_abs ≤ (norm (x * y)).nat_abs :=
by rw [norm_mul, int.nat_abs_mul];
  exact le_mul_of_one_le_right (nat.zero_le _)
    (int.coe_nat_le.1 (by rw [coe_nat_abs_norm]; exact int.add_one_le_of_lt (norm_pos.2 hy)))

instance : nontrivial ℤ[√-2] :=
⟨⟨0, 1, dec_trivial⟩⟩

instance : euclidean_domain ℤ[√-2] :=
{ quotient := (/),
  remainder := (%),
  quotient_zero := by { simp [div_def], refl },
  quotient_mul_add_remainder_eq := λ _ _, by simp [mod_def],
  r := _,
  r_well_founded := measure_wf (int.nat_abs ∘ norm),
  remainder_lt := nat_abs_norm_mod_lt,
  mul_left_not_lt := λ a b hb0, not_lt_of_ge $ norm_le_norm_mul_left a hb0,
  .. gaussian_int2.comm_ring,
  .. gaussian_int2.nontrivial
  }

end gaussian_int2


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.terminal
import category_theory.limits.preserves.basic

/-!
# Preserving terminal object

Constructions to relate the notions of preserving terminal objects and reflecting terminal objects
to concrete objects.

In particular, we show that `terminal_comparison G` is an isomorphism iff `G` preserves terminal
objects.
-/

universes v u₁ u₂

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

variables (X : C)

section terminal

/--
The map of an empty cone is a limit iff the mapped object is terminal.
-/
def is_limit_map_cone_empty_cone_equiv :
  is_limit (G.map_cone (as_empty_cone X)) ≃ is_terminal (G.obj X) :=
(is_limit.postcompose_hom_equiv (functor.empty_ext.{v} _ _) _).symm.trans
  (is_limit.equiv_iso_limit (cones.ext (iso.refl _) (by tidy)))

/-- The property of preserving terminal objects expressed in terms of `is_terminal`. -/
def is_terminal.is_terminal_obj [preserves_limit (functor.empty C) G]
  (l : is_terminal X) : is_terminal (G.obj X) :=
is_limit_map_cone_empty_cone_equiv G X (preserves_limit.preserves l)

/-- The property of reflecting terminal objects expressed in terms of `is_terminal`. -/
def is_terminal.is_terminal_of_obj [reflects_limit (functor.empty C) G]
  (l : is_terminal (G.obj X)) : is_terminal X :=
reflects_limit.reflects ((is_limit_map_cone_empty_cone_equiv G X).symm l)

variables [has_terminal C]
/--
If `G` preserves the terminal object and `C` has a terminal object, then the image of the terminal
object is terminal.
-/
def is_limit_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty C) G] :
  is_terminal (G.obj (⊤_ C)) :=
terminal_is_terminal.is_terminal_obj G (⊤_ C)

/--
If `C` has a terminal object and `G` preserves terminal objects, then `D` has a terminal object
also.
Note this property is somewhat unique to (co)limits of the empty diagram: for general `J`, if `C`
has limits of shape `J` and `G` preserves them, then `D` does not necessarily have limits of shape
`J`.
-/
lemma has_terminal_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty C) G] :
  has_terminal D :=
⟨λ F,
begin
  haveI := has_limit.mk ⟨_, is_limit_of_has_terminal_of_preserves_limit G⟩,
  apply has_limit_of_iso F.unique_from_empty.symm,
end⟩

variable [has_terminal D]
/--
If the terminal comparison map for `G` is an isomorphism, then `G` preserves terminal objects.
-/
def preserves_terminal.of_iso_comparison
  [i : is_iso (terminal_comparison G)] : preserves_limit (functor.empty C) G :=
begin
  apply preserves_limit_of_preserves_limit_cone terminal_is_terminal,
  apply (is_limit_map_cone_empty_cone_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (functor.empty D)),
  apply i,
end

/-- If there is any isomorphism `G.obj ⊤ ⟶ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_is_iso
  (f : G.obj (⊤_ C) ⟶ ⊤_ D) [i : is_iso f] : preserves_limit (functor.empty C) G :=
begin
  rw subsingleton.elim f (terminal_comparison G) at i,
  exactI preserves_terminal.of_iso_comparison G,
end

/-- If there is any isomorphism `G.obj ⊤ ≅ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_iso
  (f : G.obj (⊤_ C) ≅ ⊤_ D) : preserves_limit (functor.empty C) G :=
preserves_terminal_of_is_iso G f.hom

variables [preserves_limit (functor.empty C) G]

/--
If `G` preserves terminal objects, then the terminal comparison map for `G` is an isomorphism.
-/
def preserves_terminal.iso : G.obj (⊤_ C) ≅ ⊤_ D :=
(is_limit_of_has_terminal_of_preserves_limit G).cone_point_unique_up_to_iso (limit.is_limit _)

@[simp]
lemma preserves_terminal.iso_hom : (preserves_terminal.iso G).hom = terminal_comparison G :=
rfl

instance : is_iso (terminal_comparison G) :=
begin
  rw ← preserves_terminal.iso_hom,
  apply_instance,
end

end terminal

section initial

/--
The map of an empty cocone is a colimit iff the mapped object is initial.
-/
def is_colimit_map_cocone_empty_cocone_equiv :
  is_colimit (G.map_cocone (as_empty_cocone X)) ≃ is_initial (G.obj X) :=
(is_colimit.precompose_hom_equiv (functor.empty_ext.{v} _ _) _).symm.trans
  (is_colimit.equiv_iso_colimit (cocones.ext (iso.refl _) (by tidy)))

/-- The property of preserving initial objects expressed in terms of `is_initial`. -/
def is_initial.is_initial_obj [preserves_colimit (functor.empty C) G]
  (l : is_initial X) : is_initial (G.obj X) :=
is_colimit_map_cocone_empty_cocone_equiv G X (preserves_colimit.preserves l)

/-- The property of reflecting initial objects expressed in terms of `is_initial`. -/
def is_initial.is_initial_of_obj [reflects_colimit (functor.empty C) G]
  (l : is_initial (G.obj X)) : is_initial X :=
reflects_colimit.reflects ((is_colimit_map_cocone_empty_cocone_equiv G X).symm l)

variables [has_initial C]
/--
If `G` preserves the initial object and `C` has a initial object, then the image of the initial
object is initial.
-/
def is_colimit_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty C) G] :
  is_initial (G.obj (⊥_ C)) :=
initial_is_initial.is_initial_obj G (⊥_ C)

/--
If `C` has a initial object and `G` preserves initial objects, then `D` has a initial object
also.
Note this property is somewhat unique to colimits of the empty diagram: for general `J`, if `C`
has colimits of shape `J` and `G` preserves them, then `D` does not necessarily have colimits of
shape `J`.
-/
lemma has_initial_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty C) G] :
  has_initial D :=
⟨λ F,
begin
  haveI := has_colimit.mk ⟨_, is_colimit_of_has_initial_of_preserves_colimit G⟩,
  apply has_colimit_of_iso F.unique_from_empty,
end⟩

variable [has_initial D]
/--
If the initial comparison map for `G` is an isomorphism, then `G` preserves initial objects.
-/
def preserves_initial.of_iso_comparison
  [i : is_iso (initial_comparison G)] : preserves_colimit (functor.empty C) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone initial_is_initial,
  apply (is_colimit_map_cocone_empty_cocone_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (functor.empty D)),
  apply i,
end

/-- If there is any isomorphism `⊥ ⟶ G.obj ⊥`, then `G` preserves initial objects. -/
def preserves_initial_of_is_iso
  (f : ⊥_ D ⟶ G.obj (⊥_ C)) [i : is_iso f] : preserves_colimit (functor.empty C) G :=
begin
  rw subsingleton.elim f (initial_comparison G) at i,
  exactI preserves_initial.of_iso_comparison G,
end

/-- If there is any isomorphism `⊥ ≅ G.obj ⊥ `, then `G` preserves initial objects. -/
def preserves_initial_of_iso
  (f : ⊥_ D ≅ G.obj (⊥_ C)) : preserves_colimit (functor.empty C) G :=
preserves_initial_of_is_iso G f.hom

variables [preserves_colimit (functor.empty C) G]

/-- If `G` preserves initial objects, then the initial comparison map for `G` is an isomorphism. -/
def preserves_initial.iso : G.obj (⊥_ C) ≅ ⊥_ D :=
(is_colimit_of_has_initial_of_preserves_colimit G).cocone_point_unique_up_to_iso
  (colimit.is_colimit _)

@[simp]
lemma preserves_initial.iso_hom : (preserves_initial.iso G).inv = initial_comparison G :=
rfl

instance : is_iso (initial_comparison G) :=
begin
  rw ← preserves_initial.iso_hom,
  apply_instance,
end

end initial

end category_theory.limits


import Reynold_operator.reynold
import Tools.tools
import basic_definitions.matrix_representation
open_locale big_operators
open_locale matrix
set_option pp.generalized_field_notation false
open Reynold linear_map matrix character
universes u v w
/--
    Data for the file. Here we make the assumtion that `X` and `Y` live in the same universe
    because of `matrix X Y R` that require this.
-/
variables {G : Type u} [group G][fintype G][decidable_eq G] {R : Type v}  [comm_ring R]
          {X : Type w} [fintype X][decidable_eq X] (ρ : group_representation G R (X → R))
          {Y : Type w} [fintype Y][decidable_eq Y] (ρ' : group_representation G R (Y → R))

/-!
#   Interpretation of scalar product in term of Reynold operator.
*   I recall the theory :
*           let `ρ : G → GL( X → R)` and `ρ' : G → GL (Y → R)` with the variables above.
*           let `φ ψ : G → R `.
*     then  `scalar_product G R φ ψ :=  ∑ t, (φ t) *  (ψ t⁻¹)`
*     We define `χ : group_representation G R (X → R) →  G → R := trace to_matrix (ρ g)`
*     Note for the moment we don't invert `card G`
*     We define `Reynold operator : (X → R →ₗ[R] Y → R) →ₗ[R]  ρ ⟶ ρ'`
*     The definition is : `Re f := ∑ g : G,  ρ' g⁻¹ ∘ f ∘ ρ  g`
*     The next theorem formalize :
*     `∑ g, (χ ρ g) * (χ  ρ' g⁻¹) = ∑ g, ( ∑ x : X,  to_matrix ( ρ g) x x ) ( ∑ y : Y, to_matrix (ρ' g⁻¹ ) y y)`
*                                ` = ∑ (x,y) : X × Y,  ∑ g, to_matrix ( ρ g) x x ) ( ∑ y : Y, to_matrix (ρ' g⁻¹ ) y y)`
*                                `  = ∑ (x,y) : X × Y,   to_matrix (Re ρ ρ' ( to_lin (ℰ  y x)  )).ℓ y x`
*           Where `ℰ y x` is the `elementary matrix !
*           see the files `tools.matrix` for the calculus.
*     The fact is : Reynold operator is quasi trivial in two case
*           1. If ` not (ρ ≃ᵣ ρ')` (not isomorphic) and ` ρ ρ' : irreducible`.
*               If this case `Reynold opérator` is `0`. That depend of the theorem `Schur₁` in basic definition.irreducible
*                And we can calculate scalar product with this theorem and it's zero.
*           2. if ` (ρ = ρ')` (equal) and ` ρ : irreducible` and " algebricaly closed base field ".
*                in this case, `Reynold opérator` send a morphism `f` to an λ • 1  and we can compute.
-/
/-!
    Wihout condition :
    `to_matrix (Re ρ ρ' ( to_lin (ℰ  y0 x0)))  =  (∑ s,  (mat ρ' s⁻¹ ) ⬝  (ℰ y0 x0) ⬝  (mat ρ s  ) )`
-/

theorem to_matrix_Reynold_E  ( x0 : X) (y0 : Y) :
  linear_map.to_matrix (Re ρ ρ' ( to_lin (ℰ  y0 x0))).ℓ  =  (∑ s,  (mat ρ' s⁻¹ ) ⬝  (ℰ y0 x0) ⬝  (mat ρ s  ) ) :=
begin
    rw reynold_ext', rw to_matrix_sum,
    congr,funext w,rw mixte_conj_ext,
    rw to_matrix_mul, rw to_matrix_mul, rw to_lin_to_matrix,
    exact rfl,
end

theorem interpretation_produit_scalaire :
scalar_product G R (χ ρ ) (χ ρ' ) = ∑ (y : X × Y), to_matrix (Re ρ ρ' ( to_lin (ℰ  y.snd y.fst)  )).ℓ y.snd y.fst
:=
begin
    rw scalar_product_ext,
    conv_lhs{
        apply_congr,skip,
        rw chi_ext,
        rw chi_ext,
        erw finset.sum_mul_sum,
    },
    erw finset.sum_comm,
    congr,funext,
    conv_lhs{
        apply_congr,skip, rw mul_comm,
        rw ← mul_E_mul',
    },
       rw to_matrix_Reynold_E,
       rw sum_apply_mat,
end

theorem trace_Reynold_E ( x : X) : matrix.trace X R R (∑ s,  (mat ρ s⁻¹ ) ⬝  (ℰ x x) ⬝  (mat ρ s  ) )  = fintype.card G :=
begin
    rw sum_trace,
    conv_lhs{
        apply_congr,skip,
        rw trace_conj,
        rw trace_E,rw if_pos rfl,
    },
    rw finset.sum_const, rw add_monoid.smul_eq_mul, rw mul_one, exact rfl,
end


/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Andreas Swerdlow
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.basic
import Mathlib.ring_theory.ring_invo
import Mathlib.PostPort

universes u v l u_1 u_2

namespace Mathlib

/-!
# Sesquilinear form

This file defines a sesquilinear form over a module. The definition requires a ring antiautomorphism
on the scalar ring. Basic ideas such as
orthogonality are also introduced.

A sesquilinear form on an `R`-module `M`, is a function from `M × M` to `R`, that is linear in the
first argument and antilinear in the second, with respect to an antiautomorphism on `R` (an
antiisomorphism from `R` to `R`).

## Notations

Given any term `S` of type `sesq_form`, due to a coercion, can use the notation `S x y` to
refer to the function field, ie. `S x y = S.sesq x y`.

## References

* <https://en.wikipedia.org/wiki/Sesquilinear_form#Over_arbitrary_rings>

## Tags

Sesquilinear form,
-/

/-- A sesquilinear form over a module  -/
structure sesq_form (R : Type u) (M : Type v) [ring R] (I : R ≃+* (Rᵒᵖ)) [add_comm_group M] [module R M]
where
  sesq : M → M → R
  sesq_add_left : ∀ (x y z : M), sesq (x + y) z = sesq x z + sesq y z
  sesq_smul_left : ∀ (a : R) (x y : M), sesq (a • x) y = a * sesq x y
  sesq_add_right : ∀ (x y z : M), sesq x (y + z) = sesq x y + sesq x z
  sesq_smul_right : ∀ (a : R) (x y : M), sesq x (a • y) = opposite.unop (coe_fn I a) * sesq x y

namespace sesq_form

protected instance has_coe_to_fun {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} : has_coe_to_fun (sesq_form R M I) :=
  has_coe_to_fun.mk (fun (S : sesq_form R M I) => M → M → R) fun (S : sesq_form R M I) => sesq S

theorem add_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) (z : M) : coe_fn S (x + y) z = coe_fn S x z + coe_fn S y z :=
  sesq_add_left S x y z

theorem smul_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (a : R) (x : M) (y : M) : coe_fn S (a • x) y = a * coe_fn S x y :=
  sesq_smul_left S a x y

theorem add_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) (z : M) : coe_fn S x (y + z) = coe_fn S x y + coe_fn S x z :=
  sesq_add_right S x y z

theorem smul_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (a : R) (x : M) (y : M) : coe_fn S x (a • y) = opposite.unop (coe_fn I a) * coe_fn S x y :=
  sesq_smul_right S a x y

theorem zero_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) : coe_fn S 0 x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn S 0 x = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn S (0 • 0) x = 0)) (smul_left 0 0 x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * coe_fn S 0 x = 0)) (zero_mul (coe_fn S 0 x)))) (Eq.refl 0)))

theorem zero_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) : coe_fn S x 0 = 0 := sorry

theorem neg_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) : coe_fn S (-x) y = -coe_fn S x y := sorry

theorem neg_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) : coe_fn S x (-y) = -coe_fn S x y := sorry

theorem sub_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) (z : M) : coe_fn S (x - y) z = coe_fn S x z - coe_fn S y z := sorry

theorem sub_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) (y : M) (z : M) : coe_fn S x (y - z) = coe_fn S x y - coe_fn S x z := sorry

theorem ext {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} {D : sesq_form R M I} (H : ∀ (x y : M), coe_fn S x y = coe_fn D x y) : S = D := sorry

protected instance add_comm_group {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} : add_comm_group (sesq_form R M I) :=
  add_comm_group.mk
    (fun (S D : sesq_form R M I) => mk (fun (x y : M) => coe_fn S x y + coe_fn D x y) sorry sorry sorry sorry) sorry
    (mk (fun (x y : M) => 0) sorry sorry sorry sorry) sorry sorry
    (fun (S : sesq_form R M I) => mk (fun (x y : M) => -sesq S x y) sorry sorry sorry sorry)
    (add_group.sub._default
      (fun (S D : sesq_form R M I) => mk (fun (x y : M) => coe_fn S x y + coe_fn D x y) sorry sorry sorry sorry) sorry
      (mk (fun (x y : M) => 0) sorry sorry sorry sorry) sorry sorry
      fun (S : sesq_form R M I) => mk (fun (x y : M) => -sesq S x y) sorry sorry sorry sorry)
    sorry sorry

protected instance inhabited {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} : Inhabited (sesq_form R M I) :=
  { default := 0 }

/-- The proposition that two elements of a sesquilinear form space are orthogonal -/
def is_ortho {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) (x : M) (y : M) :=
  coe_fn S x y = 0

theorem ortho_zero {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (x : M) : is_ortho S 0 x :=
  zero_left x

theorem is_add_monoid_hom_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) (x : M) : is_add_monoid_hom fun (z : M) => coe_fn S z x :=
  is_add_monoid_hom.mk (zero_left x)

theorem is_add_monoid_hom_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) (x : M) : is_add_monoid_hom fun (z : M) => coe_fn S x z :=
  is_add_monoid_hom.mk (zero_right x)

theorem map_sum_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {α : Type u_1} (S : sesq_form R M I) (t : finset α) (g : α → M) (w : M) : coe_fn S (finset.sum t fun (i : α) => g i) w = finset.sum t fun (i : α) => coe_fn S (g i) w :=
  Eq.symm (finset.sum_hom t fun (z : M) => coe_fn S z w)

theorem map_sum_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {α : Type u_1} (S : sesq_form R M I) (t : finset α) (g : α → M) (w : M) : coe_fn S w (finset.sum t fun (i : α) => g i) = finset.sum t fun (i : α) => coe_fn S w (g i) :=
  Eq.symm (finset.sum_hom t fun (z : M) => coe_fn S w z)

protected instance to_module {R : Type u_1} [comm_ring R] {M : Type v} [add_comm_group M] [module R M] {J : R ≃+* (Rᵒᵖ)} : module R (sesq_form R M J) :=
  semimodule.mk sorry sorry

theorem ortho_smul_left {R : Type u_1} [domain R] {M : Type v} [add_comm_group M] [module R M] {K : R ≃+* (Rᵒᵖ)} {G : sesq_form R M K} {x : M} {y : M} {a : R} (ha : a ≠ 0) : is_ortho G x y ↔ is_ortho G (a • x) y := sorry

theorem ortho_smul_right {R : Type u_1} [domain R] {M : Type v} [add_comm_group M] [module R M] {K : R ≃+* (Rᵒᵖ)} {G : sesq_form R M K} {x : M} {y : M} {a : R} (ha : a ≠ 0) : is_ortho G x y ↔ is_ortho G x (a • y) := sorry

end sesq_form

namespace refl_sesq_form

/-- The proposition that a sesquilinear form is reflexive -/
def is_refl {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) :=
  ∀ (x y : M), coe_fn S x y = 0 → coe_fn S y x = 0

theorem eq_zero {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_refl S) {x : M} {y : M} : coe_fn S x y = 0 → coe_fn S y x = 0 :=
  H x y

theorem ortho_sym {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_refl S) {x : M} {y : M} : sesq_form.is_ortho S x y ↔ sesq_form.is_ortho S y x :=
  { mp := eq_zero H, mpr := eq_zero H }

end refl_sesq_form

namespace sym_sesq_form

/-- The proposition that a sesquilinear form is symmetric -/
def is_sym {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) :=
  ∀ (x y : M), opposite.unop (coe_fn I (coe_fn S x y)) = coe_fn S y x

theorem sym {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_sym S) (x : M) (y : M) : opposite.unop (coe_fn I (coe_fn S x y)) = coe_fn S y x :=
  H x y

theorem is_refl {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_sym S) : refl_sesq_form.is_refl S := sorry

theorem ortho_sym {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_sym S) {x : M} {y : M} : sesq_form.is_ortho S x y ↔ sesq_form.is_ortho S y x :=
  refl_sesq_form.ortho_sym (is_refl H)

end sym_sesq_form

namespace alt_sesq_form

/-- The proposition that a sesquilinear form is alternating -/
def is_alt {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} (S : sesq_form R M I) :=
  ∀ (x : M), coe_fn S x x = 0

theorem self_eq_zero {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_alt S) (x : M) : coe_fn S x x = 0 :=
  H x

theorem neg {R : Type u_1} {M : Type u_2} [ring R] [add_comm_group M] [module R M] {I : R ≃+* (Rᵒᵖ)} {S : sesq_form R M I} (H : is_alt S) (x : M) (y : M) : -coe_fn S x y = coe_fn S y x := sorry


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

! This file was ported from Lean 3 source module geometry.manifold.complex
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Complex.AbsMax
import Mathbin.Analysis.LocallyConvex.WithSeminorms
import Mathbin.Geometry.Manifold.Mfderiv
import Mathbin.Topology.LocallyConstant.Basic

/-! # Holomorphic functions on complex manifolds

Thanks to the rigidity of complex-differentiability compared to real-differentiability, there are
many results about complex manifolds with no analogue for manifolds over a general normed field. For
now, this file contains just two (closely related) such results:

## Main results

* `mdifferentiable.is_locally_constant`: A complex-differentiable function on a compact complex
  manifold is locally constant.
* `mdifferentiable.exists_eq_const_of_compact_space`: A complex-differentiable function on a compact
  preconnected complex manifold is constant.

## TODO

There is a whole theory to develop here.  Maybe a next step would be to develop a theory of
holomorphic vector/line bundles, including:
* the finite-dimensionality of the space of sections of a holomorphic vector bundle
* Siegel's theorem: for any `n + 1` formal ratios `g 0 / h 0`, `g 1 / h 1`, .... `g n / h n` of
  sections of a fixed line bundle `L` over a complex `n`-manifold, there exists a polynomial
  relationship `P (g 0 / h 0, g 1 / h 1, .... g n / h n) = 0`

Another direction would be to develop the relationship with sheaf theory, building the sheaves of
holomorphic and meromorphic functions on a complex manifold and proving algebraic results about the
stalks, such as the Weierstrass preparation theorem.

-/

open Manifold Topology

open Complex

namespace Mdifferentiable

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℂ E]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace ℂ F] [StrictConvexSpace ℝ F]

variable {M : Type _} [TopologicalSpace M] [CompactSpace M] [ChartedSpace E M]
  [SmoothManifoldWithCorners 𝓘(ℂ, E) M]

/-- A holomorphic function on a compact complex manifold is locally constant. -/
protected theorem isLocallyConstant {f : M → F} (hf : Mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) :
    IsLocallyConstant f :=
  by
  haveI : LocallyConnectedSpace M := ChartedSpace.locallyConnectedSpace E M
  apply IsLocallyConstant.of_constant_on_preconnected_clopens
  intro s hs₂ hs₃ a ha b hb
  have hs₁ : IsCompact s := hs₃.2.IsCompact
  -- for an empty set this fact is trivial
  rcases s.eq_empty_or_nonempty with (rfl | hs')
  · exact False.ndrec _ ha
  -- otherwise, let `p₀` be a point where the value of `f` has maximal norm
  obtain ⟨p₀, hp₀s, hp₀⟩ := hs₁.exists_forall_ge hs' hf.continuous.norm.continuous_on
  -- we will show `f` agrees everywhere with `f p₀`
  suffices s ⊆ { r : M | f r = f p₀ } ∩ s by exact (this hb).1.trans (this ha).1.symm
  clear ha hb a b
  refine' hs₂.subset_clopen _ ⟨p₀, hp₀s, ⟨rfl, hp₀s⟩⟩
  -- closedness of the set of points sent to `f p₀`
  refine' ⟨_, (is_closed_singleton.preimage hf.continuous).inter hs₃.2⟩
  -- we will show this set is open by showing it is a neighbourhood of each of its members
  rw [isOpen_iff_mem_nhds]
  rintro p ⟨hp : f p = _, hps⟩
  -- let `p` be  in this set
  have hps' : s ∈ 𝓝 p := hs₃.1.mem_nhds hps
  have key₁ : (chart_at E p).symm ⁻¹' s ∈ 𝓝 (chart_at E p p) :=
    by
    rw [← Filter.mem_map, (chart_at E p).symm_map_nhds_eq (mem_chart_source E p)]
    exact hps'
  have key₂ : (chart_at E p).target ∈ 𝓝 (chart_at E p p) :=
    (LocalHomeomorph.open_target _).mem_nhds (mem_chart_target E p)
  -- `f` pulled back by the chart at `p` is differentiable around `chart_at E p p`
  have hf' : ∀ᶠ z : E in 𝓝 (chart_at E p p), DifferentiableAt ℂ (f ∘ (chart_at E p).symm) z :=
    by
    refine' Filter.eventually_of_mem key₂ fun z hz => _
    have H₁ : (chart_at E p).symm z ∈ (chart_at E p).source := (chart_at E p).map_target hz
    have H₂ : f ((chart_at E p).symm z) ∈ (chart_at F (0 : F)).source := trivial
    have H := (mdifferentiableAt_iff_of_mem_source H₁ H₂).mp (hf ((chart_at E p).symm z))
    simp only [differentiableWithinAt_univ, mfld_simps] at H
    simpa [LocalHomeomorph.right_inv _ hz] using H.2
  -- `f` pulled back by the chart at `p` has a local max at `chart_at E p p`
  have hf'' : IsLocalMax (norm ∘ f ∘ (chart_at E p).symm) (chart_at E p p) :=
    by
    refine' Filter.eventually_of_mem key₁ fun z hz => _
    refine' (hp₀ ((chart_at E p).symm z) hz).trans (_ : ‖f p₀‖ ≤ ‖f _‖)
    rw [← hp, LocalHomeomorph.left_inv _ (mem_chart_source E p)]
  -- so by the maximum principle `f` is equal to `f p` near `p`
  obtain ⟨U, hU, hUf⟩ := (Complex.eventually_eq_of_isLocalMax_norm hf' hf'').exists_mem
  have H₁ : chart_at E p ⁻¹' U ∈ 𝓝 p := (chart_at E p).ContinuousAt (mem_chart_source E p) hU
  have H₂ : (chart_at E p).source ∈ 𝓝 p :=
    (LocalHomeomorph.open_source _).mem_nhds (mem_chart_source E p)
  apply Filter.mem_of_superset (Filter.inter_mem hps' (Filter.inter_mem H₁ H₂))
  rintro q ⟨hqs, hq : chart_at E p q ∈ _, hq'⟩
  refine' ⟨_, hqs⟩
  simpa [LocalHomeomorph.left_inv _ hq', hp, -norm_eq_abs] using hUf (chart_at E p q) hq
#align mdifferentiable.is_locally_constant Mdifferentiable.isLocallyConstant

/-- A holomorphic function on a compact connected complex manifold is constant. -/
theorem apply_eq_of_compactSpace [PreconnectedSpace M] {f : M → F}
    (hf : Mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) (a b : M) : f a = f b :=
  hf.IsLocallyConstant.apply_eq_of_preconnectedSpace _ _
#align mdifferentiable.apply_eq_of_compact_space Mdifferentiable.apply_eq_of_compactSpace

/-- A holomorphic function on a compact connected complex manifold is the constant function `f ≡ v`,
for some value `v`. -/
theorem exists_eq_const_of_compactSpace [PreconnectedSpace M] {f : M → F}
    (hf : Mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) : ∃ v : F, f = Function.const M v :=
  hf.IsLocallyConstant.exists_eq_const
#align mdifferentiable.exists_eq_const_of_compact_space Mdifferentiable.exists_eq_const_of_compactSpace

end Mdifferentiable


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module number_theory.sum_four_squares
! leanprover-community/mathlib commit bd9851ca476957ea4549eb19b40e7b5ade9428cc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GroupPower.Identities
import Mathbin.Data.Zmod.Basic
import Mathbin.FieldTheory.Finite.Basic
import Mathbin.Data.Int.Parity
import Mathbin.Data.Fintype.BigOperators

/-!
# Lagrange's four square theorem

The main result in this file is `sum_four_squares`,
a proof that every natural number is the sum of four square numbers.

## Implementation Notes

The proof used is close to Lagrange's original proof.
-/

open Finset Polynomial FiniteField Equiv

open BigOperators

namespace Int

theorem sq_add_sq_of_two_mul_sq_add_sq {m x y : ℤ} (h : 2 * m = x ^ 2 + y ^ 2) :
    m = ((x - y) / 2) ^ 2 + ((x + y) / 2) ^ 2 :=
  have : Even (x ^ 2 + y ^ 2) := by simp [← h, even_mul]
  have hxaddy : Even (x + y) := by simpa [sq, parity_simps]
  have hxsuby : Even (x - y) := by simpa [sq, parity_simps]
  (mul_right_inj' (show (2 * 2 : ℤ) ≠ 0 by decide)).1 <|
    calc
      2 * 2 * m = (x - y) ^ 2 + (x + y) ^ 2 := by rw [mul_assoc, h] <;> ring
      _ = (2 * ((x - y) / 2)) ^ 2 + (2 * ((x + y) / 2)) ^ 2 :=
        by
        rw [even_iff_two_dvd] at hxsuby hxaddy
        rw [Int.mul_ediv_cancel' hxsuby, Int.mul_ediv_cancel' hxaddy]
      _ = 2 * 2 * (((x - y) / 2) ^ 2 + ((x + y) / 2) ^ 2) := by
        simp [mul_add, pow_succ, mul_comm, mul_assoc, mul_left_comm]

#align int.sq_add_sq_of_two_mul_sq_add_sq Int.sq_add_sq_of_two_mul_sq_add_sq

theorem exists_sq_add_sq_add_one_eq_k (p : ℕ) [hp : Fact p.Prime] :
    ∃ (a b : ℤ)(k : ℕ), a ^ 2 + b ^ 2 + 1 = k * p ∧ k < p :=
  hp.1.eq_two_or_odd.elim (fun hp2 => hp2.symm ▸ ⟨1, 0, 1, rfl, by decide⟩) fun hp1 =>
    let ⟨a, b, hab⟩ := ZMod.sq_add_sq p (-1)
    have hab' : (p : ℤ) ∣ a.valMinAbs ^ 2 + b.valMinAbs ^ 2 + 1 :=
      (CharP.int_cast_eq_zero_iff (ZMod p) p _).1 <| by simpa [eq_neg_iff_add_eq_zero] using hab
    let ⟨k, hk⟩ := hab'
    have hk0 : 0 ≤ k :=
      nonneg_of_mul_nonneg_right
        (by rw [← hk] <;> exact add_nonneg (add_nonneg (sq_nonneg _) (sq_nonneg _)) zero_le_one)
        (Int.coe_nat_pos.2 hp.1.Pos)
    ⟨a.valMinAbs, b.valMinAbs, k.natAbs, by rw [hk, Int.natAbs_of_nonneg hk0, mul_comm],
      lt_of_mul_lt_mul_left
        (calc
          p * k.natAbs = a.valMinAbs.natAbs ^ 2 + b.valMinAbs.natAbs ^ 2 + 1 := by
            rw [← Int.coe_nat_inj', Int.ofNat_add, Int.ofNat_add, Int.coe_nat_pow, Int.coe_nat_pow,
              Int.natAbs_sq, Int.natAbs_sq, Int.ofNat_one, hk, Int.ofNat_mul,
              Int.natAbs_of_nonneg hk0]
          _ ≤ (p / 2) ^ 2 + (p / 2) ^ 2 + 1 :=
            (add_le_add
              (add_le_add (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _)
                (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _))
              le_rfl)
          _ < (p / 2) ^ 2 + (p / 2) ^ 2 + (p % 2) ^ 2 + (2 * (p / 2) ^ 2 + 4 * (p / 2) * (p % 2)) :=
            by
            rw [hp1, one_pow, mul_one] <;>
              exact
                (lt_add_iff_pos_right _).2
                  (add_pos_of_nonneg_of_pos (Nat.zero_le _)
                    (mul_pos (by decide) (Nat.div_pos hp.1.two_le (by decide))))
          _ = p * p := by
            conv_rhs => rw [← Nat.mod_add_div p 2]
            ring
          )
        (show 0 ≤ p from Nat.zero_le _)⟩
#align int.exists_sq_add_sq_add_one_eq_k Int.exists_sq_add_sq_add_one_eq_k

end Int

namespace Nat

open Int

open Classical

private theorem sum_four_squares_of_two_mul_sum_four_squares {m a b c d : ℤ}
    (h : a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = 2 * m) :
    ∃ w x y z : ℤ, w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 = m :=
  have :
    ∀ f : Fin 4 → ZMod 2,
      f 0 ^ 2 + f 1 ^ 2 + f 2 ^ 2 + f 3 ^ 2 = 0 →
        ∃ i : Fin 4,
          f i ^ 2 + f (swap i 0 1) ^ 2 = 0 ∧ f (swap i 0 2) ^ 2 + f (swap i 0 3) ^ 2 = 0 :=
    by decide
  let f : Fin 4 → ℤ := Vector.get (a ::ᵥ b ::ᵥ c ::ᵥ d ::ᵥ Vector.nil)
  let ⟨i, hσ⟩ :=
    this (fun x => coe (f x))
      (by
        rw [← @MulZeroClass.zero_mul (ZMod 2) _ m, ← show ((2 : ℤ) : ZMod 2) = 0 from rfl, ←
              Int.cast_mul, ← h] <;>
            simp only [Int.cast_add, Int.cast_pow] <;>
          rfl)
  let σ := swap i 0
  have h01 : 2 ∣ f (σ 0) ^ 2 + f (σ 1) ^ 2 :=
    (CharP.int_cast_eq_zero_iff (ZMod 2) 2 _).1 <| by
      simpa only [Int.cast_pow, Int.cast_add, Equiv.swap_apply_right, ZMod.pow_card] using hσ.1
  have h23 : 2 ∣ f (σ 2) ^ 2 + f (σ 3) ^ 2 :=
    (CharP.int_cast_eq_zero_iff (ZMod 2) 2 _).1 <| by
      simpa only [Int.cast_pow, Int.cast_add, ZMod.pow_card] using hσ.2
  let ⟨x, hx⟩ := h01
  let ⟨y, hy⟩ := h23
  ⟨(f (σ 0) - f (σ 1)) / 2, (f (σ 0) + f (σ 1)) / 2, (f (σ 2) - f (σ 3)) / 2,
    (f (σ 2) + f (σ 3)) / 2,
    by
    rw [← Int.sq_add_sq_of_two_mul_sq_add_sq hx.symm, add_assoc, ←
      Int.sq_add_sq_of_two_mul_sq_add_sq hy.symm, ← mul_right_inj' (show (2 : ℤ) ≠ 0 by decide), ←
      h, mul_add, ← hx, ← hy]
    have : (∑ x, f (σ x) ^ 2) = ∑ x, f x ^ 2 := by conv_rhs => rw [← Equiv.sum_comp σ]
    simpa only [Fin.sum_univ_four, add_assoc] using this⟩
#align nat.sum_four_squares_of_two_mul_sum_four_squares nat.sum_four_squares_of_two_mul_sum_four_squares

private theorem prime_sum_four_squares (p : ℕ) [hp : Fact p.Prime] :
    ∃ a b c d : ℤ, a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = p :=
  have hm : ∃ m < p, 0 < m ∧ ∃ a b c d : ℤ, a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = m * p :=
    let ⟨a, b, k, hk⟩ := exists_sq_add_sq_add_one_eq_k p
    ⟨k, hk.2,
      Nat.pos_of_ne_zero fun hk0 =>
        by
        rw [hk0, Int.ofNat_zero, MulZeroClass.zero_mul] at hk
        exact
          ne_of_gt
            (show a ^ 2 + b ^ 2 + 1 > 0 from
              add_pos_of_nonneg_of_pos (add_nonneg (sq_nonneg _) (sq_nonneg _)) zero_lt_one)
            hk.1,
      a, b, 1, 0, by simpa only [zero_pow two_pos, one_pow, add_zero] using hk.1⟩
  let m := Nat.find hm
  let ⟨a, b, c, d, (habcd : a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = m * p)⟩ := (Nat.find_spec hm).snd.2
  haveI hm0 : NeZero m := NeZero.of_pos (Nat.find_spec hm).snd.1
  have hmp : m < p := (Nat.find_spec hm).fst
  m.mod_two_eq_zero_or_one.elim
    (fun hm2 : m % 2 = 0 =>
      let ⟨k, hk⟩ := Nat.dvd_iff_mod_eq_zero.2 hm2
      have hk0 : 0 < k :=
        Nat.pos_of_ne_zero <| by
          rintro rfl
          rw [MulZeroClass.mul_zero] at hk
          exact NeZero.ne m hk
      have hkm : k < m := by rw [hk, two_mul]; exact (lt_add_iff_pos_left _).2 hk0
      False.elim <|
        Nat.find_min hm hkm
          ⟨lt_trans hkm hmp, hk0,
            sum_four_squares_of_two_mul_sum_four_squares
              (show a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = 2 * (k * p)
                by
                rw [habcd, hk, Int.ofNat_mul, mul_assoc]
                norm_num)⟩)
    fun hm2 : m % 2 = 1 =>
    if hm1 : m = 1 then ⟨a, b, c, d, by simp only [hm1, habcd, Int.ofNat_one, one_mul]⟩
    else
      let w := (a : ZMod m).valMinAbs
      let x := (b : ZMod m).valMinAbs
      let y := (c : ZMod m).valMinAbs
      let z := (d : ZMod m).valMinAbs
      have hnat_abs :
        w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 =
          (w.natAbs ^ 2 + x.natAbs ^ 2 + y.natAbs ^ 2 + z.natAbs ^ 2 : ℕ) :=
        by
        push_cast
        simp_rw [sq_abs]
      have hwxyzlt : w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 < m ^ 2 :=
        calc
          w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 =
              (w.natAbs ^ 2 + x.natAbs ^ 2 + y.natAbs ^ 2 + z.natAbs ^ 2 : ℕ) :=
            hnat_abs
          _ ≤ ((m / 2) ^ 2 + (m / 2) ^ 2 + (m / 2) ^ 2 + (m / 2) ^ 2 : ℕ) :=
            (Int.ofNat_le.2 <|
              add_le_add
                (add_le_add
                  (add_le_add (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _)
                    (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _))
                  (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _))
                (Nat.pow_le_pow_of_le_left (ZMod.natAbs_valMinAbs_le _) _))
          _ = 4 * (m / 2 : ℕ) ^ 2 := by
            simp only [bit0_mul, one_mul, two_smul, Nat.cast_add, Nat.cast_pow, add_assoc]
          _ < 4 * (m / 2 : ℕ) ^ 2 + ((4 * (m / 2) : ℕ) * (m % 2 : ℕ) + (m % 2 : ℕ) ^ 2) :=
            ((lt_add_iff_pos_right _).2
              (by
                rw [hm2, Int.ofNat_one, one_pow, mul_one]
                exact add_pos_of_nonneg_of_pos (Int.coe_nat_nonneg _) zero_lt_one))
          _ = m ^ 2 := by
            conv_rhs => rw [← Nat.mod_add_div m 2]
            simp [-Nat.mod_add_div, mul_add, add_mul, bit0, bit1, mul_comm, mul_assoc,
              mul_left_comm, pow_add, add_comm, add_left_comm]

      have hwxyzabcd :
        ((w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 : ℤ) : ZMod m) =
          ((a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 : ℤ) : ZMod m) :=
        by push_cast
      have hwxyz0 : ((w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2 : ℤ) : ZMod m) = 0 := by
        rw [hwxyzabcd, habcd, Int.cast_mul, cast_coe_nat, ZMod.nat_cast_self, MulZeroClass.zero_mul]
      let ⟨n, hn⟩ := (CharP.int_cast_eq_zero_iff _ m _).1 hwxyz0
      have hn0 : 0 < n.natAbs :=
        Int.natAbs_pos_of_ne_zero fun hn0 =>
          have hwxyz0 : (w.natAbs ^ 2 + x.natAbs ^ 2 + y.natAbs ^ 2 + z.natAbs ^ 2 : ℕ) = 0 :=
            by
            rw [← Int.coe_nat_eq_zero, ← hnat_abs]
            rwa [hn0, MulZeroClass.mul_zero] at hn
          have habcd0 : (m : ℤ) ∣ a ∧ (m : ℤ) ∣ b ∧ (m : ℤ) ∣ c ∧ (m : ℤ) ∣ d := by
            simpa only [add_eq_zero_iff, Int.natAbs_eq_zero, ZMod.valMinAbs_eq_zero, and_assoc,
              pow_eq_zero_iff two_pos, CharP.int_cast_eq_zero_iff _ m _] using hwxyz0
          let ⟨ma, hma⟩ := habcd0.1
          let ⟨mb, hmb⟩ := habcd0.2.1
          let ⟨mc, hmc⟩ := habcd0.2.2.1
          let ⟨md, hmd⟩ := habcd0.2.2.2
          have hmdvdp : m ∣ p :=
            Int.coe_nat_dvd.1
              ⟨ma ^ 2 + mb ^ 2 + mc ^ 2 + md ^ 2,
                (mul_right_inj' (show (m : ℤ) ≠ 0 from Int.coe_nat_ne_zero.2 hm0.1)).1 <|
                  by
                  rw [← habcd, hma, hmb, hmc, hmd]
                  ring⟩
          (hp.1.eq_one_or_self_of_dvd _ hmdvdp).elim hm1 fun hmeqp => by
            simpa [lt_irrefl, hmeqp] using hmp
      have hawbxcydz : ((m : ℕ) : ℤ) ∣ a * w + b * x + c * y + d * z :=
        (CharP.int_cast_eq_zero_iff (ZMod m) m _).1 <|
          by
          rw [← hwxyz0]
          simp_rw [sq]
          push_cast
      have haxbwczdy : ((m : ℕ) : ℤ) ∣ a * x - b * w - c * z + d * y :=
        (CharP.int_cast_eq_zero_iff (ZMod m) m _).1 <|
          by
          push_cast
          ring
      have haybzcwdx : ((m : ℕ) : ℤ) ∣ a * y + b * z - c * w - d * x :=
        (CharP.int_cast_eq_zero_iff (ZMod m) m _).1 <|
          by
          push_cast
          ring
      have hazbycxdw : ((m : ℕ) : ℤ) ∣ a * z - b * y + c * x - d * w :=
        (CharP.int_cast_eq_zero_iff (ZMod m) m _).1 <|
          by
          push_cast
          ring
      let ⟨s, hs⟩ := hawbxcydz
      let ⟨t, ht⟩ := haxbwczdy
      let ⟨u, hu⟩ := haybzcwdx
      let ⟨v, hv⟩ := hazbycxdw
      have hn_nonneg : 0 ≤ n :=
        nonneg_of_mul_nonneg_right
          (by
            erw [← hn]
            repeat' try refine' add_nonneg _ _; try exact sq_nonneg _)
          (Int.coe_nat_pos.2 <| NeZero.pos m)
      have hnm : n.natAbs < m :=
        Int.ofNat_lt.1
          (lt_of_mul_lt_mul_left
            (by
              rw [Int.natAbs_of_nonneg hn_nonneg, ← hn, ← sq]
              exact hwxyzlt)
            (Int.coe_nat_nonneg m))
      have hstuv : s ^ 2 + t ^ 2 + u ^ 2 + v ^ 2 = n.natAbs * p :=
        (mul_right_inj'
              (show (m ^ 2 : ℤ) ≠ 0 from pow_ne_zero 2 (Int.coe_nat_ne_zero.2 hm0.1))).1 <|
          calc
            (m : ℤ) ^ 2 * (s ^ 2 + t ^ 2 + u ^ 2 + v ^ 2) =
                ((m : ℕ) * s) ^ 2 + ((m : ℕ) * t) ^ 2 + ((m : ℕ) * u) ^ 2 + ((m : ℕ) * v) ^ 2 :=
              by
              simp [mul_pow]
              ring
            _ = (w ^ 2 + x ^ 2 + y ^ 2 + z ^ 2) * (a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2) :=
              by
              simp only [hs.symm, ht.symm, hu.symm, hv.symm]
              ring
            _ = _ := by
              rw [hn, habcd, Int.natAbs_of_nonneg hn_nonneg]
              dsimp [m]
              ring

      False.elim <| Nat.find_min hm hnm ⟨lt_trans hnm hmp, hn0, s, t, u, v, hstuv⟩
#align nat.prime_sum_four_squares nat.prime_sum_four_squares

/-- **Four squares theorem** -/
theorem sum_four_squares : ∀ n : ℕ, ∃ a b c d : ℕ, a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = n
  | 0 => ⟨0, 0, 0, 0, rfl⟩
  | 1 => ⟨1, 0, 0, 0, rfl⟩
  | n@(k + 2) =>
    have hm : Fact (minFac (k + 2)).Prime := ⟨minFac_prime (by decide)⟩
    have : n / minFac n < n := factors_lemma
    let ⟨a, b, c, d, h₁⟩ :=
      show ∃ a b c d : ℤ, a ^ 2 + b ^ 2 + c ^ 2 + d ^ 2 = minFac n from
        prime_sum_four_squares (min_fac (k + 2))
    let ⟨w, x, y, z, h₂⟩ := sum_four_squares (n / minFac n)
    ⟨(a * w - b * x - c * y - d * z).natAbs, (a * x + b * w + c * z - d * y).natAbs,
      (a * y - b * z + c * w + d * x).natAbs, (a * z + b * y - c * x + d * w).natAbs,
      by
      rw [← Int.coe_nat_inj', ← Nat.mul_div_cancel' (min_fac_dvd (k + 2)), Int.ofNat_mul, ← h₁, ←
        h₂]
      simp [sum_four_sq_mul_sum_four_sq]⟩
#align nat.sum_four_squares Nat.sum_four_squares

end Nat


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import data.matrix.basic
import data.fin.vec_notation

/-!
# Matrix and vector notation

This file includes `simp` lemmas for applying operations in `data.matrix.basic` to values built out
of the matrix notation `![a, b] = vec_cons a (vec_cons b vec_empty)` defined in
`data.fin.vec_notation`.

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

We reuse notation `![a, b]` for `vec_cons a (vec_cons b vec_empty)`. It is a localized notation in
the `matrix` locale.

## Examples

Examples of usage can be found in the `test/matrix.lean` file.
-/

namespace matrix

universe u
variables {α : Type u} {o n m : ℕ} {m' n' o' : Type*}

open_locale matrix

/-- Use `![...]` notation for displaying a `fin`-indexed matrix, for example:

```
#eval ![![1, 2], ![3, 4]] + ![![3, 4], ![5, 6]] -- ![![4, 6], ![8, 10]]
```
-/
instance [has_repr α] : has_repr (matrix (fin m) (fin n) α) := pi_fin.has_repr

@[simp] lemma cons_val' (v : n' → α) (B : matrix (fin m) n' α) (i j) :
  vec_cons v B i j = vec_cons (v j) (λ i, B i j) i :=
by { refine fin.cases _ _ i; simp }

@[simp] lemma head_val' (B : matrix (fin m.succ) n' α) (j : n') :
  vec_head (λ i, B i j) = vec_head B j := rfl

@[simp] lemma tail_val' (B : matrix (fin m.succ) n' α) (j : n') :
  vec_tail (λ i, B i j) = λ i, vec_tail B i j :=
by { ext, simp [vec_tail] }

section dot_product

variables [add_comm_monoid α] [has_mul α]

@[simp] lemma dot_product_empty (v w : fin 0 → α) :
  dot_product v w = 0 := finset.sum_empty

@[simp] lemma cons_dot_product (x : α) (v : fin n → α) (w : fin n.succ → α) :
  dot_product (vec_cons x v) w = x * vec_head w + dot_product v (vec_tail w) :=
by simp [dot_product, fin.sum_univ_succ, vec_head, vec_tail]

@[simp] lemma dot_product_cons (v : fin n.succ → α) (x : α) (w : fin n → α) :
  dot_product v (vec_cons x w) = vec_head v * x + dot_product (vec_tail v) w :=
by simp [dot_product, fin.sum_univ_succ, vec_head, vec_tail]

end dot_product

section col_row

@[simp] lemma col_empty (v : fin 0 → α) : col v = vec_empty :=
empty_eq _

@[simp] lemma col_cons (x : α) (u : fin m → α) :
  col (vec_cons x u) = vec_cons (λ _, x) (col u) :=
by { ext i j, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma row_empty : row (vec_empty : fin 0 → α) = λ _, vec_empty :=
by { ext, refl }

@[simp] lemma row_cons (x : α) (u : fin m → α) :
  row (vec_cons x u) = λ _, vec_cons x u :=
by { ext, refl }

end col_row

section transpose

@[simp] lemma transpose_empty_rows (A : matrix m' (fin 0) α) : Aᵀ = ![] := empty_eq _

@[simp] lemma transpose_empty_cols : (![] : matrix (fin 0) m' α)ᵀ = λ i, ![] :=
funext (λ i, empty_eq _)

@[simp] lemma cons_transpose (v : n' → α) (A : matrix (fin m) n' α) :
  (vec_cons v A)ᵀ = λ i, vec_cons (v i) (Aᵀ i) :=
by { ext i j, refine fin.cases _ _ j; simp }

@[simp] lemma head_transpose (A : matrix m' (fin n.succ) α) : vec_head (Aᵀ) = vec_head ∘ A :=
rfl

@[simp] lemma tail_transpose (A : matrix m' (fin n.succ) α) : vec_tail (Aᵀ) = (vec_tail ∘ A)ᵀ :=
by { ext i j, refl }

end transpose

section mul

variables [semiring α]

@[simp] lemma empty_mul [fintype n'] (A : matrix (fin 0) n' α) (B : matrix n' o' α) :
  A ⬝ B = ![] :=
empty_eq _

@[simp] lemma empty_mul_empty (A : matrix m' (fin 0) α) (B : matrix (fin 0) o' α) :
  A ⬝ B = 0 :=
rfl

@[simp] lemma mul_empty [fintype n'] (A : matrix m' n' α) (B : matrix n' (fin 0) α) :
  A ⬝ B = λ _, ![] :=
funext (λ _, empty_eq _)

lemma mul_val_succ [fintype n']
  (A : matrix (fin m.succ) n' α) (B : matrix n' o' α) (i : fin m) (j : o') :
  (A ⬝ B) i.succ j = (vec_tail A ⬝ B) i j := rfl

@[simp] lemma cons_mul [fintype n'] (v : n' → α) (A : matrix (fin m) n' α) (B : matrix n' o' α) :
  vec_cons v A ⬝ B = vec_cons (vec_mul v B) (A  ⬝ B) :=
by { ext i j, refine fin.cases _ _ i, { refl }, simp [mul_val_succ] }

end mul

section vec_mul

variables [semiring α]

@[simp] lemma empty_vec_mul (v : fin 0 → α) (B : matrix (fin 0) o' α) :
  vec_mul v B = 0 :=
rfl

@[simp] lemma vec_mul_empty [fintype n'] (v : n' → α) (B : matrix n' (fin 0) α) :
  vec_mul v B = ![] :=
empty_eq _

@[simp] lemma cons_vec_mul (x : α) (v : fin n → α) (B : matrix (fin n.succ) o' α) :
  vec_mul (vec_cons x v) B = x • (vec_head B) + vec_mul v (vec_tail B) :=
by { ext i, simp [vec_mul] }

@[simp] lemma vec_mul_cons (v : fin n.succ → α) (w : o' → α) (B : matrix (fin n) o' α) :
  vec_mul v (vec_cons w B) = vec_head v • w + vec_mul (vec_tail v) B :=
by { ext i, simp [vec_mul] }

end vec_mul

section mul_vec

variables [semiring α]

@[simp] lemma empty_mul_vec [fintype n'] (A : matrix (fin 0) n' α) (v : n' → α) :
  mul_vec A v = ![] :=
empty_eq _

@[simp] lemma mul_vec_empty (A : matrix m' (fin 0) α) (v : fin 0 → α) :
  mul_vec A v = 0 :=
rfl

@[simp] lemma cons_mul_vec [fintype n'] (v : n' → α) (A : fin m → n' → α) (w : n' → α) :
  mul_vec (vec_cons v A) w = vec_cons (dot_product v w) (mul_vec A w) :=
by { ext i, refine fin.cases _ _ i; simp [mul_vec] }

@[simp] lemma mul_vec_cons {α} [comm_semiring α] (A : m' → (fin n.succ) → α) (x : α)
  (v : fin n → α) :
  mul_vec A (vec_cons x v) = (x • vec_head ∘ A) + mul_vec (vec_tail ∘ A) v :=
by { ext i, simp [mul_vec, mul_comm] }

end mul_vec

section vec_mul_vec

variables [semiring α]

@[simp] lemma empty_vec_mul_vec (v : fin 0 → α) (w : n' → α) :
  vec_mul_vec v w = ![] :=
empty_eq _

@[simp] lemma vec_mul_vec_empty (v : m' → α) (w : fin 0 → α) :
  vec_mul_vec v w = λ _, ![] :=
funext (λ i, empty_eq _)

@[simp] lemma cons_vec_mul_vec (x : α) (v : fin m → α) (w : n' → α) :
  vec_mul_vec (vec_cons x v) w = vec_cons (x • w) (vec_mul_vec v w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_mul_vec] }

@[simp] lemma vec_mul_vec_cons (v : m' → α) (x : α) (w : fin n → α) :
  vec_mul_vec v (vec_cons x w) = λ i, v i • vec_cons x w :=
by { ext i j, rw [vec_mul_vec, pi.smul_apply, smul_eq_mul] }

end vec_mul_vec

section smul

variables [semiring α]

@[simp] lemma smul_mat_empty {m' : Type*} (x : α) (A : fin 0 → m' → α) : x • A = ![] := empty_eq _

@[simp] lemma smul_mat_cons (x : α) (v : n' → α) (A : matrix (fin m) n' α) :
  x • vec_cons v A = vec_cons (x • v) (x • A) :=
by { ext i, refine fin.cases _ _ i; simp }

end smul

section minor

@[simp] lemma minor_empty (A : matrix m' n' α) (row : fin 0 → m') (col : o' → n') :
  minor A row col = ![] :=
empty_eq _

@[simp] lemma minor_cons_row (A : matrix m' n' α) (i : m') (row : fin m → m') (col : o' → n') :
  minor A (vec_cons i row) col = vec_cons (λ j, A i (col j)) (minor A row col) :=
by { ext i j, refine fin.cases _ _ i; simp [minor] }

end minor

end matrix


import MyNat.Definition
/-!
# Tactic contradiction

The `contradiction` tactic closes the main goal if its hypotheses
are "trivially contradictory".

Inductive type/family with no applicable constructors

- `example (h : False) : p := by contradiction`

Injectivity of constructors

- `example (h : none = some true) : p := by contradiction  --`

Decidable false proposition

- `example (h : 2 + 2 = 3) : p := by contradiction`

Contradictory hypotheses

  `example (h : p) (h' : ¬ p) : q := by contradiction`

Other simple contradictions such as

- `example (x : Nat) (h : x ≠ x) : p := by contradiction`

-/