/-
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 topology 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 (name := real.pi) `π` := 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_ne_zero.symm 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 (int.sub_floor_div_mul_nonneg _ pi_pos))
  (sub_nonpos.1 $ le_of_not_gt $ λ h₃,
    (sin_pos_of_pos_of_lt_pi h₃ (int.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) }

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_pi_div_two_sub (x : ℝ) : tan (π / 2 - x) = (tan x)⁻¹ :=
by rw [tan_eq_sin_div_cos, tan_eq_sin_div_cos, inv_div, sin_pi_div_two_sub, cos_pi_div_two_sub]

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 (𝓝[<] (π/2)) (𝓝 1) :=
by { convert continuous_sin.continuous_within_at, simp }

lemma tendsto_cos_pi_div_two : tendsto cos (𝓝[<] (π/2)) (𝓝[>] 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 (neg_lt_self pi_div_two_pos))]
      with x hx using cos_pos_of_mem_Ioo hx },
end

lemma tendsto_tan_pi_div_two : tendsto tan (𝓝[<] (π/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 (𝓝[>] (-(π/2))) (𝓝 (-1)) :=
by { convert continuous_sin.continuous_within_at, simp }

lemma tendsto_cos_neg_pi_div_two : tendsto cos (𝓝[>] (-(π/2))) (𝓝[>] 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 (neg_lt_self pi_div_two_pos))]
      with x hx using cos_pos_of_mem_Ioo hx },
end

lemma tendsto_tan_neg_pi_div_two : tendsto tan (𝓝[>] (-(π/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_pi_div_two_sub (x : ℂ) : tan (π / 2 - x) = (tan x)⁻¹ :=
by rw [tan_eq_sin_div_cos, tan_eq_sin_div_cos, inv_div, sin_pi_div_two_sub, cos_pi_div_two_sub]

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

/-- A supporting lemma for the **Phragmen-Lindelöf principle** in a horizontal strip. If `z : ℂ`
belongs to a horizontal strip `|complex.im z| ≤ b`, `b ≤ π / 2`, and `a ≤ 0`, then
$$\left|exp^{a\left(e^{z}+e^{-z}\right)}\right| \le e^{a\cos b \exp^{|re z|}}.$$
-/
lemma abs_exp_mul_exp_add_exp_neg_le_of_abs_im_le {a b : ℝ} (ha : a ≤ 0)
  {z : ℂ} (hz : |z.im| ≤ b) (hb : b ≤ π / 2) :
  abs (exp (a * (exp z + exp (-z)))) ≤ real.exp (a * real.cos b * real.exp (|z.re|)) :=
begin
  simp only [abs_exp, real.exp_le_exp, of_real_mul_re, add_re, exp_re, neg_im, real.cos_neg,
    ← add_mul, mul_assoc, mul_comm (real.cos b), neg_re, ← real.cos_abs z.im],
  have : real.exp (|z.re|) ≤ real.exp z.re + real.exp (-z.re),
    from apply_abs_le_add_of_nonneg (λ x, (real.exp_pos x).le) z.re,
  refine mul_le_mul_of_nonpos_left (mul_le_mul this _ _ ((real.exp_pos _).le.trans this)) ha,
  { exact real.cos_le_cos_of_nonneg_of_le_pi (_root_.abs_nonneg _)
      (hb.trans $ half_le_self $ real.pi_pos.le) hz },
  { refine real.cos_nonneg_of_mem_Icc ⟨_, hb⟩,
    exact (neg_nonpos.2 $ real.pi_div_two_pos.le).trans ((_root_.abs_nonneg _).trans hz) }
end

end complex


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import algebra.hom.equiv.units.basic
import algebra.group_with_zero.units.basic

/-!
# Multiplication by a nonzero element in a `group_with_zero` is a permutation.

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

variables {G : Type*}

namespace equiv

section group_with_zero
variables [group_with_zero G]

/-- Left multiplication by a nonzero element in a `group_with_zero` is a permutation of the
underlying type. -/
@[simps {fully_applied := ff}]
protected def mul_left₀ (a : G) (ha : a ≠ 0) : perm G :=
(units.mk0 a ha).mul_left

lemma _root_.mul_left_bijective₀ (a : G) (ha : a ≠ 0) :
  function.bijective ((*) a : G → G) :=
(equiv.mul_left₀ a ha).bijective

/-- Right multiplication by a nonzero element in a `group_with_zero` is a permutation of the
underlying type. -/
@[simps {fully_applied := ff}]
protected def mul_right₀ (a : G) (ha : a ≠ 0) : perm G :=
(units.mk0 a ha).mul_right

lemma _root_.mul_right_bijective₀ (a : G) (ha : a ≠ 0) :
  function.bijective ((* a) : G → G) :=
(equiv.mul_right₀ a ha).bijective

end group_with_zero

end equiv


import Lean
open Classical

-- For Core / standard library?
def List.forall (p : α → Prop) := List.foldr (λ a b => p a ∧ b) True

theorem List.forallCons (hd : α) (tl : List α) : List.forall p (hd :: tl) ↔ p hd ∧ List.forall p tl :=
by simp [List.forall, List.foldr]

theorem Option.someOfNotNone {T: Type} (x: Option T): x ≠ none <-> ∃ t: T, x = some t :=
by
apply Iff.intro
intro notNone
match x with
| some u => exact ⟨u, by rfl⟩
| none => exact absurd notNone (by simp)
intro hsome
rw [hsome.2]
exact Option.noConfusion

theorem Nat.neOfLt {n m: Nat} (h: n < m): n ≠ m :=
by
intro heq;
rw [heq] at h
exact Nat.ltIrrefl _ h

theorem Nat.ltAddLeft {n m k: Nat} (h: n < m): n < k + m :=
by induction k with
    | zero => exact show n < 0 + m from (Nat.zero_add m).symm ▸ h
    | succ k h => exact succ_add k m ▸ leStep h
theorem Nat.ltAddRight {n m k: Nat} (h: n < m): n < m + k :=
  Nat.add_comm k m ▸ Nat.ltAddLeft h

theorem Nat.ltMaxLeft {a b c: Nat}: a < b -> a < Nat.max b c :=
fun hab => by
simp only [Nat.max]
byCases hbc: b ≤ c
rw [ifPos hbc]; exact Nat.ltOfLtOfLe hab hbc
rw [ifNeg hbc]; exact hab

theorem Nat.ltMaxRight {a b c: Nat}: a < c -> a < Nat.max b c :=
fun hac => by
simp only [Nat.max]
byCases hbc: b ≤ c
rw [ifPos hbc]; exact hac
rw [ifNeg hbc]; exact Nat.ltTrans hac (Nat.gtOfNotLe hbc)

theorem Nat.succMaxEqMaxSucc {a b: Nat}: Nat.succ (Nat.max a b) = Nat.max (Nat.succ a) (Nat.succ b) :=
by
  simp [Nat.max];
  byCases hab: a ≤ b
  focus
    byCases hsucc: succ a ≤ succ b
    rw [ifPos hab, ifPos hsucc]
    rw [ifNeg hsucc, ifNeg <| show ¬ a ≤ b from λ h => hsucc <| succLeSucc h]
  focus
    byCases hsucc: succ a ≤ succ b
    rw [ifPos hsucc, ifPos <| leOfSuccLeSucc hsucc]
    rw [ifNeg hab, ifNeg hsucc]

theorem Nat.ltSuccMaxLeft {a b: Nat}: a < Nat.succ (Nat.max a b) :=
by rw [succMaxEqMaxSucc]; exact ltMaxLeft (lt.base _)
theorem Nat.ltSuccMaxRight {a b: Nat}: b < Nat.succ (Nat.max a b) :=
by rw [succMaxEqMaxSucc]; exact ltMaxRight (lt.base _)

theorem List.lengthMap (f : α → β) (l : List α) : List.length (List.map f l) = List.length l :=
by induction l with
| nil => simp [length, lengthAux]
| cons hd tl h_tl => simp [map, length_cons, h_tl]

inductive LambdaTerm where
| var (val : Nat)
| app (fn: LambdaTerm) (arg: LambdaTerm)
| lambda (body: LambdaTerm)
deriving Inhabited

-- Q1.2
def allFreeVariablesBoundBy (n: Nat) (t: LambdaTerm): Prop :=
  aux n t 0
where
  aux n t depth : Prop := match t with
| LambdaTerm.var (val := m) => m < n + depth
| LambdaTerm.app (fn := fn) (arg := arg) => aux n fn depth ∧ aux n arg depth
| LambdaTerm.lambda (body := fn) => aux n fn (depth + 1)

theorem allFreeVariablesBoundBy.auxRec (t: LambdaTerm): ∀ n d: Nat, (allFreeVariablesBoundBy.aux n t d -> allFreeVariablesBoundBy.aux (n + 1) t d) :=
fun n d hn => by induction t generalizing d with
| var m => apply Nat.ltTrans hn (Nat.addLtAddRight (Nat.lt.base _) _)
| app fn arg h_fn h_arg => exact ⟨ h_fn _ hn.1, h_arg _ hn.2 ⟩
| lambda body h_body => exact h_body _ hn

theorem allFreeVariablesBoundBy.auxRec₂ {t: LambdaTerm}: ∀ {n d: Nat}, (allFreeVariablesBoundBy.aux (n + 1) t d <-> allFreeVariablesBoundBy.aux n t (d + 1)) :=
by intro n d; induction t generalizing d with
| var v =>
  simp only [aux]
  rw [Nat.add_assoc, Nat.add_comm 1 d]
  exact Iff.rfl
| app fn arg h_fn h_arg =>
  exact Iff.intro
    (fun H => ⟨ h_fn.1 H.1, h_arg.1 H.2 ⟩)
    (fun H => ⟨ h_fn.2 H.1, h_arg.2 H.2 ⟩)
| lambda body h_body =>
   exact Iff.intro
    (fun H => (@h_body (d + 1)).1 H)
    (fun H => (@h_body (d + 1)).2 H)

theorem allFreeVariablesBoundBy.lambda {t: LambdaTerm}: ∀ {n: Nat}, allFreeVariablesBoundBy n (LambdaTerm.lambda t) -> allFreeVariablesBoundBy (n + 1) t :=
by intro n hn; exact allFreeVariablesBoundBy.auxRec₂.2 hn

macro "C[" n:term "](" t:term ")" : term => `(allFreeVariablesBoundBy $n $t)
def isClosedTerm (t: LambdaTerm): Prop := C[0](t)

theorem boundedByFollowing (m : Nat) (h : C[n](t)) : C[n + m](t) :=
by induction m with
| zero => assumption
| succ m ih => match t with
    | LambdaTerm.var (val := p) => exact allFreeVariablesBoundBy.auxRec _ _ _ ih
    | LambdaTerm.app (fn := fn) (arg := arg) => exact ⟨ allFreeVariablesBoundBy.auxRec _ _ _ ih.1, allFreeVariablesBoundBy.auxRec _ _ _ ih.2 ⟩
    | LambdaTerm.lambda (body := fn) => exact allFreeVariablesBoundBy.auxRec _ _ _ ih

theorem boundByGreater (greater : n ≤ m) (h : C[n](t)) : C[m](t) :=
by match Nat.le.dest greater with
| ⟨ w, hw ⟩ =>
  rw [← hw]
  exact boundedByFollowing w h

theorem isClosedTerm.FVBoundness (t: LambdaTerm) (h: isClosedTerm t): ∀ n: Nat, C[n](t) :=
fun n => by induction n with
| zero => assumption
| succ m ih => match t with
    | LambdaTerm.var (val := p) => exact allFreeVariablesBoundBy.auxRec _ _ _ ih
    | LambdaTerm.app (fn := fn) (arg := arg) => exact ⟨ allFreeVariablesBoundBy.auxRec _ _ _ ih.1, allFreeVariablesBoundBy.auxRec _ _ _ ih.2 ⟩
    | LambdaTerm.lambda (body := fn) => exact allFreeVariablesBoundBy.auxRec _ _ _ ih

-- Q1.3
def substitute (t: LambdaTerm) (index: Nat) (expr: LambdaTerm): LambdaTerm :=
  aux index t 0
where
  aux i t depth : LambdaTerm := match t with
  | LambdaTerm.var (val := m) => if i + depth = m then expr else t
  | LambdaTerm.app fn arg => LambdaTerm.app (aux i fn depth) (aux i arg depth)
  | LambdaTerm.lambda body => LambdaTerm.lambda (aux i body (depth + 1))

theorem substitute.idOnClosed (depth: Nat) (t: LambdaTerm) (ht: C[depth](t)) (index: Nat) (expr: LambdaTerm) (hexpr: isClosedTerm expr): substitute.aux expr index t depth = t :=
by induction t generalizing depth with
| var m => have neg: index + depth ≠ m := (Nat.neOfLt $ Nat.ltAddLeft ht).symm; simp [aux, neg];
| app fn arg h_fn h_arg => simp [aux, h_fn depth (ht.1), h_arg depth (ht.2)]
| lambda body h_body => simp [aux, h_body (depth + 1) (allFreeVariablesBoundBy.lambda ht)]

-- Q1.4
def batchSubstitute (t : LambdaTerm) (index: Nat) (exprs : List LambdaTerm) : LambdaTerm :=
  aux t 0
where
  find (l : List (Nat × LambdaTerm)) depth m : LambdaTerm :=
    match l with
      | [] => LambdaTerm.var m
      | (i, expr) :: tail => if i + depth = m then expr else find tail depth m
  aux t depth : LambdaTerm := match t with
    | LambdaTerm.var (val := m) => find (List.enumFrom index exprs) depth m
    | LambdaTerm.app fn arg => LambdaTerm.app (aux fn depth) (aux arg depth)
    | LambdaTerm.lambda body => LambdaTerm.lambda (aux body (depth + 1))

macro t:term "[" i:term "←" l:term "]" : term => `(batchSubstitute $t $i $l)

theorem batchSubstituteFindSwap (index depth : Nat) (exprs : List LambdaTerm) :
  batchSubstitute.find (List.enumFrom index exprs) (depth + 1) m =
  batchSubstitute.find (List.enumFrom (index + 1) exprs) depth m :=
by induction exprs generalizing index with
  | nil => simp [batchSubstitute.find]
  | cons e t h =>
    have this : index + 1 + depth = index + (depth + 1) :=
    by rw [Nat.add_assoc, Nat.add_comm 1 depth]
    simp [batchSubstitute.find, this, h (index + 1)]

theorem batchSubstituteFindPop (index m : Nat) {depth : Nat} (exprs : List LambdaTerm)
  (h₁ : m < index + exprs.length) (h₂ : index + depth ≤ m) :
  batchSubstitute.find (List.enumFrom (index + 1) exprs) depth (m + 1) =
  batchSubstitute.find (List.enumFrom index exprs) depth m :=
by induction exprs generalizing index with
| nil =>
  simp only [List.length_nil, Nat.add_zero] at h₁
  have p : m < index + depth := Nat.ltAddRight h₁
  have p' := Nat.ltOfLtOfLe p h₂
  exact absurd p' <| Nat.ltIrrefl m
| cons hd tl h_tl =>
  simp [batchSubstitute.find]
  byCases h' : (index + depth = m)
  focus
    have h'' : index + 1 + depth = m + 1 by rw [Nat.add_assoc, Nat.add_comm 1, ← Nat.add_assoc, h']
    simp [ifPos h', ifPos h'']
  focus
    have h'' : index + 1 + depth ≠ m + 1 by
      rw [Nat.add_assoc, Nat.add_comm 1, ← Nat.add_assoc]
      intro h₀
      simp [Nat.add_one] at h₀
      apply Nat.noConfusion h₀
      exact (λ h : index + depth = m => h' h)
    simp [ifNeg h', ifNeg h'']
    apply h_tl (index + 1)
    focus
      simp only [List.length_cons, (Nat.add_one _).symm,
        Nat.add_comm (List.length _) 1, (Nat.add_assoc _ _ _).symm] at h₁
      exact h₁
    focus
      apply Nat.leOfLtSucc
      rw [Nat.add_assoc, Nat.add_comm 1, ← Nat.add_assoc]
      apply Nat.succLeSucc
      exact Nat.succLeOfLt <| Nat.ltOfLeOfNe h₂ h'

theorem batchSubstituteSwap (t : LambdaTerm) (l : List LambdaTerm) (i : Nat) (depth : Nat) :
  batchSubstitute.aux i l t (depth + 1) = batchSubstitute.aux (i + 1) l t depth :=
by induction t generalizing depth with
  | var m =>
    simp [batchSubstitute.aux, batchSubstituteFindSwap]
  | app fn arg h_fn h_arg => simp [batchSubstitute.aux, h_fn, h_arg]
  | lambda body h_body => simp [batchSubstitute.aux, h_body]

theorem substEmpty (t : LambdaTerm) {i : Nat} :
  t[i ← []] = t :=
by induction t generalizing i with
| var m => simp [batchSubstitute, batchSubstitute.aux, batchSubstitute.find]
| app fn arg h_fn h_arg =>
  simp only [batchSubstitute] at h_fn
  simp only [batchSubstitute] at h_arg
  simp [batchSubstitute, batchSubstitute.aux, h_fn, h_arg]
| lambda body h_body =>
  simp only [batchSubstitute] at h_body
  simp only [batchSubstitute, batchSubstitute.aux]
  rw [batchSubstituteSwap body [] i 0, h_body]

theorem substMinorized (h : C[i](t)) (l : List LambdaTerm) : t[i ← l] = t :=
by induction t generalizing i with
| var m =>
  simp [batchSubstitute, batchSubstitute.aux]
  suffices p : ∀ j, i ≤ j → batchSubstitute.find (List.enumFrom j l) 0 m = LambdaTerm.var m
  from p i (Nat.leRefl i)
  induction l with
  | nil =>
    intro j h'
    simp [batchSubstitute.find]
  | cons hd tl tl_h =>
    intro j h'
    simp [batchSubstitute.find]
    have p : j ≠ m := Nat.ltOfLtOfLe h h' |> Nat.neOfLt |> Ne.symm
    simp [p, tl_h (j + 1) (Nat.leStep h')]
| app fn arg h_fn h_arg =>
  simp only [batchSubstitute] at h_fn
  simp only [batchSubstitute] at h_arg
  simp [batchSubstitute, batchSubstitute.aux, h_fn h.1, h_arg h.2]
| lambda body h_body =>
  have p := h_body (allFreeVariablesBoundBy.auxRec₂.2 h)
  simp only [batchSubstitute] at p
  rw [← batchSubstituteSwap body l i 0] at p
  simp [batchSubstitute, batchSubstitute.aux, p]

theorem batchSubstituteFindLower (h : m < i) :
  batchSubstitute.find (List.enumFrom i l) 0 m = LambdaTerm.var m :=
by induction l generalizing i with
| nil => simp [batchSubstitute.find]
| cons hd tl h_tl =>
  simp only [Nat.add_zero, batchSubstitute.find, ifNeg $ Ne.symm $ Nat.neOfLt h]
  exact h_tl $ Nat.ltTrans h $ Nat.ltSuccSelf i

theorem batchSubstituteFindMinorized (l : List LambdaTerm)
  (h_l : List.forall (λ t => C[i](t)) l) (i_le_j : i ≤ j) (depth m : Nat) :
  (λ result => result = LambdaTerm.var m ∨ C[i](result)) $
  batchSubstitute.find (List.enumFrom j l) depth m :=
by induction l generalizing j with
| nil => simp [batchSubstitute.find]
| cons hd tl h_tl =>
  simp only [batchSubstitute.find]
  simp only [List.forall, List.foldr] at h_l
  byCases h : j + depth = m
  focus
    simp only [ifPos h]
    exact Or.inr h_l.1
  focus
    simp only [ifNeg h]
    exact h_tl h_l.2 $ Nat.leTrans i_le_j $ Nat.leSucc j

theorem substRotate (t : LambdaTerm) {i : Nat} {hd : LambdaTerm} {tl : List LambdaTerm}
  (h_hd : C[i](hd)) (h_tl : List.forall (λ t => C[i](t)) tl) :
  t[i ← hd :: tl] = t[(i + 1) ← tl][i ← [hd]] :=
by
  suffices p : ∀ j : Nat, i ≤ j → t[j ← hd :: tl] = t[(j + 1) ← tl][j ← [hd]]
  by exact p i (Nat.leRefl i)
  induction t with
  | var m =>
    intro j h
    simp only [batchSubstitute, batchSubstitute.aux, batchSubstitute.find, Nat.add_zero]
    byCases h₁ : m ≤ j
    focus
      rw [batchSubstituteFindLower (show m < j + 1 from Nat.ltOfLeOfLt h₁ $ Nat.ltSuccSelf j)]
      byCases h₂ : m = j
      simp [batchSubstitute.aux, batchSubstitute.find, h₂]
      simp [batchSubstitute.aux, batchSubstitute.find, Ne.symm h₂]
    focus
      have j_ne_m : j ≠ m := λ h' => h₁ $ Nat.leOfEq h'.symm
      have p := batchSubstituteFindMinorized tl h_tl (Nat.leTrans h $ Nat.leSucc j) 0 m
      simp at p
      cases p with
      | inl h => simp [h, batchSubstitute.aux, batchSubstitute.find, j_ne_m]
      | inr h' =>
        have p' : C[j](_) := boundByGreater h h'
        have p'' := substMinorized p' [hd]
        simp only [ifNeg j_ne_m]
        simp only [batchSubstitute] at p''
        rw [p'']
  | app fn arg h_fn h_arg =>
    intro j h
    simp [batchSubstitute] at h_fn
    simp [batchSubstitute] at h_arg
    simp [batchSubstitute, batchSubstitute.aux, h_fn j h, h_arg j h]
  | lambda body h_body =>
    intro j h
    simp only [batchSubstitute] at h_body
    simp only [batchSubstitute, batchSubstitute.aux, batchSubstituteSwap]
    rw [h_body (j + 1) (Nat.leTrans h $ Nat.leSucc j)]

-- Another useful lemma
theorem substAllByClosed {l : List LambdaTerm} {t : LambdaTerm}
  (h₁ : C[List.length l](t)) (h₂ : List.forall (λ t => C[0](t)) l) : C[0](t[0 ← l]) :=
by
  suffices p : ∀ {t i}, C[List.length l + i](t) →
    C[i](t[i ← l])
  by
    apply p
    rw [Nat.add_zero]
    exact h₁
  intro t
  induction t with
  | var m =>
    intro i h
    simp only [allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux] at h
    simp only [batchSubstitute, batchSubstitute.aux]
    suffices p :
      ∀ l j, (List.forall (λ t => C[0](t)) l) →
      (m < List.length l + j + i) →
      C[0](batchSubstitute.find (List.enumFrom (j + i) l) 0 m) ∨
      (batchSubstitute.find (List.enumFrom (j + i) l) 0 m = LambdaTerm.var m ∧ m < j + i)
    from match p l 0 h₂ h with
    | Or.inl p => boundByGreater (Nat.zeroLe i) (Nat.zero_add i ▸ p)
    | Or.inr p => by
      simp [Nat.add_zero] at p
      rw [p.1];
      exact p.2
    intro l j hl h
    induction l generalizing j with
    | nil =>
      apply Or.inr
      simp [List.enumFrom, batchSubstitute.find]
      simp [List.length_nil] at h
      exact h
    | cons hd tl h_tl =>
      simp [List.forall, List.foldr] at hl
      simp [List.length_cons, (Nat.add_one _).symm] at h
      rw [Nat.add_assoc _ 1 j] at h
      have p := h_tl (1 + j) hl.2 h
      byCases hm : m < j + i
      focus simp [batchSubstituteFindLower hm, hm]
      focus
        byCases hm' : j + i = m
        focus simp [List.enumFrom, batchSubstitute.find, hm', hl.1]
        focus match p with
        | Or.inl p =>
          apply Or.inl
          simp [List.enumFrom, batchSubstitute.find, hm']
          exact (show j + i + 1 = 1 + j + i by rw [Nat.add_comm, Nat.add_assoc]) ▸ p
        | Or.inr p =>
          exact absurd p.2 (show ¬ m < 1 + j + i from λ h => by
            rw [Nat.add_assoc, Nat.add_comm, Nat.add_one] at h
            match Nat.eqOrLtOfLe (Nat.leOfLtSucc h) with
            | Or.inl h => exact hm' h.symm
            | Or.inr h => exact hm h)
  | app fn arg h_fn h_arg =>
    intro i h
    simp [allFreeVariablesBoundBy, batchSubstitute] at h_fn
    simp [allFreeVariablesBoundBy, batchSubstitute] at h_arg
    simp [allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux, h_fn h.1, h_arg h.2]
  | lambda body h_body =>
    intro i h
    simp [allFreeVariablesBoundBy, batchSubstitute] at h_body
    simp [allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux]
    have p := allFreeVariablesBoundBy.lambda h
    simp [allFreeVariablesBoundBy] at p
    simp [batchSubstituteSwap]
    apply allFreeVariablesBoundBy.auxRec₂.1
    exact h_body p

-- Part 2
-- Q2.1
inductive SmallStepBetaReduction: LambdaTerm -> LambdaTerm -> Prop :=
| Eval : ∀ (u v: LambdaTerm), SmallStepBetaReduction (LambdaTerm.app (LambdaTerm.lambda u) v) (u[0 ← [v]])
| LeftContext : ∀ (u v t: LambdaTerm), SmallStepBetaReduction t u -> SmallStepBetaReduction (LambdaTerm.app t v) (LambdaTerm.app u v)
| RightContext : ∀ (t u v : LambdaTerm), SmallStepBetaReduction t u -> SmallStepBetaReduction (LambdaTerm.app v t) (LambdaTerm.app v u)
| LambdaContext : ∀ (t u : LambdaTerm), SmallStepBetaReduction t u -> SmallStepBetaReduction (LambdaTerm.lambda t) (LambdaTerm.lambda u)

-- Q2.2
inductive BetaReduction: LambdaTerm -> LambdaTerm -> Prop :=
| Rfl (u: LambdaTerm): BetaReduction u u
| Trans (t u v: LambdaTerm): SmallStepBetaReduction t u -> BetaReduction u v -> BetaReduction t v

-- Q2.3
theorem BetaReduction.subterms.reduceAux1 (t u v: LambdaTerm):
  BetaReduction t u -> BetaReduction (LambdaTerm.app t v) (LambdaTerm.app u v) :=
fun h_red => by induction h_red with
| Rfl => exact BetaReduction.Rfl _
| Trans w x y h_smallstep h_step₁ h_step₂ =>
  -- TODO(Ryan): golf me.
  apply BetaReduction.Trans (LambdaTerm.app w v) (LambdaTerm.app x v)
  apply SmallStepBetaReduction.LeftContext
  assumption
  assumption

theorem BetaReduction.subterms.reduceAux2 (t u v: LambdaTerm):
  BetaReduction t u -> BetaReduction (LambdaTerm.app v t) (LambdaTerm.app v u) :=
fun h_red => by induction h_red with
| Rfl => exact BetaReduction.Rfl _
| Trans w x y h_smallstep h_step₁ h_step₂ =>
  -- TODO(Ryan): golf me.
  apply BetaReduction.Trans (LambdaTerm.app v w) (LambdaTerm.app v x)
  apply SmallStepBetaReduction.RightContext
  assumption
  assumption

theorem BetaReduction.subterms.reduceAux3 (t u: LambdaTerm):
  BetaReduction t u -> BetaReduction (LambdaTerm.lambda t) (LambdaTerm.lambda u) :=
fun h_red => by induction h_red with
| Rfl => exact BetaReduction.Rfl _
| Trans w x y h_smallstep h_step₁ h_step₂ =>
  -- TODO(Ryan): golf me.
  apply BetaReduction.Trans (LambdaTerm.lambda w) (LambdaTerm.lambda x)
  apply SmallStepBetaReduction.LambdaContext
  assumption; assumption

-- Part 3
-- Q3.2
inductive KrivineInstruction
| Access (n: Nat)
| Grab (next: KrivineInstruction)
| Push (next: KrivineInstruction) (continuation: KrivineInstruction)

inductive KrivineClosure
| pair (i: KrivineInstruction) (e: List KrivineClosure)

def KrivineEnv := List KrivineClosure
def KrivineStack := List KrivineClosure

-- TODO(Ryan): maybe, merge these two definitions?

structure KrivineState where
  code: KrivineInstruction
  env: KrivineEnv
  stack: KrivineEnv

instance : Inhabited KrivineState where
  default := { code := KrivineInstruction.Access 0, env := [], stack := [] }

-- Q3.3
-- @[reducible]
def evalKrivineMachine (state: KrivineState): Option KrivineState :=
match state.code, state.env, state.stack with
| KrivineInstruction.Access 0, (KrivineClosure.pair code recEnv :: closures), stack =>
  some $ KrivineState.mk code recEnv stack
| KrivineInstruction.Access (Nat.succ n), (KrivineClosure.pair code recEnv :: closures), stack =>
  some $ KrivineState.mk (KrivineInstruction.Access n) closures stack
| KrivineInstruction.Push c' c, env, stack =>
  some $ KrivineState.mk c env (KrivineClosure.pair c' env :: stack)
| KrivineInstruction.Grab code, closures, (KrivineClosure.pair c₀ e₀ :: stack) =>
  some $ KrivineState.mk code (KrivineClosure.pair c₀ e₀ :: closures) stack
| _, _, _ =>
  none

-- Part 4
-- Q4.1
def compile_instr: LambdaTerm -> KrivineInstruction
| LambdaTerm.lambda t => KrivineInstruction.Grab (compile_instr t)
| LambdaTerm.app t u => KrivineInstruction.Push (compile_instr u) (compile_instr t)
| LambdaTerm.var n => KrivineInstruction.Access n

def compile : LambdaTerm -> KrivineState :=
fun t => KrivineState.mk (compile_instr t) [] []

-- Part 5

-- Q5.1
def undoInstruction : KrivineInstruction → LambdaTerm
| KrivineInstruction.Access n => LambdaTerm.var n
| KrivineInstruction.Push c' c => LambdaTerm.app (undoInstruction c) (undoInstruction c')
| KrivineInstruction.Grab c => LambdaTerm.lambda (undoInstruction c)

set_option codegen false in
def undoClosure : KrivineClosure → LambdaTerm := KrivineClosure.rec
  (λ inst env env_undone => (undoInstruction inst)[0 ← env_undone])
  []
  (λ hd tl hd_undone tl_undone => hd_undone :: tl_undone)

/-def a : List KrivineClosure → LambdaTerm := KrivineClosure.rec_1
  (λ inst env env_undone => (undoInstruction inst)[0 ← env_undone])
  []
  (λ hd tl hd_undone tl_undone => hd_undone :: tl_undone)-/

set_option codegen false in
def undo (s : KrivineState) : LambdaTerm := List.foldl
  (λ f arg => LambdaTerm.app f $ undoClosure arg)
  ((undoInstruction s.code)[0 ← List.map undoClosure s.env])
  s.stack

theorem undoClosureSpec :
  undoClosure (KrivineClosure.pair i e) = (undoInstruction i)[0 ← List.map undoClosure e] :=
by
  simp [undoClosure]
  apply show ∀ {x y}, x = y → (undoInstruction i)[0 ← x] = (undoInstruction i)[0 ← y] from λ h => by rw [h]
  induction e with
  | nil => simp
  | cons hd tl h_tl =>
    simp [List.map]
    rw [h_tl]

-- Q5.2
def compile.idOfLeftInv (t: LambdaTerm): undoInstruction (compile_instr t) = t :=
by induction t with
| var n => rfl
| app fn arg h_fn h_arg => simp [undoInstruction, h_fn, h_arg]
| lambda t ht => simp [undoInstruction, ht]

def List.max: List Nat → Nat
| [] => 0
| x :: q => Nat.max x (max q)

partial def KrivineClosure.depthUnsafe: KrivineClosure -> Nat
| KrivineClosure.pair i env => List.max (List.map depthUnsafe env) + 1

set_option codegen false in
@[implementedBy KrivineClosure.depthUnsafe]
def KrivineClosure.depth: KrivineClosure -> Nat :=
fun closure => by induction closure with
| pair i env depth_env => exact depth_env
| nil => exact 0
| cons head tail head_depth tail_depth => exact Nat.max (head_depth + 1) (tail_depth + 1)

theorem KrivineClosure.depth.cons (c: KrivineInstruction) (a: KrivineClosure) (q: List KrivineClosure):
depth (pair c (a :: q)) = Nat.max (depth a + 1) (depth (pair c q) + 1) := rfl

def KrivineClosure.depth.spec: ∀ (c: KrivineInstruction) (x: KrivineClosure) (e: List KrivineClosure),
  depth x < depth (KrivineClosure.pair c (x :: e)) :=
fun c x e => by
simp [KrivineClosure.depth.cons]
exact Nat.ltSuccMaxLeft

namespace KrivineEnv
def depth: KrivineEnv -> Nat
| [] => 0
| closure :: closures => Nat.max (KrivineClosure.depth closure + 1) (depth closures + 1)

theorem depth_of_kcDepth (c: KrivineInstruction) (x: KrivineEnv): KrivineClosure.depth (KrivineClosure.pair c x) = depth x :=
by induction x with
| nil => simp [depth, KrivineClosure.depth]
| cons a q hq => simp [depth, KrivineClosure.depth.cons, hq]

theorem depth_spec₁: ∀ (c: KrivineInstruction) (x: KrivineEnv) (q: KrivineEnv),
  measure depth q (KrivineClosure.pair c x :: q) :=
fun c x q => by
  simp only [measure, InvImage, depth]
  rw [← Nat.succMaxEqMaxSucc]
  exact Nat.ltSuccMaxRight

theorem depth_spec₂: ∀ (c: KrivineInstruction) (x: KrivineEnv) (q: KrivineEnv),
  measure depth x (KrivineClosure.pair c x :: q) :=
fun c x q => by
  simp only [measure, InvImage, depth, depth_of_kcDepth]
  exact Nat.ltSuccMaxLeft

def depth_rel: KrivineEnv -> KrivineEnv -> Prop := measure depth
def depth_wf: WellFounded (measure depth) := measureWf depth

def correctF: (e: KrivineEnv) -> ((y : KrivineEnv) → measure depth y e → Prop) -> Prop :=
fun e correct => match (generalizing := true) e with
| [] => true
| KrivineClosure.pair c₀ e₀ :: env =>
  C[List.length e₀](undoInstruction c₀)
  ∧ (correct e₀ (depth_spec₂ _ _ _))
  ∧ (correct env (depth_spec₁ _ _ _))

def correct: KrivineEnv -> Prop :=
WellFounded.fix depth_wf correctF

def correct.spec:
  ∀ (x: KrivineEnv), WellFounded.fix depth_wf correctF x = correctF x (fun y correct => WellFounded.fix depth_wf correctF y)
  := WellFounded.fixEq depth_wf correctF

theorem lateralInduction {motive : KrivineEnv → Sort}
  (env : KrivineEnv)
  (nil : motive [])
  (cons : ∀ code env tail, motive env → motive tail →
    motive (KrivineClosure.pair code env :: tail)) : motive env :=
by
  apply WellFounded.fix depth_wf
  intros x h_acc
  match x with
  | [] => exact nil
  | KrivineClosure.pair code env :: tail =>
    exact cons _ _ _ (h_acc _ $ depth_spec₂ _ _ _) (h_acc _ $ depth_spec₁ _ _ _)

end KrivineEnv

def KrivineState.correct (state: KrivineState): Prop :=
  C[List.length state.env](undoInstruction state.code)
  ∧ (KrivineEnv.correct state.env)
  ∧ (KrivineEnv.correct state.stack)

-- Q5.3
theorem Classical.dne {p: Prop}: ¬¬p -> p :=
fun hnnp => match (em p) with
| Or.inl hp => hp
| Or.inr hnp => absurd hnp hnnp

theorem evalKrivineMachine.isTransitionOfCorrect (state: KrivineState) (hcorrect: KrivineState.correct state)
  (h_grab: (∃ c: KrivineInstruction, state.code = KrivineInstruction.Grab c) -> (List.length state.stack) ≥ 1):
  (evalKrivineMachine state) ≠ none :=
byContradiction (fun hcontra =>
  by
  simp at hcontra
  have evalKrivineMachine state = none from Classical.dne hcontra
  match state with
  | KrivineState.mk code env stack =>
    match code with
    | KrivineInstruction.Access 0 =>
      match env, stack with
      | (KrivineClosure.pair code recEnv :: closures), stack =>
        simp [evalKrivineMachine] at this
    | KrivineInstruction.Access (Nat.succ n) =>
      match env, stack with
      | (KrivineClosure.pair code recEnv :: closures), stack =>
        simp [evalKrivineMachine] at this
    | KrivineInstruction.Push c' c =>
      match env, stack with
      | env, stack =>
        simp [evalKrivineMachine] at this
    | KrivineInstruction.Grab code =>
      match env, stack with
      | closures, (KrivineClosure.pair c₀ e₀ :: stack) =>
        simp [evalKrivineMachine] at this
      | env, [] =>
        simp only [List.length] at h_grab
        exact h_grab ⟨ code, by rfl ⟩
)

theorem correctness.code.aux₁ (code: KrivineInstruction) (env: KrivineEnv)
  (tail: KrivineEnv)
  (h: KrivineEnv.correct (KrivineClosure.pair code env :: tail)): C[List.length env](undoInstruction code) :=
by
simp [KrivineEnv.correct] at h
rw [KrivineEnv.correct.spec] at h
exact h.1

theorem correctness.code.aux₂ (m n: Nat):
  C[Nat.succ m](undoInstruction $ KrivineInstruction.Access (Nat.succ n)) -> C[m](undoInstruction $ KrivineInstruction.Access n) :=
by
intro h; simp [undoInstruction, allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux, Nat.lt.base]; simp [undoInstruction, allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux] at h; exact h

theorem correctness.code.aux₃ {c c': KrivineInstruction} {n: Nat}:
  C[n](undoInstruction $ KrivineInstruction.Push c c') -> C[n](undoInstruction c') ∧ C[n](undoInstruction c) :=
by
simp [undoInstruction, allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux]
exact (fun a => a)

theorem correctness.code.aux₄ {c: KrivineInstruction}:
  C[n](undoInstruction $ KrivineInstruction.Grab c) -> C[Nat.succ n](undoInstruction c) :=
by
simp [undoInstruction, allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux]
exact (fun H => by apply (allFreeVariablesBoundBy.auxRec₂).2; exact H)

theorem correctness.env.aux₁ (code: KrivineInstruction) (env: KrivineEnv)
  (tail: KrivineEnv)
  (h: KrivineEnv.correct (KrivineClosure.pair code env :: tail)): KrivineEnv.correct env :=
by
simp only [KrivineEnv.correct] at h; rw [KrivineEnv.correct.spec] at h
exact h.2.1

theorem correctness.env.aux₂ {code: KrivineInstruction} {env: KrivineEnv}
  {tail: KrivineEnv}
  (h: KrivineEnv.correct (KrivineClosure.pair code env :: tail)): KrivineEnv.correct tail :=
by
simp only [KrivineEnv.correct] at h; rw [KrivineEnv.correct.spec] at h
exact h.2.2

theorem correctness.env.aux₃ {code: KrivineInstruction} {env: KrivineEnv}
  {tail: KrivineEnv} (h_code: C[List.length env](undoInstruction code))
  (h_head: KrivineEnv.correct env) (h_tail: KrivineEnv.correct tail): KrivineEnv.correct (KrivineClosure.pair code env :: tail) :=
by
simp only [KrivineEnv.correct]; rw [KrivineEnv.correct.spec]
exact ⟨ h_code, ⟨ h_head, h_tail ⟩ ⟩

theorem transitionCorrectness (state: KrivineState) (hcorrect: KrivineState.correct state)
  (h_istransition: evalKrivineMachine state ≠ none):
  KrivineState.correct $ (evalKrivineMachine state).get! :=
by
simp [KrivineState.correct]
match state with
| KrivineState.mk code env stack =>
  match code with
  | KrivineInstruction.Access 0 =>
    match env, stack with
    | (KrivineClosure.pair code recEnv :: closures), stack =>
      simp [KrivineState.correct] at hcorrect
      have evalKrivineMachine { code := KrivineInstruction.Access 0, env := KrivineClosure.pair code recEnv :: closures, stack := stack } = some { code := code, env := recEnv, stack := stack} from by rfl
      simp [this, Option.get!]
      exact ⟨ (correctness.code.aux₁ _ _ closures hcorrect.2.1), ⟨ (correctness.env.aux₁ code recEnv closures hcorrect.2.1), hcorrect.2.2 ⟩ ⟩
  | KrivineInstruction.Access (Nat.succ n) =>
    match env, stack with
    | (KrivineClosure.pair code recEnv :: closures), stack =>
      simp [KrivineState.correct] at hcorrect
      simp [evalKrivineMachine, Option.get!]
      exact ⟨ (correctness.code.aux₂ _ _ hcorrect.1), ⟨ correctness.env.aux₂ hcorrect.2.1, hcorrect.2.2 ⟩ ⟩
  | KrivineInstruction.Push c' c =>
    match env, stack with
    | env, stack =>
      simp [KrivineState.correct] at hcorrect
      simp [evalKrivineMachine, Option.get!]
      have allFreeVariablesBoundBy (List.length env) (undoInstruction c') from (correctness.code.aux₃ hcorrect.1).2
      exact ⟨ (correctness.code.aux₃ hcorrect.1).1, ⟨ hcorrect.2.1, correctness.env.aux₃ this hcorrect.2.1 hcorrect.2.2⟩⟩
  | KrivineInstruction.Grab code =>
    match env, stack with
    | closures, (KrivineClosure.pair c₀ e₀ :: stack) =>
      simp [KrivineState.correct] at hcorrect
      simp [evalKrivineMachine, Option.get!]
      have h₁: allFreeVariablesBoundBy (List.length e₀) (undoInstruction c₀) from correctness.code.aux₁ _ _ _ hcorrect.2.2
      have h₂: KrivineEnv.correct e₀ from correctness.env.aux₁ _ _ _ hcorrect.2.2
      exact ⟨ correctness.code.aux₄ hcorrect.1, ⟨ correctness.env.aux₃ h₁ h₂ hcorrect.2.1, correctness.env.aux₂ hcorrect.2.2 ⟩ ⟩
    | env, [] =>
      simp [KrivineState.correct] at hcorrect
      simp [evalKrivineMachine, Option.get!]
      have evalKrivineMachine { code := KrivineInstruction.Grab code, env := env, stack := [] } = none from by rfl
      exact absurd this h_istransition

-- Q5.4

theorem lemma₀ : SmallStepBetaReduction u v →
  SmallStepBetaReduction
    (List.foldl (λ f arg => LambdaTerm.app f (undoClosure arg)) u l)
    (List.foldl (λ f arg => LambdaTerm.app f (undoClosure arg)) v l) :=
by induction l generalizing u v with
| nil =>
  simp [List.foldl]
  exact λ h => h
| cons hd tl tl_h =>
  intro h
  apply tl_h
  simp [List.foldl]
  exact SmallStepBetaReduction.LeftContext _ _ _ h

theorem lemma₁ (h₁ : C[0](u)) (h₂ : List.forall (λ t => C[0](t)) l) :
  SmallStepBetaReduction (LambdaTerm.app (LambdaTerm.lambda (t[1 ← l])) u) (t[0 ← u :: l]) :=
by
  rw [substRotate t h₁ h₂]
  apply SmallStepBetaReduction.Eval

theorem closedOfCorrect {env : KrivineEnv} (correct : KrivineEnv.correct env) :
  List.forall (λ t => C[0](t)) (List.map undoClosure env) :=
by induction env using KrivineEnv.lateralInduction with
| nil => simp [List.map, List.forall, List.foldr]
| cons code env tail h_env h_tail =>
  simp [List.map, List.forallCons, h_tail <| correctness.env.aux₂ correct]
  simp [undoClosureSpec]
  exact substAllByClosed
    (by
      rw [List.lengthMap undoClosure env]
      exact correctness.code.aux₁ code env tail correct)
    (h_env <| correctness.env.aux₁ _ _ _ correct)

/-
Nous avons rencontré un léger problème : nous avons dû modifier la question 5.4
qui était fausse en l'état (une transition de la machine de Krivine ne correspond
pas toujours à une beta-reduction -- on le voit par exemple dans les cas où l'instruction
à exécuter est `Access n` avec n > 0).

Nous avons donc décidé de simplement montrer qu'une transition de la machine de Krivine
correspond soit à une beta-reduction, soit à aucune opération modulo τ.
-/
theorem simulationCorrectness (state₀ : KrivineState) (state₁ : KrivineState)
 (eval : evalKrivineMachine state₀ = state₁) (correct : KrivineState.correct state₀) :
 SmallStepBetaReduction (undo state₀) (undo state₁) ∨ undo state₀ = undo state₁ :=
by match state₀ with
| KrivineState.mk code state stack =>
  induction code with
  | Access n => match state with
    | [] =>
      cases n with
      | zero => simp [evalKrivineMachine] at eval
      | succ n => simp [evalKrivineMachine] at eval
    | KrivineClosure.pair code recEnv :: closures =>
      apply Or.inr
      cases n with
      | zero =>
        simp [evalKrivineMachine] at eval
        apply Option.noConfusion eval
        intro eval
        rw [← eval]
        simp [undo, undoInstruction, batchSubstitute, batchSubstitute.aux, List.enumFrom, batchSubstitute.find]
        rw [undoClosureSpec]
        rfl
      | succ n =>
        simp [evalKrivineMachine] at eval
        apply Option.noConfusion eval
        intro eval
        rw [← eval]
        simp [undo, undoInstruction, batchSubstitute, batchSubstitute.aux, List.enumFrom, batchSubstitute.find]
        suffices p : batchSubstitute.find (List.enumFrom 1 (List.map undoClosure closures)) 0 (Nat.succ n) =
          batchSubstitute.find (List.enumFrom 0 (List.map undoClosure closures)) 0 n
        by rw [p]
        apply batchSubstituteFindPop
        focus
          have p := correct.1
          simp [List.length_cons, undoInstruction, allFreeVariablesBoundBy, allFreeVariablesBoundBy.aux] at p
          rw [List.lengthMap, Nat.zero_add]
          apply Nat.lt_of_succ_lt_succ
          exact p
        focus
          exact Nat.zeroLe n
  | Push c' c c'_h c_h =>
    simp [evalKrivineMachine] at eval
    apply Option.noConfusion eval
    intro eval
    rw [← eval]
    simp [undo, undoInstruction, batchSubstitute, batchSubstitute.aux, undoClosureSpec, List.foldl]
  | Grab c c_h =>
    apply Or.inl
    match stack with
    | [] => simp [evalKrivineMachine] at eval
    | KrivineClosure.pair code recEnv :: closures =>
      simp [evalKrivineMachine] at eval
      apply Option.noConfusion eval
      intro eval
      rw [← eval]
      simp [undo, undoInstruction, batchSubstitute, batchSubstitute.aux,
        undoClosureSpec, List.foldl, List.map]
      simp [KrivineState.correct] at correct
      apply lemma₀
      simp [batchSubstituteSwap]
      have p₁ := substAllByClosed
        (by
          rw [List.lengthMap undoClosure recEnv]
          exact correctness.code.aux₁ _ _ _ correct.2.2)
        (closedOfCorrect <| correctness.env.aux₁ _ _ _ correct.2.2)
      apply lemma₁ p₁ (closedOfCorrect correct.2.1)

-- Q5.5
inductive EvalTC: KrivineState -> KrivineState -> Prop :=
| Rfl (u: KrivineState): EvalTC u u
| Trans (t u v: KrivineState): evalKrivineMachine t = u -> EvalTC u v -> EvalTC t v

/-
Le vrai problème se pose à la dernière question : nous n'avons pas assez de lemmes pour
montrer un théorème de correction vraiment puissant. En l'état, nous avons simplement
montré qu'une chaîne de transitions de la machine de Krivine correspond à une chaîne
de beta-reductions, c'est à dire une version itérée de 5.4.

Nous aurions pu montrer un théorème plus puissant en renforçant des lemmes précédents.
Le mieux aurait été de montrer que pour tout état `s` correct, s'il existe une transition
de la machine de Krivine partant de `s`, alors il existe une chaîne de transitions
`s = s₀ -> s₁ -> ... -> sₙ` telle que `τ(s₀) -> τ(sₙ)`. Ceci nous aurait permis d'exhiber
une équivalence entre les exécutions du modèle du lambda calcul que l'on a dans le sujet
et les exécutions de la machine de Krivine.
-/
theorem simulationCorrectnessTC (u v : KrivineState) (h : EvalTC u v) (correct : KrivineState.correct u) :
  BetaReduction (undo u) (undo v) :=
by induction h with
| Rfl u => apply BetaReduction.Rfl
| Trans t u v t_h a a_h =>
  have p := simulationCorrectness t u t_h correct
  have u_correct := transitionCorrectness t correct (by simp [t_h])
  rw [t_h] at u_correct
  match p with
  | Or.inl p =>
    exact BetaReduction.Trans (undo t) (undo u) (undo v) p (a_h u_correct)
  | Or.inr p =>
    rw [p]
    exact a_h u_correct


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.continued_fractions.translations
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Recurrence Lemmas for the `continuants` Function of Continued Fractions.

## Summary

Given a generalized continued fraction `g`, for all `n ≥ 1`, we prove that the `continuants`
function indeed satisfies the following recurrences:
- `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂`, and
- `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`.
-/

namespace generalized_continued_fraction

theorem continuants_aux_recurrence {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {gp : pair K} {ppred : pair K} {pred : pair K} (nth_s_eq : seq.nth (s g) n = some gp) (nth_conts_aux_eq : continuants_aux g n = ppred) (succ_nth_conts_aux_eq : continuants_aux g (n + 1) = pred) : continuants_aux g (n + bit0 1) =
  pair.mk (pair.b gp * pair.a pred + pair.a gp * pair.a ppred) (pair.b gp * pair.b pred + pair.a gp * pair.b ppred) := sorry

theorem continuants_recurrence_aux {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {gp : pair K} {ppred : pair K} {pred : pair K} (nth_s_eq : seq.nth (s g) n = some gp) (nth_conts_aux_eq : continuants_aux g n = ppred) (succ_nth_conts_aux_eq : continuants_aux g (n + 1) = pred) : continuants g (n + 1) =
  pair.mk (pair.b gp * pair.a pred + pair.a gp * pair.a ppred) (pair.b gp * pair.b pred + pair.a gp * pair.b ppred) := sorry

/-- Shows that `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂` and `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`. -/
theorem continuants_recurrence {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {gp : pair K} {ppred : pair K} {pred : pair K} (succ_nth_s_eq : seq.nth (s g) (n + 1) = some gp) (nth_conts_eq : continuants g n = ppred) (succ_nth_conts_eq : continuants g (n + 1) = pred) : continuants g (n + bit0 1) =
  pair.mk (pair.b gp * pair.a pred + pair.a gp * pair.a ppred) (pair.b gp * pair.b pred + pair.a gp * pair.b ppred) :=
  continuants_recurrence_aux succ_nth_s_eq
    (eq.mp (Eq._oldrec (Eq.refl (continuants g n = ppred)) nth_cont_eq_succ_nth_cont_aux) nth_conts_eq)
    (eq.mp (Eq._oldrec (Eq.refl (continuants g (n + 1) = pred)) nth_cont_eq_succ_nth_cont_aux) succ_nth_conts_eq)

/-- Shows that `Aₙ = bₙ * Aₙ₋₁ + aₙ * Aₙ₋₂`. -/
theorem numerators_recurrence {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {gp : pair K} {ppredA : K} {predA : K} (succ_nth_s_eq : seq.nth (s g) (n + 1) = some gp) (nth_num_eq : numerators g n = ppredA) (succ_nth_num_eq : numerators g (n + 1) = predA) : numerators g (n + bit0 1) = pair.b gp * predA + pair.a gp * ppredA := sorry

/-- Shows that `Bₙ = bₙ * Bₙ₋₁ + aₙ * Bₙ₋₂`. -/
theorem denominators_recurrence {K : Type u_1} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K] {gp : pair K} {ppredB : K} {predB : K} (succ_nth_s_eq : seq.nth (s g) (n + 1) = some gp) (nth_denom_eq : denominators g n = ppredB) (succ_nth_denom_eq : denominators g (n + 1) = predB) : denominators g (n + bit0 1) = pair.b gp * predB + pair.a gp * ppredB := sorry


import analysis.normed_space.hahn_banach
import data.real.basic
import analysis.normed_space.extend
import tactic
import topology.basic

open function metric filter is_R_or_C
open_locale classical topological_space big_operators nnreal
namespace vilnius

variables {𝕜 : Type} [is_R_or_C 𝕜]
variables {V : Type*} [normed_group V] [normed_space 𝕜 V]

-- ## Example 1

/- The Hahn-Banach theorem about extending linear functionals to a field `𝕜 = ℝ` or `𝕜 = ℂ`: -/

theorem Hahn_Banach [complete_space V] (p : subspace 𝕜 V)
(f : p →L[𝕜] 𝕜) : ∃ g : V →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  letI : module ℝ V := restrict_scalars.module ℝ 𝕜 V,
  letI : is_scalar_tower ℝ 𝕜 V := restrict_scalars.is_scalar_tower _ _ _,
  letI : normed_space ℝ V := normed_space.restrict_scalars _ 𝕜 _,
  -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`.
  let fr := re_clm.comp (f.restrict_scalars ℝ),
  have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl },
  -- Use the real version to get a norm-preserving extension of `fr`, which
  -- we'll call `g : V →L[ℝ] ℝ`.
  rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩,
  -- **Now `g` can be extended to the `V →L[𝕜] 𝕜` we need.**
  refine ⟨g.extend_to_𝕜, _⟩,
  -- It is an extension of `f`.
  have h : ∀ x : p, g.extend_to_𝕜 x = f x,
  { assume x,
    rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends],
    have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))),
      by refl,
    rw this,
    apply ext,
    { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add,
        zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, of_real_neg, mul_re,
          mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul, mul_neg, sub_neg_eq_add,
          map_add, of_real_re, I_mul_re, of_real_im, neg_zero', add_zero] },
    { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im',
        zero_mul, of_real_re, mul_im, zero_add, of_real_neg, mul_re,
        sub_neg_eq_add, continuous_linear_map.map_smul, mul_neg, sub_neg_eq_add, map_add,
        of_real_im, mul_im, mul_zero, of_real_re, I_im', zero_add] } },
  -- And we derive the equality of the norms by bounding on both sides.
  refine ⟨h, le_antisymm _ _⟩,
  { calc ∥g.extend_to_𝕜∥
        ≤ ∥g∥ : g.extend_to_𝕜.op_norm_le_bound g.op_norm_nonneg (norm_bound _)
    ... = ∥fr∥ : hnormeq
    ... ≤ ∥re_clm∥ * ∥f∥ : continuous_linear_map.op_norm_comp_le _ _
    ... = ∥f∥ : by rw [re_clm_norm, one_mul] },
  -- We're **almost** there...
  { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) },
end

-- #lint

/-- ## Example 2

We are going to show the trivial result asserting that the sum of two odd numbers is even: first, the definitions:-/

definition even (n : ℕ) := ∃ (k : ℕ), n = 2 * k
definition odd (n : ℕ) := ∃ (k : ℕ), n = 2 * k + 1

/--Then, some results that are already in the library:
* theorem `add_add_add_comm` (a b c d : G) : (a + b) + (c + d) = (a + c) + (b + d)
* theorem `one_add_one_eq_two` : 1 + 1 = 2
* theorem `mul_add` (a b c : G) : a * (b + c) = a * b + a * c
* theorem `mul_add_one` (a b : G) : a * (b + 1) = a * b + a

-/

example (n m : ℕ) (hyp_n : odd n) (hyp_m : odd m) : even (n + m) :=
begin
  sorry,
end

-- ## Example 3 --

/-- To play with some topology, observe that the library contains the following
* `definition` continuous_def {f : α → β} : continuous f ↔
  (∀s, is_open s → is_open (f ⁻¹' s))

from which we deduce (= the system automatically constructs) the
***Modus Ponens*** variant
* `lemma` continuous_def.mp {f : α → β} : continuous f →
  (∀s, is_open s → is_open (f ⁻¹' s)) -/

variables {X Y Z : Type}

example [topological_space X] [topological_space Y] [topological_space Z]
(f : X → Y) (g : Y → Z) (hyp_f : continuous f) (hyp_g : continuous g) :
continuous (g ∘ f : X → Z) :=
begin
  sorry,
end

end vilnius


/-
Copyright (c) 2015 Joe Hendrix. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Sebastian Ullrich

! This file was ported from Lean 3 source module data.bitvec.core
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Vector.Basic
import Mathbin.Data.Nat.Pow

/-!
# Basic operations on bitvectors

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

This is a work-in-progress, and contains additions to other theories.

This file was moved to mathlib from core Lean in the switch to Lean 3.20.0c.
It is not fully in compliance with mathlib style standards.
-/

#print Bitvec /-
/-- `bitvec n` is a `vector` of `bool` with length `n`. -/
@[reducible]
def Bitvec (n : ℕ) :=
  Vector Bool n
#align bitvec Bitvec
-/

namespace Bitvec

open Nat

open Vector

-- mathport name: «expr ++ₜ »
local infixl:65 "++ₜ" => Vector.append

#print Bitvec.zero /-
/-- Create a zero bitvector -/
@[reducible]
protected def zero (n : ℕ) : Bitvec n :=
  replicate n false
#align bitvec.zero Bitvec.zero
-/

#print Bitvec.one /-
/-- Create a bitvector of length `n` whose `n-1`st entry is 1 and other entries are 0. -/
@[reducible]
protected def one : ∀ n : ℕ, Bitvec n
  | 0 => nil
  | succ n => replicate n false++ₜtrue ::ᵥ nil
#align bitvec.one Bitvec.one
-/

#print Bitvec.cong /-
/-- Create a bitvector from another with a provably equal length. -/
protected def cong {a b : ℕ} (h : a = b) : Bitvec a → Bitvec b
  | ⟨x, p⟩ => ⟨x, h ▸ p⟩
#align bitvec.cong Bitvec.cong
-/

#print Bitvec.append /-
/-- `bitvec` specific version of `vector.append` -/
def append {m n} : Bitvec m → Bitvec n → Bitvec (m + n) :=
  Vector.append
#align bitvec.append Bitvec.append
-/

/-! ### Shift operations -/

section Shift

variable {n : ℕ}

#print Bitvec.shl /-
/-- `shl x i` is the bitvector obtained by left-shifting `x` `i` times and padding with `ff`.
If `x.length < i` then this will return the all-`ff`s bitvector. -/
def shl (x : Bitvec n) (i : ℕ) : Bitvec n :=
  Bitvec.cong (by simp) <| drop i x++ₜreplicate (min n i) false
#align bitvec.shl Bitvec.shl
-/

#print Bitvec.fillShr /-
/-- `fill_shr x i fill` is the bitvector obtained by right-shifting `x` `i` times and then
padding with `fill : bool`. If `x.length < i` then this will return the constant `fill`
bitvector. -/
def fillShr (x : Bitvec n) (i : ℕ) (fill : Bool) : Bitvec n :=
  Bitvec.cong
      (by
        by_cases i ≤ n
        · have h₁ := Nat.sub_le n i
          rw [min_eq_right h]
          rw [min_eq_left h₁, ← add_tsub_assoc_of_le h, Nat.add_comm, add_tsub_cancel_right]
        · have h₁ := le_of_not_ge h
          rw [min_eq_left h₁, tsub_eq_zero_iff_le.mpr h₁, zero_min, Nat.add_zero]) <|
    replicate (min n i) fill++ₜtake (n - i) x
#align bitvec.fill_shr Bitvec.fillShr
-/

#print Bitvec.ushr /-
/-- unsigned shift right -/
def ushr (x : Bitvec n) (i : ℕ) : Bitvec n :=
  fillShr x i false
#align bitvec.ushr Bitvec.ushr
-/

#print Bitvec.sshr /-
/-- signed shift right -/
def sshr : ∀ {m : ℕ}, Bitvec m → ℕ → Bitvec m
  | 0, _, _ => nil
  | succ m, x, i => head x ::ᵥ fillShr (tail x) i (head x)
#align bitvec.sshr Bitvec.sshr
-/

end Shift

/-! ### Bitwise operations -/

section Bitwise

variable {n : ℕ}

#print Bitvec.not /-
/-- bitwise not -/
def not : Bitvec n → Bitvec n :=
  map not
#align bitvec.not Bitvec.not
-/

#print Bitvec.and /-
/-- bitwise and -/
def and : Bitvec n → Bitvec n → Bitvec n :=
  map₂ and
#align bitvec.and Bitvec.and
-/

#print Bitvec.or /-
/-- bitwise or -/
def or : Bitvec n → Bitvec n → Bitvec n :=
  map₂ or
#align bitvec.or Bitvec.or
-/

#print Bitvec.xor /-
/-- bitwise xor -/
def xor : Bitvec n → Bitvec n → Bitvec n :=
  map₂ xor
#align bitvec.xor Bitvec.xor
-/

end Bitwise

/-! ### Arithmetic operators -/

section Arith

variable {n : ℕ}

#print Bitvec.xor3 /-
/-- `xor3 x y c` is `((x XOR y) XOR c)`. -/
protected def xor3 (x y c : Bool) :=
  xor (xor x y) c
#align bitvec.xor3 Bitvec.xor3
-/

#print Bitvec.carry /-
/-- `carry x y c` is `x && y || x && c || y && c`. -/
protected def carry (x y c : Bool) :=
  x && y || x && c || y && c
#align bitvec.carry Bitvec.carry
-/

#print Bitvec.neg /-
/-- `neg x` is the two's complement of `x`. -/
protected def neg (x : Bitvec n) : Bitvec n :=
  let f y c := (y || c, xor y c)
  Prod.snd (mapAccumr f x false)
#align bitvec.neg Bitvec.neg
-/

#print Bitvec.adc /-
/-- Add with carry (no overflow) -/
def adc (x y : Bitvec n) (c : Bool) : Bitvec (n + 1) :=
  let f x y c := (Bitvec.carry x y c, Bitvec.xor3 x y c)
  let ⟨c, z⟩ := Vector.mapAccumr₂ f x y c
  c ::ᵥ z
#align bitvec.adc Bitvec.adc
-/

#print Bitvec.add /-
/-- The sum of two bitvectors -/
protected def add (x y : Bitvec n) : Bitvec n :=
  tail (adc x y false)
#align bitvec.add Bitvec.add
-/

#print Bitvec.sbb /-
/-- Subtract with borrow -/
def sbb (x y : Bitvec n) (b : Bool) : Bool × Bitvec n :=
  let f x y c := (Bitvec.carry (not x) y c, Bitvec.xor3 x y c)
  Vector.mapAccumr₂ f x y b
#align bitvec.sbb Bitvec.sbb
-/

#print Bitvec.sub /-
/-- The difference of two bitvectors -/
protected def sub (x y : Bitvec n) : Bitvec n :=
  Prod.snd (sbb x y false)
#align bitvec.sub Bitvec.sub
-/

instance : Zero (Bitvec n) :=
  ⟨Bitvec.zero n⟩

instance : One (Bitvec n) :=
  ⟨Bitvec.one n⟩

instance : Add (Bitvec n) :=
  ⟨Bitvec.add⟩

instance : Sub (Bitvec n) :=
  ⟨Bitvec.sub⟩

instance : Neg (Bitvec n) :=
  ⟨Bitvec.neg⟩

#print Bitvec.mul /-
/-- The product of two bitvectors -/
protected def mul (x y : Bitvec n) : Bitvec n :=
  let f r b := cond b (r + r + y) (r + r)
  (toList x).foldl f 0
#align bitvec.mul Bitvec.mul
-/

instance : Mul (Bitvec n) :=
  ⟨Bitvec.mul⟩

end Arith

/-! ### Comparison operators -/

section Comparison

variable {n : ℕ}

#print Bitvec.uborrow /-
/-- `uborrow x y` returns `tt` iff the "subtract with borrow" operation on `x`, `y` and `ff`
required a borrow. -/
def uborrow (x y : Bitvec n) : Bool :=
  Prod.fst (sbb x y false)
#align bitvec.uborrow Bitvec.uborrow
-/

#print Bitvec.Ult /-
/-- unsigned less-than proposition -/
def Ult (x y : Bitvec n) : Prop :=
  uborrow x y
#align bitvec.ult Bitvec.Ult
-/

#print Bitvec.Ugt /-
/-- unsigned greater-than proposition -/
def Ugt (x y : Bitvec n) : Prop :=
  Ult y x
#align bitvec.ugt Bitvec.Ugt
-/

#print Bitvec.Ule /-
/-- unsigned less-than-or-equal-to proposition -/
def Ule (x y : Bitvec n) : Prop :=
  ¬Ult y x
#align bitvec.ule Bitvec.Ule
-/

#print Bitvec.Uge /-
/-- unsigned greater-than-or-equal-to proposition -/
def Uge (x y : Bitvec n) : Prop :=
  Ule y x
#align bitvec.uge Bitvec.Uge
-/

#print Bitvec.sborrow /-
/-- `sborrow x y` returns `tt` iff `x < y` as two's complement integers -/
def sborrow : ∀ {n : ℕ}, Bitvec n → Bitvec n → Bool
  | 0, _, _ => false
  | succ n, x, y =>
    match (head x, head y) with
    | (tt, ff) => true
    | (ff, tt) => false
    | _ => uborrow (tail x) (tail y)
#align bitvec.sborrow Bitvec.sborrow
-/

#print Bitvec.Slt /-
/-- signed less-than proposition -/
def Slt (x y : Bitvec n) : Prop :=
  sborrow x y
#align bitvec.slt Bitvec.Slt
-/

#print Bitvec.Sgt /-
/-- signed greater-than proposition -/
def Sgt (x y : Bitvec n) : Prop :=
  Slt y x
#align bitvec.sgt Bitvec.Sgt
-/

#print Bitvec.Sle /-
/-- signed less-than-or-equal-to proposition -/
def Sle (x y : Bitvec n) : Prop :=
  ¬Slt y x
#align bitvec.sle Bitvec.Sle
-/

#print Bitvec.Sge /-
/-- signed greater-than-or-equal-to proposition -/
def Sge (x y : Bitvec n) : Prop :=
  Sle y x
#align bitvec.sge Bitvec.Sge
-/

end Comparison

/-! ### Conversion to `nat` and `int` -/

section Conversion

variable {α : Type}

#print Bitvec.ofNat /-
/-- Create a bitvector from a `nat` -/
protected def ofNat : ∀ n : ℕ, Nat → Bitvec n
  | 0, x => nil
  | succ n, x => of_nat n (x / 2)++ₜdecide (x % 2 = 1) ::ᵥ nil
#align bitvec.of_nat Bitvec.ofNat
-/

#print Bitvec.ofInt /-
/-- Create a bitvector in the two's complement representation from an `int` -/
protected def ofInt : ∀ n : ℕ, Int → Bitvec (succ n)
  | n, Int.ofNat m => false ::ᵥ Bitvec.ofNat n m
  | n, Int.negSucc m => true ::ᵥ not (Bitvec.ofNat n m)
#align bitvec.of_int Bitvec.ofInt
-/

#print Bitvec.addLsb /-
/-- `add_lsb r b` is `r + r + 1` if `b` is `tt` and `r + r` otherwise. -/
def addLsb (r : ℕ) (b : Bool) :=
  r + r + cond b 1 0
#align bitvec.add_lsb Bitvec.addLsb
-/

#print Bitvec.bitsToNat /-
/-- Given a `list` of `bool`s, return the `nat` they represent as a list of binary digits. -/
def bitsToNat (v : List Bool) : Nat :=
  v.foldl addLsb 0
#align bitvec.bits_to_nat Bitvec.bitsToNat
-/

#print Bitvec.toNat /-
/-- Return the natural number encoded by the input bitvector -/
protected def toNat {n : Nat} (v : Bitvec n) : Nat :=
  bitsToNat (toList v)
#align bitvec.to_nat Bitvec.toNat
-/

#print Bitvec.bitsToNat_toList /-
theorem bitsToNat_toList {n : ℕ} (x : Bitvec n) : Bitvec.toNat x = bitsToNat (Vector.toList x) :=
  rfl
#align bitvec.bits_to_nat_to_list Bitvec.bitsToNat_toList
-/

attribute [local simp] Nat.add_comm Nat.add_assoc Nat.add_left_comm Nat.mul_comm Nat.mul_assoc

attribute [local simp] Nat.zero_add Nat.add_zero Nat.one_mul Nat.mul_one Nat.zero_mul Nat.mul_zero

#print Bitvec.toNat_append /-
-- mul_left_comm
theorem toNat_append {m : ℕ} (xs : Bitvec m) (b : Bool) :
    Bitvec.toNat (xs++ₜb ::ᵥ nil) = Bitvec.toNat xs * 2 + Bitvec.toNat (b ::ᵥ nil) :=
  by
  cases' xs with xs P
  simp [bits_to_nat_to_list]; clear P
  unfold bits_to_nat List.foldl
  -- generalize the accumulator of foldl
  generalize h : 0 = x;
  conv in add_lsb x b => rw [← h]; clear h
  simp
  induction' xs with x xs generalizing x
  · simp
    unfold List.foldl add_lsb
    simp [Nat.mul_succ]
  · simp
    apply xs_ih
#align bitvec.to_nat_append Bitvec.toNat_append
-/

/- warning: bitvec.bits_to_nat_to_bool -> Bitvec.bits_toNat_decide is a dubious translation:
lean 3 declaration is
  forall (n : Nat), Eq.{1} Nat (Bitvec.toNat (Nat.succ (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) (Vector.cons.{0} Bool (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (Decidable.decide (Eq.{1} Nat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Nat.decidableEq (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Vector.nil.{0} Bool))) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))
but is expected to have type
  forall (n : Nat), Eq.{1} Nat (Bitvec.toNat (Nat.succ (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) (Vector.cons.{0} Bool (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (Decidable.decide (Eq.{1} Nat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (instDecidableEqNat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Vector.nil.{0} Bool))) (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))
Case conversion may be inaccurate. Consider using '#align bitvec.bits_to_nat_to_bool Bitvec.bits_toNat_decideₓ'. -/
theorem bits_toNat_decide (n : ℕ) : Bitvec.toNat (decide (n % 2 = 1) ::ᵥ nil) = n % 2 :=
  by
  simp [bits_to_nat_to_list]
  unfold bits_to_nat add_lsb List.foldl cond
  simp [cond_to_bool_mod_two]
#align bitvec.bits_to_nat_to_bool Bitvec.bits_toNat_decide

/- warning: bitvec.of_nat_succ -> Bitvec.ofNat_succ is a dubious translation:
lean 3 declaration is
  forall {k : Nat} {n : Nat}, Eq.{1} (Bitvec (Nat.succ k)) (Bitvec.ofNat (Nat.succ k) n) (Vector.append.{0} Bool k (Nat.succ (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) (Bitvec.ofNat k (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.hasDiv) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))) (Vector.cons.{0} Bool (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (Decidable.decide (Eq.{1} Nat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Nat.decidableEq (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (Vector.nil.{0} Bool)))
but is expected to have type
  forall {k : Nat} {n : Nat}, Eq.{1} (Bitvec (Nat.succ k)) (Bitvec.ofNat (Nat.succ k) n) (Vector.append.{0} Bool k (Nat.succ (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) (Bitvec.ofNat k (HDiv.hDiv.{0, 0, 0} Nat Nat Nat (instHDiv.{0} Nat Nat.instDivNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))) (Vector.cons.{0} Bool (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (Decidable.decide (Eq.{1} Nat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (instDecidableEqNat (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Vector.nil.{0} Bool)))
Case conversion may be inaccurate. Consider using '#align bitvec.of_nat_succ Bitvec.ofNat_succₓ'. -/
theorem ofNat_succ {k n : ℕ} :
    Bitvec.ofNat (succ k) n = Bitvec.ofNat k (n / 2)++ₜdecide (n % 2 = 1) ::ᵥ nil :=
  rfl
#align bitvec.of_nat_succ Bitvec.ofNat_succ

#print Bitvec.toNat_ofNat /-
theorem toNat_ofNat {k n : ℕ} : Bitvec.toNat (Bitvec.ofNat k n) = n % 2 ^ k :=
  by
  induction' k with k ih generalizing n
  · simp [Nat.mod_one]
    rfl
  · rw [of_nat_succ, to_nat_append, ih, bits_to_nat_to_bool, mod_pow_succ, Nat.mul_comm]
#align bitvec.to_nat_of_nat Bitvec.toNat_ofNat
-/

#print Bitvec.toInt /-
/-- Return the integer encoded by the input bitvector -/
protected def toInt : ∀ {n : Nat}, Bitvec n → Int
  | 0, _ => 0
  | succ n, v =>
    cond (head v) (Int.negSucc <| Bitvec.toNat <| not <| tail v)
      (Int.ofNat <| Bitvec.toNat <| tail v)
#align bitvec.to_int Bitvec.toInt
-/

end Conversion

/-! ### Miscellaneous instances -/

private def repr {n : Nat} : Bitvec n → String
  | ⟨bs, p⟩ => "0b" ++ (bs.map fun b : Bool => if b then '1' else '0').asString
#align bitvec.repr bitvec.repr

instance (n : Nat) : Repr (Bitvec n) :=
  ⟨repr⟩

end Bitvec

instance {n} {x y : Bitvec n} : Decidable (Bitvec.Ult x y) :=
  Bool.decidableEq _ _

instance {n} {x y : Bitvec n} : Decidable (Bitvec.Ugt x y) :=
  Bool.decidableEq _ _