/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import data.real.sqrt
import analysis.normed_space.star.basic
import analysis.normed_space.continuous_linear_map

/-!
# `is_R_or_C`: a typeclass for ℝ or ℂ

This file defines the typeclass `is_R_or_C` intended to have only two instances:
ℝ and ℂ. It is meant for definitions and theorems which hold for both the real and the complex case,
and in particular when the real case follows directly from the complex case by setting `re` to `id`,
`im` to zero and so on. Its API follows closely that of ℂ.

Applications include defining inner products and Hilbert spaces for both the real and
complex case. One typically produces the definitions and proof for an arbitrary field of this
typeclass, which basically amounts to doing the complex case, and the two cases then fall out
immediately from the two instances of the class.

The instance for `ℝ` is registered in this file.
The instance for `ℂ` is declared in `analysis.complex.basic`.

## Implementation notes

The coercion from reals into an `is_R_or_C` field is done by registering `algebra_map ℝ K` as
a `has_coe_t`. For this to work, we must proceed carefully to avoid problems involving circular
coercions in the case `K=ℝ`; in particular, we cannot use the plain `has_coe` and must set
priorities carefully. This problem was already solved for `ℕ`, and we copy the solution detailed
in `data/nat/cast`. See also Note [coercion into rings] for more details.

In addition, several lemmas need to be set at priority 900 to make sure that they do not override
their counterparts in `complex.lean` (which causes linter errors).

A few lemmas requiring heavier imports are in `data.is_R_or_C.lemmas`.
-/

open_locale big_operators

section

local notation `𝓚` := algebra_map ℝ _
open_locale complex_conjugate

/--
This typeclass captures properties shared by ℝ and ℂ, with an API that closely matches that of ℂ.
-/
class is_R_or_C (K : Type*)
  extends densely_normed_field K, star_ring K, normed_algebra ℝ K, complete_space K :=
(re : K →+ ℝ)
(im : K →+ ℝ)
(I : K)                 -- Meant to be set to 0 for K=ℝ
(I_re_ax : re I = 0)
(I_mul_I_ax : I = 0 ∨ I * I = -1)
(re_add_im_ax : ∀ (z : K), 𝓚 (re z) + 𝓚 (im z) * I = z)
(of_real_re_ax : ∀ r : ℝ, re (𝓚 r) = r)
(of_real_im_ax : ∀ r : ℝ, im (𝓚 r) = 0)
(mul_re_ax : ∀ z w : K, re (z * w) = re z * re w - im z * im w)
(mul_im_ax : ∀ z w : K, im (z * w) = re z * im w + im z * re w)
(conj_re_ax : ∀ z : K, re (conj z) = re z)
(conj_im_ax : ∀ z : K, im (conj z) = -(im z))
(conj_I_ax : conj I = -I)
(norm_sq_eq_def_ax : ∀ (z : K), ‖z‖^2 = (re z) * (re z) + (im z) * (im z))
(mul_im_I_ax : ∀ (z : K), (im z) * im I = im z)
(inv_def_ax : ∀ (z : K), z⁻¹ = conj z * 𝓚 ((‖z‖^2)⁻¹))
(div_I_ax : ∀ (z : K), z / I = -(z * I))

end

mk_simp_attribute is_R_or_C_simps "Simp attribute for lemmas about `is_R_or_C`"

variables {K E : Type*} [is_R_or_C K]

namespace is_R_or_C

open_locale complex_conjugate

/- The priority must be set at 900 to ensure that coercions are tried in the right order.
See Note [coercion into rings], or `data/nat/cast.lean` for more details. -/
@[priority 900] noncomputable instance algebra_map_coe : has_coe_t ℝ K := ⟨algebra_map ℝ K⟩

lemma of_real_alg (x : ℝ) : (x : K) = x • (1 : K) :=
algebra.algebra_map_eq_smul_one x

lemma real_smul_eq_coe_mul (r : ℝ) (z : K) : r • z = (r : K) * z :=
by rw [is_R_or_C.of_real_alg, ←smul_eq_mul, smul_assoc, smul_eq_mul, one_mul]

lemma real_smul_eq_coe_smul [add_comm_group E] [module K E] [module ℝ E] [is_scalar_tower ℝ K E]
  (r : ℝ) (x : E) : r • x = (r : K) • x :=
by rw [is_R_or_C.of_real_alg, smul_one_smul]

lemma algebra_map_eq_of_real : ⇑(algebra_map ℝ K) = coe := rfl

@[simp, is_R_or_C_simps] lemma re_add_im (z : K) : ((re z) : K) + (im z) * I = z :=
is_R_or_C.re_add_im_ax z
@[simp, norm_cast, is_R_or_C_simps] lemma of_real_re : ∀ r : ℝ, re (r : K) = r :=
is_R_or_C.of_real_re_ax
@[simp, norm_cast, is_R_or_C_simps] lemma of_real_im : ∀ r : ℝ, im (r : K) = 0 :=
is_R_or_C.of_real_im_ax
@[simp, is_R_or_C_simps] lemma mul_re : ∀ z w : K, re (z * w) = re z * re w - im z * im w :=
is_R_or_C.mul_re_ax
@[simp, is_R_or_C_simps] lemma mul_im : ∀ z w : K, im (z * w) = re z * im w + im z * re w :=
is_R_or_C.mul_im_ax

theorem inv_def (z : K) : z⁻¹ = conj z * ((‖z‖^2)⁻¹:ℝ) :=
is_R_or_C.inv_def_ax z

theorem ext_iff : ∀ {z w : K}, z = w ↔ re z = re w ∧ im z = im w :=
λ z w, { mp := by { rintro rfl, cc },
         mpr := by { rintro ⟨h₁,h₂⟩, rw [←re_add_im z, ←re_add_im w, h₁, h₂] } }

theorem ext : ∀ {z w : K}, re z = re w → im z = im w → z = w :=
by { simp_rw ext_iff, cc }

@[norm_cast] lemma of_real_zero : ((0 : ℝ) : K) = 0 :=
by rw [of_real_alg, zero_smul]

@[simp, is_R_or_C_simps] lemma zero_re' : re (0 : K) = (0 : ℝ) := re.map_zero

@[norm_cast] lemma of_real_one : ((1 : ℝ) : K) = 1 :=
by rw [of_real_alg, one_smul]
@[simp, is_R_or_C_simps] lemma one_re : re (1 : K) = 1 := by rw [←of_real_one, of_real_re]
@[simp, is_R_or_C_simps] lemma one_im : im (1 : K) = 0 := by rw [←of_real_one, of_real_im]

@[norm_cast] theorem of_real_inj {z w : ℝ} : (z : K) = (w : K) ↔ z = w :=
{ mp := λ h, by { convert congr_arg re h; simp only [of_real_re] },
  mpr := λ h, by rw h }

@[simp, is_R_or_C_simps] lemma bit0_re (z : K) : re (bit0 z) = bit0 (re z) :=
by simp only [bit0, map_add]
@[simp, is_R_or_C_simps] lemma bit1_re (z : K) : re (bit1 z) = bit1 (re z) :=
by simp only [bit1, add_monoid_hom.map_add, bit0_re, add_right_inj, one_re]
@[simp, is_R_or_C_simps] lemma bit0_im (z : K) : im (bit0 z) = bit0 (im z) :=
by simp only [bit0, map_add]
@[simp, is_R_or_C_simps] lemma bit1_im (z : K) : im (bit1 z) = bit0 (im z) :=
by simp only [bit1, add_right_eq_self, add_monoid_hom.map_add, bit0_im, one_im]

theorem of_real_eq_zero {z : ℝ} : (z : K) = 0 ↔ z = 0 :=
by rw [←of_real_zero]; exact of_real_inj

theorem of_real_ne_zero {z : ℝ} : (z : K) ≠ 0 ↔ z ≠ 0 := of_real_eq_zero.not

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_add ⦃r s : ℝ⦄ : ((r + s : ℝ) : K) = r + s :=
by { apply (@is_R_or_C.ext_iff K _ ((r + s : ℝ) : K) (r + s)).mpr, simp }

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : K) = bit0 (r : K) :=
ext_iff.2 $ by simp [bit0]

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : K) = bit1 (r : K) :=
ext_iff.2 $ by simp [bit1]

@[simp, norm_cast, is_R_or_C_simps, priority 900]
lemma of_real_neg (r : ℝ) : ((-r : ℝ) : K) = -r := ext_iff.2 $ by simp

@[simp, norm_cast, is_R_or_C_simps, priority 900]
lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : K) = r * s := ext_iff.2 $ by simp with is_R_or_C_simps

@[simp, norm_cast, is_R_or_C_simps]
lemma of_real_smul (r x : ℝ) : r • (x : K) = (r : K) * (x : K) :=
begin
  simp_rw [← smul_eq_mul, of_real_alg r],
  simp only [algebra.id.smul_eq_mul, one_mul, algebra.smul_mul_assoc],
end

@[is_R_or_C_simps] lemma of_real_mul_re (r : ℝ) (z : K) : re (↑r * z) = r * re z :=
by simp only [mul_re, of_real_im, zero_mul, of_real_re, sub_zero]
@[is_R_or_C_simps] lemma of_real_mul_im (r : ℝ) (z : K) : im (↑r * z) = r * (im z) :=
by simp only [add_zero, of_real_im, zero_mul, of_real_re, mul_im]

@[is_R_or_C_simps] lemma smul_re : ∀ (r : ℝ) (z : K), re (r • z) = r * (re z) :=
λ r z, by { rw algebra.smul_def, apply of_real_mul_re }
@[is_R_or_C_simps] lemma smul_im : ∀ (r : ℝ) (z : K), im (r • z) = r * (im z) :=
λ r z, by { rw algebra.smul_def, apply of_real_mul_im }

@[simp, is_R_or_C_simps] lemma norm_real (r : ℝ) : ‖(r : K)‖ = ‖r‖ :=
by rw [is_R_or_C.of_real_alg, norm_smul, norm_one, mul_one]

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
@[simp, is_R_or_C_simps] lemma I_re : re (I : K) = 0 := I_re_ax
@[simp, is_R_or_C_simps] lemma I_im (z : K) : im z * im (I : K) = im z := mul_im_I_ax z
@[simp, is_R_or_C_simps] lemma I_im' (z : K) : im (I : K) * im z = im z :=
by rw [mul_comm, I_im _]

@[simp, is_R_or_C_simps] lemma I_mul_re (z : K) : re (I * z) = - im z :=
by simp only [I_re, zero_sub, I_im', zero_mul, mul_re]

lemma I_mul_I : (I : K) = 0 ∨ (I : K) * I = -1 := I_mul_I_ax

@[simp, is_R_or_C_simps] lemma conj_re (z : K) : re (conj z) = re z := is_R_or_C.conj_re_ax z
@[simp, is_R_or_C_simps] lemma conj_im (z : K) : im (conj z) = -(im z) := is_R_or_C.conj_im_ax z
@[simp, is_R_or_C_simps] lemma conj_I : conj (I : K) = -I := is_R_or_C.conj_I_ax
@[simp, is_R_or_C_simps] lemma conj_of_real (r : ℝ) : conj (r : K) = (r : K) :=
by { rw ext_iff, simp only [of_real_im, conj_im, eq_self_iff_true, conj_re, and_self, neg_zero] }

@[simp, is_R_or_C_simps] lemma conj_bit0 (z : K) : conj (bit0 z) = bit0 (conj z) :=
by simp only [bit0, ring_hom.map_add, eq_self_iff_true]
@[simp, is_R_or_C_simps] lemma conj_bit1 (z : K) : conj (bit1 z) = bit1 (conj z) :=
by simp only [bit0, ext_iff, bit1_re, conj_im, eq_self_iff_true, conj_re, neg_add_rev,
              and_self, bit1_im]

@[simp, is_R_or_C_simps] lemma conj_neg_I : conj (-I) = (I : K) :=
by simp only [conj_I, ring_hom.map_neg, eq_self_iff_true, neg_neg]

lemma conj_eq_re_sub_im (z : K) : conj z = re z - (im z) * I :=
by { rw ext_iff, simp only [add_zero, I_re, of_real_im, I_im, zero_sub, zero_mul, conj_im,
                            of_real_re, eq_self_iff_true, sub_zero, conj_re, mul_im, neg_inj,
                            and_self, mul_re, mul_zero, map_sub], }

@[is_R_or_C_simps] lemma conj_smul (r : ℝ) (z : K) : conj (r • z) = r • conj z :=
begin
  simp_rw conj_eq_re_sub_im,
  simp only [smul_re, smul_im, of_real_mul],
  rw smul_sub,
  simp_rw of_real_alg,
  simp only [one_mul, algebra.smul_mul_assoc],
end

lemma eq_conj_iff_real {z : K} : conj z = z ↔ ∃ r : ℝ, z = (r : K) :=
begin
  split,
  { intro h,
    suffices : im z = 0,
    { use (re z),
      rw ← add_zero (coe _),
      convert (re_add_im z).symm, simp [this] },
    contrapose! h,
    rw ← re_add_im z,
    simp only [conj_of_real, ring_hom.map_add, ring_hom.map_mul, conj_I_ax],
    rw [add_left_cancel_iff, ext_iff],
    simpa [neg_eq_iff_add_eq_zero, add_self_eq_zero] },
  { rintros ⟨r, rfl⟩, apply conj_of_real }
end

@[simp] lemma star_def : (has_star.star : K → K) = conj := rfl

variables (K)
/-- Conjugation as a ring equivalence. This is used to convert the inner product into a
sesquilinear product. -/
abbreviation conj_to_ring_equiv : K ≃+* Kᵐᵒᵖ := star_ring_equiv

variables {K}

lemma eq_conj_iff_re {z : K} : conj z = z ↔ ((re z) : K) = z :=
eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩

/-- The norm squared function. -/
def norm_sq : K →*₀ ℝ :=
{ to_fun := λ z, re z * re z + im z * im z,
  map_zero' := by simp only [add_zero, mul_zero, map_zero],
  map_one' := by simp only [one_im, add_zero, mul_one, one_re, mul_zero],
  map_mul' := λ z w, by { simp only [mul_im, mul_re], ring } }

lemma norm_sq_eq_def {z : K} : ‖z‖^2 = (re z) * (re z) + (im z) * (im z) := norm_sq_eq_def_ax z
lemma norm_sq_eq_def' (z : K) : norm_sq z = ‖z‖^2 := by { rw norm_sq_eq_def, refl }

@[is_R_or_C_simps] lemma norm_sq_zero : norm_sq (0 : K) = 0 := norm_sq.map_zero
@[is_R_or_C_simps] lemma norm_sq_one : norm_sq (1 : K) = 1 := norm_sq.map_one

lemma norm_sq_nonneg (z : K) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

@[simp, is_R_or_C_simps] lemma norm_sq_eq_zero {z : K} : norm_sq z = 0 ↔ z = 0 :=
by { rw [norm_sq_eq_def'], simp [sq] }

@[simp, is_R_or_C_simps] lemma norm_sq_pos {z : K} : 0 < norm_sq z ↔ z ≠ 0 :=
by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg]

@[simp, is_R_or_C_simps] lemma norm_sq_neg (z : K) : norm_sq (-z) = norm_sq z :=
by simp only [norm_sq_eq_def', norm_neg]

@[simp, is_R_or_C_simps] lemma norm_sq_conj (z : K) : norm_sq (conj z) = norm_sq z :=
by simp only [norm_sq, neg_mul, monoid_with_zero_hom.coe_mk,
              mul_neg, neg_neg] with is_R_or_C_simps

@[simp, is_R_or_C_simps] lemma norm_sq_mul (z w : K) : norm_sq (z * w) = norm_sq z * norm_sq w :=
norm_sq.map_mul z w

lemma norm_sq_add (z w : K) :
  norm_sq (z + w) = norm_sq z + norm_sq w + 2 * (re (z * conj w)) :=
by { simp only [norm_sq, map_add, monoid_with_zero_hom.coe_mk, mul_neg,
                sub_neg_eq_add] with is_R_or_C_simps, ring }

lemma re_sq_le_norm_sq (z : K) : re z * re z ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : K) : im z * im z ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : K) : z * conj z = ((norm_sq z) : K) :=
by simp only [map_add, add_zero, ext_iff, monoid_with_zero_hom.coe_mk,
              add_left_inj, mul_eq_mul_left_iff, zero_mul, add_comm, true_or, eq_self_iff_true,
              mul_neg, add_right_neg, zero_add, norm_sq, mul_comm, and_self,
              neg_neg, mul_zero, sub_eq_neg_add, neg_zero] with is_R_or_C_simps

theorem add_conj (z : K) : z + conj z = 2 * (re z) :=
by simp only [ext_iff, two_mul, map_add, add_zero, of_real_im, conj_im, of_real_re,
              eq_self_iff_true, add_right_neg, conj_re, and_self]

/-- The pseudo-coercion `of_real` as a `ring_hom`. -/
noncomputable def of_real_hom : ℝ →+* K := algebra_map ℝ K

/-- The coercion from reals as a `ring_hom`. -/
noncomputable def coe_hom : ℝ →+* K := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩

@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_sub (r s : ℝ) :
  ((r - s : ℝ) : K) = r - s :=
ext_iff.2 $ by simp only [of_real_im, of_real_re, eq_self_iff_true, sub_zero, and_self, map_sub]

@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_pow (r : ℝ) (n : ℕ) :
  ((r ^ n : ℝ) : K) = r ^ n :=
begin
  induction n,
  { simp only [of_real_one, pow_zero]},
  { simp only [*, of_real_mul, pow_succ]}
end

theorem sub_conj (z : K) : z - conj z = (2 * im z) * I :=
by simp only [ext_iff, two_mul, sub_eq_add_neg, add_mul, map_add, add_zero, add_left_inj, zero_mul,
              map_add_neg, eq_self_iff_true, add_right_neg, and_self, neg_neg, mul_zero, neg_zero]
              with is_R_or_C_simps

lemma norm_sq_sub (z w : K) : norm_sq (z - w) = norm_sq z + norm_sq w - 2 * re (z * conj w) :=
by simp only [norm_sq_add, sub_eq_add_neg, ring_equiv.map_neg, mul_neg,
              norm_sq_neg, map_neg]

lemma sqrt_norm_sq_eq_norm {z : K} : real.sqrt (norm_sq z) = ‖z‖ :=
begin
  have h₂ : ‖z‖ = real.sqrt (‖z‖^2) := (real.sqrt_sq (norm_nonneg z)).symm,
  rw [h₂],
  exact congr_arg real.sqrt (norm_sq_eq_def' z)
end

/-! ### Inversion -/

@[simp, is_R_or_C_simps] lemma inv_re (z : K) : re (z⁻¹) = re z / norm_sq z :=
by simp only [inv_def, norm_sq_eq_def, norm_sq, division_def,
              monoid_with_zero_hom.coe_mk, sub_zero, mul_zero] with is_R_or_C_simps
@[simp, is_R_or_C_simps] lemma inv_im (z : K) : im (z⁻¹) = im (-z) / norm_sq z :=
by simp only [inv_def, norm_sq_eq_def, norm_sq, division_def, of_real_im,
              monoid_with_zero_hom.coe_mk, of_real_re, zero_add, map_neg, mul_zero]
              with is_R_or_C_simps

@[simp, norm_cast, is_R_or_C_simps, priority 900]
lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : K) = r⁻¹ :=
begin
  rw ext_iff,
  by_cases r = 0,
  { simp only [h, of_real_zero, inv_zero, and_self, map_zero]},
  { simp only with is_R_or_C_simps,
    field_simp [h, norm_sq] }
end

protected lemma inv_zero : (0⁻¹ : K) = 0 :=
by rw [← of_real_zero, ← of_real_inv, inv_zero]

protected theorem mul_inv_cancel {z : K} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ←mul_assoc, mul_conj, ←of_real_mul, ←norm_sq_eq_def',
      mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

lemma div_re (z w : K) : re (z / w) = re z * re w / norm_sq w + im z * im w / norm_sq w :=
by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, neg_mul,
              mul_neg, neg_neg, map_neg] with is_R_or_C_simps
lemma div_im (z w : K) : im (z / w) = im z * re w / norm_sq w - re z * im w / norm_sq w :=
by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm, neg_mul,
              mul_neg, map_neg] with is_R_or_C_simps

@[simp, is_R_or_C_simps]
lemma conj_inv (x : K) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _

@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_div (r s : ℝ) :
  ((r / s : ℝ) : K) = r / s :=
map_div₀ (@is_R_or_C.coe_hom K _) r s

lemma div_re_of_real {z : K} {r : ℝ} : re (z / r) = re z / r :=
begin
  by_cases h : r = 0,
  { simp only [h, of_real_zero, div_zero, zero_re']},
  { change r ≠ 0 at h,
    rw [div_eq_mul_inv, ←of_real_inv, div_eq_mul_inv],
    simp only [one_div, of_real_im, of_real_re, sub_zero, mul_re, mul_zero]}
end

@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_zpow (r : ℝ) (n : ℤ) :
  ((r ^ n : ℝ) : K) = r ^ n :=
map_zpow₀ (@is_R_or_C.coe_hom K _) r n

lemma I_mul_I_of_nonzero : (I : K) ≠ 0 → (I : K) * I = -1 :=
by { have := I_mul_I_ax, tauto }

@[simp, is_R_or_C_simps] lemma div_I (z : K) : z / I = -(z * I) :=
begin
  by_cases h : (I : K) = 0,
  { simp [h] },
  { field_simp [mul_assoc, I_mul_I_of_nonzero h] }
end

@[simp, is_R_or_C_simps] lemma inv_I : (I : K)⁻¹ = -I :=
by field_simp

@[simp, is_R_or_C_simps] lemma norm_sq_inv (z : K) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
map_inv₀ (@norm_sq K _) z

@[simp, is_R_or_C_simps] lemma norm_sq_div (z w : K) : norm_sq (z / w) = norm_sq z / norm_sq w :=
map_div₀ (@norm_sq K _) z w

@[is_R_or_C_simps] lemma norm_conj {z : K} : ‖conj z‖ = ‖z‖ :=
by simp only [←sqrt_norm_sq_eq_norm, norm_sq_conj]

@[priority 100] instance : cstar_ring K :=
{ norm_star_mul_self := λ x, (norm_mul _ _).trans $ congr_arg (* ‖x‖) norm_conj }

/-! ### Cast lemmas -/

@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_nat_cast (n : ℕ) :
  ((n : ℝ) : K) = n :=
map_nat_cast (@of_real_hom K _) n

@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_re (n : ℕ) : re (n : K) = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_im (n : ℕ) : im (n : K) = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_int_cast (n : ℤ) : ((n : ℝ) : K) = n := map_int_cast (@of_real_hom K _) n

@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_re (n : ℤ) : re (n : K) = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_im (n : ℤ) : im (n : K) = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_rat_cast (n : ℚ) :
  ((n : ℝ) : K) = n :=
map_rat_cast (@is_R_or_C.of_real_hom K _) n

@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_re (q : ℚ) : re (q : K) = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_im (q : ℚ) : im (q : K) = 0 :=
by rw [← of_real_rat_cast, of_real_im]

/-! ### Characteristic zero -/
/-- ℝ and ℂ are both of characteristic zero.  -/
@[priority 100] -- see Note [lower instance priority]
instance char_zero_R_or_C : char_zero K :=
char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

theorem re_eq_add_conj (z : K) : ↑(re z) = (z + conj z) / 2 :=
by rw [add_conj, mul_div_cancel_left ((re z):K) two_ne_zero]

theorem im_eq_conj_sub (z : K) : ↑(im z) = I * (conj z - z) / 2 :=
begin
  rw [← neg_inj, ← of_real_neg, ← I_mul_re, re_eq_add_conj],
  simp only [mul_add, sub_eq_add_neg, neg_div', neg_mul, conj_I,
             mul_neg, neg_add_rev, neg_neg, ring_hom.map_mul]
end

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
@[pp_nodot] noncomputable def abs (z : K) : ℝ := (norm_sq z).sqrt

local notation `abs'` := has_abs.abs
local notation `absK` := @abs K _

@[simp, norm_cast] lemma abs_of_real (r : ℝ) : absK r = abs' r :=
by simp only [abs, norm_sq, real.sqrt_mul_self_eq_abs, add_zero, of_real_im,
              monoid_with_zero_hom.coe_mk, of_real_re, mul_zero]

lemma norm_eq_abs (z : K) : ‖z‖ = absK z :=
by simp only [abs, norm_sq_eq_def', norm_nonneg, real.sqrt_sq]

@[is_R_or_C_simps, norm_cast]
lemma norm_of_real (z : ℝ) : ‖(z : K)‖ = ‖z‖ :=
by { rw [is_R_or_C.norm_eq_abs, is_R_or_C.abs_of_real, real.norm_eq_abs] }

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : absK r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma norm_of_nonneg {r : ℝ} (r_nn : 0 ≤ r) : ‖(r : K)‖ = r :=
by { rw norm_of_real, exact abs_eq_self.mpr r_nn, }

lemma abs_of_nat (n : ℕ) : absK n = n :=
by { rw [← of_real_nat_cast], exact abs_of_nonneg (nat.cast_nonneg n) }

lemma mul_self_abs (z : K) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

@[simp, is_R_or_C_simps] lemma abs_zero : absK 0 = 0 := by simp only [abs, real.sqrt_zero, map_zero]
@[simp, is_R_or_C_simps] lemma abs_one : absK 1 = 1 := by simp only [abs, map_one, real.sqrt_one]

@[simp, is_R_or_C_simps] lemma abs_two : absK 2 = 2 :=
calc absK 2 = absK (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

lemma abs_nonneg (z : K) : 0 ≤ absK z :=
real.sqrt_nonneg _

@[simp, is_R_or_C_simps] lemma abs_eq_zero {z : K} : absK z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

lemma abs_ne_zero {z : K} : abs z ≠ 0 ↔ z ≠ 0 :=
not_congr abs_eq_zero

@[simp, is_R_or_C_simps] lemma abs_conj (z : K) : abs (conj z) = abs z :=
by simp only [abs, norm_sq_conj]

@[simp, is_R_or_C_simps] lemma abs_mul (z w : K) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

lemma abs_re_le_abs (z : K) : abs' (re z) ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (re z)) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : K) : abs' (im z) ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (im z)) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma norm_im_le_norm (z : K) : ‖im z‖ ≤ ‖z‖ :=
by { rw [is_R_or_C.norm_eq_abs, real.norm_eq_abs], exact is_R_or_C.abs_im_le_abs _, }

lemma re_le_abs (z : K) : re z ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : K) : im z ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

lemma im_eq_zero_of_le {a : K} (h : abs a ≤ re a) : im a = 0 :=
begin
  rw ← zero_eq_mul_self,
  have : re a * re a = re a * re a + im a * im a,
  { convert is_R_or_C.mul_self_abs a;
    linarith [re_le_abs a] },
  linarith
end

lemma re_eq_self_of_le {a : K} (h : abs a ≤ re a) : (re a : K) = a :=
by { rw ← re_add_im a, simp only [im_eq_zero_of_le h, add_zero, zero_mul, algebra_map.coe_zero]
  with is_R_or_C_simps, }

lemma abs_add (z w : K) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (zero_lt_two' ℝ)],
  simpa [-mul_re] with is_R_or_C_simps using re_le_abs (z * conj w)
end

instance : is_absolute_value absK :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp, is_R_or_C_simps] lemma abs_abs (z : K) : abs' (abs z) = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp, is_R_or_C_simps] lemma abs_pos {z : K} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp, is_R_or_C_simps] lemma abs_neg : ∀ z : K, abs (-z) = abs z := abv_neg abs
lemma abs_sub : ∀ z w : K, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c : K, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp, is_R_or_C_simps] theorem abs_inv : ∀ z : K, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp, is_R_or_C_simps] theorem abs_div : ∀ z w : K, abs (z / w) = abs z / abs w := abv_div abs

lemma abs_abs_sub_le_abs_sub : ∀ z w : K, abs' (abs z - abs w) ≤ abs (z - w) :=
abs_abv_sub_le_abv_sub abs

lemma abs_re_div_abs_le_one (z : K) : abs' (re z / abs z) ≤ 1 :=
begin
  by_cases hz : z = 0,
  { simp [hz, zero_le_one] },
  { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] }
end

lemma abs_im_div_abs_le_one (z : K) : abs' (im z / abs z) ≤ 1 :=
begin
  by_cases hz : z = 0,
  { simp [hz, zero_le_one] },
  { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] }
end

@[simp, is_R_or_C_simps, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : K) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

lemma norm_sq_eq_abs (x : K) : norm_sq x = abs x ^ 2 :=
by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)]

lemma re_eq_abs_of_mul_conj (x : K) : re (x * (conj x)) = abs (x * (conj x)) :=
by rw [mul_conj, of_real_re, abs_of_real, norm_sq_eq_abs, sq, _root_.abs_mul, abs_abs]

lemma abs_sq_re_add_conj (x : K) : (abs (x + conj x))^2 = (re (x + conj x))^2 :=
by simp only [sq, ←norm_sq_eq_abs, norm_sq, map_add, add_zero, monoid_with_zero_hom.coe_mk,
              add_right_neg, mul_zero] with is_R_or_C_simps

lemma abs_sq_re_add_conj' (x : K) : (abs (conj x + x))^2 = (re (conj x + x))^2 :=
by simp only [sq, ←norm_sq_eq_abs, norm_sq, map_add, add_zero, monoid_with_zero_hom.coe_mk,
              add_left_neg, mul_zero] with is_R_or_C_simps

lemma conj_mul_eq_norm_sq_left (x : K) : conj x * x = ((norm_sq x) : K) :=
begin
  rw ext_iff,
  refine ⟨by simp only [norm_sq, neg_mul, monoid_with_zero_hom.coe_mk,
                        sub_neg_eq_add, map_add, sub_zero, mul_zero] with is_R_or_C_simps, _⟩,
  simp only [mul_comm, mul_neg, add_left_neg] with is_R_or_C_simps
end

/-! ### Cauchy sequences -/

theorem is_cau_seq_re (f : cau_seq K abs) : is_cau_seq abs' (λ n, re (f n)) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq K abs) : is_cau_seq abs' (λ n, im (f n)) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

/-- The real part of a K Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_re (f : cau_seq K abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

/-- The imaginary part of a K Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_im (f : cau_seq K abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → K} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∏ i in s, f i : ℝ) : K) = ∏ i in s, (f i : K) :=
ring_hom.map_prod _ _ _

@[simp, is_R_or_C_simps, norm_cast, priority 900]
lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∑ i in s, f i : ℝ) : K) = ∑ i in s, (f i : K) :=
ring_hom.map_sum _ _ _

@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_sum
  {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) :
  ((f.sum (λ a b, g a b) : ℝ) : K) = f.sum (λ a b, ((g a b) : K)) :=
ring_hom.map_finsupp_sum _ f g

@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_prod
  {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) :
  ((f.prod (λ a b, g a b) : ℝ) : K) = f.prod (λ a b, ((g a b) : K)) :=
ring_hom.map_finsupp_prod _ f g

end is_R_or_C

section instances

noncomputable instance real.is_R_or_C : is_R_or_C ℝ :=
{ re := add_monoid_hom.id ℝ,
  im := 0,
  I := 0,
  I_re_ax := by simp only [add_monoid_hom.map_zero],
  I_mul_I_ax := or.intro_left _ rfl,
  re_add_im_ax := λ z, by simp only [add_zero, mul_zero, algebra.id.map_eq_id, ring_hom.id_apply,
                                     add_monoid_hom.id_apply],
  of_real_re_ax := λ r, by simp only [add_monoid_hom.id_apply, algebra.id.map_eq_self],
  of_real_im_ax := λ r, by simp only [add_monoid_hom.zero_apply],
  mul_re_ax := λ z w,
    by simp only [sub_zero, mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply],
  mul_im_ax := λ z w, by simp only [add_zero, zero_mul, mul_zero, add_monoid_hom.zero_apply],
  conj_re_ax := λ z, by simp only [star_ring_end_apply, star_id_of_comm],
  conj_im_ax := λ z, by simp only [neg_zero, add_monoid_hom.zero_apply],
  conj_I_ax := by simp only [ring_hom.map_zero, neg_zero],
  norm_sq_eq_def_ax := λ z, by simp only [sq, real.norm_eq_abs, ←abs_mul, abs_mul_self z, add_zero,
    mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply],
  mul_im_I_ax := λ z, by simp only [mul_zero, add_monoid_hom.zero_apply],
  inv_def_ax := λ z, by simp only [star_ring_end_apply, star, sq, real.norm_eq_abs,
    abs_mul_abs_self, ←div_eq_mul_inv, algebra.id.map_eq_id, id.def, ring_hom.id_apply,
    div_self_mul_self'],
  div_I_ax := λ z, by simp only [div_zero, mul_zero, neg_zero],
  .. real.densely_normed_field, .. real.metric_space }

end instances

namespace is_R_or_C

open_locale complex_conjugate

section cleanup_lemmas

local notation `reR` := @is_R_or_C.re ℝ _
local notation `imR` := @is_R_or_C.im ℝ _
local notation `IR` := @is_R_or_C.I ℝ _
local notation `absR` := @is_R_or_C.abs ℝ _
local notation `norm_sqR` := @is_R_or_C.norm_sq ℝ _

@[simp, is_R_or_C_simps] lemma re_to_real {x : ℝ} : reR x = x := rfl
@[simp, is_R_or_C_simps] lemma im_to_real {x : ℝ} : imR x = 0 := rfl
@[simp, is_R_or_C_simps] lemma conj_to_real {x : ℝ} : conj x = x := rfl
@[simp, is_R_or_C_simps] lemma I_to_real : IR = 0 := rfl
@[simp, is_R_or_C_simps] lemma norm_sq_to_real {x : ℝ} : norm_sq x = x*x :=
by simp [is_R_or_C.norm_sq]
@[simp, is_R_or_C_simps] lemma abs_to_real {x : ℝ} : absR x = has_abs.abs x :=
by simp [is_R_or_C.abs, abs, real.sqrt_mul_self_eq_abs]

@[simp] lemma coe_real_eq_id : @coe ℝ ℝ _ = id := rfl

end cleanup_lemmas

section linear_maps

/-- The real part in a `is_R_or_C` field, as a linear map. -/
def re_lm : K →ₗ[ℝ] ℝ :=
{ map_smul' := smul_re,  .. re }

@[simp, is_R_or_C_simps] lemma re_lm_coe : (re_lm : K → ℝ) = re := rfl

/-- The real part in a `is_R_or_C` field, as a continuous linear map. -/
noncomputable def re_clm : K →L[ℝ] ℝ :=
linear_map.mk_continuous re_lm 1 $ by
{ simp only [norm_eq_abs, re_lm_coe, one_mul, abs_to_real], exact abs_re_le_abs, }

@[simp, is_R_or_C_simps, norm_cast] lemma re_clm_coe : ((re_clm : K →L[ℝ] ℝ) :
  K →ₗ[ℝ] ℝ) = re_lm := rfl

@[simp, is_R_or_C_simps] lemma re_clm_apply : ((re_clm : K →L[ℝ] ℝ) : K → ℝ) = re := rfl

@[continuity] lemma continuous_re : continuous (re : K → ℝ) := re_clm.continuous

/-- The imaginary part in a `is_R_or_C` field, as a linear map. -/
def im_lm : K →ₗ[ℝ] ℝ :=
{ map_smul' := smul_im,  .. im }

@[simp, is_R_or_C_simps] lemma im_lm_coe : (im_lm : K → ℝ) = im := rfl

/-- The imaginary part in a `is_R_or_C` field, as a continuous linear map. -/
noncomputable def im_clm : K →L[ℝ] ℝ :=
linear_map.mk_continuous im_lm 1 $ by
{ simp only [norm_eq_abs, re_lm_coe, one_mul, abs_to_real], exact abs_im_le_abs, }

@[simp, is_R_or_C_simps, norm_cast] lemma im_clm_coe : ((im_clm : K →L[ℝ] ℝ) :
  K →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp, is_R_or_C_simps] lemma im_clm_apply : ((im_clm : K →L[ℝ] ℝ) : K → ℝ) = im := rfl

@[continuity] lemma continuous_im : continuous (im : K → ℝ) := im_clm.continuous

/-- Conjugate as an `ℝ`-algebra equivalence -/
def conj_ae : K ≃ₐ[ℝ] K :=
{ inv_fun := conj,
  left_inv := conj_conj,
  right_inv := conj_conj,
  commutes' := conj_of_real,
  .. conj }

@[simp, is_R_or_C_simps] lemma conj_ae_coe : (conj_ae : K → K) = conj := rfl

/-- Conjugate as a linear isometry -/
noncomputable def conj_lie : K ≃ₗᵢ[ℝ] K :=
⟨conj_ae.to_linear_equiv, λ z, by simp [norm_eq_abs] with is_R_or_C_simps⟩

@[simp, is_R_or_C_simps] lemma conj_lie_apply : (conj_lie : K → K) = conj := rfl

/-- Conjugate as a continuous linear equivalence -/
noncomputable def conj_cle : K ≃L[ℝ] K := @conj_lie K _

@[simp, is_R_or_C_simps] lemma conj_cle_coe :
  (@conj_cle K _).to_linear_equiv = conj_ae.to_linear_equiv := rfl

@[simp, is_R_or_C_simps] lemma conj_cle_apply : (conj_cle : K → K) = conj := rfl

@[priority 100]
instance : has_continuous_star K := ⟨conj_lie.continuous⟩

@[continuity] lemma continuous_conj : continuous (conj : K → K) := continuous_star

/-- The `ℝ → K` coercion, as a linear map -/
noncomputable def of_real_am : ℝ →ₐ[ℝ] K := algebra.of_id ℝ K

@[simp, is_R_or_C_simps] lemma of_real_am_coe : (of_real_am : ℝ → K) = coe := rfl

/-- The ℝ → K coercion, as a linear isometry -/
noncomputable def of_real_li : ℝ →ₗᵢ[ℝ] K :=
{ to_linear_map := of_real_am.to_linear_map, norm_map' := by simp [norm_eq_abs] }

@[simp, is_R_or_C_simps] lemma of_real_li_apply : (of_real_li : ℝ → K) = coe := rfl

/-- The `ℝ → K` coercion, as a continuous linear map -/
noncomputable def of_real_clm : ℝ →L[ℝ] K := of_real_li.to_continuous_linear_map

@[simp, is_R_or_C_simps] lemma of_real_clm_coe :
  ((@of_real_clm K _) : ℝ →ₗ[ℝ] K) = of_real_am.to_linear_map := rfl

@[simp, is_R_or_C_simps] lemma of_real_clm_apply : (of_real_clm : ℝ → K) = coe := rfl

@[continuity] lemma continuous_of_real : continuous (coe : ℝ → K) := of_real_li.continuous

@[continuity] lemma continuous_abs : continuous (@is_R_or_C.abs K _) :=
by simp only [show @is_R_or_C.abs K _ = has_norm.norm, by { ext, exact (norm_eq_abs _).symm },
              continuous_norm]

@[continuity] lemma continuous_norm_sq : continuous (@is_R_or_C.norm_sq K _) :=
begin
  have : (@is_R_or_C.norm_sq K _ : K → ℝ) = λ x, (is_R_or_C.abs x) ^ 2,
  { ext,
    exact norm_sq_eq_abs _ },
  simp only [this, continuous_abs.pow 2],
end

end linear_maps

end is_R_or_C


import LeanUtils
open Nat

-- first theorem
theorem square_mod_3 (q : Nat) : (¬divisible 3 q) → (q^2 % 3 = 1) := by
  intros h₁
  apply mod_rewrite.mpr
  have h2 : q % 3 = 0 ∨ q % 3 = 1 ∨ q % 3 = 2 := mod_3_poss _

  -- divide cases into 3 goals
  rcases h2 with h2 | h2 | h2

  contradiction

  have ⟨k, h3⟩ : ∃ (k : Nat), q = 3 * k + 1 := by simp_all

  have q_square : q^2 = 3 * (3 * k^2 + 2 * k) + 1  := by
    calc
      q^2 = (3 * k + 1)^2 := by
        repeat (first | ring | simp_all)
      _ = 9 * k^2 + 6 * k + 1 := by
        repeat (first | ring | simp_all)
      _ = 3 * (3 * k^2 + 2 * k) + 1 := by
        repeat (first | ring | simp_all)
  exact ⟨_, by assumption⟩

  have ⟨k, h3⟩ : ∃ (k : Nat), q = 3 * k + 2 := by simp_all

  have q_square : q^2 = 3 * (3 * k^2 + 4 * k + 1) + 1 := by
    calc
      q^2 = (3 * k + 2)^2 := by
        repeat (first | ring | simp_all)
      _ = 3 * (3 * k^2 + 4 * k + 1) + 1 := by
        repeat (first | ring | simp_all)

  exact ⟨_, by assumption⟩

-- second using the first
theorem square_of_q_divisible_by_3_means_q_is_divisible_by_3 (q : Nat) (h₁ : divisible 3 (q^2)) : divisible 3 q := by

  revert h₁
  rw [not_imp_not.symm]
  repeat rw [not_not]
  intro h₁

  have h₂ : q^2 % 3 = 1 := by
    repeat (first | ring | simp_all [square_mod_3])

  simp_all


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

/-!
# The abelianization of a group

This file defines the commutator and the abelianization of a group. It furthermore prepares for the
result that the abelianization is left adjoint to the forgetful functor from abelian groups to
groups, which can be found in `algebra/category/Group/adjunctions`.

## Main definitions

* `commutator`: defines the commutator of a group `G` as a subgroup of `G`.
* `abelianization`: defines the abelianization of a group `G` as the quotient of a group by its
  commutator subgroup.
* `abelianization.map`: lifts a group homomorphism to a homomorphism between the abelianizations
* `mul_equiv.abelianization_congr`: Equivalent groups have equivalent abelianizations

-/

universes u v w

-- Let G be a group.
variables (G : Type u) [group G]

/-- The commutator subgroup of a group G is the normal subgroup
  generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹`. -/
@[derive subgroup.normal]
def commutator : subgroup G :=
⁅(⊤ : subgroup G), ⊤⁆

lemma commutator_def : commutator G = ⁅(⊤ : subgroup G), ⊤⁆ := rfl

lemma commutator_eq_closure : commutator G = subgroup.closure {g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g} :=
by simp_rw [commutator, subgroup.commutator_def, subgroup.mem_top, exists_true_left]

lemma commutator_eq_normal_closure :
  commutator G = subgroup.normal_closure {g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g} :=
by simp_rw [commutator, subgroup.commutator_def', subgroup.mem_top, exists_true_left]

lemma commutator_centralizer_commutator_le_center :
  ⁅(commutator G).centralizer, (commutator G).centralizer⁆ ≤ subgroup.center G :=
begin
  rw [←subgroup.centralizer_top, ←subgroup.commutator_eq_bot_iff_le_centralizer],
  suffices : ⁅⁅⊤, (commutator G).centralizer⁆, (commutator G).centralizer⁆ = ⊥,
  { refine subgroup.commutator_commutator_eq_bot_of_rotate _ this,
    rwa subgroup.commutator_comm (commutator G).centralizer },
  rw [subgroup.commutator_comm, subgroup.commutator_eq_bot_iff_le_centralizer],
  exact set.centralizer_subset (subgroup.commutator_mono le_top le_top),
end

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

namespace abelianization

local attribute [instance] quotient_group.left_rel

instance : comm_group (abelianization G) :=
{ mul_comm := λ x y, quotient.induction_on₂' x y $ λ a b, quotient.sound' $
    subgroup.subset_closure ⟨b⁻¹, subgroup.mem_top b⁻¹, a⁻¹, subgroup.mem_top a⁻¹, by group⟩,
.. quotient_group.quotient.group _ }

instance : inhabited (abelianization G) := ⟨1⟩

instance [fintype G] [decidable_pred (∈ commutator G)] :
  fintype (abelianization G) :=
quotient_group.fintype (commutator G)

variable {G}

/-- `of` is the canonical projection from G to its abelianization. -/
def of : G →* abelianization G :=
{ to_fun := quotient_group.mk,
  map_one' := rfl,
  map_mul' := λ x y, rfl }

@[simp] lemma mk_eq_of (a : G) : quot.mk _ a = of a := rfl

section lift
-- So far we have built Gᵃᵇ and proved it's an abelian group.
-- Furthremore we defined the canonical projection `of : G → Gᵃᵇ`

-- Let `A` be an abelian group and let `f` be a group homomorphism from `G` to `A`.
variables {A : Type v} [comm_group A] (f : G →* A)

lemma commutator_subset_ker : commutator G ≤ f.ker :=
begin
  rw [commutator_eq_closure, subgroup.closure_le],
  rintros x ⟨p, q, rfl⟩,
  simp [monoid_hom.mem_ker, mul_right_comm (f p) (f q), commutator_element_def],
end

/-- If `f : G → A` is a group homomorphism to an abelian group, then `lift f` is the unique map from
  the abelianization of a `G` to `A` that factors through `f`. -/
def lift : (G →* A) ≃ (abelianization G →* A) :=
{ to_fun := λ f, quotient_group.lift _ f (λ x h, f.mem_ker.2 $ commutator_subset_ker _ h),
  inv_fun := λ F, F.comp of,
  left_inv := λ f, monoid_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, quotient_group.induction_on x $ λ z, rfl }

@[simp] lemma lift.of (x : G) : lift f (of x) = f x :=
rfl

theorem lift.unique
  (φ : abelianization G →* A)
  -- hφ : φ agrees with f on the image of G in Gᵃᵇ
  (hφ : ∀ (x : G), φ (of x) = f x)
  {x : abelianization G} :
  φ x = lift f x :=
quotient_group.induction_on x hφ

@[simp] lemma lift_of : lift of = monoid_hom.id (abelianization G) :=
lift.apply_symm_apply $ monoid_hom.id _

end lift

variables {A : Type v} [monoid A]

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext (φ ψ : abelianization G →* A)
  (h : φ.comp of = ψ.comp of) : φ = ψ :=
monoid_hom.ext $ λ x, quotient_group.induction_on x $ monoid_hom.congr_fun h

section map

variables {H : Type v} [group H] (f : G →* H)

/-- The map operation of the `abelianization` functor -/
def map : abelianization G →* abelianization H := lift (of.comp f)

@[simp]
lemma map_of (x : G) : map f (of x) = of (f x) := rfl

@[simp]
lemma map_id : map (monoid_hom.id G) = monoid_hom.id (abelianization G) := hom_ext _ _ rfl

@[simp]
lemma map_comp {I : Type w} [group I] (g : H →* I) :
  (map g).comp (map f) = map (g.comp f) := hom_ext _ _ rfl

@[simp]
lemma map_map_apply {I : Type w} [group I] {g : H →* I} {x : abelianization G}:
  map g (map f x) = map (g.comp f) x := monoid_hom.congr_fun (map_comp _ _) x

end map

end abelianization

section abelianization_congr

variables {G} {H : Type v} [group H] (e : G ≃* H)

/-- Equivalent groups have equivalent abelianizations -/
def mul_equiv.abelianization_congr : abelianization G ≃* abelianization H :=
{ to_fun := abelianization.map e.to_monoid_hom,
  inv_fun := abelianization.map e.symm.to_monoid_hom,
  left_inv := by { rintros ⟨a⟩, simp },
  right_inv := by { rintros ⟨a⟩, simp },
  map_mul' := monoid_hom.map_mul _ }

@[simp]
lemma abelianization_congr_of (x : G) :
  (e.abelianization_congr) (abelianization.of x) = abelianization.of (e x) := rfl

@[simp]
lemma abelianization_congr_refl :
  (mul_equiv.refl G).abelianization_congr = mul_equiv.refl (abelianization G) :=
mul_equiv.to_monoid_hom_injective abelianization.lift_of

@[simp]
lemma abelianization_congr_symm  :
  e.abelianization_congr.symm = e.symm.abelianization_congr := rfl

@[simp]
lemma abelianization_congr_trans {I : Type v} [group I] (e₂ : H ≃* I) :
  e.abelianization_congr.trans e₂.abelianization_congr = (e.trans e₂).abelianization_congr :=
mul_equiv.to_monoid_hom_injective (abelianization.hom_ext _ _ rfl)

end abelianization_congr

/-- An Abelian group is equivalent to its own abelianization. -/
@[simps] def abelianization.equiv_of_comm {H : Type*} [comm_group H] :
  H ≃* abelianization H :=
{ to_fun    := abelianization.of,
  inv_fun   := abelianization.lift (monoid_hom.id H),
  left_inv  := λ a, rfl,
  right_inv := by { rintros ⟨a⟩, refl, },
  .. abelianization.of }


import data.real.basic
import tactic.linarith
import limits

open real

local attribute [instance, priority 1000] classical.prop_decidable

noncomputable definition a : ℕ → ℝ
| 0 := 0
| (n + 1) := sqrt (1 + a n)

@[simp] lemma a_succ (n : ℕ) : a (n + 1) = sqrt (1 + a n) := begin
  unfold a,
end

@[simp] lemma a_one : a 1 = 1 :=
begin
  show sqrt (1 + 0) = 1,
  convert sqrt_one,
  simp,
end

lemma a_nonneg (n : ℕ) : 0 ≤ a n :=
begin
  induction n with d Hd,
    exact le_refl _,
  rw a_succ,
  apply sqrt_nonneg,
end

lemma a_ge_one (n : ℕ) (hn : 0 < n) : 1 ≤ a n :=
begin
  cases n with d,
  { cases hn},
  clear hn,
  induction d with m Hm,
  { -- base case
    simp
  },
  { -- inductive step
    generalize h : nat.succ m = n,
    rw h at Hm,
    show 1 ≤ a (n + 1),
    rw a_succ,
    refine le_trans (show 1 ≤ sqrt 1, by rw sqrt_one) _,
    rw sqrt_le,
    repeat {linarith},
  }
end

noncomputable def φ := (1 + sqrt 5) / 2

lemma phi_squared : φ ^ 2 = φ + 1 :=
begin
  rw pow_two,
  show (1 + sqrt 5) / 2 * ((1 + sqrt 5) / 2) = (1 + sqrt 5) / 2 + 1,
  -- First goal: get rid of divisions.
  rw div_mul_div,
  symmetry, -- kind of annoying that I have to stop my rewrite,
  rw [eq_div_iff_mul_eq, add_mul, ←mul_assoc, div_mul_cancel],
    swap, norm_num, swap, norm_num,
  -- now `ring` will do it but we need to square the sqrt(5)
  rw [mul_add, add_mul _ _ (sqrt 5), mul_self_sqrt],
    swap, norm_num,
  ring,
end

lemma φ_squared' : φ ^ 2 = φ + 1 :=
begin
  rw φ,
  rw div_pow (_:ℝ) two_ne_zero,
  rw pow_two,
  rw add_mul_self_eq,
  rw mul_self_sqrt (show (0:ℝ) ≤ 5, by norm_num),
  ring
end

lemma φ_pos : 0 < φ :=
begin
  rw [φ, lt_div_iff, zero_mul],
    swap, norm_num,
  apply lt_add_of_lt_of_nonneg,
    norm_num,
  exact sqrt_nonneg _
end

lemma φ_nonneg : 0 ≤ φ := le_of_lt φ_pos

lemma a_lt_φ (n : ℕ) : a n < φ :=
begin
  induction n with d Hd,
    exact φ_pos,
  rw a_succ,
  rw mul_self_lt_mul_self_iff,
    swap, exact sqrt_nonneg _, swap, exact le_of_lt φ_pos,
  rw ←pow_two,
  rw sqr_sqrt,
    { rw [←pow_two,phi_squared],
      linarith
    },
    { have h : 0 ≤ a d := a_nonneg d,
      linarith,
    }
end

lemma a_mono (n : ℕ) : a n < a (n + 1) :=
begin
  rw a_succ,
  rw mul_self_lt_mul_self_iff,
    swap, exact a_nonneg _, swap, exact sqrt_nonneg _,
  rw ←pow_two (sqrt _), rw sqr_sqrt,
  { suffices : a n * (a n - 1) < 1,
      rwa [mul_sub, mul_one, sub_lt_iff_lt_add] at this,
    have h2 : 0 ≤ a n := a_nonneg n,
    cases classical.em (a n - 1 ≤ 0),
    {
      refine lt_of_le_of_lt _ (zero_lt_one),
      exact mul_nonpos_of_nonneg_of_nonpos h2 h,
    },
    { replace h := lt_of_not_ge h,
      have h3 : a n < φ := a_lt_φ n,
      have h4 : a n - 1 < φ - 1 := sub_lt_sub_right h3 _,
      refine lt_of_lt_of_le (mul_lt_mul h3 (le_of_lt h4) h φ_nonneg) _,
      apply le_of_eq,
      rw [mul_sub, ←pow_two, phi_squared],
      simp
    }
  },
  { have h : 0 ≤ a n := a_nonneg n,
    linarith,
  }
end

lemma aux_thing (c : ℕ → ℝ) (h : ∀ n, c n ≤ c (n + 1)) (m n : ℕ)
(h2 : m ≤ n) : c m ≤ c n :=
begin
  induction h2 with p Hp ih,
    refl,
  exact le_trans ih (h p),
end

lemma cgt_of_increasing_and_bounded_above (c : ℕ → ℝ)
(h1 : ∃ B, ∀ n, c n ≤ B) (h2 : ∀ n, c n ≤ c (n + 1)) :
∃ l : ℝ, M1P1.is_limit c l :=
begin
  let S := set.range c,
  let l : ℝ := Sup S,
  use l,
  have h3 : ∃ x, x ∈ S := ⟨c 0, set.mem_range_self 0⟩,
  cases h1 with B HB,
  have h4 : ∃ (x : ℝ), ∀ (y : ℝ), y ∈ S → y ≤ x,
  { use B,
    exact λ y ⟨n, H⟩, H ▸ HB _,
  },
  intros ε Hε,
  have h5 := Sup_le S h3 h4,
    swap, exact Sup S - ε,
  have h6 : ¬(Sup S ≤ Sup S - ε),
    linarith,
  rw h5 at h6,
  simp only [not_forall] at h6,
  rcases h6 with ⟨x, ⟨N, rfl⟩, HN⟩,
  use N,
  intros n Hn,
  rw abs_lt,
  change N ≤ n at Hn,

  split,
  { have h6 := aux_thing c h2 N n Hn,
    change _ < _ - Sup S,
    linarith,
  },
  { have h7 := le_Sup S h4 ⟨n, rfl⟩,
    change _ - Sup S < _,
    linarith,
  }
end

-- lemma a_cgt : ∃ l : ℝ, M1P1.is_limit a l :=


import tactic
import data.real.basic
import data.pnat.basic

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

def is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

def tends_to_plus_infinity (a : ℕ → ℝ) : Prop :=
∀ B, ∃ N, ∀ n ≥ N, B < a n

def is_convergent (a : ℕ → ℝ) : Prop :=
∃ l : ℝ, is_limit a l

namespace sheet_five

theorem Q1a (x : ℝ) (hx : 0 < x) (n : ℕ) : (1 : ℝ) + n * x ≤ (1 + x)^n :=
begin
  sorry
end

theorem Q1b (x : ℝ) (hx : 0 < x) : is_limit (λ n, (1 + x) ^ (-(n : ℤ))) 0 :=
begin
  sorry
end

theorem Q1c (r : ℝ) (hr : r ∈ set.Ioo (0 : ℝ) 1) : is_limit (λ n, r ^ n) 0 :=
begin
  sorry
end

theorem Q1d (r : ℝ) (hr : 1 < r) : tends_to_plus_infinity (λ n, r ^ n) :=
begin
  sorry
end


import logic
import set_theory.zfc

namespace Set

-- We have ext axiom. (Set.ext)
-- Set.eq_empty proves there is only one empty set (using extensionality).
-- We have pairing axiom. (Set.mem_pair)
theorem pair_commutative {x y : Set} : ({x, y} : Set) = {y, x} :=
begin
  apply Set.ext,
  intro z,
  simp [Set.mem_pair] at *,
  exact or.comm,
end
theorem singleton_of_pair_self {x : Set} : ({x, x} : Set) = {x} :=
begin
  apply Set.ext,
  intro z,
  simp [Set.mem_pair] at *,
end
def from_list : list Set → Set
| [] := ∅
| (hd :: tl) := {hd} ∪ from_list tl
theorem mem_from_list {l : list Set} (z : Set) : z ∈ from_list l ↔ z ∈ l :=
begin
  induction l with hd tl ih,
    simp only [list.mem_nil_iff, iff_false, from_list], exact Set.mem_empty _,
  simp only [from_list, list.mem_cons_iff, Set.mem_union, Set.mem_singleton],
  rw ih,
end
theorem empty_is_subset (x : Set) : ∅ ⊆ x :=
begin
  intros z h,
  exfalso, exact (Set.mem_empty _) h,
end
theorem p2a : (∅ : Set) ≠ {∅} :=
begin
  intro he,
  have h : ∅ ∈ {∅} := Set.mem_singleton.mpr rfl,
  rw ←he at h,
  exact Set.mem_empty _ h,
end
theorem p2b : ({∅} : Set) ≠ {{∅}} :=
begin
  intro he,
  have h : {∅} ∈ {{∅}} := Set.mem_singleton.mpr rfl,
  rw ←he at h,
  rw Set.mem_singleton at h,
  exact p2a h.symm,
end
theorem p2c : (∅ : Set) ≠ {{∅}} :=
begin
  intro he,
  have h : {∅} ∈ {{∅}} := Set.mem_singleton.mpr rfl,
  rw ←he at h,
  exact Set.mem_empty _ h,
end
-- powerset axiom enabled by Set.powerset and Set.mem_powerset
theorem p4 {x y B : Set} (h : {x, y} ⊆ B) : x.pair y ∈ B.powerset.powerset :=
begin
  simp only [Set.mem_powerset, Set.pair],
  intros z hm,
  simp only [Set.mem_pair] at hm,
  simp only [Set.mem_powerset],
  cases hm,
  { rw hm,
    intros s he,
    rw Set.mem_singleton at he,
    rw he,
    apply h,
    simp only [Set.mem_pair],
    left, refl, },
  { rw hm,
    exact h, },
end
def finite_hierarchy : ℕ → Set
| 0 := ∅
| (n + 1) := let V := finite_hierarchy n in V ∪ V.powerset
theorem subset_union_of_subset {x y z : Set} (h : x ⊆ z) : x ⊆ z ∪ y :=
begin
  intros c hm,
  specialize h hm,
  simp only [Set.mem_union],
  left, exact h,
end
theorem subset_finite_hierarchy_of_mem {n : ℕ} {x : Set} : x ∈ finite_hierarchy n → x ⊆ finite_hierarchy n :=
begin
  induction n with m ih,
  { simp only [finite_hierarchy],
    intro h,
    exfalso,
    exact Set.mem_empty _ h, },
  { simp only [finite_hierarchy, Set.mem_union],
    intros h,
    cases h,
    exact subset_union_of_subset (ih h),
    exact subset_union_of_subset (Set.mem_powerset.mp h), },
end
theorem finite_hierarchy_succ (n : ℕ) : finite_hierarchy (n + 1) = (finite_hierarchy n).powerset :=
begin
  simp only [finite_hierarchy],
  apply Set.ext,
  simp only [Set.mem_union],
  intro z,
  split; intro h,
  { cases h,
      simp only [Set.mem_powerset],
      exact subset_finite_hierarchy_of_mem h,
    exact h, },
  { right, exact h, },
end

lemma singleton_eq {x y : Set} : ({x} : Set) = {y} ↔ x = y :=
begin
  rw ←Set.ext_iff, simp only [Set.mem_singleton], exact eq_iff_eq_cancel_left,
end

end Set


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
-/
import algebra.euclidean_domain.basic
import data.nat.factors
import ring_theory.coprime.basic
import ring_theory.principal_ideal_domain

/-!
# Divisibility over ℕ and ℤ

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

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `nat.factors_eq`: the multiset of elements of `nat.factors` is equal to the factors
   given by the `unique_factorization_monoid` instance
* ℤ is a `normalization_monoid`
* ℤ is a `gcd_monoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

namespace nat

instance : wf_dvd_monoid ℕ :=
⟨begin
  refine rel_hom_class.well_founded
    (⟨λ (x : ℕ), if x = 0 then (⊤ : ℕ∞) else x, _⟩ : dvd_not_unit →r (<))
    (with_top.well_founded_lt nat.lt_wf),
  intros a b h,
  cases a,
  { exfalso, revert h, simp [dvd_not_unit] },
  cases b,
  { simpa [succ_ne_zero] using with_top.coe_lt_top (a + 1) },
  cases dvd_and_not_dvd_iff.2 h with h1 h2,
  simp only [succ_ne_zero, with_top.coe_lt_coe, if_false],
  apply lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h1) (λ con, h2 _),
  rw con,
end⟩

instance : unique_factorization_monoid ℕ :=
⟨λ _, nat.irreducible_iff_prime⟩

end nat

/-- `ℕ` is a gcd_monoid. -/
instance : gcd_monoid ℕ :=
{ gcd := nat.gcd,
  lcm := nat.lcm,
  gcd_dvd_left := nat.gcd_dvd_left ,
  gcd_dvd_right := nat.gcd_dvd_right,
  dvd_gcd := λ a b c, nat.dvd_gcd,
  gcd_mul_lcm := λ a b, by rw [nat.gcd_mul_lcm],
  lcm_zero_left := nat.lcm_zero_left,
  lcm_zero_right := nat.lcm_zero_right }

instance : normalized_gcd_monoid ℕ :=
{ normalize_gcd := λ a b, normalize_eq _,
  normalize_lcm := λ a b, normalize_eq _,
  .. (infer_instance : gcd_monoid ℕ),
  .. (infer_instance : normalization_monoid ℕ) }

lemma gcd_eq_nat_gcd (m n : ℕ) : gcd m n = nat.gcd m n := rfl

lemma lcm_eq_nat_lcm (m n : ℕ) : lcm m n = nat.lcm m n := rfl

namespace int

section normalization_monoid

instance : normalization_monoid ℤ :=
{ norm_unit      := λa:ℤ, if 0 ≤ a then 1 else -1,
  norm_unit_zero := if_pos le_rfl,
  norm_unit_mul  := assume a b hna hnb,
  begin
    cases hna.lt_or_lt with ha ha; cases hnb.lt_or_lt with hb hb;
      simp [mul_nonneg_iff, ha.le, ha.not_le, hb.le, hb.not_le]
  end,
  norm_unit_coe_units := assume u, (units_eq_one_or u).elim
    (assume eq, eq.symm ▸ if_pos zero_le_one)
    (assume eq, eq.symm ▸ if_neg (not_le_of_gt $ show (-1:ℤ) < 0, by dec_trivial)), }

lemma normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z :=
show z * ↑(ite _ _ _) = z, by rw [if_pos h, units.coe_one, mul_one]

lemma normalize_of_nonpos {z : ℤ} (h : z ≤ 0) : normalize z = -z :=
begin
  obtain rfl | h := h.eq_or_lt,
  { simp },
  { change z * ↑(ite _ _ _) = -z,
   rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one] }
end

lemma normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
normalize_of_nonneg (coe_nat_le_coe_nat_of_le $ nat.zero_le n)

lemma abs_eq_normalize (z : ℤ) : |z| = normalize z :=
by cases le_total 0 z; simp [normalize_of_nonneg, normalize_of_nonpos, *]

lemma nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
abs_eq_self.1 $ by rw [abs_eq_normalize, hz]

lemma nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩

lemma eq_of_associated_of_nonneg {a b : ℤ} (h : associated a b) (ha : 0 ≤ a) (hb : 0 ≤ b) : a = b :=
dvd_antisymm_of_normalize_eq (normalize_of_nonneg ha) (normalize_of_nonneg hb) h.dvd h.symm.dvd

end normalization_monoid

section gcd_monoid

instance : gcd_monoid ℤ :=
{ gcd            := λa b, int.gcd a b,
  lcm            := λa b, int.lcm a b,
  gcd_dvd_left   := assume a b, int.gcd_dvd_left _ _,
  gcd_dvd_right  := assume a b, int.gcd_dvd_right _ _,
  dvd_gcd        := assume a b c, dvd_gcd,
  gcd_mul_lcm    := λ a b, by
  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs, abs_eq_normalize],
    exact normalize_associated (a * b) },
  lcm_zero_left  := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_left _,
  lcm_zero_right := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_right _}

instance : normalized_gcd_monoid ℤ :=
{ normalize_gcd  := λ a b, normalize_coe_nat _,
  normalize_lcm  := λ a b, normalize_coe_nat _,
  .. int.normalization_monoid,
  .. (infer_instance : gcd_monoid ℤ) }

lemma coe_gcd (i j : ℤ) : ↑(int.gcd i j) = gcd_monoid.gcd i j := rfl
lemma coe_lcm (i j : ℤ) : ↑(int.lcm i j) = gcd_monoid.lcm i j := rfl

lemma nat_abs_gcd (i j : ℤ) : nat_abs (gcd_monoid.gcd i j) = int.gcd i j := rfl
lemma nat_abs_lcm (i j : ℤ) : nat_abs (gcd_monoid.lcm i j) = int.lcm i j := rfl

end gcd_monoid

lemma exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (h : is_unit u), (int.nat_abs a : ℤ) = u * a :=
begin
  cases (nat_abs_eq a) with h,
  { use [1, is_unit_one], rw [← h, one_mul], },
  { use [-1, is_unit_one.neg], rw [← neg_eq_iff_eq_neg.mpr h],
    simp only [neg_mul, one_mul] }
end

lemma gcd_eq_nat_abs {a b : ℤ} : int.gcd a b = nat.gcd a.nat_abs b.nat_abs := rfl

lemma gcd_eq_one_iff_coprime {a b : ℤ} : int.gcd a b = 1 ↔ is_coprime a b :=
begin
  split,
  { intro hg,
    obtain ⟨ua, hua, ha⟩ := exists_unit_of_abs a,
    obtain ⟨ub, hub, hb⟩ := exists_unit_of_abs b,
    use [(nat.gcd_a (int.nat_abs a) (int.nat_abs b)) * ua,
        (nat.gcd_b (int.nat_abs a) (int.nat_abs b)) * ub],
    rw [mul_assoc, ← ha, mul_assoc, ← hb, mul_comm, mul_comm _ (int.nat_abs b : ℤ),
      ← nat.gcd_eq_gcd_ab, ←gcd_eq_nat_abs, hg, int.coe_nat_one] },
  { rintro ⟨r, s, h⟩,
    by_contradiction hg,
    obtain ⟨p, ⟨hp, ha, hb⟩⟩ := nat.prime.not_coprime_iff_dvd.mp hg,
    apply nat.prime.not_dvd_one hp,
    rw [←coe_nat_dvd, int.coe_nat_one, ← h],
    exact dvd_add ((coe_nat_dvd_left.mpr ha).mul_left _)
      ((coe_nat_dvd_left.mpr hb).mul_left _) }
end

lemma coprime_iff_nat_coprime {a b : ℤ} : is_coprime a b ↔ nat.coprime a.nat_abs b.nat_abs :=
by rw [←gcd_eq_one_iff_coprime, nat.coprime_iff_gcd_eq_one, gcd_eq_nat_abs]

/-- If `gcd a (m * n) ≠ 1`, then `gcd a m ≠ 1` or `gcd a n ≠ 1`. -/
lemma gcd_ne_one_iff_gcd_mul_right_ne_one {a : ℤ} {m n : ℕ} :
  a.gcd (m * n) ≠ 1 ↔ a.gcd m ≠ 1 ∨ a.gcd n ≠ 1 :=
by simp only [gcd_eq_one_iff_coprime, ← not_and_distrib, not_iff_not, is_coprime.mul_right_iff]

/-- If `gcd a (m * n) = 1`, then `gcd a m = 1`. -/
lemma gcd_eq_one_of_gcd_mul_right_eq_one_left {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
  a.gcd m = 1 :=
nat.dvd_one.mp $ trans_rel_left _ (gcd_dvd_gcd_mul_right_right a m n) h

/-- If `gcd a (m * n) = 1`, then `gcd a n = 1`. -/
lemma gcd_eq_one_of_gcd_mul_right_eq_one_right {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
  a.gcd n = 1 :=
nat.dvd_one.mp $ trans_rel_left _ (gcd_dvd_gcd_mul_left_right a n m) h

lemma sq_of_gcd_eq_one {a b c : ℤ} (h : int.gcd a b = 1) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) :=
begin
  have h' : is_unit (gcd_monoid.gcd a b), { rw [← coe_gcd, h, int.coe_nat_one], exact is_unit_one },
  obtain ⟨d, ⟨u, hu⟩⟩ := exists_associated_pow_of_mul_eq_pow h' heq,
  use d,
  rw ← hu,
  cases int.units_eq_one_or u with hu' hu'; { rw hu', simp }
end

lemma sq_of_coprime {a b c : ℤ} (h : is_coprime a b) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) := sq_of_gcd_eq_one (gcd_eq_one_iff_coprime.mpr h) heq

lemma nat_abs_euclidean_domain_gcd (a b : ℤ) :
  int.nat_abs (euclidean_domain.gcd a b) = int.gcd a b :=
begin
  apply nat.dvd_antisymm; rw ← int.coe_nat_dvd,
  { rw int.nat_abs_dvd,
    exact int.dvd_gcd (euclidean_domain.gcd_dvd_left _ _) (euclidean_domain.gcd_dvd_right _ _) },
  { rw int.dvd_nat_abs,
    exact euclidean_domain.dvd_gcd (int.gcd_dvd_left _ _) (int.gcd_dvd_right _ _) }
end

end int

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
def associates_int_equiv_nat : associates ℤ ≃ ℕ :=
begin
  refine ⟨λz, z.out.nat_abs, λn, associates.mk n, _, _⟩,
  { refine (assume a, quotient.induction_on' a $ assume a,
      associates.mk_eq_mk_iff_associated.2 $ associated.symm $ ⟨norm_unit a, _⟩),
    show normalize a = int.nat_abs (normalize a),
    rw [int.coe_nat_abs, int.abs_eq_normalize, normalize_idem] },
  { intro n,
    dsimp,
    rw [←normalize_apply, ←int.abs_eq_normalize, int.nat_abs_abs, int.nat_abs_of_nat] }
end

lemma int.prime.dvd_mul {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : p ∣ m.nat_abs ∨ p ∣ n.nat_abs :=
begin
  apply (nat.prime.dvd_mul hp).mp,
  rw ← int.nat_abs_mul,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_mul' {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : (p : ℤ) ∣ m ∨ (p : ℤ) ∣ n :=
begin
  rw [int.coe_nat_dvd_left, int.coe_nat_dvd_left],
  exact int.prime.dvd_mul hp h
end

lemma int.prime.dvd_pow {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : p  ∣ n.nat_abs :=
begin
  apply @nat.prime.dvd_of_dvd_pow _ _ k hp,
  rw ← int.nat_abs_pow,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_pow' {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : (p : ℤ)  ∣ n :=
begin
  rw int.coe_nat_dvd_left,
  exact int.prime.dvd_pow hp h
end

lemma prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ 2 * m ^ 2) : p = 2 ∨ p ∣ int.nat_abs m :=
begin
  cases int.prime.dvd_mul hp h with hp2 hpp,
  { apply or.intro_left,
    exact le_antisymm (nat.le_of_dvd zero_lt_two hp2) (nat.prime.two_le hp) },
  { apply or.intro_right,
    rw [sq, int.nat_abs_mul] at hpp,
    exact (or_self _).mp ((nat.prime.dvd_mul hp).mp hpp)}
end

lemma int.exists_prime_and_dvd {n : ℤ} (hn : n.nat_abs ≠ 1) : ∃ p, prime p ∧ p ∣ n :=
begin
  obtain ⟨p, pp, pd⟩ := nat.exists_prime_and_dvd hn,
  exact ⟨p, nat.prime_iff_prime_int.mp pp, int.coe_nat_dvd_left.mpr pd⟩,
end

open unique_factorization_monoid

theorem nat.factors_eq {n : ℕ} : normalized_factors n = n.factors :=
begin
  cases n, { simp },
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply factors_unique (irreducible_of_normalized_factor) _,
  { rw [multiset.coe_prod, nat.prod_factors n.succ_ne_zero],
    apply normalized_factors_prod (nat.succ_ne_zero _) },
  { apply_instance },
  { intros x hx,
    rw [nat.irreducible_iff_prime, ← nat.prime_iff],
    exact nat.prime_of_mem_factors hx }
end

lemma nat.factors_multiset_prod_of_irreducible
  {s : multiset ℕ} (h : ∀ (x : ℕ), x ∈ s → irreducible x) :
  normalized_factors (s.prod) = s :=
begin
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply unique_factorization_monoid.factors_unique irreducible_of_normalized_factor h
    (normalized_factors_prod _),
  rw [ne.def, multiset.prod_eq_zero_iff],
  intro con,
  exact not_irreducible_zero (h 0 con),
end

namespace multiplicity

lemma finite_int_iff_nat_abs_finite {a b : ℤ} : finite a b ↔ finite a.nat_abs b.nat_abs :=
by simp only [finite_def, ← int.nat_abs_dvd_iff_dvd, int.nat_abs_pow]

lemma finite_int_iff {a b : ℤ} : finite a b ↔ (a.nat_abs ≠ 1 ∧ b ≠ 0) :=
by rw [finite_int_iff_nat_abs_finite, finite_nat_iff, pos_iff_ne_zero, int.nat_abs_ne_zero]

instance decidable_nat : decidable_rel (λ a b : ℕ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_nat_iff.symm

instance decidable_int : decidable_rel (λ a b : ℤ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_int_iff.symm

end multiplicity

lemma induction_on_primes {P : ℕ → Prop} (h₀ : P 0) (h₁ : P 1)
  (h : ∀ p a : ℕ, p.prime → P a → P (p * a)) (n : ℕ) : P n :=
begin
  apply unique_factorization_monoid.induction_on_prime,
  exact h₀,
  { intros n h,
    rw nat.is_unit_iff.1 h,
    exact h₁, },
  { intros a p _ hp ha,
    exact h p a hp.nat_prime ha, },
end

lemma int.associated_nat_abs (k : ℤ) : associated k k.nat_abs :=
associated_of_dvd_dvd (int.coe_nat_dvd_right.mpr dvd_rfl) (int.nat_abs_dvd.mpr dvd_rfl)

lemma int.prime_iff_nat_abs_prime {k : ℤ} : prime k ↔ nat.prime k.nat_abs :=
(int.associated_nat_abs k).prime_iff.trans nat.prime_iff_prime_int.symm

theorem int.associated_iff_nat_abs {a b : ℤ} : associated a b ↔ a.nat_abs = b.nat_abs :=
begin
  rw [←dvd_dvd_iff_associated, ←int.nat_abs_dvd_iff_dvd,
      ←int.nat_abs_dvd_iff_dvd, dvd_dvd_iff_associated],
  exact associated_iff_eq,
end

lemma int.associated_iff {a b : ℤ} : associated a b ↔ (a = b ∨ a = -b) :=
begin
  rw int.associated_iff_nat_abs,
  exact int.nat_abs_eq_nat_abs_iff,
end

namespace int

lemma zmultiples_nat_abs (a : ℤ) :
  add_subgroup.zmultiples (a.nat_abs : ℤ) = add_subgroup.zmultiples a :=
le_antisymm
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))

lemma span_nat_abs (a : ℤ) : ideal.span ({a.nat_abs} : set ℤ) = ideal.span {a} :=
by { rw ideal.span_singleton_eq_span_singleton, exact (associated_nat_abs _).symm }

theorem eq_pow_of_mul_eq_pow_bit1_left {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, a = d ^ (bit1 k) :=
begin
  obtain ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow' hab h,
  replace hd := hd.symm,
  rw [associated_iff_nat_abs, nat_abs_eq_nat_abs_iff, ←neg_pow_bit1] at hd,
  obtain rfl|rfl := hd; exact ⟨_, rfl⟩,
end

theorem eq_pow_of_mul_eq_pow_bit1_right {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, b = d ^ (bit1 k) :=
eq_pow_of_mul_eq_pow_bit1_left hab.symm (by rwa mul_comm at h)

theorem eq_pow_of_mul_eq_pow_bit1 {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) :
  (∃ d, a = d ^ (bit1 k)) ∧ (∃ e, b = e ^ (bit1 k)) :=
⟨eq_pow_of_mul_eq_pow_bit1_left hab h, eq_pow_of_mul_eq_pow_bit1_right hab h⟩

end int


/-
Copyright (c) 2020 Kyle Miller All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/

import data.multiset.basic
import data.vector.basic
import data.setoid.basic
import tactic.apply_fun

/-!
# Symmetric powers

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

This file defines symmetric powers of a type.  The nth symmetric power
consists of homogeneous n-tuples modulo permutations by the symmetric
group.

The special case of 2-tuples is called the symmetric square, which is
addressed in more detail in `data.sym.sym2`.

TODO: This was created as supporting material for `sym2`; it
needs a fleshed-out interface.

## Tags

symmetric powers

-/

open function

/--
The nth symmetric power is n-tuples up to permutation.  We define it
as a subtype of `multiset` since these are well developed in the
library.  We also give a definition `sym.sym'` in terms of vectors, and we
show these are equivalent in `sym.sym_equiv_sym'`.
-/
def sym (α : Type*) (n : ℕ) := {s : multiset α // s.card = n}

instance sym.has_coe (α : Type*) (n : ℕ) : has_coe (sym α n) (multiset α) := coe_subtype

/--
This is the `list.perm` setoid lifted to `vector`.

See note [reducible non-instances].
-/
@[reducible]
def vector.perm.is_setoid (α : Type*) (n : ℕ) : setoid (vector α n) :=
(list.is_setoid α).comap subtype.val

local attribute [instance] vector.perm.is_setoid

namespace sym

variables {α β : Type*} {n n' m : ℕ} {s : sym α n} {a b : α}

lemma coe_injective : injective (coe : sym α n → multiset α) := subtype.coe_injective

@[simp, norm_cast] lemma coe_inj {s₁ s₂ : sym α n} : (s₁ : multiset α) = s₂ ↔ s₁ = s₂ :=
coe_injective.eq_iff

/--
Construct an element of the `n`th symmetric power from a multiset of cardinality `n`.
-/
@[simps, pattern]
abbreviation mk (m : multiset α) (h : m.card = n) : sym α n := ⟨m, h⟩

/--
The unique element in `sym α 0`.
-/
@[pattern] def nil : sym α 0 := ⟨0, multiset.card_zero⟩

@[simp] lemma coe_nil : (coe (@sym.nil α)) = (0 : multiset α) := rfl

/--
Inserts an element into the term of `sym α n`, increasing the length by one.
-/
@[pattern] def cons (a : α) (s : sym α n) : sym α n.succ :=
⟨a ::ₘ s.1, by rw [multiset.card_cons, s.2]⟩

infixr ` ::ₛ `:67 := cons

@[simp]
lemma cons_inj_right (a : α) (s s' : sym α n) : a ::ₛ s = a ::ₛ s' ↔ s = s' :=
subtype.ext_iff.trans $ (multiset.cons_inj_right _).trans subtype.ext_iff.symm

@[simp]
lemma cons_inj_left (a a' : α) (s : sym α n) : a ::ₛ s = a' ::ₛ s ↔ a = a' :=
subtype.ext_iff.trans $ multiset.cons_inj_left _

lemma cons_swap (a b : α) (s : sym α n) : a ::ₛ b ::ₛ s = b ::ₛ a ::ₛ s :=
subtype.ext $ multiset.cons_swap a b s.1

lemma coe_cons (s : sym α n) (a : α) : (a ::ₛ s : multiset α) = a ::ₘ s := rfl

/--
This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
symmetric power.
-/
instance : has_lift (vector α n) (sym α n) :=
{ lift := λ x, ⟨↑x.val, (multiset.coe_card _).trans x.2⟩ }

@[simp] lemma of_vector_nil : ↑(vector.nil : vector α 0) = (sym.nil : sym α 0) := rfl

@[simp] lemma of_vector_cons (a : α) (v : vector α n) :
  ↑(vector.cons a v) = a ::ₛ (↑v : sym α n) := by { cases v, refl }

/--
`α ∈ s` means that `a` appears as one of the factors in `s`.
-/
instance : has_mem α (sym α n) := ⟨λ a s, a ∈ s.1⟩

instance decidable_mem [decidable_eq α] (a : α) (s : sym α n) : decidable (a ∈ s) :=
s.1.decidable_mem _

@[simp]
lemma mem_mk (a : α) (s : multiset α) (h : s.card = n) : a ∈ mk s h ↔ a ∈ s := iff.rfl

@[simp] lemma mem_cons : a ∈ b ::ₛ s ↔ a = b ∨ a ∈ s :=
multiset.mem_cons

@[simp] lemma mem_coe : a ∈ (s : multiset α) ↔ a ∈ s := iff.rfl

lemma mem_cons_of_mem (h : a ∈ s) : a ∈ b ::ₛ s :=
multiset.mem_cons_of_mem h

@[simp] lemma mem_cons_self (a : α) (s : sym α n) : a ∈ a ::ₛ s :=
multiset.mem_cons_self a s.1

lemma sound {a b : vector α n} (h : a.val ~ b.val) : (↑a : sym α n) = ↑b :=
subtype.ext $ quotient.sound h

/-- `erase s a h` is the sym that subtracts 1 from the
  multiplicity of `a` if a is present in the sym. -/
def erase [decidable_eq α] (s : sym α (n + 1)) (a : α) (h : a ∈ s) : sym α n :=
⟨s.val.erase a, (multiset.card_erase_of_mem h).trans $ s.property.symm ▸ n.pred_succ⟩

@[simp] lemma erase_mk [decidable_eq α] (m : multiset α) (hc : m.card = n + 1) (a : α) (h : a ∈ m) :
  (mk m hc).erase a h = mk (m.erase a) (by { rw [multiset.card_erase_of_mem h, hc], refl }) := rfl

@[simp] lemma coe_erase [decidable_eq α] {s : sym α n.succ} {a : α} (h : a ∈ s) :
  (s.erase a h : multiset α) = multiset.erase s a := rfl

@[simp] lemma cons_erase [decidable_eq α] {s : sym α n.succ} {a : α} (h : a ∈ s) :
  a ::ₛ s.erase a h = s :=
coe_injective $ multiset.cons_erase h

@[simp] lemma erase_cons_head [decidable_eq α] (s : sym α n) (a : α)
  (h : a ∈ a ::ₛ s := mem_cons_self a s) : (a ::ₛ s).erase a h = s :=
coe_injective $ multiset.erase_cons_head a s.1

/--
Another definition of the nth symmetric power, using vectors modulo permutations. (See `sym`.)
-/
def sym' (α : Type*) (n : ℕ) := quotient (vector.perm.is_setoid α n)

/--
This is `cons` but for the alternative `sym'` definition.
-/
def cons' {α : Type*} {n : ℕ} : α → sym' α n → sym' α (nat.succ n) :=
λ a, quotient.map (vector.cons a) (λ ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ h, list.perm.cons _ h)

notation (name := sym.cons') a :: b := cons' a b

/--
Multisets of cardinality n are equivalent to length-n vectors up to permutations.
-/
def sym_equiv_sym' {α : Type*} {n : ℕ} : sym α n ≃ sym' α n :=
equiv.subtype_quotient_equiv_quotient_subtype _ _ (λ _, by refl) (λ _ _, by refl)

lemma cons_equiv_eq_equiv_cons (α : Type*) (n : ℕ) (a : α) (s : sym α n) :
  a :: sym_equiv_sym' s = sym_equiv_sym' (a ::ₛ s) :=
by { rcases s with ⟨⟨l⟩, _⟩, refl, }

instance : has_zero (sym α 0) := ⟨⟨0, rfl⟩⟩
instance : has_emptyc (sym α 0) := ⟨0⟩

lemma eq_nil_of_card_zero (s : sym α 0) : s = nil :=
subtype.ext $ multiset.card_eq_zero.1 s.2

instance unique_zero : unique (sym α 0) :=
⟨⟨nil⟩, eq_nil_of_card_zero⟩

/-- `replicate n a` is the sym containing only `a` with multiplicity `n`. -/
def replicate (n : ℕ) (a : α) : sym α n := ⟨multiset.replicate n a, multiset.card_replicate _ _⟩

lemma replicate_succ {a : α} {n : ℕ} : replicate n.succ a = a ::ₛ replicate n a := rfl

lemma coe_replicate : (replicate n a : multiset α) = multiset.replicate n a := rfl

@[simp] lemma mem_replicate : b ∈ replicate n a ↔ n ≠ 0 ∧ b = a := multiset.mem_replicate

lemma eq_replicate_iff : s = replicate n a ↔ ∀ b ∈ s, b = a :=
begin
  rw [subtype.ext_iff, coe_replicate, multiset.eq_replicate],
  exact and_iff_right s.2
end

lemma exists_mem (s : sym α n.succ) : ∃ a, a ∈ s :=
multiset.card_pos_iff_exists_mem.1 $ s.2.symm ▸ n.succ_pos

lemma exists_eq_cons_of_succ (s : sym α n.succ) : ∃ (a : α) (s' : sym α n), s = a ::ₛ s' :=
begin
  obtain ⟨a, ha⟩ := exists_mem s,
  classical,
  exact ⟨a, s.erase a ha, (cons_erase ha).symm⟩,
end

lemma eq_replicate {a : α} {n : ℕ} {s : sym α n} : s = replicate n a ↔ ∀ b ∈ s, b = a :=
subtype.ext_iff.trans $ multiset.eq_replicate.trans $ and_iff_right s.prop

lemma eq_replicate_of_subsingleton [subsingleton α] (a : α) {n : ℕ} (s : sym α n) :
  s = replicate n a :=
eq_replicate.2 $ λ b hb, subsingleton.elim _ _

instance [subsingleton α] (n : ℕ) : subsingleton (sym α n) :=
⟨begin
  cases n,
  { simp, },
  { intros s s',
    obtain ⟨b, -⟩ := exists_mem s,
    rw [eq_replicate_of_subsingleton b s', eq_replicate_of_subsingleton b s], },
end⟩

instance inhabited_sym [inhabited α] (n : ℕ) : inhabited (sym α n) :=
⟨replicate n default⟩

instance inhabited_sym' [inhabited α] (n : ℕ) : inhabited (sym' α n) :=
⟨quotient.mk' (vector.replicate n default)⟩

instance (n : ℕ) [is_empty α] : is_empty (sym α n.succ) :=
⟨λ s, by { obtain ⟨a, -⟩ := exists_mem s, exact is_empty_elim a }⟩

instance (n : ℕ) [unique α] : unique (sym α n) := unique.mk' _

lemma replicate_right_inj {a b : α} {n : ℕ} (h : n ≠ 0) : replicate n a = replicate n b ↔ a = b :=
subtype.ext_iff.trans (multiset.replicate_right_inj h)

lemma replicate_right_injective {n : ℕ} (h : n ≠ 0) :
  function.injective (replicate n : α → sym α n) :=
λ a b, (replicate_right_inj h).1

instance (n : ℕ) [nontrivial α] : nontrivial (sym α (n + 1)) :=
(replicate_right_injective n.succ_ne_zero).nontrivial

/-- A function `α → β` induces a function `sym α n → sym β n` by applying it to every element of
the underlying `n`-tuple. -/
def map {n : ℕ} (f : α → β) (x : sym α n) : sym β n :=
⟨x.val.map f, by simpa [multiset.card_map] using x.property⟩

@[simp] lemma mem_map {n : ℕ} {f : α → β} {b : β} {l : sym α n} :
  b ∈ sym.map f l ↔ ∃ a, a ∈ l ∧ f a = b := multiset.mem_map

/-- Note: `sym.map_id` is not simp-normal, as simp ends up unfolding `id` with `sym.map_congr` -/
@[simp] lemma map_id' {α : Type*} {n : ℕ} (s : sym α n) : sym.map (λ (x : α), x) s = s :=
by simp [sym.map]

lemma map_id {α : Type*} {n : ℕ} (s : sym α n) : sym.map id s = s :=
by simp [sym.map]

@[simp] lemma map_map {α β γ : Type*} {n : ℕ} (g : β → γ) (f : α → β) (s : sym α n) :
  sym.map g (sym.map f s) = sym.map (g ∘ f) s :=
by simp [sym.map]

@[simp] lemma map_zero (f : α → β) :
  sym.map f (0 : sym α 0) = (0 : sym β 0) := rfl

@[simp] lemma map_cons {n : ℕ} (f : α → β) (a : α) (s : sym α n) :
  (a ::ₛ s).map f = (f a) ::ₛ s.map f :=
by simp [map, cons]

@[congr] lemma map_congr {f g : α → β} {s : sym α n} (h : ∀ x ∈ s, f x = g x) :
  map f s = map g s := subtype.ext $ multiset.map_congr rfl h

@[simp] lemma map_mk {f : α → β} {m : multiset α} {hc : m.card = n} :
  map f (mk m hc) = mk (m.map f) (by simp [hc]) := rfl

@[simp] lemma coe_map (s : sym α n) (f : α → β) : ↑(s.map f) = multiset.map f s := rfl

lemma map_injective {f : α → β} (hf : injective f) (n : ℕ) :
  injective (map f : sym α n → sym β n) :=
λ s t h, coe_injective $ multiset.map_injective hf $ coe_inj.2 h

/-- Mapping an equivalence `α ≃ β` using `sym.map` gives an equivalence between `sym α n` and
`sym β n`. -/
@[simps]
def equiv_congr (e : α ≃ β) : sym α n ≃ sym β n :=
{ to_fun := map e,
  inv_fun := map e.symm,
  left_inv := λ x, by rw [map_map, equiv.symm_comp_self, map_id],
  right_inv := λ x, by rw [map_map, equiv.self_comp_symm, map_id] }

/-- "Attach" a proof that `a ∈ s` to each element `a` in `s` to produce
an element of the symmetric power on `{x // x ∈ s}`. -/
def attach (s : sym α n) : sym {x // x ∈ s} n := ⟨s.val.attach, by rw [multiset.card_attach, s.2]⟩

@[simp] lemma attach_mk {m : multiset α} {hc : m.card = n} :
  attach (mk m hc) = mk m.attach (multiset.card_attach.trans hc) := rfl

@[simp] lemma coe_attach (s : sym α n) : (s.attach : multiset {a // a ∈ s}) = multiset.attach s :=
rfl

lemma attach_map_coe (s : sym α n) : s.attach.map coe = s :=
coe_injective $ multiset.attach_map_val _

@[simp] lemma mem_attach (s : sym α n) (x : {x // x ∈ s}) : x ∈ s.attach :=
multiset.mem_attach _ _

@[simp] lemma attach_nil : (nil : sym α 0).attach = nil := rfl

@[simp] lemma attach_cons (x : α) (s : sym α n) :
  (cons x s).attach = cons ⟨x, mem_cons_self _ _⟩ (s.attach.map (λ x, ⟨x, mem_cons_of_mem x.prop⟩))
  :=
coe_injective $ multiset.attach_cons _ _

/-- Change the length of a `sym` using an equality.
The simp-normal form is for the `cast` to be pushed outward. -/
protected def cast {n m : ℕ} (h : n = m) : sym α n ≃ sym α m :=
{ to_fun := λ s, ⟨s.val, s.2.trans h⟩,
  inv_fun := λ s, ⟨s.val, s.2.trans h.symm⟩,
  left_inv := λ s, subtype.ext rfl,
  right_inv := λ s, subtype.ext rfl }

@[simp] lemma cast_rfl : sym.cast rfl s = s := subtype.ext rfl

@[simp] lemma cast_cast {n'' : ℕ} (h : n = n') (h' : n' = n'') :
  sym.cast h' (sym.cast h s) = sym.cast (h.trans h') s := rfl

@[simp] lemma coe_cast (h : n = m) : (sym.cast h s : multiset α) = s := rfl

@[simp] lemma mem_cast (h : n = m) : a ∈ sym.cast h s ↔ a ∈ s := iff.rfl

/-- Append a pair of `sym` terms. -/
def append (s : sym α n) (s' : sym α n') : sym α (n + n') :=
⟨s.1 + s'.1, by simp_rw [← s.2, ← s'.2, map_add]⟩

@[simp] lemma append_inj_right (s : sym α n) {t t' : sym α n'} :
  s.append t = s.append t' ↔ t = t' :=
subtype.ext_iff.trans $ (add_right_inj _).trans subtype.ext_iff.symm

@[simp] lemma append_inj_left {s s' : sym α n} (t : sym α n') :
  s.append t = s'.append t ↔ s = s' :=
subtype.ext_iff.trans $ (add_left_inj _).trans subtype.ext_iff.symm

lemma append_comm (s : sym α n') (s' : sym α n') :
  s.append s' = sym.cast (add_comm _ _) (s'.append s) :=
by { ext, simp [append, add_comm], }

@[simp, norm_cast] lemma coe_append (s : sym α n) (s' : sym α n') :
  (s.append s' : multiset α) = s + s' := rfl

lemma mem_append_iff {s' : sym α m} : a ∈ s.append s' ↔ a ∈ s ∨ a ∈ s' := multiset.mem_add

/-- Fill a term `m : sym α (n - i)` with `i` copies of `a` to obtain a term of `sym α n`.
This is a convenience wrapper for `m.append (replicate i a)` that adjusts the term using
`sym.cast`. -/
def fill (a : α) (i : fin (n + 1)) (m : sym α (n - i)) : sym α n :=
sym.cast (nat.sub_add_cancel i.is_le) (m.append (replicate i a))

lemma coe_fill {a : α} {i : fin (n + 1)} {m : sym α (n - i)} :
  (fill a i m : multiset α) = m + replicate i a := rfl

lemma mem_fill_iff {a b : α} {i : fin (n + 1)} {s : sym α (n - i)} :
  a ∈ sym.fill b i s ↔ ((i : ℕ) ≠ 0 ∧ a = b) ∨ a ∈ s :=
by rw [fill, mem_cast, mem_append_iff, or_comm, mem_replicate]

open multiset

/-- Remove every `a` from a given `sym α n`.
Yields the number of copies `i` and a term of `sym α (n - i)`. -/
def filter_ne [decidable_eq α] (a : α) (m : sym α n) : Σ i : fin (n + 1), sym α (n - i) :=
⟨⟨m.1.count a, (count_le_card _ _).trans_lt $ by rw [m.2, nat.lt_succ_iff]⟩,
  m.1.filter ((≠) a), eq_tsub_of_add_eq $ eq.trans begin
    rw [← countp_eq_card_filter, add_comm],
    exact (card_eq_countp_add_countp _ _).symm,
  end m.2⟩

lemma sigma_sub_ext {m₁ m₂ : Σ i : fin (n + 1), sym α (n - i)}
  (h : (m₁.2 : multiset α) = m₂.2) : m₁ = m₂ :=
sigma.subtype_ext (fin.ext $ by rw [← nat.sub_sub_self m₁.1.is_le, ← nat.sub_sub_self m₂.1.is_le,
  ← m₁.2.2, ← m₂.2.2, subtype.val_eq_coe, subtype.val_eq_coe, h]) h

lemma fill_filter_ne [decidable_eq α] (a : α) (m : sym α n) :
  (m.filter_ne a).2.fill a (m.filter_ne a).1 = m :=
subtype.ext begin
  dsimp only [coe_fill, filter_ne, subtype.coe_mk, fin.coe_mk],
  ext b, rw [count_add, count_filter, sym.coe_replicate, count_replicate],
  obtain rfl | h := eq_or_ne a b,
  { rw [if_pos rfl, if_neg (not_not.2 rfl), zero_add], refl },
  { rw [if_pos h, if_neg h.symm, add_zero], refl },
end

lemma filter_ne_fill [decidable_eq α] (a : α) (m : Σ i : fin (n + 1), sym α (n - i)) (h : a ∉ m.2) :
  (m.2.fill a m.1).filter_ne a = m :=
sigma_sub_ext begin
  dsimp only [filter_ne, subtype.coe_mk, subtype.val_eq_coe, coe_fill],
  rw [filter_add, filter_eq_self.2, add_right_eq_self, eq_zero_iff_forall_not_mem],
  { intros b hb, rw [mem_filter, sym.mem_coe, mem_replicate] at hb, exact hb.2 hb.1.2.symm },
  { exact λ b hb, (hb.ne_of_not_mem h).symm },
end

end sym

section equiv

/-! ### Combinatorial equivalences -/

variables {α : Type*} {n : ℕ}
open sym

namespace sym_option_succ_equiv

/-- Function from the symmetric product over `option` splitting on whether or not
it contains a `none`. -/
def encode [decidable_eq α] (s : sym (option α) n.succ) : sym (option α) n ⊕ sym α n.succ :=
if h : none ∈ s
then sum.inl (s.erase none h)
else sum.inr (s.attach.map $ λ o,
  option.get $ option.ne_none_iff_is_some.1 $ ne_of_mem_of_not_mem o.2 h)

@[simp] lemma encode_of_none_mem [decidable_eq α] (s : sym (option α) n.succ) (h : none ∈ s) :
  encode s = sum.inl (s.erase none h) := dif_pos h

@[simp] lemma encode_of_not_none_mem [decidable_eq α] (s : sym (option α) n.succ) (h : ¬ none ∈ s) :
  encode s = sum.inr (s.attach.map $ λ o,
    option.get $ option.ne_none_iff_is_some.1 $ ne_of_mem_of_not_mem o.2 h) := dif_neg h

/-- Inverse of `sym_option_succ_equiv.decode`. -/
@[simp] def decode : sym (option α) n ⊕ sym α n.succ → sym (option α) n.succ
| (sum.inl s) := none ::ₛ s
| (sum.inr s) := s.map embedding.coe_option

@[simp] lemma decode_encode [decidable_eq α] (s : sym (option α) n.succ) :
  decode (encode s) = s :=
begin
  by_cases h : none ∈ s,
  { simp [h] },
  { simp only [h, decode, not_false_iff, subtype.val_eq_coe, encode_of_not_none_mem,
      embedding.coe_option_apply, map_map, comp_app, option.coe_get],
    convert s.attach_map_coe }
end

@[simp] lemma encode_decode [decidable_eq α] (s : sym (option α) n ⊕ sym α n.succ) :
  encode (decode s) = s :=
begin
  obtain (s | s) := s,
  { simp },
  { unfold sym_option_succ_equiv.encode,
    split_ifs,
    { obtain ⟨a, _, ha⟩ := multiset.mem_map.mp h,
      exact option.some_ne_none _ ha },
    { refine map_injective (option.some_injective _) _ _,
      convert eq.trans _ (sym_option_succ_equiv.decode (sum.inr s)).attach_map_coe,
      simp } }
end

end sym_option_succ_equiv

/-- The symmetric product over `option` is a disjoint union over simpler symmetric products. -/
@[simps] def sym_option_succ_equiv [decidable_eq α] :
  sym (option α) n.succ ≃ sym (option α) n ⊕ sym α n.succ :=
{ to_fun := sym_option_succ_equiv.encode,
  inv_fun := sym_option_succ_equiv.decode,
  left_inv := sym_option_succ_equiv.decode_encode,
  right_inv := sym_option_succ_equiv.encode_decode }

end equiv


import tutorial_world.level14_apply --hide
open IncidencePlane --hide

/- Tactic : simp

## Summary
The `simp` tactic is a high-level tactic which tries to prove equalities using facts in its database.

## Details
The `simp` tactic does basic automation. It uses lemmas already proved that have been tagged
with a special label, to simplify either a goal or a hypothesis.

## Example:
For `S` a segment, we have a lemma
`mem_pts : P ∈ S ↔ P = S.A ∨ P = S.B ∨ (S.A * P * S.B)`, and it is tagged as a simp lemma
in this game. This means that the `simp` tactic will replace occurrences of `P ∈ S` with
the right-hand side, which is more concrete.
-/

/-
# Tutorial World

## Level 15: the `simp` tactic.

In this level, we introduce a high level tactic called `simp`. This is an Artificial Intelligence (AI) tactic which
can nail some really tedious-for-a-human-to-solve goals. It uses lemmas that are already in our database to make
the goal simpler for us to solve.

As a simple example, for `S` being a segment (the concept of segment will be defined in the Betweenness World), we have the lemma
`mem_pts : P ∈ S ↔ P = S.A ∨ P = S.B ∨ (S.A * P * S.B)`, which is tagged as a simp lemma
in this game. This means that the `simp` tactic will replace occurrences of `P ∈ S` with
the right-hand side of the double implication, which is more concrete. Now, delete the `sorry` and type
`simp,`. After that, try to complete the level by using the tactics that we've learned so far.
-/

/- Hint : Click here for a hint, in case you get stuck.
Do you remember how to solve a goal of the form `⊢ P ∨ Q`? Think of either `left` or `right` tactic to make progress.
Using one of them twice, will set the goal to look exactly like one of the hypothesis. Still bewildered? Click on "View source"
(located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
A point in between the endpoints of a segment is in the segment.
-/
lemma simp_example (P : Ω) (S : Segment Ω) (h : S.A * P * S.B) : P ∈ S :=
begin

  simp,
  right,
  right,
  exact h,

end