/-
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 field_theory.tower
import analysis.normed_space.finite_dimension
import analysis.normed_space.star

/-!
# `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 ℂ.

Possible applications include defining inner products and Hilbert spaces for both the real and
complex case. One would produce 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).
-/

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 nondiscrete_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

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

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 algebra_map_eq_of_real : ⇑(algebra_map ℝ K) = coe := rfl

@[simp] 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] lemma of_real_re : ∀ r : ℝ, re (r : K) = r := is_R_or_C.of_real_re_ax
@[simp, norm_cast] lemma of_real_im : ∀ r : ℝ, im (r : K) = 0 := is_R_or_C.of_real_im_ax
@[simp] 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] 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 }

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

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

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

@[simp, norm_cast, priority 900] 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] lemma bit0_re (z : K) : re (bit0 z) = bit0 (re z) := by simp [bit0]
@[simp] 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] lemma bit0_im (z : K) : im (bit0 z) = bit0 (im z) := by simp [bit0]
@[simp] 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]

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

@[simp, 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, norm_cast, priority 900] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : K) = bit0 (r : K) :=
ext_iff.2 $ by simp [bit0]

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

/- Note: This can be proven by `norm_num` once K is proven to be of characteristic zero below. -/
lemma two_ne_zero : (2 : K) ≠ 0 :=
begin
  intro h, rw [(show (2 : K) = ((2 : ℝ) : K), by norm_num), ←of_real_zero, of_real_inj] at h,
  linarith,
end

@[simp, norm_cast, priority 900] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : K) = -r :=
ext_iff.2 $ by simp
@[simp, norm_cast, priority 900] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : K) = r * s :=
ext_iff.2 $ by simp
@[simp, norm_cast] lemma of_real_smul (r x : ℝ) : r • (x : K) = (r : K) * (x : K) :=
by { simp_rw [← smul_eq_mul, of_real_alg r], simp, }

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]
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]

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

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

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

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] lemma conj_re (z : K) : re (conj z) = re z := is_R_or_C.conj_re_ax z
@[simp] lemma conj_im (z : K) : im (conj z) = -(im z) := is_R_or_C.conj_im_ax z
@[simp] lemma conj_I : conj (I : K) = -I := is_R_or_C.conj_I_ax
@[simp] 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] lemma conj_bit0 (z : K) : conj (bit0 z) = bit0 (conj z) := by simp [bit0, ext_iff]
@[simp] lemma conj_bit1 (z : K) : conj (bit1 z) = bit1 (conj z) := by simp [bit0, ext_iff]

@[simp] lemma conj_neg_I : conj (-I) = (I : K) := by simp [ext_iff]

lemma conj_eq_re_sub_im (z : K) : conj z = re z - (im z) * I := by { rw ext_iff, simp, }

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,
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_equiv.map_add, ring_equiv.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

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 : monoid_with_zero_hom K ℝ :=
{ to_fun := λ z, re z * re z + im z * im z,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := λ z w, by { simp, 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 }

@[simp] lemma norm_sq_of_real (r : ℝ) : ∥(r : K)∥^2 = r * r :=
by simp [norm_sq_eq_def]

lemma norm_sq_zero : norm_sq (0 : K) = 0 := norm_sq.map_zero
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] lemma norm_sq_eq_zero {z : K} : norm_sq z = 0 ↔ z = 0 :=
by { rw [norm_sq_eq_def'], simp [sq] }

@[simp] 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] lemma norm_sq_neg (z : K) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq_eq_def']

@[simp] lemma norm_sq_conj (z : K) : norm_sq (conj z) = norm_sq z := by simp [norm_sq]

@[simp] 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 [norm_sq, sq]; 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 [ext_iff, norm_sq, mul_comm, sub_eq_neg_add, add_comm]

theorem add_conj (z : K) : z + conj z = 2 * (re z) :=
by simp [ext_iff, two_mul]

/-- 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, priority 900] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : K) = r - s :=
ext_iff.2 $ by simp
@[simp, norm_cast, priority 900] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : K) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : K) : z - conj z = (2 * im z) * I :=
by simp [ext_iff, two_mul, sub_eq_add_neg, add_mul, mul_im_I_ax]

lemma norm_sq_sub (z w : K) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * re (z * conj w) :=
by simp [-mul_re, norm_sq_add, add_comm, add_left_comm, sub_eq_add_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] lemma inv_re (z : K) : re (z⁻¹) = re z / norm_sq z :=
by simp [inv_def, norm_sq_eq_def, norm_sq, division_def]
@[simp] lemma inv_im (z : K) : im (z⁻¹) = im (-z) / norm_sq z :=
by simp [inv_def, norm_sq_eq_def, norm_sq, division_def]

@[simp, norm_cast, priority 900] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : K) = r⁻¹ :=
begin
  rw ext_iff, by_cases r = 0, { simp [h] },
  { simp; 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 [div_eq_mul_inv, mul_assoc, sub_eq_add_neg]
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 [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm]

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

lemma div_re_of_real {z : K} {r : ℝ} : re (z / r) = re z / r :=
begin
  by_cases h : r = 0,
  { simp [h, of_real_zero] },
  { change r ≠ 0 at h,
    rw [div_eq_mul_inv, ←of_real_inv, div_eq_mul_inv],
    simp [norm_sq, div_mul_eq_div_mul_one_div, div_self h] }
end

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

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

@[simp] 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] lemma inv_I : (I : K)⁻¹ = -I :=
by field_simp

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

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

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, (normed_field.norm_mul _ _).trans $ congr_arg (* ∥x∥) norm_conj }

/-! ### Cast lemmas -/

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

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

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

@[simp, norm_cast, priority 900] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : K) = n :=
of_real_hom.map_int_cast n

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

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

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

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

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

/-! ### Characteristic zero -/

-- TODO: I think this can be instance, because it is a `Prop`

/--
ℝ and ℂ are both of characteristic zero.

Note: This is not registered as an instance to avoid having multiple instances on ℝ and ℂ.
-/
lemma 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 :=
begin
  haveI : char_zero K := char_zero_R_or_C,
  rw [add_conj, mul_div_cancel_left ((re z):K) two_ne_zero'],
end

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 [mul_add, sub_eq_add_neg, neg_div']
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 [abs, norm_sq, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma norm_eq_abs (z : K) : ∥z∥ = absK z := by simp [abs, norm_sq_eq_def']

@[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] lemma abs_zero : absK 0 = 0 := by simp [abs]
@[simp] lemma abs_one : absK 1 = 1 := by simp [abs]

@[simp] 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] 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] lemma abs_conj (z : K) : abs (conj z) = abs z :=
by simp [abs]

@[simp] 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_re_le_norm (z : K) : ∥re z∥ ≤ ∥z∥ :=
by { rw [is_R_or_C.norm_eq_abs, real.norm_eq_abs], exact is_R_or_C.abs_re_le_abs _, }

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 [im_eq_zero_of_le h] }

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] 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] lemma abs_abs (z : K) : abs' (abs z) = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : K} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] 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] theorem abs_inv : ∀ z : K, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] 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, 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 [sq, ←norm_sq_eq_abs, norm_sq]

lemma abs_sq_re_add_conj' (x : K) : (abs (conj x + x))^2 = (re (conj x + x))^2 :=
by simp [sq, ←norm_sq_eq_abs, norm_sq]

lemma conj_mul_eq_norm_sq_left (x : K) : conj x * x = ((norm_sq x) : K) :=
begin
  rw ext_iff,
  refine ⟨by simp [of_real_re, mul_re, conj_re, conj_im, norm_sq],_⟩,
  simp [of_real_im, mul_im, conj_im, conj_re, mul_comm],
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, 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, 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, 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, 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

namespace finite_dimensional
variables {K : Type*} [is_R_or_C K]

open_locale classical
open is_R_or_C

/-- This instance generates a type-class problem with a metavariable `?m` that should satisfy
`is_R_or_C ?m`. Since this can only be satisfied by `ℝ` or `ℂ`, this does not cause problems. -/
library_note "is_R_or_C instance"

/-- An `is_R_or_C` field is finite-dimensional over `ℝ`, since it is spanned by `{1, I}`. -/
@[nolint dangerous_instance] instance is_R_or_C_to_real : finite_dimensional ℝ K :=
⟨⟨{1, I},
  begin
    rw eq_top_iff,
    intros a _,
    rw [finset.coe_insert, finset.coe_singleton, submodule.mem_span_insert],
    refine ⟨re a, (im a) • I, _, _⟩,
    { rw submodule.mem_span_singleton,
      use im a },
    simp [re_add_im a, algebra.smul_def, algebra_map_eq_of_real]
  end⟩⟩

/-- Over an `is_R_or_C` field, we can register the properness of finite-dimensional normed spaces as
an instance. -/
@[priority 900, nolint dangerous_instance] instance proper_is_R_or_C -- note [is_R_or_C instance]
  {E : Type*} [normed_group E] [normed_space K E] [finite_dimensional K E] :
  proper_space E :=
begin
  letI : normed_space ℝ E := restrict_scalars.normed_space ℝ K E,
  letI : is_scalar_tower ℝ K E := restrict_scalars.is_scalar_tower _ _ _,
  letI : finite_dimensional ℝ E := finite_dimensional.trans ℝ K E,
  apply_instance
end

end finite_dimensional

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 [add_zero, id.def, mul_zero],
  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_aut_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_equiv.map_zero, neg_zero],
  norm_sq_eq_def_ax := λ z, by simp only [sq, norm, ←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_aut_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]}

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] lemma re_to_real {x : ℝ} : reR x = x := rfl
@[simp] lemma im_to_real {x : ℝ} : imR x = 0 := rfl
@[simp] lemma conj_to_real {x : ℝ} : conj x = x := rfl
@[simp] lemma I_to_real : IR = 0 := rfl
@[simp] lemma norm_sq_to_real {x : ℝ} : norm_sq x = x*x := by simp [is_R_or_C.norm_sq]
@[simp] 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

variables {K : Type*} [is_R_or_C K]

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

@[simp] 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] lemma re_clm_norm : ∥(re_clm : K →L[ℝ] ℝ)∥ = 1 :=
begin
  apply le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _),
  convert continuous_linear_map.ratio_le_op_norm _ (1 : K),
  simp,
end

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

@[simp] 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. -/
noncomputable def im_lm : K →ₗ[ℝ] ℝ :=
{ map_smul' := smul_im,  .. im }

@[simp] 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, norm_cast] lemma im_clm_coe : ((im_clm : K →L[ℝ] ℝ) : K →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp] 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 -/
noncomputable def conj_ae : K ≃ₐ[ℝ] K :=
{ commutes' := conj_of_real,
  .. star_ring_aut }

@[simp] 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]⟩

@[simp] 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] lemma conj_cle_coe : (@conj_cle K _).to_linear_equiv = conj_ae.to_linear_equiv := rfl

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

@[simp] lemma conj_cle_norm : ∥(@conj_cle K _ : K →L[ℝ] K)∥ = 1 :=
(@conj_lie K _).to_linear_isometry.norm_to_continuous_linear_map

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

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

@[simp] 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] 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] lemma of_real_clm_coe : ((@of_real_clm K _) : ℝ →ₗ[ℝ] K) = of_real_am.to_linear_map := rfl

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

@[simp] lemma of_real_clm_norm : ∥(of_real_clm : ℝ →L[ℝ] K)∥ = 1 :=
linear_isometry.norm_to_continuous_linear_map of_real_li

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

end linear_maps

end is_R_or_C


import .mod_f
import .holomorphic_functions
import analysis.complex.removable_singularity
import analysis.complex.upper_half_plane.basic
import analysis.complex.upper_half_plane.topology
import number_theory.modular
import group_theory.index
import .upper_half_plane_manifold

/-!
# The original file can be found in https://github.com/CBirkbeck/ModularForms/blob/2d45f5501a0390c2150a6882f1dc6e07f3589847/src/mod_forms/q_expansion.lean
# By Chris Birkbeck
# q-expansions of periodic functions (Modified by Ferran Delgà)
We show that if `f : ℂ → ℂ` satisfies `f(z + h) = f(z)`, for some nonzero real `h`, then
there is a well-defined `F` such that `f(z) = F(exp(2 * π * I * z / h))` for all `z`;
and if `f` is holomorphic at some `z`, then `F` is holomorphic at `q = exp (2 * π * I * z / h)`.
We also show (using Riemann's removable singularity theorem) that if `f` is holomorphic and bounded
for all sufficiently large `im z`, then `F` extends to a holomorphic function on a neighbourhood of
`0`. As a consequence, if `f` tends to zero as `im z → ∞`, then in fact it decays *exponentially*
to zero.
-/

open modular_form complex filter asymptotics
open_locale real topological_space manifold filter

noncomputable theory

abbreviation ℝ_pos := {u : ℝ // 0 < u}

instance : has_one ℝ_pos := by { use 1, }

/-- Function-theoretic lemma, maybe move this elsewhere? -/
lemma bound_holo_fcn (g : ℂ → ℂ) (hg : differentiable_at ℂ g 0) (hg' : g 0 = 0):
  is_O (𝓝 0) g id  :=
begin
  replace hg := hg.has_deriv_at.is_O_sub, simp_rw [hg', sub_zero] at hg, exact hg,
end

section Q_and_Z

variables (h : ℝ_pos)

def Q (z : ℂ) : ℂ := exp ( 2 * π * I * z / h )

def Z (q : ℂ) : ℂ := h / (2 * π * I) * log q

lemma log_exp' (z : ℂ) : ∃ (n : ℤ), log (exp z) = z + n * (2 * π * I) :=
begin
  rw [←exp_eq_exp_iff_exists_int, exp_log], exact exp_ne_zero z,
end

lemma QZ_eq_id (q : ℂ) (hq : q ≠ 0) : Q h (Z h q) = q :=
begin
  dsimp only [Q, Z],
  suffices : 2 * ↑π * I * (↑h / (2 * ↑π * I) * log q) / ↑h = log q,
  { rw this, exact exp_log hq },
  have : (h : ℂ) ≠ 0 := of_real_ne_zero.mpr h.2.ne',
  field_simp [two_pi_I_ne_zero, this], ring,
end

lemma abs_Q_eq (z : ℂ) : abs (Q h z) = real.exp(-2 * π * im z / h) :=
begin
  dsimp only [Q], rw abs_exp, congr,
  rw [div_eq_mul_inv, mul_comm],
  have : (↑h)⁻¹ = (↑((h : ℝ)⁻¹) : ℂ) := by simp, rw this,
  rw of_real_mul_re,
  have : 2 * ↑π * I * z = (↑(2 * π) * z) * I := by { simp, ring, },
  rw [this, mul_I_re, of_real_mul_im], field_simp [h.2.ne'],
end

lemma im_Z_eq (q : ℂ) (hq : q ≠ 0) : im (Z h q) = -h / (2 * π) * real.log (abs q) :=
begin
  dsimp only [Z],
  have : ↑h / (2 * ↑π * I) * log q = -↑h / (2 * ↑π) * log q * I,
  { field_simp [of_real_ne_zero.mpr real.pi_pos.ne', two_pi_I_ne_zero], ring_nf, simp, },
  rw [this, mul_I_im],
  have : -↑h / (2 * ↑π) * log q = ↑(-↑h / (2 * π)) * log q := by simp,
  rw [this, of_real_mul_re, log_re],
end

lemma ZQ_eq_mod_period (z : ℂ) : ∃ (m : ℤ), Z h (Q h z) = z + m * h :=
begin
  dsimp only [Q, Z],
  have t := log_exp' ( 2 * ↑π * I * z / ↑h ),
  cases t with m t, use m, rw t,
  have : (h:ℂ) ≠ 0 := of_real_ne_zero.mpr h.2.ne',
  field_simp [two_pi_I_ne_zero], ring,
end

lemma abs_q_lt_iff (A : ℝ) (z : ℂ) : abs (Q h z) < real.exp(-2 * π * A / h) ↔ A < im z :=
begin
  rw [abs_Q_eq, real.exp_lt_exp],
  split,
  { intro hz, rw div_lt_div_right at hz, swap, exact h.2,
    have : (-2) * π < 0 := by simpa using real.pi_pos,
    rwa mul_lt_mul_left_of_neg this at hz, },
  { intro hz, rw div_lt_div_right, swap, exact h.2,
    have : (-2) * π < 0 := by simpa using real.pi_pos,
    rwa mul_lt_mul_left_of_neg this, },
end

-- Filter stuff

def at_I_inf' : filter ℂ := at_top.comap im

lemma at_I_inf'_mem (S : set ℂ) : S ∈ at_I_inf' ↔ (∃ A : ℝ, ∀ z : ℂ, A < im z → z ∈ S) :=
begin
  rw [at_I_inf', mem_comap', mem_at_top_sets],
  simp, split,
  { intro h, cases h with a h, use a,
    intros z hz, specialize h (im z) hz.le, apply h, refl },
  { intro h, cases h with A h, use A + 1,
    intros b hb x hx, apply (h x), rw hx, linarith, }
end

lemma Z_tendsto : tendsto (Z h) (𝓝[{0}ᶜ] 0) at_I_inf' :=
begin
  rw [tendsto, map_le_iff_le_comap, comap],
  intros S h, simp_rw at_I_inf'_mem at h, obtain ⟨T, ⟨A, hA⟩, hT⟩ := h,
  simp_rw [metric.mem_nhds_within_iff, metric.ball, dist_eq, sub_zero],
  use real.exp(-2 * π * A / h), split, apply real.exp_pos,
  intro q, dsimp, rintro ⟨u1, u2⟩,
  rw [←(QZ_eq_id h _ u2), abs_q_lt_iff] at u1, specialize hA (Z h q) u1,
  apply hT, exact hA,
end

lemma Q_tendsto : tendsto (Q h) at_I_inf' (𝓝 0) :=
begin
  rw [tendsto_zero_iff_norm_tendsto_zero],
  simp_rw [norm_eq_abs,abs_Q_eq],
  have : set.range im ∈ at_top,
  { suffices : set.range im = ⊤, { rw this, apply univ_mem, },
    ext1, simp only [set.mem_range, set.top_eq_univ, set.mem_univ, iff_true],
    use I * x, simp, },
  have := (@tendsto_comap'_iff ℝ ℝ ℂ (λ y, real.exp ((-2) * π * y / ↑h)) at_top (𝓝 0) im this).mpr,
  apply this, refine real.tendsto_exp_at_bot.comp _,
  apply tendsto.at_bot_div_const h.2,
  apply tendsto.neg_const_mul_at_top, { simpa using real.pi_pos }, exact tendsto_id,
end

end Q_and_Z

section periodic_on_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))

def cusp_fcn_0 : ℂ → ℂ := λ q, f (Z h q)

def cusp_fcn : ℂ → ℂ := function.update (cusp_fcn_0 h f) 0 (lim (𝓝[≠] (0:ℂ)) (cusp_fcn_0 h f))

lemma cusp_fcn_eq_of_nonzero (q : ℂ) (hq : q ≠ 0) :
  (cusp_fcn h f) q = (cusp_fcn_0 h f) q :=
begin
  rw [cusp_fcn, function.update], split_ifs,
  { exfalso, exact hq h_1 },
  { refl },
end

lemma update_twice :
  cusp_fcn h f = function.update (cusp_fcn h f) 0 (lim (𝓝[≠] (0:ℂ)) (cusp_fcn h f)) :=
begin
  ext1 q, rw function.update, split_ifs,
  { rw [cusp_fcn, function.update], split_ifs,
    congr' 1, rw [lim, lim], congr' 1,
    apply map_congr, apply eventually_eq_nhds_within_of_eq_on,
    intros r hr, simp at hr,
    rw function.update, split_ifs, refl,},
  { refl, },
end

include hf

private lemma is_periodic_aux (z : ℂ) (m : ℕ) : f (z + m * h) = f z :=
begin
  induction m with m hm generalizing z, simp,
  rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one, add_mul, ←add_assoc, one_mul],
  rw hf (z + m * h), exact hm z,
end

lemma is_periodic (z : ℂ) (m : ℤ) : f (z + m * h) = f z :=
begin
  cases m, { exact is_periodic_aux h f hf z m },
  simp only [neg_add_rev, int.cast_neg_succ_of_nat],
  convert (is_periodic_aux h f hf (z - (m+1) * h) (m+1)).symm,
  { simp, ring }, { simp },
end

lemma eq_cusp_fcn (z : ℂ) : f z = (cusp_fcn h f) (Q h z) :=
begin
  have : (cusp_fcn h f) (Q h z) = (cusp_fcn_0 h f) (Q h z),
  { rw cusp_fcn, rw function.update, split_ifs,
    { exfalso, have : Q h z ≠ 0 := by apply exp_ne_zero, exact this h_1, },
    { refl } },
  rw this,
  dsimp only [cusp_fcn_0],
  obtain ⟨m, hm⟩ := ZQ_eq_mod_period h z,
  rw hm, exact (is_periodic h f hf z m).symm,
end

end periodic_on_C

section holo_on_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))
include hf

lemma cusp_fcn_diff_at (z : ℂ) (hol_z : differentiable_at ℂ f z) :
  differentiable_at ℂ (cusp_fcn h f) (Q h z) :=
begin
  let q := Q h z,
  have qdiff : has_strict_deriv_at (Q h) (q * (2 * π * I / h)) z,
  { apply has_strict_deriv_at.cexp,
    apply has_strict_deriv_at.div_const,
    have : 2 * ↑π * I = (2 * ↑π * I) * 1 := by ring,
    conv begin congr, skip, rw this, end,
    exact has_strict_deriv_at.const_mul _ (has_strict_deriv_at_id _) },
  -- Now show that the q-map has a differentiable local inverse at z, say L : ℂ → ℂ, with L(q) = z.
  have diff_ne : (q * (2 * π * I / h)) ≠ 0,
  { apply mul_ne_zero, apply exp_ne_zero, apply div_ne_zero,
    exact two_pi_I_ne_zero, simpa using h.2.ne', },
  let L := (qdiff.local_inverse (Q h) _ z) diff_ne,
  have diff_L : differentiable_at ℂ L q := (qdiff.to_local_inverse diff_ne).differentiable_at,
  have hL : (Q h) ∘ L =ᶠ[𝓝 q] (id : ℂ → ℂ),
  { exact (qdiff.has_strict_fderiv_at_equiv diff_ne).eventually_right_inverse },
  --Thus, if F = cusp_expansion f, we have F(q') = f(L(q')) for q' near q.
  --Since L is differentiable at q, and f is diffble at L(q) [ = z], we conclude
  --that F is differentiable at q.
  have hF := eventually_eq.fun_comp hL (cusp_fcn h f), dsimp at hF,
  have : (cusp_fcn h f) ∘ (Q h) ∘ L = f ∘ L := by { ext1 z, exact (eq_cusp_fcn h f hf (L z)).symm },
  rw this at hF,
  have : z = L(q),
  { have hL2 : (L ∘ (Q h)) =ᶠ[𝓝 z] (id : ℂ → ℂ),
    { exact (qdiff.has_strict_fderiv_at_equiv diff_ne).eventually_left_inverse },
    replace hL2 := eventually_eq.eq_of_nhds hL2, dsimp at hL2, rw hL2, },
  rw this at hol_z,
  exact (differentiable_at.comp q hol_z diff_L).congr_of_eventually_eq hF.symm,
end

lemma F_diff_near_zero (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  ∀ᶠ (q : ℂ) in 𝓝[≠] 0, differentiable_at ℂ (cusp_fcn h f) q :=
begin
  refine ((Z_tendsto h).eventually h_hol).mp _,
  apply eventually_nhds_within_of_forall, intros q hq h_diff,
  rw ←(QZ_eq_id _ _ hq), exact cusp_fcn_diff_at _ _ hf _ h_diff,
end

end holo_on_C

section holo_at_inf_C

variables (h : ℝ_pos) (f : ℂ → ℂ) (hf : ∀ (w : ℂ), f(w + h) = f(w))
include hf

lemma F_bound (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) ) : is_O (𝓝[≠] (0 : ℂ)) (cusp_fcn h f) (1 : ℂ → ℂ)  :=
begin
  refine is_O.congr' (h_bd.comp_tendsto $ Z_tendsto h) _ (by refl) ,
  apply eventually_nhds_within_of_forall, intros q hq,
  rw cusp_fcn_eq_of_nonzero _ _ _ hq, refl,
end

set_option trace.simp_lemmas true

lemma F_diff_at_zero (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  differentiable_at ℂ (cusp_fcn h f) 0 :=
begin
  obtain ⟨c, t⟩ := (F_bound _ _ hf h_bd).bound,
  replace t := (F_diff_near_zero h f hf h_hol).and t,
  simp only [norm_eq_abs, pi.one_apply, absolute_value.map_one, mul_one] at t,
  obtain ⟨S, hS1, hS2, hS3⟩ := eventually_nhds_iff.mp (eventually_nhds_within_iff.mp t),
  have h_diff : differentiable_on ℂ (cusp_fcn h f) (S \ {0}),
  { intros x hx, apply differentiable_at.differentiable_within_at,
    exact (hS1 x ((set.mem_diff _).mp hx).1  ((set.mem_diff _).mp hx).2).1, },
  have hF_bd : bdd_above (norm ∘ (cusp_fcn h f) '' (S \ {0})),
  { use c, rw mem_upper_bounds, simp, intros y q hq hq2 hy, rw ←hy, exact (hS1 q hq hq2).2,},
  have := differentiable_on_update_lim_of_bdd_above (is_open.mem_nhds hS2 hS3) h_diff hF_bd,
  rw ←update_twice at this,
  exact this.differentiable_at (is_open.mem_nhds hS2 hS3),
end

/-- If `f` is periodic, and holomorphic and bounded near `I∞`, then it tends to a limit at `I∞`,
and this limit is the value of its cusp function at 0. -/
theorem tendsto_at_I_inf (h_bd : is_O at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  tendsto f at_I_inf' (𝓝 $ cusp_fcn h f 0) :=
begin
  suffices : tendsto (cusp_fcn h f) (𝓝[≠] 0) (𝓝 $ cusp_fcn h f 0),
  { have t2 : f = (cusp_fcn h f) ∘ (Q h) := by { ext1, apply eq_cusp_fcn h f hf },
    conv begin congr, rw t2, end,
    apply tendsto.comp, exact this,
    apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
    exact Q_tendsto h, apply eventually_of_forall, intro q, apply exp_ne_zero, },
  exact tendsto_nhds_within_of_tendsto_nhds (F_diff_at_zero _ _ hf h_bd h_hol).continuous_at.tendsto
end

lemma cusp_fcn_zero_of_zero_at_inf (h_bd : is_o at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) : cusp_fcn h f 0 = 0 :=
begin
  rw [cusp_fcn, function.update], split_ifs, swap, tauto,
  suffices : tendsto (cusp_fcn_0 h f) (𝓝[{0}ᶜ] 0) (𝓝 (0:ℂ)),
  { exact tendsto.lim_eq this },
  have : is_o (𝓝[≠] (0 : ℂ)) (cusp_fcn h f) 1 ,
  { refine is_o.congr' (h_bd.comp_tendsto $ Z_tendsto h) _ (by refl) ,
    apply eventually_nhds_within_of_forall, intros q hq, rw cusp_fcn_eq_of_nonzero _ _ _ hq, refl },
  have : is_o (𝓝[≠] (0 : ℂ)) (cusp_fcn_0 h f) 1,
  { refine is_o.congr' this _ (by refl), apply eventually_nhds_within_of_forall,
    apply cusp_fcn_eq_of_nonzero, },
  simpa using this.tendsto_div_nhds_zero,
end

/-- Main theorem of this file: if `f` is periodic, holomorphic near `I∞`, and tends to zero
at `I∞`, then in fact it tends to zero exponentially fast. -/
theorem exp_decay_of_zero_at_inf (h_bd : is_o at_I_inf' f (1 : ℂ → ℂ) )
  (h_hol : ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ f z) :
  is_O at_I_inf' f (λ z:ℂ, real.exp (-2 * π * im z / h))  :=
begin
  have F0 := cusp_fcn_zero_of_zero_at_inf _ _ hf h_bd h_hol,
  have : f = λ z:ℂ, (cusp_fcn h f) (Q h z) := by { ext1 z, apply eq_cusp_fcn _ _ hf,},
  conv begin congr, skip, rw this, skip, funext, rw [←(abs_Q_eq h), ←norm_eq_abs], end,
  apply is_O.norm_right,
  exact (bound_holo_fcn _ (F_diff_at_zero _ _ hf h_bd.is_O h_hol) F0).comp_tendsto (Q_tendsto h),
end

end holo_at_inf_C

/-! Now we prove corresponding results about modular forms. -/

local notation `ℍ` := upper_half_plane
local notation `SL(` n `, ` R `)`:= matrix.special_linear_group (fin n) R

instance : has_vadd ℝ ℍ :=
begin
  split, intros h z, refine ⟨z + h, _⟩, dsimp at *,
  suffices : 0 < complex.im (z + h), { exact this },
  rw [complex.add_im, complex.of_real_im, add_zero], exact z.2,
end

/-! Tedious checks that notions of holomorphic, bounded, etc are compatible with extension-by-0--/

section modform_equivs

variables {f : ℍ → ℂ} {k : ℤ}

lemma modform_bound_aux (C : ℝ) (g : ℂ → ℂ) (hc : 0 ≤ C)
  (h_bd : is_O_with C  upper_half_plane.at_im_infty f (λ z:ℍ, g z)) : is_O_with C at_I_inf' (extend_by_zero f) g  :=
begin

  rw is_O_with_iff at h_bd ⊢,
  apply eventually_of_mem,
  show {z : ℂ | abs(extend_by_zero f z) ≤ C * abs(g z)} ∈ at_I_inf',
  { rw at_I_inf'_mem,
    rw [upper_half_plane.at_im_infty, eventually_iff_exists_mem] at h_bd, obtain ⟨v, hv, h_bd⟩ := h_bd,
    rw [mem_comap', mem_at_top_sets] at hv, cases hv with a hv, use a,
   intros z hz, specialize hv (im z) (hz.le), dsimp at hv,
   rw extend_by_zero, dsimp, split_ifs,
   swap, { rw absolute_value.map_zero, refine mul_nonneg hc _, apply absolute_value.nonneg, },
   specialize h_bd ⟨z, h⟩,
   specialize h_bd (hv _), refl, exact h_bd },
  { dsimp, intros x hx, linarith, },
end

local notation f `∣[`:73 k:0, A `]`  :72 := slash_action.map ℂ k A f

lemma modform_bounded (k : ℤ) (f : ℍ → ℂ) (h_mod : modular_form_weight_k k ⊤ f) :
  is_O at_I_inf' (extend_by_zero f) (1 : ℂ → ℂ)  :=
begin
  have bd := h_mod.hol.bdd_at_infty,-- (1 : SL(2, ℤ)),
  have : f ∣[k, (1 : SL(2, ℤ))] = f, by {apply slash_action.one_mul},
  --rw [this, upper_half_plane.is_bounded_at_im_infty] at bd,
  obtain ⟨c, c_pos, bd⟩ := bd.exists_nonneg,
  exact (modform_bound_aux c 1 c_pos bd).is_O,
end

lemma modform_periodic (h_mod : modular_form_weight_k k ⊤ f) (z : ℂ) :
  (extend_by_zero f)(z + 1) = (extend_by_zero f)(z) :=
begin
  by_cases hz : 0 < im z,
  { rw (extend_by_zero_eq_of_mem f z hz),
    have : 0 < im (z + 1), {rw [add_im, one_im, add_zero], exact hz },
    rw (extend_by_zero_eq_of_mem f _ this),
    sorry,
  },
  {
    sorry,
  },

end

lemma modform_hol (h_mod : modular_form_weight_k k ⊤ f) (z : ℂ) (hz : 0 < im z) :
  differentiable_at ℂ (extend_by_zero f) z :=
begin

  sorry,
end

lemma modform_hol_infty (h_mod : modular_form_weight_k k ⊤ f) :
  ∀ᶠ (z : ℂ) in at_I_inf', differentiable_at ℂ (extend_by_zero f) z :=
begin
  refine eventually_of_mem (_ : upper_half_space ∈ at_I_inf') _,
  { rw at_I_inf'_mem, use 0, tauto, },
  { intros x hx, exact modform_hol h_mod x hx },
end

end modform_equivs

section modforms

def unit_disc_sset := {z : ℂ | z.abs <  1}

lemma unit_disc_is_open : is_open unit_disc_sset := is_open_Iio.preimage complex.continuous_abs

local notation `𝔻` := ( ⟨unit_disc_sset, unit_disc_is_open⟩ : topological_space.opens ℂ)

variables (f : ℍ → ℂ) (k : ℤ)

--lemma q_in_D (z : ℍ) : abs (Q 1 z) < 1 := by { convert (abs_q_lt_iff 1 0 z).mpr z.2, simp }

lemma z_in_H (q : 𝔻) (hq : (q : ℂ) ≠ 0) : 0 < im (Z 1 q) :=
begin
  rw im_Z_eq 1 q hq,
  apply mul_pos_of_neg_of_neg,
  { exact div_neg_of_neg_of_pos (neg_lt_zero.mpr zero_lt_one) real.two_pi_pos },
  rw real.log_neg_iff, exact q.2,
  apply absolute_value.pos, exact hq,
end

end modforms


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

import Mathlib.Tactic.Basic
import Mathlib.Tactic.Contrapose

example (p q : Prop) (h : ¬q → ¬p) : p → q := by
  contrapose
  guard_target = ¬q → ¬p
  exact h

example (p q : Prop) (h : p) (hpq : ¬q → ¬p) : q := by
  contrapose h
  guard_target = ¬p
  exact hpq h

example (p q : Prop) (h : p) (hpq : ¬q → ¬p) : q := by
  contrapose h with h'
  guard_target = ¬p
  exact hpq h'

example (p q : Prop) (h : q → p) : ¬p → ¬q := by
  contrapose!
  guard_target = q → p
  exact h

example (p q : Prop) (h : ¬p) (hpq : q → p) : ¬q := by
  contrapose! h
  guard_target = p
  exact hpq h

example (p q : Prop) (h : ¬p) (hpq : q → p) : ¬q := by
  contrapose! h with h'
  guard_target = p
  exact hpq h'

example (p : Prop) (h : p) : p := by
  fail_if_success { contrapose }
  exact h

example (p q : Type) (h : p → q) : p → q := by
  fail_if_success { contrapose }
  exact h


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.monomial
import Mathlib.data.finset.nat_antidiagonal
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# Theory of univariate polynomials

The theorems include formulas for computing coefficients, such as
`coeff_add`, `coeff_sum`, `coeff_mul`

-/

namespace polynomial

theorem coeff_one {R : Type u} [semiring R] (n : ℕ) : coeff 1 n = ite (0 = n) 1 0 := coeff_monomial

@[simp] theorem coeff_add {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) (n : ℕ) :
    coeff (p + q) n = coeff p n + coeff q n :=
  rfl

theorem coeff_sum {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S] (n : ℕ)
    (f : ℕ → R → polynomial S) :
    coeff (finsupp.sum p f) n = finsupp.sum p fun (a : ℕ) (b : R) => coeff (f a b) n :=
  finsupp.sum_apply

@[simp] theorem coeff_smul {R : Type u} [semiring R] (p : polynomial R) (r : R) (n : ℕ) :
    coeff (r • p) n = r * coeff p n :=
  finsupp.smul_apply

theorem mem_support_iff_coeff_ne_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} :
    n ∈ finsupp.support p ↔ coeff p n ≠ 0 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (n ∈ finsupp.support p ↔ coeff p n ≠ 0))
        (propext (finsupp.mem_support_to_fun p n))))
    (iff.refl (finsupp.to_fun p n ≠ 0))

theorem not_mem_support_iff_coeff_zero {R : Type u} {n : ℕ} [semiring R] {p : polynomial R} :
    ¬n ∈ finsupp.support p ↔ coeff p n = 0 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (¬n ∈ finsupp.support p ↔ coeff p n = 0))
        (propext (finsupp.mem_support_to_fun p n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬finsupp.to_fun p n ≠ 0 ↔ coeff p n = 0)) (propext not_not)))
      (iff.refl (finsupp.to_fun p n = 0)))

/-- The nth coefficient, as a linear map. -/
def lcoeff (R : Type u) [semiring R] (n : ℕ) : linear_map R (polynomial R) R := finsupp.lapply n

@[simp] theorem lcoeff_apply {R : Type u} [semiring R] (n : ℕ) (f : polynomial R) :
    coe_fn (lcoeff R n) f = coeff f n :=
  rfl

@[simp] theorem finset_sum_coeff {R : Type u} [semiring R] {ι : Type u_1} (s : finset ι)
    (f : ι → polynomial R) (n : ℕ) :
    coeff (finset.sum s fun (b : ι) => f b) n = finset.sum s fun (b : ι) => coeff (f b) n :=
  Eq.symm (finset.sum_hom s fun (q : polynomial R) => coe_fn (lcoeff R n) q)

theorem coeff_mul {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) (n : ℕ) :
    coeff (p * q) n =
        finset.sum (finset.nat.antidiagonal n)
          fun (x : ℕ × ℕ) => coeff p (prod.fst x) * coeff q (prod.snd x) :=
  add_monoid_algebra.mul_apply_antidiagonal p q n (finset.nat.antidiagonal n)
    fun (x : ℕ × ℕ) => finset.nat.mem_antidiagonal

@[simp] theorem mul_coeff_zero {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) :
    coeff (p * q) 0 = coeff p 0 * coeff q 0 :=
  sorry

theorem coeff_mul_X_zero {R : Type u} [semiring R] (p : polynomial R) : coeff (p * X) 0 = 0 := sorry

theorem coeff_X_mul_zero {R : Type u} [semiring R] (p : polynomial R) : coeff (X * p) 0 = 0 := sorry

theorem coeff_C_mul_X {R : Type u} [semiring R] (x : R) (k : ℕ) (n : ℕ) :
    coeff (coe_fn C x * X ^ k) n = ite (n = k) x 0 :=
  sorry

@[simp] theorem coeff_C_mul {R : Type u} {a : R} {n : ℕ} [semiring R] (p : polynomial R) :
    coeff (coe_fn C a * p) n = a * coeff p n :=
  add_monoid_algebra.single_zero_mul_apply p a n

theorem C_mul' {R : Type u} [semiring R] (a : R) (f : polynomial R) : coe_fn C a * f = a • f :=
  ext fun (n : ℕ) => coeff_C_mul f

@[simp] theorem coeff_mul_C {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) (a : R) :
    coeff (p * coe_fn C a) n = coeff p n * a :=
  add_monoid_algebra.mul_single_zero_apply p a n

theorem coeff_X_pow {R : Type u} [semiring R] (k : ℕ) (n : ℕ) : coeff (X ^ k) n = ite (n = k) 1 0 :=
  sorry

@[simp] theorem coeff_X_pow_self {R : Type u} [semiring R] (n : ℕ) : coeff (X ^ n) n = 1 := sorry

theorem coeff_mul_X_pow {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) (d : ℕ) :
    coeff (p * X ^ n) (d + n) = coeff p d :=
  sorry

@[simp] theorem coeff_mul_X {R : Type u} [semiring R] (p : polynomial R) (n : ℕ) :
    coeff (p * X) (n + 1) = coeff p n :=
  sorry

theorem mul_X_pow_eq_zero {R : Type u} [semiring R] {p : polynomial R} {n : ℕ} (H : p * X ^ n = 0) :
    p = 0 :=
  ext fun (k : ℕ) => Eq.trans (Eq.symm (coeff_mul_X_pow p n k)) (iff.mp ext_iff H (k + n))

theorem C_mul_X_pow_eq_monomial {R : Type u} [semiring R] (c : R) (n : ℕ) :
    coe_fn C c * X ^ n = coe_fn (monomial n) c :=
  sorry

theorem support_mul_X_pow {R : Type u} [semiring R] (c : R) (n : ℕ) (H : c ≠ 0) :
    finsupp.support (coe_fn C c * X ^ n) = singleton n :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (finsupp.support (coe_fn C c * X ^ n) = singleton n))
        (C_mul_X_pow_eq_monomial c n)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (finsupp.support (coe_fn (monomial n) c) = singleton n))
          (support_monomial n c H)))
      (Eq.refl (singleton n)))

theorem support_C_mul_X_pow' {R : Type u} [semiring R] {c : R} {n : ℕ} :
    finsupp.support (coe_fn C c * X ^ n) ⊆ singleton n :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (finsupp.support (coe_fn C c * X ^ n) ⊆ singleton n))
        (C_mul_X_pow_eq_monomial c n)))
    (support_monomial' n c)

theorem C_dvd_iff_dvd_coeff {R : Type u} [semiring R] (r : R) (φ : polynomial R) :
    coe_fn C r ∣ φ ↔ ∀ (i : ℕ), r ∣ coeff φ i :=
  sorry

/--  If the coefficients of a polynomial belong to n ideal contains the submodule span of the
coefficients of a polynomial. -/
theorem span_le_of_coeff_mem_C_inverse {R : Type u} [semiring R] {f : polynomial R}
    {I : submodule (polynomial R) (polynomial R)}
    (cf : ∀ (i : ℕ), coeff f i ∈ ⇑C ⁻¹' submodule.carrier I) :
    submodule.span (polynomial R)
          (set_of fun (g : polynomial R) => ∃ (i : ℕ), g = coe_fn C (coeff f i)) ≤
        I :=
  sorry

theorem mem_span_C_coeff {R : Type u} [semiring R] {f : polynomial R} :
    f ∈
        submodule.span (polynomial R)
          (set_of fun (g : polynomial R) => ∃ (i : ℕ), g = coe_fn C (coeff f i)) :=
  sorry

theorem exists_coeff_not_mem_C_inverse {R : Type u} [semiring R] {f : polynomial R}
    {I : submodule (polynomial R) (polynomial R)} :
    ¬f ∈ I → ∃ (i : ℕ), ¬coeff f i ∈ ⇑C ⁻¹' submodule.carrier I :=
  imp_of_not_imp_not (¬f ∈ I) (∃ (i : ℕ), ¬coeff f i ∈ ⇑C ⁻¹' submodule.carrier I)
    fun (cf : ¬∃ (i : ℕ), ¬coeff f i ∈ ⇑C ⁻¹' submodule.carrier I) =>
      iff.mpr not_not (span_le_of_coeff_mem_C_inverse (iff.mp not_exists_not cf) mem_span_C_coeff)

end Mathlib


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

! This file was ported from Lean 3 source module algebra.order.interval
! leanprover-community/mathlib commit 9114ddffa023340c9ec86965e00cdd6fe26fcdf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Order
import Mathbin.Algebra.Group.Prod
import Mathbin.Data.Option.NAry
import Mathbin.Data.Set.Pointwise.Basic
import Mathbin.Order.Interval
import Mathbin.Tactic.Positivity

/-!
# Interval arithmetic

This file defines arithmetic operations on intervals and prove their correctness. Note that this is
full precision operations. The essentials of float operations can be found
in `data.fp.basic`. We hsve not yet integrated these with the rest of the library.
-/

open Function Set

open BigOperators Pointwise

universe u

variable {ι α : Type _}

/-! ### One/zero -/

section One

section Preorder

variable [Preorder α] [One α]

@[to_additive]
instance : One (NonemptyInterval α) :=
  ⟨NonemptyInterval.pure 1⟩

@[to_additive]
instance : One (Interval α) :=
  ⟨Interval.pure 1⟩

namespace NonemptyInterval

@[simp, to_additive to_prod_zero]
theorem toProd_one : (1 : NonemptyInterval α).toProd = 1 :=
  rfl
#align nonempty_interval.to_prod_one NonemptyInterval.toProd_one
#align nonempty_interval.to_prod_zero NonemptyInterval.toProd_zero

@[to_additive]
theorem fst_one : (1 : NonemptyInterval α).fst = 1 :=
  rfl
#align nonempty_interval.fst_one NonemptyInterval.fst_one
#align nonempty_interval.fst_zero NonemptyInterval.fst_zero

@[to_additive]
theorem snd_one : (1 : NonemptyInterval α).snd = 1 :=
  rfl
#align nonempty_interval.snd_one NonemptyInterval.snd_one
#align nonempty_interval.snd_zero NonemptyInterval.snd_zero

@[simp, norm_cast, to_additive]
theorem coe_one_interval : ((1 : NonemptyInterval α) : Interval α) = 1 :=
  rfl
#align nonempty_interval.coe_one_interval NonemptyInterval.coe_one_interval
#align nonempty_interval.coe_zero_interval NonemptyInterval.coe_zero_interval

@[simp, to_additive]
theorem pure_one : pure (1 : α) = 1 :=
  rfl
#align nonempty_interval.pure_one NonemptyInterval.pure_one
#align nonempty_interval.pure_zero NonemptyInterval.pure_zero

end NonemptyInterval

namespace Interval

@[simp, to_additive]
theorem pure_one : pure (1 : α) = 1 :=
  rfl
#align interval.pure_one Interval.pure_one
#align interval.pure_zero Interval.pure_zero

@[simp, to_additive]
theorem one_ne_bot : (1 : Interval α) ≠ ⊥ :=
  pure_ne_bot
#align interval.one_ne_bot Interval.one_ne_bot
#align interval.zero_ne_bot Interval.zero_ne_bot

@[simp, to_additive]
theorem bot_ne_one : (⊥ : Interval α) ≠ 1 :=
  bot_ne_pure
#align interval.bot_ne_one Interval.bot_ne_one
#align interval.bot_ne_zero Interval.bot_ne_zero

end Interval

end Preorder

section PartialOrder

variable [PartialOrder α] [One α]

namespace NonemptyInterval

@[simp, to_additive]
theorem coe_one : ((1 : NonemptyInterval α) : Set α) = 1 :=
  coe_pure _
#align nonempty_interval.coe_one NonemptyInterval.coe_one
#align nonempty_interval.coe_zero NonemptyInterval.coe_zero

@[to_additive]
theorem one_mem_one : (1 : α) ∈ (1 : NonemptyInterval α) :=
  ⟨le_rfl, le_rfl⟩
#align nonempty_interval.one_mem_one NonemptyInterval.one_mem_one
#align nonempty_interval.zero_mem_zero NonemptyInterval.zero_mem_zero

end NonemptyInterval

namespace Interval

@[simp, to_additive]
theorem coe_one : ((1 : Interval α) : Set α) = 1 :=
  Icc_self _
#align interval.coe_one Interval.coe_one
#align interval.coe_zero Interval.coe_zero

@[to_additive]
theorem one_mem_one : (1 : α) ∈ (1 : Interval α) :=
  ⟨le_rfl, le_rfl⟩
#align interval.one_mem_one Interval.one_mem_one
#align interval.zero_mem_zero Interval.zero_mem_zero

end Interval

end PartialOrder

end One

/-!
### Addition/multiplication

Note that this multiplication does not apply to `ℚ` or `ℝ`.
-/

section Mul

variable [Preorder α] [Mul α] [CovariantClass α α (· * ·) (· ≤ ·)]
  [CovariantClass α α (swap (· * ·)) (· ≤ ·)]

@[to_additive]
instance : Mul (NonemptyInterval α) :=
  ⟨fun s t => ⟨s.toProd * t.toProd, mul_le_mul' s.fst_le_snd t.fst_le_snd⟩⟩

@[to_additive]
instance : Mul (Interval α) :=
  ⟨Option.map₂ (· * ·)⟩

namespace NonemptyInterval

variable (s t : NonemptyInterval α) (a b : α)

@[simp, to_additive to_prod_add]
theorem toProd_mul : (s * t).toProd = s.toProd * t.toProd :=
  rfl
#align nonempty_interval.to_prod_mul NonemptyInterval.toProd_mul
#align nonempty_interval.to_prod_add NonemptyInterval.toProd_add

@[to_additive]
theorem fst_mul : (s * t).fst = s.fst * t.fst :=
  rfl
#align nonempty_interval.fst_mul NonemptyInterval.fst_mul
#align nonempty_interval.fst_add NonemptyInterval.fst_add

@[to_additive]
theorem snd_mul : (s * t).snd = s.snd * t.snd :=
  rfl
#align nonempty_interval.snd_mul NonemptyInterval.snd_mul
#align nonempty_interval.snd_add NonemptyInterval.snd_add

@[simp, to_additive]
theorem coe_mul_interval : (↑(s * t) : Interval α) = s * t :=
  rfl
#align nonempty_interval.coe_mul_interval NonemptyInterval.coe_mul_interval
#align nonempty_interval.coe_add_interval NonemptyInterval.coe_add_interval

@[simp, to_additive]
theorem pure_mul_pure : pure a * pure b = pure (a * b) :=
  rfl
#align nonempty_interval.pure_mul_pure NonemptyInterval.pure_mul_pure
#align nonempty_interval.pure_add_pure NonemptyInterval.pure_add_pure

end NonemptyInterval

namespace Interval

variable (s t : Interval α)

@[simp, to_additive]
theorem bot_mul : ⊥ * t = ⊥ :=
  rfl
#align interval.bot_mul Interval.bot_mul
#align interval.bot_add Interval.bot_add

@[simp, to_additive]
theorem mul_bot : s * ⊥ = ⊥ :=
  Option.map₂_none_right _ _
#align interval.mul_bot Interval.mul_bot
#align interval.add_bot Interval.add_bot

end Interval

end Mul

/-! ### Powers -/

-- TODO: if `to_additive` gets improved sufficiently, derive this from `has_pow`
instance NonemptyInterval.hasNsmul [AddMonoid α] [Preorder α] [CovariantClass α α (· + ·) (· ≤ ·)]
    [CovariantClass α α (swap (· + ·)) (· ≤ ·)] : SMul ℕ (NonemptyInterval α) :=
  ⟨fun n s => ⟨(n • s.fst, n • s.snd), nsmul_le_nsmul_of_le_right s.fst_le_snd _⟩⟩
#align nonempty_interval.has_nsmul NonemptyInterval.hasNsmul

section Pow

variable [Monoid α] [Preorder α] [CovariantClass α α (· * ·) (· ≤ ·)]
  [CovariantClass α α (swap (· * ·)) (· ≤ ·)]

@[to_additive NonemptyInterval.hasNsmul]
instance NonemptyInterval.hasPow : Pow (NonemptyInterval α) ℕ :=
  ⟨fun s n => ⟨s.toProd ^ n, pow_le_pow_of_le_left' s.fst_le_snd _⟩⟩
#align nonempty_interval.has_pow NonemptyInterval.hasPow
#align nonempty_interval.has_nsmul NonemptyInterval.hasNsmul

namespace NonemptyInterval

variable (s : NonemptyInterval α) (a : α) (n : ℕ)

@[simp, to_additive to_prod_nsmul]
theorem toProd_pow : (s ^ n).toProd = s.toProd ^ n :=
  rfl
#align nonempty_interval.to_prod_pow NonemptyInterval.toProd_pow
#align nonempty_interval.to_prod_nsmul NonemptyInterval.toProd_nsmul

@[to_additive]
theorem fst_pow : (s ^ n).fst = s.fst ^ n :=
  rfl
#align nonempty_interval.fst_pow NonemptyInterval.fst_pow
#align nonempty_interval.fst_nsmul NonemptyInterval.fst_nsmul

@[to_additive]
theorem snd_pow : (s ^ n).snd = s.snd ^ n :=
  rfl
#align nonempty_interval.snd_pow NonemptyInterval.snd_pow
#align nonempty_interval.snd_nsmul NonemptyInterval.snd_nsmul

@[simp, to_additive]
theorem pure_pow : pure a ^ n = pure (a ^ n) :=
  rfl
#align nonempty_interval.pure_pow NonemptyInterval.pure_pow
#align nonempty_interval.pure_nsmul NonemptyInterval.pure_nsmul

end NonemptyInterval

end Pow

namespace NonemptyInterval

@[to_additive]
instance [OrderedCommMonoid α] : CommMonoid (NonemptyInterval α) :=
  NonemptyInterval.toProd_injective.CommMonoid _ toProd_one toProd_mul toProd_pow

end NonemptyInterval

@[to_additive]
instance [OrderedCommMonoid α] : MulOneClass (Interval α)
    where
  mul := (· * ·)
  one := 1
  one_mul s :=
    (Option.map₂_coe_left _ _ _).trans <| by
      simp only [NonemptyInterval.pure_one, one_mul, ← id_def, Option.map_id, id]
  mul_one s :=
    (Option.map₂_coe_right _ _ _).trans <| by
      simp only [NonemptyInterval.pure_one, mul_one, ← id_def, Option.map_id, id]

@[to_additive]
instance [OrderedCommMonoid α] : CommMonoid (Interval α) :=
  {
    Interval.mulOneClass with
    mul_comm := fun _ _ => Option.map₂_comm mul_comm
    mul_assoc := fun _ _ _ => Option.map₂_assoc mul_assoc }

namespace NonemptyInterval

@[simp, to_additive]
theorem coe_pow_interval [OrderedCommMonoid α] (s : NonemptyInterval α) (n : ℕ) :
    (↑(s ^ n) : Interval α) = s ^ n :=
  map_pow (⟨coe, coe_one_interval, coe_mul_interval⟩ : NonemptyInterval α →* Interval α) _ _
#align nonempty_interval.coe_pow_interval NonemptyInterval.coe_pow_interval
#align nonempty_interval.coe_nsmul_interval NonemptyInterval.coe_nsmul_interval

end NonemptyInterval

namespace Interval

variable [OrderedCommMonoid α] (s : Interval α) {n : ℕ}

@[to_additive]
theorem bot_pow : ∀ {n : ℕ} (hn : n ≠ 0), (⊥ : Interval α) ^ n = ⊥
  | 0, h => (h rfl).elim
  | Nat.succ n, _ => bot_mul (⊥ ^ n)
#align interval.bot_pow Interval.bot_pow
#align interval.bot_nsmul Interval.bot_nsmul

end Interval

/-!
### Subtraction

Subtraction is defined more generally than division so that it applies to `ℕ` (and `has_ordered_div`
is not a thing and probably should not become one).
-/

section Sub

variable [Preorder α] [AddCommSemigroup α] [Sub α] [OrderedSub α]
  [CovariantClass α α (· + ·) (· ≤ ·)]

instance : Sub (NonemptyInterval α) :=
  ⟨fun s t => ⟨(s.fst - t.snd, s.snd - t.fst), tsub_le_tsub s.fst_le_snd t.fst_le_snd⟩⟩

instance : Sub (Interval α) :=
  ⟨Option.map₂ Sub.sub⟩

namespace NonemptyInterval

variable (s t : NonemptyInterval α) {a b : α}

@[simp]
theorem fst_sub : (s - t).fst = s.fst - t.snd :=
  rfl
#align nonempty_interval.fst_sub NonemptyInterval.fst_sub

@[simp]
theorem snd_sub : (s - t).snd = s.snd - t.fst :=
  rfl
#align nonempty_interval.snd_sub NonemptyInterval.snd_sub

@[simp]
theorem coe_sub_interval : (↑(s - t) : Interval α) = s - t :=
  rfl
#align nonempty_interval.coe_sub_interval NonemptyInterval.coe_sub_interval

theorem sub_mem_sub (ha : a ∈ s) (hb : b ∈ t) : a - b ∈ s - t :=
  ⟨tsub_le_tsub ha.1 hb.2, tsub_le_tsub ha.2 hb.1⟩
#align nonempty_interval.sub_mem_sub NonemptyInterval.sub_mem_sub

@[simp]
theorem pure_sub_pure (a b : α) : pure a - pure b = pure (a - b) :=
  rfl
#align nonempty_interval.pure_sub_pure NonemptyInterval.pure_sub_pure

end NonemptyInterval

namespace Interval

variable (s t : Interval α)

@[simp]
theorem bot_sub : ⊥ - t = ⊥ :=
  rfl
#align interval.bot_sub Interval.bot_sub

@[simp]
theorem sub_bot : s - ⊥ = ⊥ :=
  Option.map₂_none_right _ _
#align interval.sub_bot Interval.sub_bot

end Interval

end Sub

/-!
### Division in ordered groups

Note that this division does not apply to `ℚ` or `ℝ`.
-/

section Div

variable [Preorder α] [CommGroup α] [CovariantClass α α (· * ·) (· ≤ ·)]

@[to_additive]
instance : Div (NonemptyInterval α) :=
  ⟨fun s t => ⟨(s.fst / t.snd, s.snd / t.fst), div_le_div'' s.fst_le_snd t.fst_le_snd⟩⟩

@[to_additive]
instance : Div (Interval α) :=
  ⟨Option.map₂ (· / ·)⟩

namespace NonemptyInterval

variable (s t : NonemptyInterval α) (a b : α)

@[simp, to_additive]
theorem fst_div : (s / t).fst = s.fst / t.snd :=
  rfl
#align nonempty_interval.fst_div NonemptyInterval.fst_div
#align nonempty_interval.fst_sub NonemptyInterval.fst_sub

@[simp, to_additive]
theorem snd_div : (s / t).snd = s.snd / t.fst :=
  rfl
#align nonempty_interval.snd_div NonemptyInterval.snd_div
#align nonempty_interval.snd_sub NonemptyInterval.snd_sub

@[simp, to_additive]
theorem coe_div_interval : (↑(s / t) : Interval α) = s / t :=
  rfl
#align nonempty_interval.coe_div_interval NonemptyInterval.coe_div_interval
#align nonempty_interval.coe_sub_interval NonemptyInterval.coe_sub_interval

@[to_additive]
theorem div_mem_div (ha : a ∈ s) (hb : b ∈ t) : a / b ∈ s / t :=
  ⟨div_le_div'' ha.1 hb.2, div_le_div'' ha.2 hb.1⟩
#align nonempty_interval.div_mem_div NonemptyInterval.div_mem_div
#align nonempty_interval.sub_mem_sub NonemptyInterval.sub_mem_sub

@[simp, to_additive]
theorem pure_div_pure : pure a / pure b = pure (a / b) :=
  rfl
#align nonempty_interval.pure_div_pure NonemptyInterval.pure_div_pure
#align nonempty_interval.pure_sub_pure NonemptyInterval.pure_sub_pure

end NonemptyInterval

namespace Interval

variable (s t : Interval α)

@[simp, to_additive]
theorem bot_div : ⊥ / t = ⊥ :=
  rfl
#align interval.bot_div Interval.bot_div
#align interval.bot_sub Interval.bot_sub

@[simp, to_additive]
theorem div_bot : s / ⊥ = ⊥ :=
  Option.map₂_none_right _ _
#align interval.div_bot Interval.div_bot
#align interval.sub_bot Interval.sub_bot

end Interval

end Div

/-! ### Negation/inversion -/

section Inv

variable [OrderedCommGroup α]

@[to_additive]
instance : Inv (NonemptyInterval α) :=
  ⟨fun s => ⟨(s.snd⁻¹, s.fst⁻¹), inv_le_inv' s.fst_le_snd⟩⟩

@[to_additive]
instance : Inv (Interval α) :=
  ⟨Option.map Inv.inv⟩

namespace NonemptyInterval

variable (s t : NonemptyInterval α) (a : α)

@[simp, to_additive]
theorem fst_inv : s⁻¹.fst = s.snd⁻¹ :=
  rfl
#align nonempty_interval.fst_inv NonemptyInterval.fst_inv
#align nonempty_interval.fst_neg NonemptyInterval.fst_neg

@[simp, to_additive]
theorem snd_inv : s⁻¹.snd = s.fst⁻¹ :=
  rfl
#align nonempty_interval.snd_inv NonemptyInterval.snd_inv
#align nonempty_interval.snd_neg NonemptyInterval.snd_neg

@[simp, to_additive]
theorem coe_inv_interval : (↑s⁻¹ : Interval α) = s⁻¹ :=
  rfl
#align nonempty_interval.coe_inv_interval NonemptyInterval.coe_inv_interval
#align nonempty_interval.coe_neg_interval NonemptyInterval.coe_neg_interval

@[to_additive]
theorem inv_mem_inv (ha : a ∈ s) : a⁻¹ ∈ s⁻¹ :=
  ⟨inv_le_inv' ha.2, inv_le_inv' ha.1⟩
#align nonempty_interval.inv_mem_inv NonemptyInterval.inv_mem_inv
#align nonempty_interval.neg_mem_neg NonemptyInterval.neg_mem_neg

@[simp, to_additive]
theorem inv_pure : (pure a)⁻¹ = pure a⁻¹ :=
  rfl
#align nonempty_interval.inv_pure NonemptyInterval.inv_pure
#align nonempty_interval.neg_pure NonemptyInterval.neg_pure

end NonemptyInterval

@[simp, to_additive]
theorem Interval.inv_bot : (⊥ : Interval α)⁻¹ = ⊥ :=
  rfl
#align interval.inv_bot Interval.inv_bot
#align interval.neg_bot Interval.neg_bot

end Inv

namespace NonemptyInterval

variable [OrderedCommGroup α] {s t : NonemptyInterval α}

@[to_additive]
protected theorem mul_eq_one_iff : s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 :=
  by
  refine' ⟨fun h => _, _⟩
  · rw [ext_iff, Prod.ext_iff] at h
    have := (mul_le_mul_iff_of_ge s.fst_le_snd t.fst_le_snd).1 (h.2.trans h.1.symm).le
    refine' ⟨s.fst, t.fst, _, _, h.1⟩ <;> ext <;> try rfl
    exacts[this.1.symm, this.2.symm]
  · rintro ⟨b, c, rfl, rfl, h⟩
    rw [pure_mul_pure, h, pure_one]
#align nonempty_interval.mul_eq_one_iff NonemptyInterval.mul_eq_one_iff
#align nonempty_interval.add_eq_zero_iff NonemptyInterval.add_eq_zero_iff

instance {α : Type u} [OrderedAddCommGroup α] : SubtractionCommMonoid (NonemptyInterval α) :=
  { NonemptyInterval.addCommMonoid with
    neg := Neg.neg
    sub := Sub.sub
    sub_eq_add_neg := fun s t => by ext <;> exact sub_eq_add_neg _ _
    neg_neg := fun s => by ext <;> exact neg_neg _
    neg_add_rev := fun s t => by ext <;> exact neg_add_rev _ _
    neg_eq_of_add := fun s t h =>
      by
      obtain ⟨a, b, rfl, rfl, hab⟩ := NonemptyInterval.add_eq_zero_iff.1 h
      rw [neg_pure, neg_eq_of_add_eq_zero_right hab] }

@[to_additive NonemptyInterval.subtractionCommMonoid]
instance : DivisionCommMonoid (NonemptyInterval α) :=
  { NonemptyInterval.commMonoid with
    inv := Inv.inv
    div := (· / ·)
    div_eq_mul_inv := fun s t => by ext <;> exact div_eq_mul_inv _ _
    inv_inv := fun s => by ext <;> exact inv_inv _
    mul_inv_rev := fun s t => by ext <;> exact mul_inv_rev _ _
    inv_eq_of_mul := fun s t h =>
      by
      obtain ⟨a, b, rfl, rfl, hab⟩ := NonemptyInterval.mul_eq_one_iff.1 h
      rw [inv_pure, inv_eq_of_mul_eq_one_right hab] }

end NonemptyInterval

namespace Interval

variable [OrderedCommGroup α] {s t : Interval α}

@[to_additive]
protected theorem mul_eq_one_iff : s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 :=
  by
  cases s
  · simp [WithBot.none_eq_bot]
  cases t
  · simp [WithBot.none_eq_bot]
  · simp [WithBot.some_eq_coe, ← NonemptyInterval.coe_mul_interval, NonemptyInterval.mul_eq_one_iff]
#align interval.mul_eq_one_iff Interval.mul_eq_one_iff
#align interval.add_eq_zero_iff Interval.add_eq_zero_iff

instance {α : Type u} [OrderedAddCommGroup α] : SubtractionCommMonoid (Interval α) :=
  { Interval.addCommMonoid with
    neg := Neg.neg
    sub := Sub.sub
    sub_eq_add_neg := by
      rintro (_ | s) (_ | t) <;> first |rfl|exact congr_arg some (sub_eq_add_neg _ _)
    neg_neg := by rintro (_ | s) <;> first |rfl|exact congr_arg some (neg_neg _)
    neg_add_rev := by rintro (_ | s) (_ | t) <;> first |rfl|exact congr_arg some (neg_add_rev _ _)
    neg_eq_of_add := by
      rintro (_ | s) (_ | t) h <;>
        first
          |cases h|exact congr_arg some (neg_eq_of_add_eq_zero_right <| Option.some_injective _ h) }

@[to_additive Interval.subtractionCommMonoid]
instance : DivisionCommMonoid (Interval α) :=
  { Interval.commMonoid with
    inv := Inv.inv
    div := (· / ·)
    div_eq_mul_inv := by
      rintro (_ | s) (_ | t) <;> first |rfl|exact congr_arg some (div_eq_mul_inv _ _)
    inv_inv := by rintro (_ | s) <;> first |rfl|exact congr_arg some (inv_inv _)
    mul_inv_rev := by rintro (_ | s) (_ | t) <;> first |rfl|exact congr_arg some (mul_inv_rev _ _)
    inv_eq_of_mul := by
      rintro (_ | s) (_ | t) h <;>
        first
          |cases h|exact congr_arg some (inv_eq_of_mul_eq_one_right <| Option.some_injective _ h) }

end Interval

section Length

variable [OrderedAddCommGroup α]

namespace NonemptyInterval

variable (s t : NonemptyInterval α) (a : α)

/-- The length of an interval is its first component minus its second component. This measures the
accuracy of the approximation by an interval. -/
def length : α :=
  s.snd - s.fst
#align nonempty_interval.length NonemptyInterval.length

@[simp]
theorem length_nonneg : 0 ≤ s.length :=
  sub_nonneg_of_le s.fst_le_snd
#align nonempty_interval.length_nonneg NonemptyInterval.length_nonneg

@[simp]
theorem length_pure : (pure a).length = 0 :=
  sub_self _
#align nonempty_interval.length_pure NonemptyInterval.length_pure

@[simp]
theorem length_zero : (0 : NonemptyInterval α).length = 0 :=
  length_pure _
#align nonempty_interval.length_zero NonemptyInterval.length_zero

@[simp]
theorem length_neg : (-s).length = s.length :=
  neg_sub_neg _ _
#align nonempty_interval.length_neg NonemptyInterval.length_neg

@[simp]
theorem length_add : (s + t).length = s.length + t.length :=
  add_sub_add_comm _ _ _ _
#align nonempty_interval.length_add NonemptyInterval.length_add

@[simp]
theorem length_sub : (s - t).length = s.length + t.length := by simp [sub_eq_add_neg]
#align nonempty_interval.length_sub NonemptyInterval.length_sub

@[simp]
theorem length_sum (f : ι → NonemptyInterval α) (s : Finset ι) :
    (∑ i in s, f i).length = ∑ i in s, (f i).length :=
  map_sum (⟨length, length_zero, length_add⟩ : NonemptyInterval α →+ α) _ _
#align nonempty_interval.length_sum NonemptyInterval.length_sum

end NonemptyInterval

namespace Interval

variable (s t : Interval α) (a : α)

/-- The length of an interval is its first component minus its second component. This measures the
accuracy of the approximation by an interval. -/
def length : Interval α → α
  | ⊥ => 0
  | (s : NonemptyInterval α) => s.length
#align interval.length Interval.length

@[simp]
theorem length_nonneg : ∀ s : Interval α, 0 ≤ s.length
  | ⊥ => le_rfl
  | (s : NonemptyInterval α) => s.length_nonneg
#align interval.length_nonneg Interval.length_nonneg

@[simp]
theorem length_pure : (pure a).length = 0 :=
  NonemptyInterval.length_pure _
#align interval.length_pure Interval.length_pure

@[simp]
theorem length_zero : (0 : Interval α).length = 0 :=
  length_pure _
#align interval.length_zero Interval.length_zero

@[simp]
theorem length_neg : ∀ s : Interval α, (-s).length = s.length
  | ⊥ => rfl
  | (s : NonemptyInterval α) => s.length_neg
#align interval.length_neg Interval.length_neg

theorem length_add_le : ∀ s t : Interval α, (s + t).length ≤ s.length + t.length
  | ⊥, _ => by simp
  | _, ⊥ => by simp
  | (s : NonemptyInterval α), (t : NonemptyInterval α) => (s.length_add t).le
#align interval.length_add_le Interval.length_add_le

theorem length_sub_le : (s - t).length ≤ s.length + t.length := by
  simpa [sub_eq_add_neg] using length_add_le s (-t)
#align interval.length_sub_le Interval.length_sub_le

theorem length_sum_le (f : ι → Interval α) (s : Finset ι) :
    (∑ i in s, f i).length ≤ ∑ i in s, (f i).length :=
  Finset.le_sum_of_subadditive _ length_zero length_add_le _ _
#align interval.length_sum_le Interval.length_sum_le

end Interval

end Length

namespace Tactic

open Positivity

/-- Extension for the `positivity` tactic: The length of an interval is always nonnegative. -/
@[positivity]
unsafe def positivity_interval_length : expr → tactic strictness
  | q(NonemptyInterval.length $(s)) => nonnegative <$> mk_app `nonempty_interval.length_nonneg [s]
  | q(Interval.length $(s)) => nonnegative <$> mk_app `interval.length_nonneg [s]
  | e =>
    pp e >>=
      fail ∘
        format.bracket "The expression `"
          "` isn't of the form `nonempty_interval.length s` or `interval.length s`"
#align tactic.positivity_interval_length tactic.positivity_interval_length

end Tactic


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

! This file was ported from Lean 3 source module data.zmod.defs
! leanprover-community/mathlib commit 63f84d91dd847f50bae04a01071f3a5491934e36
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.NeZero
import Mathbin.Data.Nat.Modeq
import Mathbin.Data.Fintype.Lattice

/-!
# Definition of `zmod n` + basic results.

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

This file provides the basic details of `zmod n`, including its commutative ring structure.

## Implementation details

This used to be inlined into data/zmod/basic.lean. This file imports `char_p/basic`, which is an
issue; all `char_p` instances create an `algebra (zmod p) R` instance; however, this instance may
not be definitionally equal to other `algebra` instances (for example, `galois_field` also has an
`algebra` instance as it is defined as a `splitting_field`). The way to fix this is to use the
forgetful inheritance pattern, and make `char_p` carry the data of what the `smul` should be (so
for example, the `smul` on the `galois_field` `char_p` instance should be equal to the `smul` from
its `splitting_field` structure); there is only one possible `zmod p` algebra for any `p`, so this
is not an issue mathematically. For this to be possible, however, we need `char_p/basic` to be
able to import some part of `zmod`.

-/

namespace Fin

/-!
## Ring structure on `fin n`

We define a commutative ring structure on `fin n`, but we do not register it as instance.
Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
to register the ring structure on `zmod n` as type class instance.
-/

open Nat.ModEq Int

/-- Multiplicative commutative semigroup structure on `fin n`. -/
instance (n : ℕ) : CommSemigroup (Fin n) :=
  {
    Fin.hasMul with
    mul_assoc := fun ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩ =>
      Fin.eq_of_veq
        (calc
          a * b % n * c ≡ a * b * c [MOD n] := (Nat.mod_modEq _ _).mul_right _
          _ ≡ a * (b * c) [MOD n] := by rw [mul_assoc]
          _ ≡ a * (b * c % n) [MOD n] := (Nat.mod_modEq _ _).symm.mul_left _
          )
    mul_comm := Fin.mul_comm }

private theorem left_distrib_aux (n : ℕ) : ∀ a b c : Fin n, a * (b + c) = a * b + a * c :=
  fun ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩ =>
  Fin.eq_of_veq
    (calc
      a * ((b + c) % n) ≡ a * (b + c) [MOD n] := (Nat.mod_modEq _ _).mul_left _
      _ ≡ a * b + a * c [MOD n] := by rw [mul_add]
      _ ≡ a * b % n + a * c % n [MOD n] := (Nat.mod_modEq _ _).symm.add (Nat.mod_modEq _ _).symm
      )
#align fin.left_distrib_aux fin.left_distrib_aux

/-- Commutative ring structure on `fin n`. -/
instance (n : ℕ) [NeZero n] : CommRing (Fin n) :=
  { Fin.addMonoidWithOne, Fin.addCommGroup n,
    Fin.commSemigroup n with
    one_mul := Fin.one_mul
    mul_one := Fin.mul_one
    left_distrib := left_distrib_aux n
    right_distrib := fun a b c => by
      rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm] <;> rfl }

end Fin

#print ZMod /-
/-- The integers modulo `n : ℕ`. -/
def ZMod : ℕ → Type
  | 0 => ℤ
  | n + 1 => Fin (n + 1)
#align zmod ZMod
-/

#print ZMod.decidableEq /-
instance ZMod.decidableEq : ∀ n : ℕ, DecidableEq (ZMod n)
  | 0 => Int.decidableEq
  | n + 1 => Fin.decidableEq _
#align zmod.decidable_eq ZMod.decidableEq
-/

#print ZMod.repr /-
instance ZMod.repr : ∀ n : ℕ, Repr (ZMod n)
  | 0 => Int.hasRepr
  | n + 1 => Fin.hasRepr _
#align zmod.has_repr ZMod.repr
-/

namespace ZMod

#print ZMod.fintype /-
instance fintype : ∀ (n : ℕ) [NeZero n], Fintype (ZMod n)
  | 0, h => (NeZero.ne 0 rfl).elim
  | n + 1, _ => Fin.fintype (n + 1)
#align zmod.fintype ZMod.fintype
-/

#print ZMod.infinite /-
instance infinite : Infinite (ZMod 0) :=
  Int.infinite
#align zmod.infinite ZMod.infinite
-/

#print ZMod.card /-
@[simp]
theorem card (n : ℕ) [Fintype (ZMod n)] : Fintype.card (ZMod n) = n :=
  by
  cases n
  · exact (not_finite (ZMod 0)).elim
  · convert Fintype.card_fin (n + 1)
#align zmod.card ZMod.card
-/

#print ZMod.commRing /-
/- We define each field by cases, to ensure that the eta-expanded `zmod.comm_ring` is defeq to the
original, this helps avoid diamonds with instances coming from classes extending `comm_ring` such as
field. -/
instance commRing (n : ℕ) : CommRing (ZMod n)
    where
  add := Nat.casesOn n (@Add.add Int _) fun n => @Add.add (Fin n.succ) _
  add_assoc := Nat.casesOn n (@add_assoc Int _) fun n => @add_assoc (Fin n.succ) _
  zero := Nat.casesOn n (0 : Int) fun n => (0 : Fin n.succ)
  zero_add := Nat.casesOn n (@zero_add Int _) fun n => @zero_add (Fin n.succ) _
  add_zero := Nat.casesOn n (@add_zero Int _) fun n => @add_zero (Fin n.succ) _
  neg := Nat.casesOn n (@Neg.neg Int _) fun n => @Neg.neg (Fin n.succ) _
  sub := Nat.casesOn n (@Sub.sub Int _) fun n => @Sub.sub (Fin n.succ) _
  sub_eq_add_neg := Nat.casesOn n (@sub_eq_add_neg Int _) fun n => @sub_eq_add_neg (Fin n.succ) _
  zsmul := Nat.casesOn n (@CommRing.zsmul Int _) fun n => @CommRing.zsmul (Fin n.succ) _
  zsmul_zero' :=
    Nat.casesOn n (@CommRing.zsmul_zero' Int _) fun n => @CommRing.zsmul_zero' (Fin n.succ) _
  zsmul_succ' :=
    Nat.casesOn n (@CommRing.zsmul_succ' Int _) fun n => @CommRing.zsmul_succ' (Fin n.succ) _
  zsmul_neg' :=
    Nat.casesOn n (@CommRing.zsmul_neg' Int _) fun n => @CommRing.zsmul_neg' (Fin n.succ) _
  nsmul := Nat.casesOn n (@CommRing.nsmul Int _) fun n => @CommRing.nsmul (Fin n.succ) _
  nsmul_zero :=
    Nat.casesOn n (@CommRing.nsmul_zero' Int _) fun n => @CommRing.nsmul_zero' (Fin n.succ) _
  nsmul_succ :=
    Nat.casesOn n (@CommRing.nsmul_succ' Int _) fun n => @CommRing.nsmul_succ' (Fin n.succ) _
  add_left_neg := by
    cases n
    exacts[@add_left_neg Int _, @add_left_neg (Fin n.succ) _]
  add_comm := Nat.casesOn n (@add_comm Int _) fun n => @add_comm (Fin n.succ) _
  mul := Nat.casesOn n (@Mul.mul Int _) fun n => @Mul.mul (Fin n.succ) _
  mul_assoc := Nat.casesOn n (@mul_assoc Int _) fun n => @mul_assoc (Fin n.succ) _
  one := Nat.casesOn n (1 : Int) fun n => (1 : Fin n.succ)
  one_mul := Nat.casesOn n (@one_mul Int _) fun n => @one_mul (Fin n.succ) _
  mul_one := Nat.casesOn n (@mul_one Int _) fun n => @mul_one (Fin n.succ) _
  natCast := Nat.casesOn n (coe : ℕ → ℤ) fun n => (coe : ℕ → Fin n.succ)
  natCast_zero := Nat.casesOn n (@Nat.cast_zero Int _) fun n => @Nat.cast_zero (Fin n.succ) _
  natCast_succ := Nat.casesOn n (@Nat.cast_succ Int _) fun n => @Nat.cast_succ (Fin n.succ) _
  intCast := Nat.casesOn n (coe : ℤ → ℤ) fun n => (coe : ℤ → Fin n.succ)
  intCast_ofNat := Nat.casesOn n (@Int.cast_ofNat Int _) fun n => @Int.cast_ofNat (Fin n.succ) _
  intCast_negSucc :=
    Nat.casesOn n (@Int.cast_negSucc Int _) fun n => @Int.cast_negSucc (Fin n.succ) _
  left_distrib := Nat.casesOn n (@left_distrib Int _ _ _) fun n => @left_distrib (Fin n.succ) _ _ _
  right_distrib :=
    Nat.casesOn n (@right_distrib Int _ _ _) fun n => @right_distrib (Fin n.succ) _ _ _
  mul_comm := Nat.casesOn n (@mul_comm Int _) fun n => @mul_comm (Fin n.succ) _
#align zmod.comm_ring ZMod.commRing
-/

#print ZMod.inhabited /-
instance inhabited (n : ℕ) : Inhabited (ZMod n) :=
  ⟨0⟩
#align zmod.inhabited ZMod.inhabited
-/

end ZMod