/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.exp
import data.set.intervals.infinite

/-!
# Trigonometric functions

## Main definitions

This file contains the definition of `π`.

See also `analysis.special_functions.trigonometric.inverse` and
`analysis.special_functions.trigonometric.arctan` for the inverse trigonometric functions.

See also `analysis.special_functions.complex.arg` and
`analysis.special_functions.complex.log` for the complex argument function
and the complex logarithm.

## Main statements

Many basic inequalities on the real trigonometric functions are established.

The continuity of the usual trigonometric functions is proved.

Several facts about the real trigonometric functions have the proofs deferred to
`analysis.special_functions.trigonometric.complex`,
as they are most easily proved by appealing to the corresponding fact for
complex trigonometric functions.

See also `analysis.special_functions.trigonometric.chebyshev` for the multiple angle formulas
in terms of Chebyshev polynomials.

## Tags

sin, cos, tan, angle
-/

noncomputable theory
open_locale classical topological_space filter
open set filter

namespace complex

@[continuity] lemma continuous_sin : continuous sin :=
by { change continuous (λ z, ((exp (-z * I) - exp (z * I)) * I) / 2), continuity, }

lemma continuous_on_sin {s : set ℂ} : continuous_on sin s := continuous_sin.continuous_on

@[continuity] lemma continuous_cos : continuous cos :=
by { change continuous (λ z, (exp (z * I) + exp (-z * I)) / 2), continuity, }

lemma continuous_on_cos {s : set ℂ} : continuous_on cos s := continuous_cos.continuous_on

@[continuity] lemma continuous_sinh : continuous sinh :=
by { change continuous (λ z, (exp z - exp (-z)) / 2), continuity, }

@[continuity] lemma continuous_cosh : continuous cosh :=
by { change continuous (λ z, (exp z + exp (-z)) / 2), continuity, }

end complex

namespace real

variables {x y z : ℝ}

@[continuity] lemma continuous_sin : continuous sin :=
complex.continuous_re.comp (complex.continuous_sin.comp complex.continuous_of_real)

lemma continuous_on_sin {s} : continuous_on sin s :=
continuous_sin.continuous_on

@[continuity] lemma continuous_cos : continuous cos :=
complex.continuous_re.comp (complex.continuous_cos.comp complex.continuous_of_real)

lemma continuous_on_cos {s} : continuous_on cos s := continuous_cos.continuous_on

@[continuity] lemma continuous_sinh : continuous sinh :=
complex.continuous_re.comp (complex.continuous_sinh.comp complex.continuous_of_real)

@[continuity] lemma continuous_cosh : continuous cosh :=
complex.continuous_re.comp (complex.continuous_cosh.comp complex.continuous_of_real)

end real

namespace real

lemma exists_cos_eq_zero : 0 ∈ cos '' Icc (1:ℝ) 2 :=
intermediate_value_Icc' (by norm_num) continuous_on_cos
  ⟨le_of_lt cos_two_neg, le_of_lt cos_one_pos⟩

/-- The number π = 3.14159265... Defined here using choice as twice a zero of cos in [1,2], from
which one can derive all its properties. For explicit bounds on π, see `data.real.pi.bounds`. -/
protected noncomputable def pi : ℝ := 2 * classical.some exists_cos_eq_zero

localized "notation `π` := real.pi" in real

@[simp] lemma cos_pi_div_two : cos (π / 2) = 0 :=
by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)];
  exact (classical.some_spec exists_cos_eq_zero).2

lemma one_le_pi_div_two : (1 : ℝ) ≤ π / 2 :=
by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)];
  exact (classical.some_spec exists_cos_eq_zero).1.1

lemma pi_div_two_le_two : π / 2 ≤ 2 :=
by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)];
  exact (classical.some_spec exists_cos_eq_zero).1.2

lemma two_le_pi : (2 : ℝ) ≤ π :=
(div_le_div_right (show (0 : ℝ) < 2, by norm_num)).1
  (by rw div_self (@two_ne_zero' ℝ _ _ _); exact one_le_pi_div_two)

lemma pi_le_four : π ≤ 4 :=
(div_le_div_right (show (0 : ℝ) < 2, by norm_num)).1
  (calc π / 2 ≤ 2 : pi_div_two_le_two
    ... = 4 / 2 : by norm_num)

lemma pi_pos : 0 < π :=
lt_of_lt_of_le (by norm_num) two_le_pi

lemma pi_ne_zero : π ≠ 0 :=
ne_of_gt pi_pos

lemma pi_div_two_pos : 0 < π / 2 :=
half_pos pi_pos

lemma two_pi_pos : 0 < 2 * π :=
by linarith [pi_pos]

end real

namespace nnreal
open real
open_locale real nnreal

/-- `π` considered as a nonnegative real. -/
noncomputable def pi : ℝ≥0 := ⟨π, real.pi_pos.le⟩

@[simp] lemma coe_real_pi : (pi : ℝ) = π := rfl

lemma pi_pos : 0 < pi := by exact_mod_cast real.pi_pos

lemma pi_ne_zero : pi ≠ 0 := pi_pos.ne'

end nnreal

namespace real
open_locale real

@[simp] lemma sin_pi : sin π = 0 :=
by rw [← mul_div_cancel_left π (@two_ne_zero ℝ _ _), two_mul, add_div,
    sin_add, cos_pi_div_two]; simp

@[simp] lemma cos_pi : cos π = -1 :=
by rw [← mul_div_cancel_left π (@two_ne_zero ℝ _ _), mul_div_assoc,
    cos_two_mul, cos_pi_div_two];
  simp [bit0, pow_add]

@[simp] lemma sin_two_pi : sin (2 * π) = 0 :=
by simp [two_mul, sin_add]

@[simp] lemma cos_two_pi : cos (2 * π) = 1 :=
by simp [two_mul, cos_add]

lemma sin_antiperiodic : function.antiperiodic sin π :=
by simp [sin_add]

lemma sin_periodic : function.periodic sin (2 * π) :=
sin_antiperiodic.periodic

@[simp] lemma sin_add_pi (x : ℝ) : sin (x + π) = -sin x :=
sin_antiperiodic x

@[simp] lemma sin_add_two_pi (x : ℝ) : sin (x + 2 * π) = sin x :=
sin_periodic x

@[simp] lemma sin_sub_pi (x : ℝ) : sin (x - π) = -sin x :=
sin_antiperiodic.sub_eq x

@[simp] lemma sin_sub_two_pi (x : ℝ) : sin (x - 2 * π) = sin x :=
sin_periodic.sub_eq x

@[simp] lemma sin_pi_sub (x : ℝ) : sin (π - x) = sin x :=
neg_neg (sin x) ▸ sin_neg x ▸ sin_antiperiodic.sub_eq'

@[simp] lemma sin_two_pi_sub (x : ℝ) : sin (2 * π - x) = -sin x :=
sin_neg x ▸ sin_periodic.sub_eq'

@[simp] lemma sin_nat_mul_pi (n : ℕ) : sin (n * π) = 0 :=
sin_antiperiodic.nat_mul_eq_of_eq_zero sin_zero n

@[simp] lemma sin_int_mul_pi (n : ℤ) : sin (n * π) = 0 :=
sin_antiperiodic.int_mul_eq_of_eq_zero sin_zero n

@[simp]

@[simp] lemma sin_add_int_mul_two_pi (x : ℝ) (n : ℤ) : sin (x + n * (2 * π)) = sin x :=
sin_periodic.int_mul n x

@[simp] lemma sin_sub_nat_mul_two_pi (x : ℝ) (n : ℕ) : sin (x - n * (2 * π)) = sin x :=
sin_periodic.sub_nat_mul_eq n

@[simp] lemma sin_sub_int_mul_two_pi (x : ℝ) (n : ℤ) : sin (x - n * (2 * π)) = sin x :=
sin_periodic.sub_int_mul_eq n

@[simp] lemma sin_nat_mul_two_pi_sub (x : ℝ) (n : ℕ) : sin (n * (2 * π) - x) = -sin x :=
sin_neg x ▸ sin_periodic.nat_mul_sub_eq n

@[simp] lemma sin_int_mul_two_pi_sub (x : ℝ) (n : ℤ) : sin (n * (2 * π) - x) = -sin x :=
sin_neg x ▸ sin_periodic.int_mul_sub_eq n

lemma cos_antiperiodic : function.antiperiodic cos π :=
by simp [cos_add]

lemma cos_periodic : function.periodic cos (2 * π) :=
cos_antiperiodic.periodic

@[simp] lemma cos_add_pi (x : ℝ) : cos (x + π) = -cos x :=
cos_antiperiodic x

@[simp] lemma cos_add_two_pi (x : ℝ) : cos (x + 2 * π) = cos x :=
cos_periodic x

@[simp] lemma cos_sub_pi (x : ℝ) : cos (x - π) = -cos x :=
cos_antiperiodic.sub_eq x

@[simp] lemma cos_sub_two_pi (x : ℝ) : cos (x - 2 * π) = cos x :=
cos_periodic.sub_eq x

@[simp] lemma cos_pi_sub (x : ℝ) : cos (π - x) = -cos x :=
cos_neg x ▸ cos_antiperiodic.sub_eq'

@[simp] lemma cos_two_pi_sub (x : ℝ) : cos (2 * π - x) = cos x :=
cos_neg x ▸ cos_periodic.sub_eq'

@[simp] lemma cos_nat_mul_two_pi (n : ℕ) : cos (n * (2 * π)) = 1 :=
(cos_periodic.nat_mul_eq n).trans cos_zero

@[simp] lemma cos_int_mul_two_pi (n : ℤ) : cos (n * (2 * π)) = 1 :=
(cos_periodic.int_mul_eq n).trans cos_zero

@[simp] lemma cos_add_nat_mul_two_pi (x : ℝ) (n : ℕ) : cos (x + n * (2 * π)) = cos x :=
cos_periodic.nat_mul n x

@[simp] lemma cos_add_int_mul_two_pi (x : ℝ) (n : ℤ) : cos (x + n * (2 * π)) = cos x :=
cos_periodic.int_mul n x

@[simp] lemma cos_sub_nat_mul_two_pi (x : ℝ) (n : ℕ) : cos (x - n * (2 * π)) = cos x :=
cos_periodic.sub_nat_mul_eq n

@[simp] lemma cos_sub_int_mul_two_pi (x : ℝ) (n : ℤ) : cos (x - n * (2 * π)) = cos x :=
cos_periodic.sub_int_mul_eq n

@[simp] lemma cos_nat_mul_two_pi_sub (x : ℝ) (n : ℕ) : cos (n * (2 * π) - x) = cos x :=
cos_neg x ▸ cos_periodic.nat_mul_sub_eq n

@[simp] lemma cos_int_mul_two_pi_sub (x : ℝ) (n : ℤ) : cos (n * (2 * π) - x) = cos x :=
cos_neg x ▸ cos_periodic.int_mul_sub_eq n

@[simp] lemma cos_nat_mul_two_pi_add_pi (n : ℕ) : cos (n * (2 * π) + π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.nat_mul n).add_antiperiod_eq cos_antiperiodic

@[simp] lemma cos_int_mul_two_pi_add_pi (n : ℤ) : cos (n * (2 * π) + π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.int_mul n).add_antiperiod_eq cos_antiperiodic

@[simp] lemma cos_nat_mul_two_pi_sub_pi (n : ℕ) : cos (n * (2 * π) - π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.nat_mul n).sub_antiperiod_eq cos_antiperiodic

@[simp] lemma cos_int_mul_two_pi_sub_pi (n : ℤ) : cos (n * (2 * π) - π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.int_mul n).sub_antiperiod_eq cos_antiperiodic

lemma sin_pos_of_pos_of_lt_pi {x : ℝ} (h0x : 0 < x) (hxp : x < π) : 0 < sin x :=
if hx2 : x ≤ 2 then sin_pos_of_pos_of_le_two h0x hx2
else
  have (2 : ℝ) + 2 = 4, from rfl,
  have π - x ≤ 2, from sub_le_iff_le_add.2
    (le_trans pi_le_four (this ▸ add_le_add_left (le_of_not_ge hx2) _)),
  sin_pi_sub x ▸ sin_pos_of_pos_of_le_two (sub_pos.2 hxp) this

lemma sin_pos_of_mem_Ioo {x : ℝ} (hx : x ∈ Ioo 0 π) : 0 < sin x :=
sin_pos_of_pos_of_lt_pi hx.1 hx.2

lemma sin_nonneg_of_mem_Icc {x : ℝ} (hx : x ∈ Icc 0 π) : 0 ≤ sin x :=
begin
  rw ← closure_Ioo pi_pos at hx,
  exact closure_lt_subset_le continuous_const continuous_sin
    (closure_mono (λ y, sin_pos_of_mem_Ioo) hx)
end

lemma sin_nonneg_of_nonneg_of_le_pi {x : ℝ} (h0x : 0 ≤ x) (hxp : x ≤ π) : 0 ≤ sin x :=
sin_nonneg_of_mem_Icc ⟨h0x, hxp⟩

lemma sin_neg_of_neg_of_neg_pi_lt {x : ℝ} (hx0 : x < 0) (hpx : -π < x) : sin x < 0 :=
neg_pos.1 $ sin_neg x ▸ sin_pos_of_pos_of_lt_pi (neg_pos.2 hx0) (neg_lt.1 hpx)

lemma sin_nonpos_of_nonnpos_of_neg_pi_le {x : ℝ} (hx0 : x ≤ 0) (hpx : -π ≤ x) : sin x ≤ 0 :=
neg_nonneg.1 $ sin_neg x ▸ sin_nonneg_of_nonneg_of_le_pi (neg_nonneg.2 hx0) (neg_le.1 hpx)

@[simp] lemma sin_pi_div_two : sin (π / 2) = 1 :=
have sin (π / 2) = 1 ∨ sin (π / 2) = -1 :=
by simpa [sq, mul_self_eq_one_iff] using sin_sq_add_cos_sq (π / 2),
this.resolve_right
  (λ h, (show ¬(0 : ℝ) < -1, by norm_num) $
    h ▸ sin_pos_of_pos_of_lt_pi pi_div_two_pos (half_lt_self pi_pos))

lemma sin_add_pi_div_two (x : ℝ) : sin (x + π / 2) = cos x :=
by simp [sin_add]

lemma sin_sub_pi_div_two (x : ℝ) : sin (x - π / 2) = -cos x :=
by simp [sub_eq_add_neg, sin_add]

lemma sin_pi_div_two_sub (x : ℝ) : sin (π / 2 - x) = cos x :=
by simp [sub_eq_add_neg, sin_add]

lemma cos_add_pi_div_two (x : ℝ) : cos (x + π / 2) = -sin x :=
by simp [cos_add]

lemma cos_sub_pi_div_two (x : ℝ) : cos (x - π / 2) = sin x :=
by simp [sub_eq_add_neg, cos_add]

lemma cos_pi_div_two_sub (x : ℝ) : cos (π / 2 - x) = sin x :=
by rw [← cos_neg, neg_sub, cos_sub_pi_div_two]

lemma cos_pos_of_mem_Ioo {x : ℝ} (hx : x ∈ Ioo (-(π / 2)) (π / 2)) : 0 < cos x :=
sin_add_pi_div_two x ▸ sin_pos_of_mem_Ioo ⟨by linarith [hx.1], by linarith [hx.2]⟩

lemma cos_nonneg_of_mem_Icc {x : ℝ} (hx : x ∈ Icc (-(π / 2)) (π / 2)) : 0 ≤ cos x :=
sin_add_pi_div_two x ▸ sin_nonneg_of_mem_Icc ⟨by linarith [hx.1], by linarith [hx.2]⟩

lemma cos_nonneg_of_neg_pi_div_two_le_of_le {x : ℝ} (hl : -(π / 2) ≤ x) (hu : x ≤ π / 2) :
  0 ≤ cos x :=
cos_nonneg_of_mem_Icc ⟨hl, hu⟩

lemma cos_neg_of_pi_div_two_lt_of_lt {x : ℝ} (hx₁ : π / 2 < x) (hx₂ : x < π + π / 2) : cos x < 0 :=
neg_pos.1 $ cos_pi_sub x ▸ cos_pos_of_mem_Ioo ⟨by linarith, by linarith⟩

lemma cos_nonpos_of_pi_div_two_le_of_le {x : ℝ} (hx₁ : π / 2 ≤ x) (hx₂ : x ≤ π + π / 2) :
  cos x ≤ 0 :=
neg_nonneg.1 $ cos_pi_sub x ▸ cos_nonneg_of_mem_Icc ⟨by linarith, by linarith⟩

lemma sin_eq_sqrt_one_sub_cos_sq {x : ℝ} (hl : 0 ≤ x) (hu : x ≤ π) :
  sin x = sqrt (1 - cos x ^ 2) :=
by rw [← abs_sin_eq_sqrt_one_sub_cos_sq, abs_of_nonneg (sin_nonneg_of_nonneg_of_le_pi hl hu)]

lemma cos_eq_sqrt_one_sub_sin_sq {x : ℝ} (hl : -(π / 2) ≤ x) (hu : x ≤ π / 2) :
  cos x = sqrt (1 - sin x ^ 2) :=
by rw [← abs_cos_eq_sqrt_one_sub_sin_sq, abs_of_nonneg (cos_nonneg_of_mem_Icc ⟨hl, hu⟩)]

lemma sin_eq_zero_iff_of_lt_of_lt {x : ℝ} (hx₁ : -π < x) (hx₂ : x < π) :
  sin x = 0 ↔ x = 0 :=
⟨λ h, le_antisymm
    (le_of_not_gt (λ h0, lt_irrefl (0 : ℝ) $
      calc 0 < sin x : sin_pos_of_pos_of_lt_pi h0 hx₂
        ... = 0 : h))
    (le_of_not_gt (λ h0, lt_irrefl (0 : ℝ) $
      calc 0 = sin x : h.symm
        ... < 0 : sin_neg_of_neg_of_neg_pi_lt h0 hx₁)),
  λ h, by simp [h]⟩

lemma sin_eq_zero_iff {x : ℝ} : sin x = 0 ↔ ∃ n : ℤ, (n : ℝ) * π = x :=
⟨λ h, ⟨⌊x / π⌋, le_antisymm (sub_nonneg.1 (sub_floor_div_mul_nonneg _ pi_pos))
  (sub_nonpos.1 $ le_of_not_gt $ λ h₃,
    (sin_pos_of_pos_of_lt_pi h₃ (sub_floor_div_mul_lt _ pi_pos)).ne
    (by simp [sub_eq_add_neg, sin_add, h, sin_int_mul_pi]))⟩,
  λ ⟨n, hn⟩, hn ▸ sin_int_mul_pi _⟩

lemma sin_ne_zero_iff {x : ℝ} : sin x ≠ 0 ↔ ∀ n : ℤ, (n : ℝ) * π ≠ x :=
by rw [← not_exists, not_iff_not, sin_eq_zero_iff]

lemma sin_eq_zero_iff_cos_eq {x : ℝ} : sin x = 0 ↔ cos x = 1 ∨ cos x = -1 :=
by rw [← mul_self_eq_one_iff, ← sin_sq_add_cos_sq x,
    sq, sq, ← sub_eq_iff_eq_add, sub_self];
  exact ⟨λ h, by rw [h, mul_zero], eq_zero_of_mul_self_eq_zero ∘ eq.symm⟩

lemma cos_eq_one_iff (x : ℝ) : cos x = 1 ↔ ∃ n : ℤ, (n : ℝ) * (2 * π) = x :=
⟨λ h, let ⟨n, hn⟩ := sin_eq_zero_iff.1 (sin_eq_zero_iff_cos_eq.2 (or.inl h)) in
    ⟨n / 2, (int.mod_two_eq_zero_or_one n).elim
      (λ hn0, by rwa [← mul_assoc, ← @int.cast_two ℝ, ← int.cast_mul, int.div_mul_cancel
        ((int.dvd_iff_mod_eq_zero _ _).2 hn0)])
      (λ hn1, by rw [← int.mod_add_div n 2, hn1, int.cast_add, int.cast_one, add_mul,
          one_mul, add_comm, mul_comm (2 : ℤ), int.cast_mul, mul_assoc, int.cast_two] at hn;
        rw [← hn, cos_int_mul_two_pi_add_pi] at h;
        exact absurd h (by norm_num))⟩,
  λ ⟨n, hn⟩, hn ▸ cos_int_mul_two_pi _⟩

lemma cos_eq_one_iff_of_lt_of_lt {x : ℝ} (hx₁ : -(2 * π) < x) (hx₂ : x < 2 * π) :
  cos x = 1 ↔ x = 0 :=
⟨λ h,
    begin
      rcases (cos_eq_one_iff _).1 h with ⟨n, rfl⟩,
      rw [mul_lt_iff_lt_one_left two_pi_pos] at hx₂,
      rw [neg_lt, neg_mul_eq_neg_mul, mul_lt_iff_lt_one_left two_pi_pos] at hx₁,
      norm_cast at hx₁ hx₂,
      obtain rfl : n = 0 := le_antisymm (by linarith) (by linarith),
      simp
    end,
  λ h, by simp [h]⟩

lemma cos_lt_cos_of_nonneg_of_le_pi_div_two {x y : ℝ} (hx₁ : 0 ≤ x) (hy₂ : y ≤ π / 2)
  (hxy : x < y) :
  cos y < cos x :=
begin
  rw [← sub_lt_zero, cos_sub_cos],
  have : 0 < sin ((y + x) / 2),
  { refine sin_pos_of_pos_of_lt_pi _ _; linarith },
  have : 0 < sin ((y - x) / 2),
  { refine sin_pos_of_pos_of_lt_pi _ _; linarith },
  nlinarith,
end

lemma cos_lt_cos_of_nonneg_of_le_pi {x y : ℝ} (hx₁ : 0 ≤ x) (hy₂ : y ≤ π) (hxy : x < y) :
  cos y < cos x :=
match (le_total x (π / 2) : x ≤ π / 2 ∨ π / 2 ≤ x), le_total y (π / 2) with
| or.inl hx, or.inl hy := cos_lt_cos_of_nonneg_of_le_pi_div_two hx₁ hy hxy
| or.inl hx, or.inr hy := (lt_or_eq_of_le hx).elim
  (λ hx, calc cos y ≤ 0 : cos_nonpos_of_pi_div_two_le_of_le hy (by linarith [pi_pos])
    ... < cos x : cos_pos_of_mem_Ioo ⟨by linarith, hx⟩)
  (λ hx, calc cos y < 0 : cos_neg_of_pi_div_two_lt_of_lt (by linarith) (by linarith [pi_pos])
    ... = cos x : by rw [hx, cos_pi_div_two])
| or.inr hx, or.inl hy := by linarith
| or.inr hx, or.inr hy := neg_lt_neg_iff.1 (by rw [← cos_pi_sub, ← cos_pi_sub];
  apply cos_lt_cos_of_nonneg_of_le_pi_div_two; linarith)
end

lemma strict_anti_on_cos : strict_anti_on cos (Icc 0 π) :=
λ x hx y hy hxy, cos_lt_cos_of_nonneg_of_le_pi hx.1 hy.2 hxy

lemma cos_le_cos_of_nonneg_of_le_pi {x y : ℝ} (hx₁ : 0 ≤ x) (hy₂ : y ≤ π) (hxy : x ≤ y) :
  cos y ≤ cos x :=
(strict_anti_on_cos.le_iff_le ⟨hx₁.trans hxy, hy₂⟩ ⟨hx₁, hxy.trans hy₂⟩).2 hxy

lemma sin_lt_sin_of_lt_of_le_pi_div_two {x y : ℝ} (hx₁ : -(π / 2) ≤ x)
  (hy₂ : y ≤ π / 2) (hxy : x < y) : sin x < sin y :=
by rw [← cos_sub_pi_div_two, ← cos_sub_pi_div_two, ← cos_neg (x - _), ← cos_neg (y - _)];
  apply cos_lt_cos_of_nonneg_of_le_pi; linarith

lemma strict_mono_on_sin : strict_mono_on sin (Icc (-(π / 2)) (π / 2)) :=
λ x hx y hy hxy, sin_lt_sin_of_lt_of_le_pi_div_two hx.1 hy.2 hxy

lemma sin_le_sin_of_le_of_le_pi_div_two {x y : ℝ} (hx₁ : -(π / 2) ≤ x)
  (hy₂ : y ≤ π / 2) (hxy : x ≤ y) : sin x ≤ sin y :=
(strict_mono_on_sin.le_iff_le ⟨hx₁, hxy.trans hy₂⟩ ⟨hx₁.trans hxy, hy₂⟩).2 hxy

lemma inj_on_sin : inj_on sin (Icc (-(π / 2)) (π / 2)) :=
strict_mono_on_sin.inj_on

lemma inj_on_cos : inj_on cos (Icc 0 π) := strict_anti_on_cos.inj_on

lemma surj_on_sin : surj_on sin (Icc (-(π / 2)) (π / 2)) (Icc (-1) 1) :=
by simpa only [sin_neg, sin_pi_div_two]
  using intermediate_value_Icc (neg_le_self pi_div_two_pos.le) continuous_sin.continuous_on

lemma surj_on_cos : surj_on cos (Icc 0 π) (Icc (-1) 1) :=
by simpa only [cos_zero, cos_pi]
  using intermediate_value_Icc' pi_pos.le continuous_cos.continuous_on

lemma sin_mem_Icc (x : ℝ) : sin x ∈ Icc (-1 : ℝ) 1 := ⟨neg_one_le_sin x, sin_le_one x⟩

lemma cos_mem_Icc (x : ℝ) : cos x ∈ Icc (-1 : ℝ) 1 := ⟨neg_one_le_cos x, cos_le_one x⟩

lemma maps_to_sin (s : set ℝ) : maps_to sin s (Icc (-1 : ℝ) 1) := λ x _, sin_mem_Icc x

lemma maps_to_cos (s : set ℝ) : maps_to cos s (Icc (-1 : ℝ) 1) := λ x _, cos_mem_Icc x

lemma bij_on_sin : bij_on sin (Icc (-(π / 2)) (π / 2)) (Icc (-1) 1) :=
⟨maps_to_sin _, inj_on_sin, surj_on_sin⟩

lemma bij_on_cos : bij_on cos (Icc 0 π) (Icc (-1) 1) :=
⟨maps_to_cos _, inj_on_cos, surj_on_cos⟩

@[simp] lemma range_cos : range cos = (Icc (-1) 1 : set ℝ) :=
subset.antisymm (range_subset_iff.2 cos_mem_Icc) surj_on_cos.subset_range

@[simp] lemma range_sin : range sin = (Icc (-1) 1 : set ℝ) :=
subset.antisymm (range_subset_iff.2 sin_mem_Icc) surj_on_sin.subset_range

lemma range_cos_infinite : (range real.cos).infinite :=
by { rw real.range_cos, exact Icc.infinite (by norm_num) }

lemma range_sin_infinite : (range real.sin).infinite :=
by { rw real.range_sin, exact Icc.infinite (by norm_num) }

lemma sin_lt {x : ℝ} (h : 0 < x) : sin x < x :=
begin
  cases le_or_gt x 1 with h' h',
  { have hx : |x| = x := abs_of_nonneg (le_of_lt h),
    have : |x| ≤ 1, rwa [hx],
    have := sin_bound this, rw [abs_le] at this,
    have := this.2, rw [sub_le_iff_le_add', hx] at this,
    apply lt_of_le_of_lt this, rw [sub_add], apply lt_of_lt_of_le _ (le_of_eq (sub_zero x)),
    apply sub_lt_sub_left, rw [sub_pos, div_eq_mul_inv (x ^ 3)], apply mul_lt_mul',
    { rw [pow_succ x 3], refine le_trans _ (le_of_eq (one_mul _)),
      rw mul_le_mul_right, exact h', apply pow_pos h },
    norm_num, norm_num, apply pow_pos h },
  exact lt_of_le_of_lt (sin_le_one x) h'
end

/- note 1: this inequality is not tight, the tighter inequality is sin x > x - x ^ 3 / 6.
   note 2: this is also true for x > 1, but it's nontrivial for x just above 1. -/
lemma sin_gt_sub_cube {x : ℝ} (h : 0 < x) (h' : x ≤ 1) : x - x ^ 3 / 4 < sin x :=
begin
  have hx : |x| = x := abs_of_nonneg (le_of_lt h),
  have : |x| ≤ 1, rwa [hx],
  have := sin_bound this, rw [abs_le] at this,
  have := this.1, rw [le_sub_iff_add_le, hx] at this,
  refine lt_of_lt_of_le _ this,
  rw [add_comm, sub_add, sub_neg_eq_add], apply sub_lt_sub_left,
  apply add_lt_of_lt_sub_left,
  rw (show x ^ 3 / 4 - x ^ 3 / 6 = x ^ 3 * 12⁻¹,
    by simp [div_eq_mul_inv, ← mul_sub]; norm_num),
  apply mul_lt_mul',
  { rw [pow_succ x 3], refine le_trans _ (le_of_eq (one_mul _)),
    rw mul_le_mul_right, exact h', apply pow_pos h },
  norm_num, norm_num, apply pow_pos h
end

section cos_div_sq

variable (x : ℝ)

/-- the series `sqrt_two_add_series x n` is `sqrt(2 + sqrt(2 + ... ))` with `n` square roots,
  starting with `x`. We define it here because `cos (pi / 2 ^ (n+1)) = sqrt_two_add_series 0 n / 2`
-/
@[simp, pp_nodot] noncomputable def sqrt_two_add_series (x : ℝ) : ℕ → ℝ
| 0     := x
| (n+1) := sqrt (2 + sqrt_two_add_series n)

lemma sqrt_two_add_series_zero : sqrt_two_add_series x 0 = x := by simp
lemma sqrt_two_add_series_one : sqrt_two_add_series 0 1 = sqrt 2 := by simp
lemma sqrt_two_add_series_two : sqrt_two_add_series 0 2 = sqrt (2 + sqrt 2) := by simp

lemma sqrt_two_add_series_zero_nonneg : ∀(n : ℕ), 0 ≤ sqrt_two_add_series 0 n
| 0     := le_refl 0
| (n+1) := sqrt_nonneg _

lemma sqrt_two_add_series_nonneg {x : ℝ} (h : 0 ≤ x) : ∀(n : ℕ), 0 ≤ sqrt_two_add_series x n
| 0     := h
| (n+1) := sqrt_nonneg _

lemma sqrt_two_add_series_lt_two : ∀(n : ℕ), sqrt_two_add_series 0 n < 2
| 0     := by norm_num
| (n+1) :=
  begin
    refine lt_of_lt_of_le _ (sqrt_sq zero_lt_two.le).le,
    rw [sqrt_two_add_series, sqrt_lt_sqrt_iff, ← lt_sub_iff_add_lt'],
    { refine (sqrt_two_add_series_lt_two n).trans_le _, norm_num },
    { exact add_nonneg zero_le_two (sqrt_two_add_series_zero_nonneg n) }
  end

lemma sqrt_two_add_series_succ (x : ℝ) :
  ∀(n : ℕ), sqrt_two_add_series x (n+1) = sqrt_two_add_series (sqrt (2 + x)) n
| 0     := rfl
| (n+1) := by rw [sqrt_two_add_series, sqrt_two_add_series_succ, sqrt_two_add_series]

lemma sqrt_two_add_series_monotone_left {x y : ℝ} (h : x ≤ y) :
  ∀(n : ℕ), sqrt_two_add_series x n ≤ sqrt_two_add_series y n
| 0     := h
| (n+1) :=
  begin
    rw [sqrt_two_add_series, sqrt_two_add_series],
    exact sqrt_le_sqrt (add_le_add_left (sqrt_two_add_series_monotone_left _) _)
  end

@[simp] lemma cos_pi_over_two_pow : ∀(n : ℕ), cos (π / 2 ^ (n+1)) = sqrt_two_add_series 0 n / 2
| 0     := by simp
| (n+1) :=
  begin
    have : (2 : ℝ) ≠ 0 := two_ne_zero,
    symmetry, rw [div_eq_iff_mul_eq this], symmetry,
    rw [sqrt_two_add_series, sqrt_eq_iff_sq_eq, mul_pow, cos_sq, ←mul_div_assoc,
      nat.add_succ, pow_succ, mul_div_mul_left _ _ this, cos_pi_over_two_pow, add_mul],
    congr, { norm_num },
    rw [mul_comm, sq, mul_assoc, ←mul_div_assoc, mul_div_cancel_left, ←mul_div_assoc,
        mul_div_cancel_left]; try { exact this },
    apply add_nonneg, norm_num, apply sqrt_two_add_series_zero_nonneg, norm_num,
    apply le_of_lt, apply cos_pos_of_mem_Ioo ⟨_, _⟩,
    { transitivity (0 : ℝ), rw neg_lt_zero, apply pi_div_two_pos,
      apply div_pos pi_pos, apply pow_pos, norm_num },
    apply div_lt_div' (le_refl π) _ pi_pos _,
    refine lt_of_le_of_lt (le_of_eq (pow_one _).symm) _,
    apply pow_lt_pow, norm_num, apply nat.succ_lt_succ, apply nat.succ_pos, all_goals {norm_num}
  end

lemma sin_sq_pi_over_two_pow (n : ℕ) :
  sin (π / 2 ^ (n+1)) ^ 2 = 1 - (sqrt_two_add_series 0 n / 2) ^ 2 :=
by rw [sin_sq, cos_pi_over_two_pow]

lemma sin_sq_pi_over_two_pow_succ (n : ℕ) :
  sin (π / 2 ^ (n+2)) ^ 2 = 1 / 2 - sqrt_two_add_series 0 n / 4 :=
begin
  rw [sin_sq_pi_over_two_pow, sqrt_two_add_series, div_pow, sq_sqrt, add_div, ←sub_sub],
  congr, norm_num, norm_num, apply add_nonneg, norm_num, apply sqrt_two_add_series_zero_nonneg,
end

@[simp] lemma sin_pi_over_two_pow_succ (n : ℕ) :
  sin (π / 2 ^ (n+2)) = sqrt (2 - sqrt_two_add_series 0 n) / 2 :=
begin
  symmetry, rw [div_eq_iff_mul_eq], symmetry,
  rw [sqrt_eq_iff_sq_eq, mul_pow, sin_sq_pi_over_two_pow_succ, sub_mul],
  { congr, norm_num, rw [mul_comm], convert mul_div_cancel' _ _, norm_num, norm_num },
  { rw [sub_nonneg], apply le_of_lt, apply sqrt_two_add_series_lt_two },
  apply le_of_lt, apply mul_pos, apply sin_pos_of_pos_of_lt_pi,
  { apply div_pos pi_pos, apply pow_pos, norm_num },
  refine lt_of_lt_of_le _ (le_of_eq (div_one _)), rw [div_lt_div_left],
  refine lt_of_le_of_lt (le_of_eq (pow_zero 2).symm) _,
  apply pow_lt_pow, norm_num, apply nat.succ_pos, apply pi_pos,
  apply pow_pos, all_goals {norm_num}
end

@[simp] lemma cos_pi_div_four : cos (π / 4) = sqrt 2 / 2 :=
by { transitivity cos (π / 2 ^ 2), congr, norm_num, simp }

@[simp] lemma sin_pi_div_four : sin (π / 4) = sqrt 2 / 2 :=
by { transitivity sin (π / 2 ^ 2), congr, norm_num, simp }

@[simp] lemma cos_pi_div_eight : cos (π / 8) = sqrt (2 + sqrt 2) / 2 :=
by { transitivity cos (π / 2 ^ 3), congr, norm_num, simp }

@[simp] lemma sin_pi_div_eight : sin (π / 8) = sqrt (2 - sqrt 2) / 2 :=
by { transitivity sin (π / 2 ^ 3), congr, norm_num, simp }

@[simp] lemma cos_pi_div_sixteen : cos (π / 16) = sqrt (2 + sqrt (2 + sqrt 2)) / 2 :=
by { transitivity cos (π / 2 ^ 4), congr, norm_num, simp }

@[simp] lemma sin_pi_div_sixteen : sin (π / 16) = sqrt (2 - sqrt (2 + sqrt 2)) / 2 :=
by { transitivity sin (π / 2 ^ 4), congr, norm_num, simp }

@[simp] lemma cos_pi_div_thirty_two : cos (π / 32) = sqrt (2 + sqrt (2 + sqrt (2 + sqrt 2))) / 2 :=
by { transitivity cos (π / 2 ^ 5), congr, norm_num, simp }

@[simp] lemma sin_pi_div_thirty_two : sin (π / 32) = sqrt (2 - sqrt (2 + sqrt (2 + sqrt 2))) / 2 :=
by { transitivity sin (π / 2 ^ 5), congr, norm_num, simp }

-- This section is also a convenient location for other explicit values of `sin` and `cos`.

/-- The cosine of `π / 3` is `1 / 2`. -/
@[simp] lemma cos_pi_div_three : cos (π / 3) = 1 / 2 :=
begin
  have h₁ : (2 * cos (π / 3) - 1) ^ 2 * (2 * cos (π / 3) + 2) = 0,
  { have : cos (3 * (π / 3)) = cos π := by { congr' 1, ring },
    linarith [cos_pi, cos_three_mul (π / 3)] },
  cases mul_eq_zero.mp h₁ with h h,
  { linarith [pow_eq_zero h] },
  { have : cos π < cos (π / 3),
    { refine cos_lt_cos_of_nonneg_of_le_pi _ rfl.ge _;
      linarith [pi_pos] },
    linarith [cos_pi] }
end

/-- The square of the cosine of `π / 6` is `3 / 4` (this is sometimes more convenient than the
result for cosine itself). -/
lemma sq_cos_pi_div_six : cos (π / 6) ^ 2 = 3 / 4 :=
begin
  have h1 : cos (π / 6) ^ 2 = 1 / 2 + 1 / 2 / 2,
  { convert cos_sq (π / 6),
    have h2 : 2 * (π / 6) = π / 3 := by cancel_denoms,
    rw [h2, cos_pi_div_three] },
  rw ← sub_eq_zero at h1 ⊢,
  convert h1 using 1,
  ring
end

/-- The cosine of `π / 6` is `√3 / 2`. -/
@[simp] lemma cos_pi_div_six : cos (π / 6) = (sqrt 3) / 2 :=
begin
  suffices : sqrt 3 = cos (π / 6) * 2,
  { field_simp [(by norm_num : 0 ≠ 2)], exact this.symm },
  rw sqrt_eq_iff_sq_eq,
  { have h1 := (mul_right_inj' (by norm_num : (4:ℝ) ≠ 0)).mpr sq_cos_pi_div_six,
    rw ← sub_eq_zero at h1 ⊢,
    convert h1 using 1,
    ring },
  { norm_num },
  { have : 0 < cos (π / 6) := by { apply cos_pos_of_mem_Ioo; split; linarith [pi_pos] },
    linarith },
end

/-- The sine of `π / 6` is `1 / 2`. -/
@[simp] lemma sin_pi_div_six : sin (π / 6) = 1 / 2 :=
begin
  rw [← cos_pi_div_two_sub, ← cos_pi_div_three],
  congr,
  ring
end

/-- The square of the sine of `π / 3` is `3 / 4` (this is sometimes more convenient than the
result for cosine itself). -/
lemma sq_sin_pi_div_three : sin (π / 3) ^ 2 = 3 / 4 :=
begin
  rw [← cos_pi_div_two_sub, ← sq_cos_pi_div_six],
  congr,
  ring
end

/-- The sine of `π / 3` is `√3 / 2`. -/
@[simp] lemma sin_pi_div_three : sin (π / 3) = (sqrt 3) / 2 :=
begin
  rw [← cos_pi_div_two_sub, ← cos_pi_div_six],
  congr,
  ring
end

end cos_div_sq

/-- `real.sin` as an `order_iso` between `[-(π / 2), π / 2]` and `[-1, 1]`. -/
def sin_order_iso : Icc (-(π / 2)) (π / 2) ≃o Icc (-1:ℝ) 1 :=
(strict_mono_on_sin.order_iso _ _).trans $ order_iso.set_congr _ _ bij_on_sin.image_eq

@[simp] lemma coe_sin_order_iso_apply (x : Icc (-(π / 2)) (π / 2)) :
  (sin_order_iso x : ℝ) = sin x := rfl

lemma sin_order_iso_apply (x : Icc (-(π / 2)) (π / 2)) :
  sin_order_iso x = ⟨sin x, sin_mem_Icc x⟩ := rfl

@[simp] lemma tan_pi_div_four : tan (π / 4) = 1 :=
begin
  rw [tan_eq_sin_div_cos, cos_pi_div_four, sin_pi_div_four],
  have h : (sqrt 2) / 2 > 0 := by cancel_denoms,
  exact div_self (ne_of_gt h),
end

@[simp] lemma tan_pi_div_two : tan (π / 2) = 0 := by simp [tan_eq_sin_div_cos]

lemma tan_pos_of_pos_of_lt_pi_div_two {x : ℝ} (h0x : 0 < x) (hxp : x < π / 2) : 0 < tan x :=
by rw tan_eq_sin_div_cos; exact div_pos (sin_pos_of_pos_of_lt_pi h0x (by linarith))
  (cos_pos_of_mem_Ioo ⟨by linarith, hxp⟩)

lemma tan_nonneg_of_nonneg_of_le_pi_div_two {x : ℝ} (h0x : 0 ≤ x) (hxp : x ≤ π / 2) : 0 ≤ tan x :=
match lt_or_eq_of_le h0x, lt_or_eq_of_le hxp with
| or.inl hx0, or.inl hxp := le_of_lt (tan_pos_of_pos_of_lt_pi_div_two hx0 hxp)
| or.inl hx0, or.inr hxp := by simp [hxp, tan_eq_sin_div_cos]
| or.inr hx0, _          := by simp [hx0.symm]
end

lemma tan_neg_of_neg_of_pi_div_two_lt {x : ℝ} (hx0 : x < 0) (hpx : -(π / 2) < x) : tan x < 0 :=
neg_pos.1 (tan_neg x ▸ tan_pos_of_pos_of_lt_pi_div_two (by linarith) (by linarith [pi_pos]))

lemma tan_nonpos_of_nonpos_of_neg_pi_div_two_le {x : ℝ} (hx0 : x ≤ 0) (hpx : -(π / 2) ≤ x) :
  tan x ≤ 0 :=
neg_nonneg.1 (tan_neg x ▸ tan_nonneg_of_nonneg_of_le_pi_div_two (by linarith) (by linarith))

lemma tan_lt_tan_of_nonneg_of_lt_pi_div_two {x y : ℝ}
  (hx₁ : 0 ≤ x) (hy₂ : y < π / 2) (hxy : x < y) :
  tan x < tan y :=
begin
  rw [tan_eq_sin_div_cos, tan_eq_sin_div_cos],
  exact div_lt_div
    (sin_lt_sin_of_lt_of_le_pi_div_two (by linarith) (le_of_lt hy₂) hxy)
    (cos_le_cos_of_nonneg_of_le_pi hx₁ (by linarith) (le_of_lt hxy))
    (sin_nonneg_of_nonneg_of_le_pi (by linarith) (by linarith))
    (cos_pos_of_mem_Ioo ⟨by linarith, hy₂⟩)
end

lemma tan_lt_tan_of_lt_of_lt_pi_div_two {x y : ℝ} (hx₁ : -(π / 2) < x)
 (hy₂ : y < π / 2) (hxy : x < y) : tan x < tan y :=
match le_total x 0, le_total y 0 with
| or.inl hx0, or.inl hy0 := neg_lt_neg_iff.1 $ by rw [← tan_neg, ← tan_neg]; exact
  tan_lt_tan_of_nonneg_of_lt_pi_div_two (neg_nonneg.2 hy0)
    (neg_lt.2 hx₁) (neg_lt_neg hxy)
| or.inl hx0, or.inr hy0 := (lt_or_eq_of_le hy0).elim
  (λ hy0, calc tan x ≤ 0 : tan_nonpos_of_nonpos_of_neg_pi_div_two_le hx0 (le_of_lt hx₁)
    ... < tan y : tan_pos_of_pos_of_lt_pi_div_two hy0 hy₂)
  (λ hy0, by rw [← hy0, tan_zero]; exact
    tan_neg_of_neg_of_pi_div_two_lt (hy0.symm ▸ hxy) hx₁)
| or.inr hx0, or.inl hy0 := by linarith
| or.inr hx0, or.inr hy0 := tan_lt_tan_of_nonneg_of_lt_pi_div_two hx0 hy₂ hxy
end

lemma strict_mono_on_tan : strict_mono_on tan (Ioo (-(π / 2)) (π / 2)) :=
λ x hx y hy, tan_lt_tan_of_lt_of_lt_pi_div_two hx.1 hy.2

lemma inj_on_tan : inj_on tan (Ioo (-(π / 2)) (π / 2)) :=
strict_mono_on_tan.inj_on

lemma tan_inj_of_lt_of_lt_pi_div_two {x y : ℝ} (hx₁ : -(π / 2) < x) (hx₂ : x < π / 2)
  (hy₁ : -(π / 2) < y) (hy₂ : y < π / 2) (hxy : tan x = tan y) : x = y :=
inj_on_tan ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩ hxy

lemma tan_periodic : function.periodic tan π :=
by simpa only [function.periodic, tan_eq_sin_div_cos] using sin_antiperiodic.div cos_antiperiodic

lemma tan_add_pi (x : ℝ) : tan (x + π) = tan x :=
tan_periodic x

lemma tan_sub_pi (x : ℝ) : tan (x - π) = tan x :=
tan_periodic.sub_eq x

lemma tan_pi_sub (x : ℝ) : tan (π - x) = -tan x :=
tan_neg x ▸ tan_periodic.sub_eq'

lemma tan_nat_mul_pi (n : ℕ) : tan (n * π) = 0 :=
tan_zero ▸ tan_periodic.nat_mul_eq n

lemma tan_int_mul_pi (n : ℤ) : tan (n * π) = 0 :=
tan_zero ▸ tan_periodic.int_mul_eq n

lemma tan_add_nat_mul_pi (x : ℝ) (n : ℕ) : tan (x + n * π) = tan x :=
tan_periodic.nat_mul n x

lemma tan_add_int_mul_pi (x : ℝ) (n : ℤ) : tan (x + n * π) = tan x :=
tan_periodic.int_mul n x

lemma tan_sub_nat_mul_pi (x : ℝ) (n : ℕ) : tan (x - n * π) = tan x :=
tan_periodic.sub_nat_mul_eq n

lemma tan_sub_int_mul_pi (x : ℝ) (n : ℤ) : tan (x - n * π) = tan x :=
tan_periodic.sub_int_mul_eq n

lemma tan_nat_mul_pi_sub (x : ℝ) (n : ℕ) : tan (n * π - x) = -tan x :=
tan_neg x ▸ tan_periodic.nat_mul_sub_eq n

lemma tan_int_mul_pi_sub (x : ℝ) (n : ℤ) : tan (n * π - x) = -tan x :=
tan_neg x ▸ tan_periodic.int_mul_sub_eq n

lemma tendsto_sin_pi_div_two : tendsto sin (𝓝[Iio (π/2)] (π/2)) (𝓝 1) :=
by { convert continuous_sin.continuous_within_at, simp }

lemma tendsto_cos_pi_div_two : tendsto cos (𝓝[Iio (π/2)] (π/2)) (𝓝[Ioi 0] 0) :=
begin
  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
  { convert continuous_cos.continuous_within_at, simp },
  { filter_upwards [Ioo_mem_nhds_within_Iio (right_mem_Ioc.mpr (norm_num.lt_neg_pos
      _ _ pi_div_two_pos pi_div_two_pos))] λ x hx, cos_pos_of_mem_Ioo hx },
end

lemma tendsto_tan_pi_div_two : tendsto tan (𝓝[Iio (π/2)] (π/2)) at_top :=
begin
  convert tendsto_cos_pi_div_two.inv_tendsto_zero.at_top_mul zero_lt_one
            tendsto_sin_pi_div_two,
  simp only [pi.inv_apply, ← div_eq_inv_mul, ← tan_eq_sin_div_cos]
end

lemma tendsto_sin_neg_pi_div_two : tendsto sin (𝓝[Ioi (-(π/2))] (-(π/2))) (𝓝 (-1)) :=
by { convert continuous_sin.continuous_within_at, simp }

lemma tendsto_cos_neg_pi_div_two : tendsto cos (𝓝[Ioi (-(π/2))] (-(π/2))) (𝓝[Ioi 0] 0) :=
begin
  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
  { convert continuous_cos.continuous_within_at, simp },
  { filter_upwards [Ioo_mem_nhds_within_Ioi (left_mem_Ico.mpr (norm_num.lt_neg_pos
      _ _ pi_div_two_pos pi_div_two_pos))] λ x hx, cos_pos_of_mem_Ioo hx },
end

lemma tendsto_tan_neg_pi_div_two : tendsto tan (𝓝[Ioi (-(π/2))] (-(π/2))) at_bot :=
begin
  convert tendsto_cos_neg_pi_div_two.inv_tendsto_zero.at_top_mul_neg (by norm_num)
            tendsto_sin_neg_pi_div_two,
  simp only [pi.inv_apply, ← div_eq_inv_mul, ← tan_eq_sin_div_cos]
end

end real

namespace complex

open_locale real

lemma sin_eq_zero_iff_cos_eq {z : ℂ} : sin z = 0 ↔ cos z = 1 ∨ cos z = -1 :=
by rw [← mul_self_eq_one_iff, ← sin_sq_add_cos_sq, sq, sq, ← sub_eq_iff_eq_add, sub_self];
  exact ⟨λ h, by rw [h, mul_zero], eq_zero_of_mul_self_eq_zero ∘ eq.symm⟩

@[simp] lemma cos_pi_div_two : cos (π / 2) = 0 :=
calc cos (π / 2) = real.cos (π / 2) : by rw [of_real_cos]; simp
... = 0 : by simp

@[simp] lemma sin_pi_div_two : sin (π / 2) = 1 :=
calc sin (π / 2) = real.sin (π / 2) : by rw [of_real_sin]; simp
... = 1 : by simp

@[simp] lemma sin_pi : sin π = 0 :=
by rw [← of_real_sin, real.sin_pi]; simp

@[simp] lemma cos_pi : cos π = -1 :=
by rw [← of_real_cos, real.cos_pi]; simp

@[simp] lemma sin_two_pi : sin (2 * π) = 0 :=
by simp [two_mul, sin_add]

@[simp] lemma cos_two_pi : cos (2 * π) = 1 :=
by simp [two_mul, cos_add]

lemma sin_antiperiodic : function.antiperiodic sin π :=
by simp [sin_add]

lemma sin_periodic : function.periodic sin (2 * π) :=
sin_antiperiodic.periodic

lemma sin_add_pi (x : ℂ) : sin (x + π) = -sin x :=
sin_antiperiodic x

lemma sin_add_two_pi (x : ℂ) : sin (x + 2 * π) = sin x :=
sin_periodic x

lemma sin_sub_pi (x : ℂ) : sin (x - π) = -sin x :=
sin_antiperiodic.sub_eq x

lemma sin_sub_two_pi (x : ℂ) : sin (x - 2 * π) = sin x :=
sin_periodic.sub_eq x

lemma sin_pi_sub (x : ℂ) : sin (π - x) = sin x :=
neg_neg (sin x) ▸ sin_neg x ▸ sin_antiperiodic.sub_eq'

lemma sin_two_pi_sub (x : ℂ) : sin (2 * π - x) = -sin x :=
sin_neg x ▸ sin_periodic.sub_eq'

lemma sin_nat_mul_pi (n : ℕ) : sin (n * π) = 0 :=
sin_antiperiodic.nat_mul_eq_of_eq_zero sin_zero n

lemma sin_int_mul_pi (n : ℤ) : sin (n * π) = 0 :=
sin_antiperiodic.int_mul_eq_of_eq_zero sin_zero n

lemma sin_add_nat_mul_two_pi (x : ℂ) (n : ℕ) : sin (x + n * (2 * π)) = sin x :=
sin_periodic.nat_mul n x

lemma sin_add_int_mul_two_pi (x : ℂ) (n : ℤ) : sin (x + n * (2 * π)) = sin x :=
sin_periodic.int_mul n x

lemma sin_sub_nat_mul_two_pi (x : ℂ) (n : ℕ) : sin (x - n * (2 * π)) = sin x :=
sin_periodic.sub_nat_mul_eq n

lemma sin_sub_int_mul_two_pi (x : ℂ) (n : ℤ) : sin (x - n * (2 * π)) = sin x :=
sin_periodic.sub_int_mul_eq n

lemma sin_nat_mul_two_pi_sub (x : ℂ) (n : ℕ) : sin (n * (2 * π) - x) = -sin x :=
sin_neg x ▸ sin_periodic.nat_mul_sub_eq n

lemma sin_int_mul_two_pi_sub (x : ℂ) (n : ℤ) : sin (n * (2 * π) - x) = -sin x :=
sin_neg x ▸ sin_periodic.int_mul_sub_eq n

lemma cos_antiperiodic : function.antiperiodic cos π :=
by simp [cos_add]

lemma cos_periodic : function.periodic cos (2 * π) :=
cos_antiperiodic.periodic

lemma cos_add_pi (x : ℂ) : cos (x + π) = -cos x :=
cos_antiperiodic x

lemma cos_add_two_pi (x : ℂ) : cos (x + 2 * π) = cos x :=
cos_periodic x

lemma cos_sub_pi (x : ℂ) : cos (x - π) = -cos x :=
cos_antiperiodic.sub_eq x

lemma cos_sub_two_pi (x : ℂ) : cos (x - 2 * π) = cos x :=
cos_periodic.sub_eq x

lemma cos_pi_sub (x : ℂ) : cos (π - x) = -cos x :=
cos_neg x ▸ cos_antiperiodic.sub_eq'

lemma cos_two_pi_sub (x : ℂ) : cos (2 * π - x) = cos x :=
cos_neg x ▸ cos_periodic.sub_eq'

lemma cos_nat_mul_two_pi (n : ℕ) : cos (n * (2 * π)) = 1 :=
(cos_periodic.nat_mul_eq n).trans cos_zero

lemma cos_int_mul_two_pi (n : ℤ) : cos (n * (2 * π)) = 1 :=
(cos_periodic.int_mul_eq n).trans cos_zero

lemma cos_add_nat_mul_two_pi (x : ℂ) (n : ℕ) : cos (x + n * (2 * π)) = cos x :=
cos_periodic.nat_mul n x

lemma cos_add_int_mul_two_pi (x : ℂ) (n : ℤ) : cos (x + n * (2 * π)) = cos x :=
cos_periodic.int_mul n x

lemma cos_sub_nat_mul_two_pi (x : ℂ) (n : ℕ) : cos (x - n * (2 * π)) = cos x :=
cos_periodic.sub_nat_mul_eq n

lemma cos_sub_int_mul_two_pi (x : ℂ) (n : ℤ) : cos (x - n * (2 * π)) = cos x :=
cos_periodic.sub_int_mul_eq n

lemma cos_nat_mul_two_pi_sub (x : ℂ) (n : ℕ) : cos (n * (2 * π) - x) = cos x :=
cos_neg x ▸ cos_periodic.nat_mul_sub_eq n

lemma cos_int_mul_two_pi_sub (x : ℂ) (n : ℤ) : cos (n * (2 * π) - x) = cos x :=
cos_neg x ▸ cos_periodic.int_mul_sub_eq n

lemma cos_nat_mul_two_pi_add_pi (n : ℕ) : cos (n * (2 * π) + π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.nat_mul n).add_antiperiod_eq cos_antiperiodic

lemma cos_int_mul_two_pi_add_pi (n : ℤ) : cos (n * (2 * π) + π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.int_mul n).add_antiperiod_eq cos_antiperiodic

lemma cos_nat_mul_two_pi_sub_pi (n : ℕ) : cos (n * (2 * π) - π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.nat_mul n).sub_antiperiod_eq cos_antiperiodic

lemma cos_int_mul_two_pi_sub_pi (n : ℤ) : cos (n * (2 * π) - π) = -1 :=
by simpa only [cos_zero] using (cos_periodic.int_mul n).sub_antiperiod_eq cos_antiperiodic

lemma sin_add_pi_div_two (x : ℂ) : sin (x + π / 2) = cos x :=
by simp [sin_add]

lemma sin_sub_pi_div_two (x : ℂ) : sin (x - π / 2) = -cos x :=
by simp [sub_eq_add_neg, sin_add]

lemma sin_pi_div_two_sub (x : ℂ) : sin (π / 2 - x) = cos x :=
by simp [sub_eq_add_neg, sin_add]

lemma cos_add_pi_div_two (x : ℂ) : cos (x + π / 2) = -sin x :=
by simp [cos_add]

lemma cos_sub_pi_div_two (x : ℂ) : cos (x - π / 2) = sin x :=
by simp [sub_eq_add_neg, cos_add]

lemma cos_pi_div_two_sub (x : ℂ) : cos (π / 2 - x) = sin x :=
by rw [← cos_neg, neg_sub, cos_sub_pi_div_two]

lemma tan_periodic : function.periodic tan π :=
by simpa only [tan_eq_sin_div_cos] using sin_antiperiodic.div cos_antiperiodic

lemma tan_add_pi (x : ℂ) : tan (x + π) = tan x :=
tan_periodic x

lemma tan_sub_pi (x : ℂ) : tan (x - π) = tan x :=
tan_periodic.sub_eq x

lemma tan_pi_sub (x : ℂ) : tan (π - x) = -tan x :=
tan_neg x ▸ tan_periodic.sub_eq'

lemma tan_nat_mul_pi (n : ℕ) : tan (n * π) = 0 :=
tan_zero ▸ tan_periodic.nat_mul_eq n

lemma tan_int_mul_pi (n : ℤ) : tan (n * π) = 0 :=
tan_zero ▸ tan_periodic.int_mul_eq n

lemma tan_add_nat_mul_pi (x : ℂ) (n : ℕ) : tan (x + n * π) = tan x :=
tan_periodic.nat_mul n x

lemma tan_add_int_mul_pi (x : ℂ) (n : ℤ) : tan (x + n * π) = tan x :=
tan_periodic.int_mul n x

lemma tan_sub_nat_mul_pi (x : ℂ) (n : ℕ) : tan (x - n * π) = tan x :=
tan_periodic.sub_nat_mul_eq n

lemma tan_sub_int_mul_pi (x : ℂ) (n : ℤ) : tan (x - n * π) = tan x :=
tan_periodic.sub_int_mul_eq n

lemma tan_nat_mul_pi_sub (x : ℂ) (n : ℕ) : tan (n * π - x) = -tan x :=
tan_neg x ▸ tan_periodic.nat_mul_sub_eq n

lemma tan_int_mul_pi_sub (x : ℂ) (n : ℤ) : tan (n * π - x) = -tan x :=
tan_neg x ▸ tan_periodic.int_mul_sub_eq n

lemma exp_antiperiodic : function.antiperiodic exp (π * I) :=
by simp [exp_add, exp_mul_I]

lemma exp_periodic : function.periodic exp (2 * π * I) :=
(mul_assoc (2:ℂ) π I).symm ▸ exp_antiperiodic.periodic

lemma exp_mul_I_antiperiodic : function.antiperiodic (λ x, exp (x * I)) π :=
by simpa only [mul_inv_cancel_right₀ I_ne_zero] using exp_antiperiodic.mul_const I_ne_zero

lemma exp_mul_I_periodic : function.periodic (λ x, exp (x * I)) (2 * π) :=
exp_mul_I_antiperiodic.periodic

@[simp] lemma exp_pi_mul_I : exp (π * I) = -1 :=
exp_zero ▸ exp_antiperiodic.eq

@[simp] lemma exp_two_pi_mul_I : exp (2 * π * I) = 1 :=
exp_periodic.eq.trans exp_zero

@[simp] lemma exp_nat_mul_two_pi_mul_I (n : ℕ) : exp (n * (2 * π * I)) = 1 :=
(exp_periodic.nat_mul_eq n).trans exp_zero

@[simp] lemma exp_int_mul_two_pi_mul_I (n : ℤ) : exp (n * (2 * π * I)) = 1 :=
(exp_periodic.int_mul_eq n).trans exp_zero

@[simp] lemma exp_add_pi_mul_I (z : ℂ) : exp (z + π * I) = -exp z :=
exp_antiperiodic z

@[simp] lemma exp_sub_pi_mul_I (z : ℂ) : exp (z - π * I) = -exp z :=
exp_antiperiodic.sub_eq z

end complex


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

/-!
# `ne_zero` typeclass

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

We create a typeclass `ne_zero n` which carries around the fact that `(n : R) ≠ 0`.

## Main declarations

* `ne_zero`: `n ≠ 0` as a typeclass.

-/

/-- A type-class version of `n ≠ 0`.  -/
class ne_zero {R} [has_zero R] (n : R) : Prop := (out : n ≠ 0)

lemma ne_zero.ne {R} [has_zero R] (n : R) [h : ne_zero n] : n ≠ 0 := h.out

lemma ne_zero.ne' {R} [has_zero R] (n : R) [h : ne_zero n] : 0 ≠ n := h.out.symm

lemma ne_zero_iff {R : Type*} [has_zero R] {n : R} : ne_zero n ↔ n ≠ 0 :=
⟨λ h, h.out, ne_zero.mk⟩

lemma not_ne_zero {R : Type*} [has_zero R] {n : R} : ¬ ne_zero n ↔ n = 0 :=
by simp [ne_zero_iff]

lemma eq_zero_or_ne_zero {α} [has_zero α] (a : α) : a = 0 ∨ ne_zero a :=
(eq_or_ne a 0).imp_right ne_zero.mk

section
variables {α : Type*} [has_zero α] [has_one α]

@[simp] lemma zero_ne_one [ne_zero (1 : α)] : (0 : α) ≠ 1 := ne_zero.ne' (1 : α)
@[simp] lemma one_ne_zero [ne_zero (1 : α)] : (1 : α) ≠ 0 := ne_zero.ne (1 : α)
lemma two_ne_zero [has_add α] [ne_zero (2 : α)] : (2 : α) ≠ 0 := ne_zero.ne (2 : α)
lemma three_ne_zero [has_add α] [ne_zero (3 : α)] : (3 : α) ≠ 0 := ne_zero.ne (3 : α)
lemma four_ne_zero [has_add α] [ne_zero (4 : α)] : (4 : α) ≠ 0 := ne_zero.ne (4 : α)

lemma ne_zero_of_eq_one [ne_zero (1 : α)] {a : α} (h : a = 1) : a ≠ 0 :=
calc a = 1 : h
   ... ≠ 0 : one_ne_zero

variable (α)

lemma zero_ne_one' [ne_zero (1 : α)] : (0 : α) ≠ 1 := ne_zero.ne' (1 : α)
lemma one_ne_zero' [ne_zero (1 : α)] : (1 : α) ≠ 0 := ne_zero.ne (1 : α)
lemma two_ne_zero' [has_add α] [ne_zero (2 : α)] : (2 : α) ≠ 0 := ne_zero.ne (2 : α)
lemma three_ne_zero' [has_add α] [ne_zero (3 : α)] : (3 : α) ≠ 0 := ne_zero.ne (3 : α)
lemma four_ne_zero' [has_add α] [ne_zero (4 : α)] : (4 : α) ≠ 0 := ne_zero.ne (4 : α)

end

namespace ne_zero

variables {R S M F : Type*} {r : R} {x y : M} {n p : ℕ} --{a : ℕ+}

instance succ : ne_zero (n + 1) := ⟨n.succ_ne_zero⟩

instance coe_trans [has_zero M] [has_coe R S] [has_coe_t S M] [h : ne_zero (r : M)] :
  ne_zero ((r : S) : M) := ⟨h.out⟩

lemma trans [has_zero M] [has_coe R S] [has_coe_t S M] (h : ne_zero ((r : S) : M)) :
  ne_zero (r : M) := ⟨h.out⟩

end ne_zero


example (p q : Prop) : p ∧ q ↔ q ∧ p :=
begin
  apply iff.intro,
  { intro h,
    have hp : p := h.left,
    have hq : q := h.right,
    show q ∧ p,
      exact ⟨hq, hp⟩ },
    intro h,
    have hp : p := h.right,
    have hq : q := h.left,
    show p ∧ q,
      exact ⟨hp, hq⟩
end


import topology_tools

universes u v
variables {X : Type u} {Y : Type v} [topological_space X] [topological_space Y]

/-- Proof that the product of two compact sets is itself compact. -/
theorem prod_of_compact {U : set X} {V : set Y} (hU : is_compact U) (hV : is_compact V) : is_compact (U ×ˢ V) :=
begin
  apply is_compact_of_finite_subcover', intro C,
  have h₁ : ∀ x : U, ∃ t : finset V, V ⊆ ⋃ (y : V) (_ : y ∈ t), (C.rect x.2 y.2).V,
  { intro x,
    let D : cover V := {
      ι      := V,
      sι     := λ y, (C.rect x.2 y.2).V,
      hopen  := λ _, rect.hV _,
      hcover := λ y hy, set.mem_Union.mpr ⟨⟨y, hy⟩, (rect.hp _).2⟩
    },
    exact D.has_finite_subcover_of_compact hV },
  have h₂ : ∃ t : finset U, U ⊆ ⋃ (x : U) (_ : x ∈ t), ⋂ (y : V) (_ : y ∈ (h₁ x).some), (C.rect x.2 y.2).U,
  { let D : cover U := {
      ι      := U,
      sι     := λ x, ⋂ (y : V) (_ : y ∈ (h₁ x).some), (C.rect x.2 y.2).U,
      hopen  := λ x, is_open_bInter (h₁ x).some.finite_to_set $ λ _ _, rect.hU _,
      hcover := λ x hx, set.mem_Union.mpr ⟨⟨x, hx⟩, set.mem_Inter₂.mpr $ λ _ _, (rect.hp _).1⟩
    },
    exact D.has_finite_subcover_of_compact hU },
  cases h₂ with fx hfx, classical,
  use finset.bUnion fx (λ x : U, ((h₁ x).some.1.map $ λ y : V, (C.rect x.2 y.2).j).to_finset),
  intros p hp,
  rcases set.mem_Union₂.mp (hfx hp.1) with ⟨x, hx, hp₁⟩,
  rcases set.mem_Union₂.mp ((h₁ x).some_spec hp.2) with ⟨y, hy, hp₂⟩,
  let R := C.rect x.2 y.2,
  apply set.mem_Union₂.mpr,
  exact ⟨R.j,
    finset.mem_bUnion.mpr ⟨x, hx, multiset.mem_to_finset.mpr $ multiset.mem_map.mpr ⟨y, hy, rfl⟩⟩,
    R.hj ⟨(set.mem_Inter₂.mp hp₁ y hy : _), hp₂⟩⟩
end

/-- Proof that if the product of two nonempty sets is compact, so are the two sets. -/
theorem compact_of_prod {U : set X} {V : set Y} (hU : U.nonempty) (hV : V.nonempty) (hUV : is_compact (U ×ˢ V)) :
  is_compact U ∧ is_compact V :=
    ⟨prod_image_fst U hV ▸ (hUV.image_of_continuous_on continuous_on_fst),
      prod_image_snd hU V ▸ (hUV.image_of_continuous_on continuous_on_snd)⟩

/-- Proof that if the nonempty product of two sets is compact, so are the two sets. -/
theorem compact_of_prod' {U : set X} {V : set Y} : set.nonempty (U ×ˢ V) → is_compact (U ×ˢ V) →
  is_compact U ∧ is_compact V := λ ⟨p, hp⟩, compact_of_prod ⟨p.1, hp.1⟩ ⟨p.2, hp.2⟩

/-- Proof that for a compact set `U` and any set `V`, the projection map
  `U × V → V` preserves closed sets. -/
theorem proj_closed_of_compact {U : set X} (hU : is_compact U) : ∀ (V : set Y),
  is_closed_map (prod.snd : U × V → V) :=
begin
  intros V C hC,
  apply is_closed_iff_outside_neighbourhoods.mpr,
  intros y hy,
  let D : cover U := {
    ι      := {U' : set X // is_open U' ∧ ∃ W : set Y, is_open W ∧
      y.1 ∈ W ∧ ∀ p ∈ C, ((p.1.1, p.2.1) : X × Y) ∉ U' ×ˢ W},
    sι     := subtype.val,
    hopen  := λ i, i.2.1,
    hcover := begin
      intros x hx, let x' : U := ⟨x, hx⟩, let p := (x', y),
      apply set.mem_Union.mpr,
      rcases is_closed_iff_outside_neighbourhoods.mp hC p (λ h, hy ⟨p, h, rfl⟩) with ⟨R, hR, hpR, hCR⟩,
      rcases is_open_prod_iff.mp hR x' y hpR with ⟨U', V', hU', hV', hxU', hyV', hUV'⟩,
      rcases is_open_subtype.mp hU' with ⟨S, hS, hUS'⟩,
      rcases is_open_subtype.mp hV' with ⟨T, hT, hVT'⟩,
      exact ⟨⟨S, hS, T, hT, (hVT' y).mp hyV', λ q hq ⟨h₁, h₂⟩, by {
        have : q ∈ C ∩ R := ⟨hq, hUV' ⟨(hUS' q.1).mpr h₁, (hVT' q.2).mpr h₂⟩⟩,
        rw [hCR] at this, exact this }⟩, (hUS' x').mp hxU'⟩
    end },
  cases D.has_finite_subcover_of_compact hU with Dι hDι,
  let W := ⋂ (i : D.ι) (_ : i ∈ Dι), i.2.2.some,
  have hW := is_open_bInter Dι.finite_to_set (λ i _, i.2.2.some_spec.1),
  have hyW : y.1 ∈ W := set.mem_bInter (λ i _, i.2.2.some_spec.2.1),
  have hWC : ∀ p : U × V, p.2.1 ∈ W → p ∉ C,
  { intros p hp hpC,
    rcases set.mem_Union₂.mp (hDι p.1.2) with ⟨i, hi, hpi⟩,
    exact i.2.2.some_spec.2.2 p hpC ⟨hpi, (set.mem_Inter₂.mp hp i hi : _)⟩ },
  exact ⟨{y : V | y.1 ∈ W}, is_open_subtype.mpr ⟨W, hW, λ _, iff.rfl⟩, hyW, by
  { ext y', apply (iff_false _).mpr, apply not_and.mpr,
    intros hyC' hyW', rcases hyC' with ⟨p', hpC', hpy'⟩,
    exact absurd hpC' (hWC p' (hpy'.symm ▸ hyW')) }⟩
end

/-- Space consisting of an embedding of `U` and a single distinguished point `pt`. -/
inductive pt_space (U : set X)
| pt  : pt_space
| emb : U → pt_space

open pt_space

/-- A topology on `pt_space U` with opens:
  • the embedding of any subset of `U` (regardless of whether it's open or not),
  • for all `i` in the indexing type `ι`, `pt` unioned with the embedding of `sι i`.
  This is not an instance as it requires the set `U` and the collection of sets `sι` as arguments. -/
def pt_space_topology (U : set X) {ι : Type u} (sι : ι → set X) : topological_space (pt_space U) := {
  is_open := λ s, pt ∉ s ∨ ∃ t : finset ι, ∀ x : U, (x.1 ∈ ⋂ i ∈ t, sι i) → emb x ∈ s,
  is_open_univ := or.inr ⟨∅, λ _ _, trivial⟩,
  is_open_inter := begin
    intros s t hs ht,
    cases hs with hs hs,
    { exact or.inl (λ h, hs h.1) },
    { cases ht with ht ht,
      { exact or.inl (λ h, ht h.2) },
      { apply or.inr, cases hs with fs hs, cases ht with ft ht, classical,
        exact ⟨fs ∪ ft, λ x hx, ⟨hs x $ finset_intersection_subset (finset.subset_union_left fs ft) hx,
          ht x $ finset_intersection_subset (finset.subset_union_right fs ft) hx⟩⟩ } }
  end,
  is_open_sUnion := begin
    intros s hs,
    by_cases h : ∀ t ∈ s, pt ∉ t,
    { apply or.inl, intro h',
      rcases set.mem_sUnion.mp h' with ⟨t, hts, hptt⟩,
      exact absurd hptt (h t hts) },
    { simp only [not_forall] at h,
      rcases h with ⟨t, hts, hptt⟩,
      cases (hs t hts).resolve_left hptt with fs h,
      exact or.inr ⟨fs, λ x hx, set.mem_sUnion.mpr ⟨t, hts, h x hx⟩⟩ }
  end
}

/-- The set `sι i ∪ {pt}` in `pt_space`. -/
def pt_embedding (U : set X) {ι : Type u} (sι : ι → set X) (i : ι) : set (pt_space U) :=
  {x | x = pt ∨ ∃ x' : U, x'.1 ∈ sι i ∧ x = emb x'}

/-- Proof that the set `sι i ∪ {pt}` is open in `pt_space_topology`. -/
theorem pt_embedding.is_open (U : set X) {ι : Type u} (sι : ι → set X) (i : ι) :
  @is_open _ (pt_space_topology U sι) (pt_embedding U sι i) :=
begin
  apply or.inr, use {i}, intros x hx,
  simp only [finset.mem_singleton, set.Inter_Inter_eq_left] at hx,
  exact or.inr ⟨x, hx, rfl⟩
end

/-- If the topology inducing collection of sets `sι` satisfies the finite intersection property,
  then the singleton `{pt}` cannot be open in `pt_space_topology`. -/
theorem pt_nonempty {U : set X} {ι : Type u} {sι : ι → set X}
  (hfip : ∀ t : finset ι, (U ∩ ⋂ i ∈ t, sι i).nonempty) : ¬@is_open _ (pt_space_topology U sι) {pt} :=
begin
  intro h,
  cases h.resolve_left (not_not.mpr (set.mem_singleton pt)) with t ht,
  cases hfip t with x hx,
  apply not_not.mpr (set.mem_singleton_iff.mp (ht ⟨x, hx.1⟩ hx.2)),
  apply pt_space.no_confusion
end

/-- Wrapper for explicit use of the subtype topology instance. -/
def subtype_topology {X : Type u} (_ : topological_space X) (U : set X) :
  topological_space U := infer_instance

/-- Wrapper for explicit use of the product topology instance. -/
def product_topology {X : Type u} {Y : Type v} (_ : topological_space X) (_ : topological_space Y) :
  topological_space (X × Y) := infer_instance

/-- If a set `U` satisfies, for any set `V`, the projection map `U × V → V` is closed, then `U` is compact.  -/
theorem compact_of_proj_closed {U : set X} (h : ∀ {Y : Type u} {ty : topological_space Y} (V : set Y),
  @is_closed_map _ _ (product_topology infer_instance (subtype_topology ty V)) (subtype_topology ty V)
    (prod.snd : U × V → V)) : is_compact U :=
begin
  apply is_compact_iff_finite_intersection_property.mpr,
  intros ι sι hι hfip,
  let pt_sp := pt_space U,
  let top₀  := pt_space_topology U sι,
  let top₁  := subtype_topology top₀ set.univ,
  let top₂  : topological_space (U × @set.univ pt_sp) := product_topology infer_instance top₁,
  let K     := @closure _ top₂ {p | p.2.1 = emb p.1},
  have : (prod.snd '' K)ᶜ ⊆ {⟨pt, trivial⟩},
  { rintros ⟨x, _⟩ hx,
    simp only [set.mem_compl_eq, set.mem_image, not_exists, not_and] at hx,
    cases x,
    { exact set.mem_singleton_iff.mpr rfl },
    { have := hx ⟨x, emb x, trivial⟩ (by { apply subset_closure, change _ = _, refl }),
      exfalso, apply this, refl } },
  have : (⟨pt, trivial⟩ : @set.univ pt_sp) ∈ prod.snd '' K,
  { cases set.subset_singleton_iff_eq.mp this with he he,
    { rw [set.compl_empty_iff.mp he], trivial },
    { have : @is_closed _ top₁ (prod.snd '' K) := h set.univ K (@is_closed_closure _ top₂ _),
      have : @is_open _ top₁ {⟨pt, trivial⟩} := he ▸ ((@is_open_compl_iff _ top₁ _).mpr this),
      cases (@is_open_subtype _ top₀ _ _).mp this with T hT,
      have : T = {pt},
      { ext x, have := hT.2 ⟨x, trivial⟩, rw [set.mem_singleton_iff] at this ⊢,
        cases x; { simp only [eq_self_iff_true, subtype.mk_eq_mk] at this ⊢, exact this.symm } },
      exact absurd (this ▸ hT.1 : @is_open _ top₀ {pt}) (pt_nonempty hfip) } },
  rcases this with ⟨p, hpK, hpe⟩,
  have : ∀ i : ι, p.1.1 ∈ sι i,
  { intro i,
    have := (@mem_closure_iff _ top₂ _ _).mp hpK (@set.univ U ×ˢ {x : set.univ | x.1 ∈ pt_embedding U sι i})
      ((@is_open.prod _ _ _ top₁ _ _) is_open_univ $ (@is_open_subtype _ top₀ _ _).mpr
        ⟨pt_embedding U sι i, pt_embedding.is_open U sι i, λ x, iff.rfl⟩) ⟨trivial, hpe.symm ▸ or.inl rfl⟩,
    rcases this with ⟨p', ⟨_, hp'⟩, (hpD' : _ = _)⟩,
    rcases hp'.resolve_left (by { rw [hpD'], apply pt_space.no_confusion }) with ⟨x, hxi, hxe⟩,
    by_contra hi,
    rcases is_closed_iff_outside_neighbourhoods.mp (hι i) p.1.1 hi with ⟨V, hV, hpV, hiV⟩,
    have := (@mem_closure_iff _ top₂ _ _).mp hpK ({x : U | x.1 ∈ V} ×ˢ {x : set.univ | x.1 ∈ pt_embedding U sι i})
      ((@is_open.prod _ _ _ top₁ _ _) (is_open_subtype.mpr ⟨V, hV, λ x, iff.rfl⟩) $ (@is_open_subtype _ top₀ _ _).mpr
        ⟨pt_embedding U sι i, pt_embedding.is_open U sι i, λ x, iff.rfl⟩) ⟨hpV, or.inl $ congr_arg subtype.val hpe⟩,
    rcases this with ⟨x', ⟨hxV', hxi'⟩, (hxD' : _ = _)⟩,
    rcases hxi'.resolve_left (by { rw [hxD'], apply pt_space.no_confusion }) with ⟨x'', hxi'', hxe''⟩,
    apply set.not_nonempty_iff_eq_empty.mpr hiV,
    exact ⟨x'.1.1, emb.inj (hxe''.symm.trans hxD') ▸ hxi'', hxV'⟩ },
  exact ⟨p.1.1, p.1.2, set.mem_Inter.mpr this⟩
end

/-- A set `U` is compact if and only if for every set `V`, the projection map `U × V → V` is closed. -/
theorem compact_iff_proj_closed {U : set X} : is_compact U ↔ (∀ {Y : Type u} {ty : topological_space Y} (V : set Y),
  @is_closed_map _ _ (product_topology infer_instance (subtype_topology ty V)) (subtype_topology ty V)
    (prod.snd : U × V → V)) := ⟨λ h Y topY V, @proj_closed_of_compact _ _ _ topY U h V, compact_of_proj_closed⟩


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import field_theory.splitting_field
/-!
# Algebraically Closed Field

In this file we define the typeclass for algebraically closed fields and algebraic closures,
and prove some of their properties.

## Main Definitions

- `is_alg_closed k` is the typeclass saying `k` is an algebraically closed field, i.e. every
polynomial in `k` splits.

- `is_alg_closure k K` is the typeclass saying `K` is an algebraic closure of `k`.

- `is_alg_closed.lift` is a map from an algebraic extension `L` of `K`, into any algebraically
  closed extension of `K`.

- `is_alg_closure.equiv` is a proof that any two algebraic closures of the
  same field are isomorphic.

## TODO

Show that any two algebraic closures are isomorphic

## Tags

algebraic closure, algebraically closed

-/
universes u v w

open_locale classical big_operators
open polynomial

variables (k : Type u) [field k]

/-- Typeclass for algebraically closed fields.

To show `polynomial.splits p f` for an arbitrary ring homomorphism `f`,
see `is_alg_closed.splits_codomain` and `is_alg_closed.splits_domain`.
-/
class is_alg_closed : Prop :=
(splits : ∀ p : polynomial k, p.splits $ ring_hom.id k)

/-- Every polynomial splits in the field extension `f : K →+* k` if `k` is algebraically closed.

See also `is_alg_closed.splits_domain` for the case where `K` is algebraically closed.
-/
theorem is_alg_closed.splits_codomain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : K →+* k} (p : polynomial K) : p.splits f :=
by { convert is_alg_closed.splits (p.map f), simp [splits_map_iff] }

/-- Every polynomial splits in the field extension `f : K →+* k` if `K` is algebraically closed.

See also `is_alg_closed.splits_codomain` for the case where `k` is algebraically closed.
-/
theorem is_alg_closed.splits_domain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : k →+* K} (p : polynomial k) : p.splits f :=
polynomial.splits_of_splits_id _ $ is_alg_closed.splits _

namespace is_alg_closed

variables {k}

theorem exists_root [is_alg_closed k] (p : polynomial k) (hp : p.degree ≠ 0) : ∃ x, is_root p x :=
exists_root_of_splits _ (is_alg_closed.splits p) hp

lemma exists_pow_nat_eq [is_alg_closed k] (x : k) {n : ℕ} (hn : 0 < n) : ∃ z, z ^ n = x :=
begin
  rcases exists_root (X ^ n - C x) _ with ⟨z, hz⟩, swap,
  { rw degree_X_pow_sub_C hn x,
    exact ne_of_gt (with_bot.coe_lt_coe.2 hn) },
  use z,
  simp only [eval_C, eval_X, eval_pow, eval_sub, is_root.def] at hz,
  exact sub_eq_zero.1 hz
end

lemma exists_eq_mul_self [is_alg_closed k] (x : k) : ∃ z, x = z * z :=
begin
  rcases exists_pow_nat_eq x zero_lt_two with ⟨z, rfl⟩,
  exact ⟨z, sq z⟩
end

theorem exists_eval₂_eq_zero_of_injective {R : Type*} [ring R] [is_alg_closed k] (f : R →+* k)
  (hf : function.injective f) (p : polynomial R) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
let ⟨x, hx⟩ := exists_root (p.map f) (by rwa [degree_map_eq_of_injective hf]) in
⟨x, by rwa [eval₂_eq_eval_map, ← is_root]⟩

theorem exists_eval₂_eq_zero {R : Type*} [field R] [is_alg_closed k] (f : R →+* k)
  (p : polynomial R) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
exists_eval₂_eq_zero_of_injective f f.injective p hp

variables (k)

theorem exists_aeval_eq_zero_of_injective {R : Type*} [comm_ring R] [is_alg_closed k] [algebra R k]
  (hinj : function.injective (algebra_map R k)) (p : polynomial R) (hp : p.degree ≠ 0) :
  ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero_of_injective (algebra_map R k) hinj p hp

theorem exists_aeval_eq_zero {R : Type*} [field R] [is_alg_closed k] [algebra R k]
  (p : polynomial R) (hp : p.degree ≠ 0) : ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero (algebra_map R k) p hp

theorem of_exists_root (H : ∀ p : polynomial k, p.monic → irreducible p → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
⟨λ p, or.inr $ λ q hq hqp,
 have irreducible (q * C (leading_coeff q)⁻¹),
   by { rw ← coe_norm_unit_of_ne_zero hq.ne_zero,
        exact (associated_normalize _).irreducible hq },
 let ⟨x, hx⟩ := H (q * C (leading_coeff q)⁻¹) (monic_mul_leading_coeff_inv hq.ne_zero) this in
 degree_mul_leading_coeff_inv q hq.ne_zero ▸ degree_eq_one_of_irreducible_of_root this hx⟩

lemma degree_eq_one_of_irreducible [is_alg_closed k] {p : polynomial k} (h_nz : p ≠ 0)
  (hp : irreducible p) :
  p.degree = 1 :=
degree_eq_one_of_irreducible_of_splits h_nz hp (is_alg_closed.splits_codomain _)

lemma algebra_map_surjective_of_is_integral {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_integral k K) :
  function.surjective (algebra_map k K) :=
begin
  refine λ x, ⟨-((minpoly k x).coeff 0), _⟩,
  have hq : (minpoly k x).leading_coeff = 1 := minpoly.monic (hf x),
  have h : (minpoly k x).degree = 1 := degree_eq_one_of_irreducible k
    (minpoly.ne_zero (hf x)) (minpoly.irreducible (hf x)),
  have : (aeval x (minpoly k x)) = 0 := minpoly.aeval k x,
  rw [eq_X_add_C_of_degree_eq_one h, hq, C_1, one_mul,
    aeval_add, aeval_X, aeval_C, add_eq_zero_iff_eq_neg] at this,
  exact (ring_hom.map_neg (algebra_map k K) ((minpoly k x).coeff 0)).symm ▸ this.symm,
end

lemma algebra_map_surjective_of_is_integral'
  {k K : Type*} [field k] [comm_ring K] [is_domain K]
  [hk : is_alg_closed k] (f : k →+* K) (hf : f.is_integral) : function.surjective f :=
@algebra_map_surjective_of_is_integral k K _ _ _ _ f.to_algebra hf

lemma algebra_map_surjective_of_is_algebraic {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_algebraic k K) :
  function.surjective (algebra_map k K) :=
algebra_map_surjective_of_is_integral ((is_algebraic_iff_is_integral' k).mp hf)

end is_alg_closed

/-- Typeclass for an extension being an algebraic closure. -/
class is_alg_closure (K : Type v) [field K] [algebra k K] : Prop :=
(alg_closed : is_alg_closed K)
(algebraic : algebra.is_algebraic k K)

theorem is_alg_closure_iff (K : Type v) [field K] [algebra k K] :
  is_alg_closure k K ↔ is_alg_closed K ∧ algebra.is_algebraic k K :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

/--
Every element `f` in a nontrivial finite-dimensional algebra `A`
over an algebraically closed field `K`
has non-empty spectrum:
that is, there is some `c : K` so `f - c • 1` is not invertible.
-/
-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
lemma exists_spectrum_of_is_alg_closed_of_finite_dimensional (𝕜 : Type*) [field 𝕜] [is_alg_closed 𝕜]
  {A : Type*} [nontrivial A] [ring A] [algebra 𝕜 A] [I : finite_dimensional 𝕜 A] (f : A) :
  ∃ c : 𝕜, ¬ is_unit (f - algebra_map 𝕜 A c) :=
begin
  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) f,
  have nu : ¬ is_unit (aeval f p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p),
    ←multiset.prod_to_list, alg_hom.map_list_prod] at nu,
  replace nu := mt list.prod_is_unit nu,
  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at nu,
  exact ⟨nu.some, nu.some_spec.2⟩,
end

namespace lift
/- In this section, the homomorphism from any algebraic extension into an algebraically
  closed extension is proven to exist. The assumption that M is algebraically closed could probably
  easily be switched to an assumption that M contains all the roots of polynomials in K -/
variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL
open zorn subalgebra alg_hom function

/-- This structure is used to prove the existence of a homomorphism from any algebraic extension
into an algebraic closure -/
structure subfield_with_hom :=
(carrier : subalgebra K L)
(emb : carrier →ₐ[K] M)

variables {K L M hL}

namespace subfield_with_hom
variables {E₁ E₂ E₃ : subfield_with_hom K L M hL}

instance : has_le (subfield_with_hom K L M hL) :=
{ le := λ E₁ E₂, ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x }

noncomputable instance : inhabited (subfield_with_hom K L M hL) :=
⟨{ carrier := ⊥,
   emb := (algebra.of_id K M).comp (algebra.bot_equiv K L).to_alg_hom }⟩

lemma le_def : E₁ ≤ E₂ ↔ ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x :=
iff.rfl

lemma compat (h : E₁ ≤ E₂) : ∀ x, E₂.emb (inclusion h.fst x) = E₁.emb x :=
by { rw le_def at h, cases h, assumption }

instance : preorder (subfield_with_hom K L M hL) :=
{ le := (≤),
  le_refl := λ E, ⟨le_refl _, by simp⟩,
  le_trans := λ E₁ E₂ E₃ h₁₂ h₂₃,
    ⟨le_trans h₁₂.fst h₂₃.fst,
    λ _, by erw [← inclusion_inclusion h₁₂.fst h₂₃.fst, compat, compat]⟩ }

open lattice

lemma maximal_subfield_with_hom_chain_bounded (c : set (subfield_with_hom K L M hL))
  (hc : chain (≤) c) (hcn  : c.nonempty) :
  ∃ ub : subfield_with_hom K L M hL, ∀ N, N ∈ c → N ≤ ub :=
let ub : subfield_with_hom K L M hL :=
by haveI : nonempty c := set.nonempty.to_subtype hcn; exact
{ carrier := ⨆ i : c, (i : subfield_with_hom K L M hL).carrier,
  emb := subalgebra.supr_lift
    (λ i : c, (i : subfield_with_hom K L M hL).carrier)
    (λ i j, let ⟨k, hik, hjk⟩ := directed_on_iff_directed.1 hc.directed_on i j in
      ⟨k, hik.fst, hjk.fst⟩)
    (λ i, (i : subfield_with_hom K L M hL).emb)
    begin
      assume i j h,
      ext x,
      cases hc.total i.prop j.prop with hij hji,
      { simp [← hij.snd x] },
      { erw [alg_hom.comp_apply, ← hji.snd (inclusion h x),
          inclusion_inclusion, inclusion_self, alg_hom.id_apply x] }
    end _ rfl } in
⟨ub, λ N hN, ⟨(le_supr (λ i : c, (i : subfield_with_hom K L M hL).carrier) ⟨N, hN⟩ : _),
  begin
    intro x,
    simp [ub],
    refl
  end⟩⟩

variables (hL M)

lemma exists_maximal_subfield_with_hom : ∃ E : subfield_with_hom K L M hL,
  ∀ N, E ≤ N → N ≤ E :=
zorn.exists_maximal_of_nonempty_chains_bounded
  maximal_subfield_with_hom_chain_bounded (λ _ _ _, le_trans)

/-- The maximal `subfield_with_hom`. We later prove that this is equal to `⊤`. -/
noncomputable def maximal_subfield_with_hom : subfield_with_hom K L M hL :=
classical.some (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_is_maximal :
  ∀ (N : subfield_with_hom K L M hL),
    (maximal_subfield_with_hom M hL) ≤ N → N ≤ (maximal_subfield_with_hom M hL) :=
classical.some_spec (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_eq_top :
  (maximal_subfield_with_hom M hL).carrier = ⊤ :=
begin
  rw [eq_top_iff],
  intros x _,
  let p := minpoly K x,
  let N : subalgebra K L := (maximal_subfield_with_hom M hL).carrier,
  letI : field N := is_field.to_field _ (subalgebra.is_field_of_algebraic N hL),
  letI : algebra N M := (maximal_subfield_with_hom M hL).emb.to_ring_hom.to_algebra,
  cases is_alg_closed.exists_aeval_eq_zero M (minpoly N x)
    (ne_of_gt (minpoly.degree_pos
      ((is_algebraic_iff_is_integral _).1
        (algebra.is_algebraic_of_larger_base _ _ hL x)))) with y hy,
  let O : subalgebra N L := algebra.adjoin N {(x : L)},
  let larger_emb := ((adjoin_root.lift_hom (minpoly N x) y hy).comp
     (alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly N x).to_alg_hom),
  have hNO : N ≤ O.restrict_scalars K,
  { intros z hz,
    show algebra_map N L ⟨z, hz⟩ ∈ O,
    exact O.algebra_map_mem _ },
  let O' : subfield_with_hom K L M hL :=
  { carrier := O.restrict_scalars K,
    emb := larger_emb.restrict_scalars K },
  have hO' : maximal_subfield_with_hom M hL ≤ O',
  { refine ⟨hNO, _⟩,
    intros z,
    show O'.emb (algebra_map N O z) = algebra_map N M z,
    simp only [O', restrict_scalars_apply, alg_hom.commutes] },
  refine (maximal_subfield_with_hom_is_maximal M hL O' hO').fst _,
  exact algebra.subset_adjoin (set.mem_singleton x),
end

end subfield_with_hom
end lift

namespace is_alg_closed

variables {K : Type u} [field K] {L : Type v} {M : Type w} [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL

/-- A (random) hom from an algebraic extension of K into an algebraically closed extension of K -/
@[irreducible] noncomputable def lift : L →ₐ[K] M :=
(lift.subfield_with_hom.maximal_subfield_with_hom M hL).emb.comp $
  eq.rec_on (lift.subfield_with_hom.maximal_subfield_with_hom_eq_top M hL).symm algebra.to_top

end is_alg_closed

namespace is_alg_closure

variables (J : Type*) (K : Type u) [field J] [field K] (L : Type v) (M : Type w) [field L]
  [field M] [algebra K M] [is_alg_closure K M]

local attribute [instance] is_alg_closure.alg_closed

section
variables [algebra K L] [is_alg_closure K L]

/-- A (random) isomorphism between two algebraic closures of `K`. -/
noncomputable def equiv : L ≃ₐ[K] M :=
let f : L →ₐ[K] M := is_alg_closed.lift K L M is_alg_closure.algebraic in
alg_equiv.of_bijective f
  ⟨ring_hom.injective f.to_ring_hom,
    begin
      letI : algebra L M := ring_hom.to_algebra f,
      letI : is_scalar_tower K L M :=
        is_scalar_tower.of_algebra_map_eq (by simp [ring_hom.algebra_map_to_algebra]),
      show function.surjective (algebra_map L M),
      exact is_alg_closed.algebra_map_surjective_of_is_algebraic
        (algebra.is_algebraic_of_larger_base K L is_alg_closure.algebraic),
    end⟩

end

section equiv_of_algebraic

variables [algebra K J] [algebra J L] [is_alg_closure J L] [algebra K L]
  [is_scalar_tower K J L]

/-- An equiv between an algebraic closure of `K` and an algebraic closure of an algebraic
  extension of `K` -/
noncomputable def equiv_of_algebraic (hKJ : algebra.is_algebraic K J) : L ≃ₐ[K] M :=
begin
  letI : is_alg_closure K L :=
  { alg_closed := by apply_instance,
    algebraic := algebra.is_algebraic_trans hKJ is_alg_closure.algebraic  },
  exact is_alg_closure.equiv _ _ _
end

end equiv_of_algebraic

section equiv_of_equiv

variables [algebra J L] [is_alg_closure J L]

variables {J K}

/-- Used in the definition of `equiv_of_equiv` -/
noncomputable def equiv_of_equiv_aux (hJK : J ≃+* K) :
  { e : L ≃+* M // e.to_ring_hom.comp (algebra_map J L) =
    (algebra_map K M).comp hJK.to_ring_hom }:=
begin
  letI : algebra K J := ring_hom.to_algebra hJK.symm.to_ring_hom,
  have : algebra.is_algebraic K J,
    from λ x, begin
      rw [← ring_equiv.symm_apply_apply hJK x],
      exact is_algebraic_algebra_map _
    end,
  letI : algebra K L := ring_hom.to_algebra ((algebra_map J L).comp (algebra_map K J)),
  letI : is_scalar_tower K J L := is_scalar_tower.of_algebra_map_eq (λ _, rfl),
  refine ⟨equiv_of_algebraic J K L M this, _⟩,
  ext,
  simp only [ring_equiv.to_ring_hom_eq_coe, function.comp_app, ring_hom.coe_comp,
    alg_equiv.coe_ring_equiv, ring_equiv.coe_to_ring_hom],
  conv_lhs { rw [← hJK.symm_apply_apply x] },
  show equiv_of_algebraic J K L M this (algebra_map K L (hJK x)) = _,
  rw [alg_equiv.commutes]
end

/-- Algebraic closure of isomorphic fields are isomorphic -/
noncomputable def equiv_of_equiv (hJK : J ≃+* K) : L ≃+* M :=
equiv_of_equiv_aux L M hJK

@[simp] lemma equiv_of_equiv_comp_algebra_map (hJK : J ≃+* K) :
  (↑(equiv_of_equiv L M hJK) : L →+* M).comp (algebra_map J L) =
  (algebra_map K M).comp hJK :=
(equiv_of_equiv_aux L M hJK).2

@[simp] lemma equiv_of_equiv_algebra_map (hJK : J ≃+* K) (j : J):
  equiv_of_equiv L M hJK (algebra_map J L j) =
  algebra_map K M (hJK j) :=
ring_hom.ext_iff.1 (equiv_of_equiv_comp_algebra_map L M hJK) j

@[simp] lemma equiv_of_equiv_symm_algebra_map (hJK : J ≃+* K) (k : K):
  (equiv_of_equiv L M hJK).symm (algebra_map K M k) =
  algebra_map J L (hJK.symm k) :=
(equiv_of_equiv L M hJK).injective (by simp)

@[simp] lemma equiv_of_equiv_symm_comp_algebra_map (hJK : J ≃+* K) :
  ((equiv_of_equiv L M hJK).symm : M →+* L).comp (algebra_map K M) =
  (algebra_map J L).comp hJK.symm :=
ring_hom.ext_iff.2 (equiv_of_equiv_symm_algebra_map L M hJK)

end equiv_of_equiv

end is_alg_closure


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.nilpotent
import algebra.lie.normalizer

/-!
# Cartan subalgebras

Cartan subalgebras are one of the most important concepts in Lie theory. We define them here.
The standard example is the set of diagonal matrices in the Lie algebra of matrices.

## Main definitions

  * `lie_submodule.is_ucs_limit`
  * `lie_subalgebra.is_cartan_subalgebra`
  * `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit`

## Tags

lie subalgebra, normalizer, idealizer, cartan subalgebra
-/

universes u v w w₁ w₂

variables {R : Type u} {L : Type v}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] (H : lie_subalgebra R L)

/-- Given a Lie module `M` of a Lie algebra `L`, `lie_submodule.is_ucs_limit` is the proposition
that a Lie submodule `N ⊆ M` is the limiting value for the upper central series.

This is a characteristic property of Cartan subalgebras with the roles of `L`, `M`, `N` played by
`H`, `L`, `H`, respectively. See `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit`. -/
def lie_submodule.is_ucs_limit
  {M : Type*} [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
  (N : lie_submodule R L M) : Prop :=
∃ k, ∀ l, k ≤ l → (⊥ : lie_submodule R L M).ucs l = N

namespace lie_subalgebra

/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/
class is_cartan_subalgebra : Prop :=
(nilpotent        : lie_algebra.is_nilpotent R H)
(self_normalizing : H.normalizer = H)

instance [H.is_cartan_subalgebra] : lie_algebra.is_nilpotent R H := is_cartan_subalgebra.nilpotent

@[simp] lemma normalizer_eq_self_of_is_cartan_subalgebra
  (H : lie_subalgebra R L) [H.is_cartan_subalgebra] :
  H.to_lie_submodule.normalizer = H.to_lie_submodule :=
by rw [← lie_submodule.coe_to_submodule_eq_iff, coe_normalizer_eq_normalizer,
  is_cartan_subalgebra.self_normalizing, coe_to_lie_submodule]

@[simp] lemma ucs_eq_self_of_is_cartan_subalgebra
  (H : lie_subalgebra R L) [H.is_cartan_subalgebra] (k : ℕ) :
  H.to_lie_submodule.ucs k = H.to_lie_submodule :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih], },
end

lemma is_cartan_subalgebra_iff_is_ucs_limit :
  H.is_cartan_subalgebra ↔ H.to_lie_submodule.is_ucs_limit :=
begin
  split,
  { introsI h,
    have h₁ : _root_.lie_algebra.is_nilpotent R H := by apply_instance,
    obtain ⟨k, hk⟩ := H.to_lie_submodule.is_nilpotent_iff_exists_self_le_ucs.mp h₁,
    replace hk : H.to_lie_submodule = lie_submodule.ucs k ⊥ :=
      le_antisymm hk (lie_submodule.ucs_le_of_normalizer_eq_self
      H.normalizer_eq_self_of_is_cartan_subalgebra k),
    refine ⟨k, λ l hl, _⟩,
    rw [← nat.sub_add_cancel hl, lie_submodule.ucs_add, ← hk,
      lie_subalgebra.ucs_eq_self_of_is_cartan_subalgebra], },
  { rintros ⟨k, hk⟩,
    exact
    { nilpotent :=
      begin
        dunfold lie_algebra.is_nilpotent,
        erw H.to_lie_submodule.is_nilpotent_iff_exists_lcs_eq_bot,
        use k,
        rw [_root_.eq_bot_iff, lie_submodule.lcs_le_iff, hk k (le_refl k)],
        exact le_refl _,
      end,
      self_normalizing :=
      begin
        have hk' := hk (k + 1) k.le_succ,
        rw [lie_submodule.ucs_succ, hk k (le_refl k)] at hk',
        rw [← lie_subalgebra.coe_to_submodule_eq_iff,
          ← lie_subalgebra.coe_normalizer_eq_normalizer, hk',
          lie_subalgebra.coe_to_lie_submodule],
      end } },
end

end lie_subalgebra

@[simp] lemma lie_ideal.normalizer_eq_top {R : Type u} {L : Type v}
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) :
  (I : lie_subalgebra R L).normalizer = ⊤ :=
begin
  ext x,
  simpa only [lie_subalgebra.mem_normalizer_iff, lie_subalgebra.mem_top, iff_true]
    using λ y hy, I.lie_mem hy
end

open lie_ideal

/-- A nilpotent Lie algebra is its own Cartan subalgebra. -/
instance lie_algebra.top_is_cartan_subalgebra_of_nilpotent [lie_algebra.is_nilpotent R L] :
  lie_subalgebra.is_cartan_subalgebra (⊤ : lie_subalgebra R L) :=
{ nilpotent        := infer_instance,
  self_normalizing :=
    by { rw [← top_coe_lie_subalgebra, normalizer_eq_top, top_coe_lie_subalgebra], }, }


/-
Copyright (c) 2021 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/
import linear_algebra.matrix
import linear_algebra.nonsingular_inverse
import data.complex.basic

/-!
# The Unitary Group

This file defines elements of the unitary group `unitary_group n α`, where `α` is a `star_ring`.
This consists of all `n` by `n` matrices with entries in `α` such that the star-transpose is its
inverse. In addition, we define the group structure on `unitary_group n α`, and the embedding into
the general linear group `general_linear_group α (n → α)`.

We also define the orthogonal group `orthogonal_group n β`, where `β` is a `comm_ring`.

## Main Definitions

 * `matrix.unitary_group` is the type of matrices where the star-transpose is the inverse
 * `matrix.unitary_group.group` is the group structure (under multiplication)
 * `matrix.unitary_group.embedding_GL` is the embedding `unitary_group n α → GLₙ(α)`
 * `matrix.orthogonal_group` is the type of matrices where the transpose is the inverse

## References

 * https://en.wikipedia.org/wiki/Unitary_group

## Tags

matrix group, group, unitary group, orthogonal group

-/

universes u v

section

variables (M : Type v) [monoid M] [star_monoid M]

/--
In a `star_monoid M`, `unitary_submonoid M` is the submonoid consisting of all the elements of
`M` such that `star A * A = 1`.
-/
def unitary_submonoid : submonoid M :=
{ carrier := {A | star A * A = 1},
  one_mem' := by simp,
  mul_mem' := λ A B (hA : star A * A = 1) (hB : star B * B = 1), show star (A * B) * (A * B) = 1,
  by rwa [star_mul, ←mul_assoc, mul_assoc _ _ A, hA, mul_one] }

end

namespace matrix
open linear_map
open_locale matrix

section

variables (n : Type u) [decidable_eq n] [fintype n]
variables (α : Type v) [comm_ring α] [star_ring α]

/--
`unitary_group n` is the group of `n` by `n` matrices where the star-transpose is the inverse.
-/
@[derive monoid]
def unitary_group : Type* := unitary_submonoid (matrix n n α)

end

variables {n : Type u} [decidable_eq n] [fintype n]
variables {α : Type v} [comm_ring α] [star_ring α]

namespace unitary_submonoid

lemma star_mem {A : matrix n n α} (h : A ∈ unitary_submonoid (matrix n n α)) :
  star A ∈ unitary_submonoid (matrix n n α) :=
matrix.nonsing_inv_left_right _ _ $ (star_star A).symm ▸ h

@[simp]
lemma star_mem_iff {A : matrix n n α} :
  star A ∈ unitary_submonoid (matrix n n α) ↔ A ∈ unitary_submonoid (matrix n n α) :=
⟨λ ha, star_star A ▸ star_mem ha, star_mem⟩

end unitary_submonoid

namespace unitary_group

instance coe_matrix : has_coe (unitary_group n α) (matrix n n α) := ⟨subtype.val⟩

instance coe_fun : has_coe_to_fun (unitary_group n α) :=
{ F   := λ _, n → n → α,
  coe := λ A, A.val }

/--
`to_lin' A` is matrix multiplication of vectors by `A`, as a linear map.

After the group structure on `unitary_group n` is defined,
we show in `to_linear_equiv` that this gives a linear equivalence.
-/
def to_lin' (A : unitary_group n α) := matrix.to_lin' A

lemma ext_iff (A B : unitary_group n α) : A = B ↔ ∀ i j, A i j = B i j :=
subtype.ext_iff_val.trans ⟨(λ h i j, congr_fun (congr_fun h i) j), matrix.ext⟩

@[ext] lemma ext (A B : unitary_group n α) : (∀ i j, A i j = B i j) → A = B :=
(unitary_group.ext_iff A B).mpr

instance : has_inv (unitary_group n α) :=
⟨λ A, ⟨star A.1, unitary_submonoid.star_mem_iff.mpr A.2⟩⟩

instance : star_monoid (unitary_group n α) :=
{ star := λ A, ⟨star A.1, unitary_submonoid.star_mem A.2⟩,
  star_involutive := λ A, subtype.ext $ star_star A.1,
  star_mul := λ A B, subtype.ext $ star_mul A.1 B.1 }

@[simp]

instance : inhabited (unitary_group n α) := ⟨1⟩

section coe_lemmas

variables (A B : unitary_group n α)

@[simp] lemma inv_val : ↑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma inv_apply : ⇑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma mul_val : ↑(A * B) = A ⬝ B := rfl

@[simp] lemma mul_apply : ⇑(A * B) = (A ⬝ B) := rfl

@[simp] lemma one_val : ↑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma one_apply : ⇑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma to_lin'_mul :
  to_lin' (A * B) = (to_lin' A).comp (to_lin' B) :=
matrix.to_lin'_mul A B

@[simp] lemma to_lin'_one :
  to_lin' (1 : unitary_group n α) = linear_map.id :=
matrix.to_lin'_one

end coe_lemmas

instance : group (unitary_group n α) :=
{ mul_left_inv := λ A, subtype.eq A.2,
  ..unitary_group.has_inv,
  ..unitary_group.monoid n α }

/-- `to_linear_equiv A` is matrix multiplication of vectors by `A`, as a linear equivalence. -/
def to_linear_equiv (A : unitary_group n α) : (n → α) ≃ₗ[α] (n → α) :=
{ inv_fun := A⁻¹.to_lin',
  left_inv := λ x, calc
    A⁻¹.to_lin'.comp A.to_lin' x
        = (A⁻¹ * A).to_lin' x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_left_inv, to_lin'_one, id_apply],
  right_inv := λ x, calc
    A.to_lin'.comp A⁻¹.to_lin' x
        = (A * A⁻¹).to_lin' x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_right_inv, to_lin'_one, id_apply],
  ..matrix.to_lin' A }

/-- `to_GL` is the map from the unitary group to the general linear group -/
def to_GL (A : unitary_group n α) : general_linear_group α (n → α) :=
general_linear_group.of_linear_equiv (to_linear_equiv A)

lemma coe_to_GL (A : unitary_group n α) :
  ↑(to_GL A) = A.to_lin' :=
rfl

@[simp]
lemma to_GL_one : to_GL (1 : unitary_group n α) = 1 :=
by { ext1 v i, rw [coe_to_GL, to_lin'_one], refl }

@[simp]
lemma to_GL_mul (A B : unitary_group n α) :
  to_GL (A * B) = to_GL A * to_GL B :=
by { ext1 v i, rw [coe_to_GL, to_lin'_mul], refl }

/-- `unitary_group.embedding_GL` is the embedding from `unitary_group n α`
to `general_linear_group n α`. -/
def embedding_GL : unitary_group n α →* general_linear_group α (n → α) :=
⟨λ A, to_GL A, by simp, by simp⟩

end unitary_group

section orthogonal_group

variables (β : Type v) [comm_ring β]

local attribute [instance] star_ring_of_comm
/--
`orthogonal_group n` is the group of `n` by `n` matrices where the transpose is the inverse.
-/
abbreviation orthogonal_group := unitary_group n β

end orthogonal_group

end matrix


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

! This file was ported from Lean 3 source module probability.probability_mass_function.monad
! leanprover-community/mathlib commit 4ac69b290818724c159de091daa3acd31da0ee6d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.ProbabilityMassFunction.Basic

/-!
# Monad Operations for Probability Mass Functions

This file constructs two operations on `pmf` that give it a monad structure.
`pure a` is the distribution where a single value `a` has probability `1`.
`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
and then sampling from `pb a : pmf β` to get a final result `b : β`.

`bind_on_support` generalizes `bind` to allow binding to a partial function,
so that the second argument only needs to be defined on the support of the first argument.

-/

noncomputable section

variable {α β γ : Type _}

open Classical BigOperators NNReal ENNReal

open MeasureTheory

namespace Pmf

section Pure

/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
def pure (a : α) : Pmf α :=
  ⟨fun a' => if a' = a then 1 else 0, hasSum_ite_eq _ _⟩
#align pmf.pure Pmf.pure

variable (a a' : α)

@[simp]
theorem pure_apply : pure a a' = if a' = a then 1 else 0 :=
  rfl
#align pmf.pure_apply Pmf.pure_apply

@[simp]
theorem support_pure : (pure a).support = {a} :=
  Set.ext fun a' => by simp [mem_support_iff]
#align pmf.support_pure Pmf.support_pure

theorem mem_support_pure_iff : a' ∈ (pure a).support ↔ a' = a := by simp
#align pmf.mem_support_pure_iff Pmf.mem_support_pure_iff

@[simp]
theorem pure_apply_self : pure a a = 1 :=
  if_pos rfl
#align pmf.pure_apply_self Pmf.pure_apply_self

theorem pure_apply_of_ne (h : a' ≠ a) : pure a a' = 0 :=
  if_neg h
#align pmf.pure_apply_of_ne Pmf.pure_apply_of_ne

instance [Inhabited α] : Inhabited (Pmf α) :=
  ⟨pure default⟩

section Measure

variable (s : Set α)

@[simp]
theorem toOuterMeasure_pure_apply : (pure a).toOuterMeasure s = if a ∈ s then 1 else 0 :=
  by
  refine' (to_outer_measure_apply (pure a) s).trans _
  split_ifs with ha ha
  · refine' (tsum_congr fun b => _).trans (tsum_ite_eq a 1)
    exact ite_eq_left_iff.2 fun hb => symm (ite_eq_right_iff.2 fun h => (hb <| h.symm ▸ ha).elim)
  · refine' (tsum_congr fun b => _).trans tsum_zero
    exact ite_eq_right_iff.2 fun hb => ite_eq_right_iff.2 fun h => (ha <| h ▸ hb).elim
#align pmf.to_outer_measure_pure_apply Pmf.toOuterMeasure_pure_apply

variable [MeasurableSpace α]

/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
@[simp]
theorem toMeasure_pure_apply (hs : MeasurableSet s) :
    (pure a).toMeasure s = if a ∈ s then 1 else 0 :=
  (toMeasure_apply_eq_toOuterMeasure_apply (pure a) s hs).trans (toOuterMeasure_pure_apply a s)
#align pmf.to_measure_pure_apply Pmf.toMeasure_pure_apply

theorem toMeasure_pure : (pure a).toMeasure = Measure.dirac a :=
  Measure.ext fun s hs => by simpa only [to_measure_pure_apply a s hs, measure.dirac_apply' a hs]
#align pmf.to_measure_pure Pmf.toMeasure_pure

@[simp]
theorem toPmf_dirac [Countable α] [h : MeasurableSingletonClass α] :
    (Measure.dirac a).toPmf = pure a := by rw [to_pmf_eq_iff_to_measure_eq, to_measure_pure]
#align pmf.to_pmf_dirac Pmf.toPmf_dirac

end Measure

end Pure

section Bind

/-- The monadic bind operation for `pmf`. -/
def bind (p : Pmf α) (f : α → Pmf β) : Pmf β :=
  ⟨fun b => ∑' a, p a * f a b,
    ENNReal.summable.hasSum_iff.2
      (ENNReal.tsum_comm.trans <| by simp only [ENNReal.tsum_mul_left, tsum_coe, mul_one])⟩
#align pmf.bind Pmf.bind

variable (p : Pmf α) (f : α → Pmf β) (g : β → Pmf γ)

@[simp]
theorem bind_apply (b : β) : p.bind f b = ∑' a, p a * f a b :=
  rfl
#align pmf.bind_apply Pmf.bind_apply

@[simp]
theorem support_bind : (p.bind f).support = ⋃ a ∈ p.support, (f a).support :=
  Set.ext fun b => by simp [mem_support_iff, ENNReal.tsum_eq_zero, not_or]
#align pmf.support_bind Pmf.support_bind

theorem mem_support_bind_iff (b : β) :
    b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support := by
  simp only [support_bind, Set.mem_unionᵢ, Set.mem_setOf_eq]
#align pmf.mem_support_bind_iff Pmf.mem_support_bind_iff

@[simp]
theorem pure_bind (a : α) (f : α → Pmf β) : (pure a).bind f = f a :=
  by
  have : ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0 := fun b a' => by
    split_ifs <;> simp <;> subst h <;> simp
  ext b <;> simp [this]
#align pmf.pure_bind Pmf.pure_bind

@[simp]
theorem bind_pure : p.bind pure = p :=
  Pmf.ext fun x =>
    (bind_apply _ _ _).trans
      (trans
          (tsum_eq_single x fun y hy => by
            rw [pure_apply_of_ne _ _ hy.symm, MulZeroClass.mul_zero]) <|
        by rw [pure_apply_self, mul_one])
#align pmf.bind_pure Pmf.bind_pure

@[simp]
theorem bind_const (p : Pmf α) (q : Pmf β) : (p.bind fun _ => q) = q :=
  Pmf.ext fun x => by rw [bind_apply, ENNReal.tsum_mul_right, tsum_coe, one_mul]
#align pmf.bind_const Pmf.bind_const

@[simp]
theorem bind_bind : (p.bind f).bind g = p.bind fun a => (f a).bind g :=
  Pmf.ext fun b => by
    simpa only [ennreal.coe_eq_coe.symm, bind_apply, ennreal.tsum_mul_left.symm,
      ennreal.tsum_mul_right.symm, mul_assoc, mul_left_comm, mul_comm] using ENNReal.tsum_comm
#align pmf.bind_bind Pmf.bind_bind

theorem bind_comm (p : Pmf α) (q : Pmf β) (f : α → β → Pmf γ) :
    (p.bind fun a => q.bind (f a)) = q.bind fun b => p.bind fun a => f a b :=
  Pmf.ext fun b => by
    simpa only [ennreal.coe_eq_coe.symm, bind_apply, ennreal.tsum_mul_left.symm,
      ennreal.tsum_mul_right.symm, mul_assoc, mul_left_comm, mul_comm] using ENNReal.tsum_comm
#align pmf.bind_comm Pmf.bind_comm

section Measure

variable (s : Set β)

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (b a) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (a b) -/
@[simp]
theorem toOuterMeasure_bind_apply :
    (p.bind f).toOuterMeasure s = ∑' a, p a * (f a).toOuterMeasure s :=
  calc
    (p.bind f).toOuterMeasure s = ∑' b, if b ∈ s then ∑' a, p a * f a b else 0 := by
      simp [to_outer_measure_apply, Set.indicator_apply]
    _ = ∑' (b) (a), p a * if b ∈ s then f a b else 0 := (tsum_congr fun b => by split_ifs <;> simp)
    _ = ∑' (a) (b), p a * if b ∈ s then f a b else 0 :=
      (tsum_comm' ENNReal.summable (fun _ => ENNReal.summable) fun _ => ENNReal.summable)
    _ = ∑' a, p a * ∑' b, if b ∈ s then f a b else 0 := (tsum_congr fun a => ENNReal.tsum_mul_left)
    _ = ∑' a, p a * ∑' b, if b ∈ s then f a b else 0 :=
      (tsum_congr fun a => (congr_arg fun x => p a * x) <| tsum_congr fun b => by split_ifs <;> rfl)
    _ = ∑' a, p a * (f a).toOuterMeasure s :=
      tsum_congr fun a => by simp only [to_outer_measure_apply, Set.indicator_apply]

#align pmf.to_outer_measure_bind_apply Pmf.toOuterMeasure_bind_apply

/-- The measure of a set under `p.bind f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a` -/
@[simp]
theorem toMeasure_bind_apply [MeasurableSpace β] (hs : MeasurableSet s) :
    (p.bind f).toMeasure s = ∑' a, p a * (f a).toMeasure s :=
  (toMeasure_apply_eq_toOuterMeasure_apply (p.bind f) s hs).trans
    ((toOuterMeasure_bind_apply p f s).trans
      (tsum_congr fun a =>
        congr_arg (fun x => p a * x) (toMeasure_apply_eq_toOuterMeasure_apply (f a) s hs).symm))
#align pmf.to_measure_bind_apply Pmf.toMeasure_bind_apply

end Measure

end Bind

instance : Monad Pmf where
  pure A a := pure a
  bind A B pa pb := pa.bind pb

section BindOnSupport

/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
def bindOnSupport (p : Pmf α) (f : ∀ a ∈ p.support, Pmf β) : Pmf β :=
  ⟨fun b => ∑' a, p a * if h : p a = 0 then 0 else f a h b,
    ENNReal.summable.hasSum_iff.2
      (by
        refine' ennreal.tsum_comm.trans (trans (tsum_congr fun a => _) p.tsum_coe)
        simp_rw [ENNReal.tsum_mul_left]
        split_ifs with h
        · simp only [h, MulZeroClass.zero_mul]
        · rw [(f a h).tsum_coe, mul_one])⟩
#align pmf.bind_on_support Pmf.bindOnSupport

variable {p : Pmf α} (f : ∀ a ∈ p.support, Pmf β)

@[simp]
theorem bindOnSupport_apply (b : β) :
    p.bindOnSupport f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
  rfl
#align pmf.bind_on_support_apply Pmf.bindOnSupport_apply

@[simp]
theorem support_bindOnSupport :
    (p.bindOnSupport f).support = ⋃ (a : α) (h : a ∈ p.support), (f a h).support :=
  by
  refine' Set.ext fun b => _
  simp only [ENNReal.tsum_eq_zero, not_or, mem_support_iff, bind_on_support_apply, Ne.def,
    not_forall, mul_eq_zero, Set.mem_unionᵢ]
  exact
    ⟨fun hb =>
      let ⟨a, ⟨ha, ha'⟩⟩ := hb
      ⟨a, ha, by simpa [ha] using ha'⟩,
      fun hb =>
      let ⟨a, ha, ha'⟩ := hb
      ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
#align pmf.support_bind_on_support Pmf.support_bindOnSupport

theorem mem_support_bindOnSupport_iff (b : β) :
    b ∈ (p.bindOnSupport f).support ↔ ∃ (a : α)(h : a ∈ p.support), b ∈ (f a h).support := by
  simp only [support_bind_on_support, Set.mem_setOf_eq, Set.mem_unionᵢ]
#align pmf.mem_support_bind_on_support_iff Pmf.mem_support_bindOnSupport_iff

/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
@[simp]
theorem bindOnSupport_eq_bind (p : Pmf α) (f : α → Pmf β) :
    (p.bindOnSupport fun a _ => f a) = p.bind f :=
  by
  ext (b x)
  have : ∀ a, ite (p a = 0) 0 (p a * f a b) = p a * f a b := fun a =>
    ite_eq_right_iff.2 fun h => h.symm ▸ symm (MulZeroClass.zero_mul <| f a b)
  simp only [bind_on_support_apply fun a _ => f a, p.bind_apply f, dite_eq_ite, mul_ite,
    MulZeroClass.mul_zero, this]
#align pmf.bind_on_support_eq_bind Pmf.bindOnSupport_eq_bind

theorem bindOnSupport_eq_zero_iff (b : β) :
    p.bindOnSupport f b = 0 ↔ ∀ (a) (ha : p a ≠ 0), f a ha b = 0 :=
  by
  simp only [bind_on_support_apply, ENNReal.tsum_eq_zero, mul_eq_zero, or_iff_not_imp_left]
  exact ⟨fun h a ha => trans (dif_neg ha).symm (h a ha), fun h a ha => trans (dif_neg ha) (h a ha)⟩
#align pmf.bind_on_support_eq_zero_iff Pmf.bindOnSupport_eq_zero_iff

@[simp]
theorem pure_bindOnSupport (a : α) (f : ∀ (a' : α) (ha : a' ∈ (pure a).support), Pmf β) :
    (pure a).bindOnSupport f = f a ((mem_support_pure_iff a a).mpr rfl) :=
  by
  refine' Pmf.ext fun b => _
  simp only [bind_on_support_apply, pure_apply]
  refine' trans (tsum_congr fun a' => _) (tsum_ite_eq a _)
  by_cases h : a' = a <;> simp [h]
#align pmf.pure_bind_on_support Pmf.pure_bindOnSupport

theorem bindOnSupport_pure (p : Pmf α) : (p.bindOnSupport fun a _ => pure a) = p := by
  simp only [Pmf.bind_pure, Pmf.bindOnSupport_eq_bind]
#align pmf.bind_on_support_pure Pmf.bindOnSupport_pure

@[simp]
theorem bindOnSupport_bindOnSupport (p : Pmf α) (f : ∀ a ∈ p.support, Pmf β)
    (g : ∀ b ∈ (p.bindOnSupport f).support, Pmf γ) :
    (p.bindOnSupport f).bindOnSupport g =
      p.bindOnSupport fun a ha =>
        (f a ha).bindOnSupport fun b hb =>
          g b ((mem_support_bindOnSupport_iff f b).mpr ⟨a, ha, hb⟩) :=
  by
  refine' Pmf.ext fun a => _
  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm]
  simp only [ENNReal.tsum_eq_zero, ENNReal.coe_eq_coe, ENNReal.coe_eq_zero, ENNReal.coe_zero,
    dite_eq_left_iff, mul_eq_zero]
  refine' ennreal.tsum_comm.trans (tsum_congr fun a' => tsum_congr fun b => _)
  split_ifs
  any_goals ring1
  · have := h_1 a'
    simp [h] at this
    contradiction
  · simp [h_2]
#align pmf.bind_on_support_bind_on_support Pmf.bindOnSupport_bindOnSupport

theorem bindOnSupport_comm (p : Pmf α) (q : Pmf β) (f : ∀ a ∈ p.support, ∀ b ∈ q.support, Pmf γ) :
    (p.bindOnSupport fun a ha => q.bindOnSupport (f a ha)) =
      q.bindOnSupport fun b hb => p.bindOnSupport fun a ha => f a ha b hb :=
  by
  apply Pmf.ext; rintro c
  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm]
  refine' trans ENNReal.tsum_comm (tsum_congr fun b => tsum_congr fun a => _)
  split_ifs with h1 h2 h2 <;> ring
#align pmf.bind_on_support_comm Pmf.bindOnSupport_comm

section Measure

variable (s : Set β)

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (a b) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (b a) -/
@[simp]
theorem toOuterMeasure_bindOnSupport_apply :
    (p.bindOnSupport f).toOuterMeasure s =
      ∑' a, p a * if h : p a = 0 then 0 else (f a h).toOuterMeasure s :=
  by
  simp only [to_outer_measure_apply, Set.indicator_apply, bind_on_support_apply]
  calc
    (∑' b, ite (b ∈ s) (∑' a, p a * dite (p a = 0) (fun h => 0) fun h => f a h b) 0) =
        ∑' (b) (a), ite (b ∈ s) (p a * dite (p a = 0) (fun h => 0) fun h => f a h b) 0 :=
      tsum_congr fun b => by split_ifs with hbs <;> simp only [eq_self_iff_true, tsum_zero]
    _ = ∑' (a) (b), ite (b ∈ s) (p a * dite (p a = 0) (fun h => 0) fun h => f a h b) 0 :=
      ENNReal.tsum_comm
    _ = ∑' a, p a * ∑' b, ite (b ∈ s) (dite (p a = 0) (fun h => 0) fun h => f a h b) 0 :=
      (tsum_congr fun a => by simp only [← ENNReal.tsum_mul_left, mul_ite, MulZeroClass.mul_zero])
    _ = ∑' a, p a * dite (p a = 0) (fun h => 0) fun h => ∑' b, ite (b ∈ s) (f a h b) 0 :=
      tsum_congr fun a => by split_ifs with ha <;> simp only [if_t_t, tsum_zero, eq_self_iff_true]

#align pmf.to_outer_measure_bind_on_support_apply Pmf.toOuterMeasure_bindOnSupport_apply

/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a _`.
  The additional if statement is needed since `f` is only a partial function -/
@[simp]
theorem toMeasure_bindOnSupport_apply [MeasurableSpace β] (hs : MeasurableSet s) :
    (p.bindOnSupport f).toMeasure s = ∑' a, p a * if h : p a = 0 then 0 else (f a h).toMeasure s :=
  by
  simp only [to_measure_apply_eq_to_outer_measure_apply _ _ hs,
    to_outer_measure_bind_on_support_apply]
#align pmf.to_measure_bind_on_support_apply Pmf.toMeasure_bindOnSupport_apply

end Measure

end BindOnSupport

end Pmf