import tactic
import analysis.special_functions.trigonometric
import measure_theory.interval_integral
import topology.basic
import data.finset
import .integrals

noncomputable theory
open_locale classical
open_locale big_operators
open interval_integral
open filter
open real

open_locale topological_space

/-!
#### The proof of Euler summation : ∑ 1/n^2 = π^2/6

## Strategy

1. Define sequences

  Aₙ = ∫ x in 0..π/2 (cos x)^(2*n) and
  Bₙ = ∫ x in 0..π/2 x^2 * (cos x)^(2*n).

2. Use integration by parts to prove recurrence formulas

  Aₙ₊₁ = (2 * n + 1) * (n+1) * Bₙ - 2*(n+1)^2 * Bₙ₊₁
    and
  Aₙ₊₁ = (2*n + 1) * (Aₙ - Aₙ₊₁)

3. Express 1/((n+1)^2) in terms of two consecutive ratios:

  1 / ((n +1)^2 = 2 * (Bₙ) / (Aₙ) - 2 * Bₙ₊₁ / Aₙ₊₁

4. The partial sums telescope and yield

  ∑ k=0..(n-1) 1 / ((k+1)^2 =  2 * B₀ / A₀ - 2 * Bₙ/Aₙ = π^2 / 6 - 2 * Bₙ/Aₙ

5.  Bound the error term using the fact that

  2/π * x ≤ sin x.

## References

Daniel Daners,
A short elementary proof of ...
Mathematics Magazine 85 (2012), 361-364. (MR 3007217, Zbl 1274.97037)

* <http://talus.maths.usyd.edu.au/u/daners/publ/abstracts/zeta2/>

## Tags

euler summation, number theory, reciprocals

-/

def A : ℕ → ℝ := λ n, ∫ x in 0..real.pi/2, (cos x)^(2*n)
def B : ℕ → ℝ := λ n, ∫ x in 0..real.pi/2, x^2 * (cos x)^(2*n)

/-
Evaluate A 0 and B 0, which will be useful later
-/
lemma eval_A0 : A 0 = real.pi / (2 : ℝ) :=
begin
  unfold A,
  simp only [mul_zero, pow_zero],
  suffices : ∫ (x : ℝ) in 0..real.pi / 2, (1:ℝ) = (real.pi / 2 - 0) • 1,
  {
    rw this,
    simp only [mul_one, algebra.id.smul_eq_mul, sub_zero],
  },
  apply interval_integral.integral_const,
end

lemma has_deriv_at_congr {f : ℝ → ℝ} {f' g' : ℝ} (x : ℝ) (h: f' = g') :
has_deriv_at f f' x → has_deriv_at f g' x :=
(iff_of_eq (congr_fun (congr_arg (has_deriv_at f) h) x)).1

lemma eval_B0 : B 0 = real.pi^3 / (24 : ℝ) :=
begin
  unfold B,
  simp only [mul_one, mul_zero, pow_zero],
  have h : ∀ x ∈ set.interval 0 (real.pi/2), has_deriv_at (λ (x:ℝ), x^3/3) (x^2) x,
  {
    intros x hx,
    have hh : (3⁻¹ * (3 * x ^ 2)) = x^2 := by discrete_field,
    suffices : has_deriv_at (λ (x : ℝ), x ^ 3 / 3) (3⁻¹ * (3 * x ^ 2)) x, by exact has_deriv_at_congr x hh this,
    simp [div_eq_mul_inv, mul_comm],
    apply has_deriv_at.const_mul,
    apply_mod_cast (has_deriv_at_pow 3 x),
  },
  rw integral_eq_sub_of_has_deriv_at h,
  { simp only [div_pow],
    ring },
  { show_continuous },
end

/-
Show that B n is positive for all n. A similar proof works to show that A n is positive,
but we decided to prove the latter one by induction, which we will do once we have
an explicit recursive formula for A n.

For B n, the proof just uses that the integrand is the square of a nonzero function.
-/
lemma B_pos {n : ℕ} : 0 < B n :=
begin
  unfold B,
  have pi_pos := pi_pos,
  simp only [mul_comm, pow_mul, ←mul_pow],
  apply int_pos_of_square (real.pi/3) pi_div_two_pos,
  { show_continuous },
  { -- Show here that the integrand is nonzero at π/3
    repeat {split},
    repeat {linarith},
    rw cos_pi_div_three,
    field_simp [pi_ne_zero],
  }
end

lemma first_lemma' (n : ℕ) : A (n + 1)= (2*(n:ℝ)+1) * ∫ x in 0..real.pi/2, ((sin x)^2 * (cos x)^(2*n)) :=
begin
  calc
  A (n + 1) = ∫ x in 0..real.pi/2, (cos x)^(2*(n+1)) : by {unfold A}
  ... =  ∫ x in 0..real.pi/2, (cos x)^(2*n+1) * (deriv sin x) :
  begin
    congr, ext1,
    rw real.deriv_sin,
    ring_nf,
  end
  ... = ∫ x in 0..real.pi/2, (2*n+1) * (sin x)^2 * (cos x)^(2*n) :
  begin
    rw int_by_parts,
    {
    suffices : ∫ x in 0..real.pi / 2,
    sin x * ((2*n + 1) * (cos x ^ (2 * n) * sin x)) =
    ∫ x in 0..real.pi / 2, (2*n + 1) * sin x^2 * cos x^(2 * n), by simpa,
      congr, ext1,
      ring,
    },
    { apply differentiable.pow,
      apply differentiable.cos,
      exact differentiable_id },
    { exact differentiable_sin },
    { exact continuous_deriv_cospow (2*n) },
    { rw real.deriv_sin,
      exact continuous_cos },
  end
  ... = ∫ x in 0..real.pi/2, (2*(n:ℝ)+1) * ((sin x)^2 * (cos x)^(2*n)) : by {congr, ext1, ring}
  ... = (2*(n:ℝ)+1) * ∫ x in 0..real.pi/2, ((sin x)^2 * (cos x)^(2*n)) : by {simp [my_integral_smul]}
end

lemma first_lemma (n : ℕ) : A (n + 1)  = (2*n + 1) * (A (n) - A (n+1)) :=
begin
  calc
  A (n + 1) = (2*(n:ℝ)+1) * ∫ x in 0..real.pi/2, ((sin x)^2 * (cos x)^(2*n)) : first_lemma' n
  ... = (2*(n:ℝ)+1) * ∫ x in 0..real.pi/2, (1- (cos x)^2) * (cos x)^(2*n) :
  begin
    congr, ext1,
    suffices : sin x^2 = 1 - cos x^2, rw this,
    simp only [eq_sub_iff_add_eq, sin_sq_add_cos_sq],
  end
  ... = (2*(n:ℝ)+1) * (A (n) - A (n+1)) :-- by {rw f5}
  begin
    unfold A,
    rw ←integral_sub,
    { congr, discrete_field },
    all_goals {
      apply integrable_of_cont,
      apply continuous.pow continuous_cos,
    },
  end
end

lemma first_lemma_cor (n : ℕ) : A (n+1) = (2 * n + 1) / (2 * n + 2) * A n :=
begin
  have h := first_lemma n,
  have h1 : 2 * (n : ℝ) + 1 ≠ 0 := by show_nonzero,
  have h2 : 2 * (n : ℝ) + 2 ≠ 0 := by show_nonzero,
  have h3 : 2 * (n : ℝ) + 2 = (2 * n + 1) + 1 := by ring,
  field_simp [h1, h2],
  rw [h3, mul_add, mul_one],
  nth_rewrite_lhs 1 h,
  ring,
end

/-
The recurrence formula for A n directly gives positivity by induction.
-/
lemma A_pos {n : ℕ} : 0 < A n :=
begin
  induction n with d hd,
  { rw eval_A0,
    exact pi_div_two_pos },
  { rw_mod_cast first_lemma_cor d,
    show_pos },
end
/-
-/
lemma display4 (n : ℕ) :
  A (n+1) = (2 * n + 1) * (n+1) * B n - 2*(n+1)^2 * B (n+1) :=
begin
  calc
  A (n + 1) = ∫ x in 0..real.pi/2, (cos x)^(2*(n+1)) : by {unfold A}
  ... = ∫ x in 0..real.pi/2, (cos x)^(2*n+2) * ((deriv id) x) : by {discrete_field}
-- Integrate by parts
  ... = -∫ x in 0..real.pi/2, x * (2*n+2) * (cos x)^(2*n+1) * (deriv cos) x :
  begin
    rw int_by_parts_zero_ends,
    { congr,
      discrete_field },
    all_goals
    {
      discrete_field,
      try {show_continuous}
    },
  end
  ... = ((n:ℝ)+1) * ∫ x in 0..real.pi/2, (2*x) * sin x * (cos x)^(2*n+1) :
  begin
    rw [←my_integral_smul, ←integral_neg],
    congr,
    discrete_field,
  end
  ... = (n+1) * ∫ x in 0..real.pi/2, sin x * (cos x)^(2*n+1) * deriv (λ x, x^2) x :
  begin
    congr, ext,
    simp only [mul_one, differentiable_at_id', deriv_pow'',
      nat.cast_bit0, deriv_id'', pow_one, nat.cast_one],
    linarith,
  end
-- Integrate by parts a second time
  ... = (n+1) * -∫ x in 0..real.pi/2, x^2 * (deriv (λ x, sin x * (cos x)^(2*n+1))) x :
  begin
    rw int_by_parts_zero_ends,
    { show_differentiable },
    { exact differentiable_pow },
    {
      rw deriv_sin_cos,
      apply continuous.sub;
      exact continuous_cospow',
    },
    all_goals {
      simp only [algebra.id.smul_eq_mul, pow_one,
      nat.cast_one, power_rule'', continuous_mul_left,
      sin_zero, zero_mul,
      cos_pi_div_two, zero_mul, add_eq_zero_iff, ne.def, not_false_iff,
      one_ne_zero, mul_zero, and_false, zero_pow'],
    },
  end
  ... = (n+1) * -∫ x in 0..real.pi/2,
    x^2 * ((cos x)^(2*n+2) - (2*n+1) * (1 - cos x^2) * (cos x)^(2*n)) :
  begin
    congr, ext, congr,
    discrete_field,
  end
  ... = (n+1) * ((2 *n + 1) * B n - 2*(n+1) * B (n+1)) :
  begin
    congr,
    unfold B,
    rw ←integral_neg,
    repeat {rw_mod_cast ←my_integral_smul,},
    rw ←integral_sub,
    {
      congr, ext,
      simp only [nat.cast_bit0, nat.cast_add, nat.cast_one, nat.cast_mul],
      ring_exp,
    },
    all_goals {
      apply integrable_of_cont,
      show_continuous,
    },
  end
  ... = (2 * n + 1) * (n+1) * B n - 2*(n+1)^2 * B (n+1) : by {ring}
end

lemma summand_expression (n : ℕ) :
  1 / ((n : ℝ) + 1)^2 = 2 * (B n) / (A n) - 2 * B (n+1) / A (n+1) :=
begin
  have A_nonzero : ∀ (m:ℕ), A m ≠ 0,
  {
    intro m,
    apply norm_num.ne_zero_of_pos,
    exact A_pos,
  },
  have nplusone_nonzero : (n:ℝ)+1 ≠ 0 := nat.cast_add_one_ne_zero n,
  have twonplusone_nonzero : 2*(n:ℝ)+1 ≠ 0,
    show_nonzero,
  have h_first_lemma := first_lemma n,
  calc
  1 / ((n : ℝ) + 1)^2 = (A (n+1)) / (A (n+1) * ((n : ℝ) + 1)^2) :
  begin
    rw div_mul_right,
    exact A_nonzero (n+1),
  end
  ... = ((2 * n + 1) * (n+1) * (B n) - 2*(n+1)^2 * (B (n+1))) / (A (n+1) * ((n : ℝ) + 1)^2) :
    by {nth_rewrite 0 display4,}
  ... = ((2 * n + 1) * (n+1) * (B n)) / (A (n+1) * ((n : ℝ) + 1)^2) -
    (2*(n+1)^2 * (B (n+1))) / (A (n+1) * ((n : ℝ) + 1)^2) :
    by {rw sub_div}
  ... = ((2 * n + 1) * (B n)) / (A (n+1) * ((n : ℝ) + 1)) -
    2 * (B (n+1)) / (A (n+1)) : by {field_simp *, ring}
  ... = 2 * (B n) / (A n) - 2 * B (n+1) / A (n+1) :
  begin
    have : (A (n+1) * ((n:ℝ) + 1)) = (2*n + 1) / 2 * (A n) := by discrete_field,
    rw this,
    discrete_field,
  end
end

lemma telescoping (n : ℕ) : ∑ k in (finset.range n), (1 : ℝ) / ((k+1)^2) = 2 * B 0 / A 0 - 2 * B n / A n :=
begin
  simp only [summand_expression],
  exact finset.sum_range_sub' (λ k, 2 * (B k) / (A k)) n,
end

/-
The sin function is concave on the interval [0..pi/2].
-/
lemma sin_is_concave : concave_on (set.Icc 0 (real.pi/2)) sin :=
begin
  have h0 : -sin = λ y, -sin y := by refl,
  rw ←neg_convex_on_iff,
  apply convex_on_of_deriv2_nonneg (convex_Icc 0 (real.pi / 2)),
  { show_continuous },
  { show_differentiable },
  {
    simp only [h0],
    show_differentiable,
  },
  {
    intros x hx,
    replace hx : 0 ≤ x ∧ x ≤ real.pi / 2 := set.mem_Icc.mp (interior_subset hx),
    suffices : 0 ≤ deriv (deriv (-sin)) x, by simpa,
    simp only [h0],
    suffices : 0 ≤ sin x, by simpa,
    apply sin_nonneg_of_nonneg_of_le_pi;
    linarith,
  }
end

/-
Use concavity of sin on [0..pi/2] to bound it below.
-/
lemma bound_sin {x : ℝ} (hx1 : 0 ≤ x) (hx2 : x ≤ real.pi / 2) : 2 / real.pi * x ≤ sin x :=
begin
  have h := sin_is_concave.2,
  dsimp at h,
  have pi_pos := pi_pos,
  have pi_nonzero := pi_ne_zero,
  have two_over_pi_pos : (0 :ℝ) < (2:ℝ) / real.pi := div_pos zero_lt_two pi_pos,
  have hzero : (0:ℝ) ∈ set.Icc 0 (real.pi / 2),
  {
    rw set.mem_Icc,
    split; linarith,
  },
  have hpi2 : real.pi / 2 ∈ set.Icc 0 (real.pi / 2),
  {
    rw set.mem_Icc,
    split; linarith,
  },
  replace h := h hzero hpi2,
  simp only [sin_zero, mul_one, zero_add, mul_zero, sin_pi_div_two] at h,
  have ha : 0 ≤ (1:ℝ) - 2 / real.pi * x,
  {
    simp only [sub_nonneg],
    refine (le_div_iff' two_over_pi_pos).mp _,
    simp only [one_div_div],
    exact hx2,
  },
  have hb : 0 ≤ 2 / real.pi * x := (zero_le_mul_left two_over_pi_pos).mpr hx1,
  replace h := h ha hb,
  simp only [forall_prop_of_true, sub_add_cancel] at h,
  suffices : 2 / real.pi * x * (real.pi / 2) = x,
  {
    rw this at h,
    exact h,
  },
  discrete_field,
end

lemma key_inequality {n : ℕ} {x : ℝ} (hx1 : 0 ≤ x) (hx2 : x ≤ real.pi /2) :
  x ^ 2 * cos x ^ (2 * n) ≤ (real.pi ^ 2 / 4) • (sin x ^ 2 * cos x ^ (2 * n)) :=
begin
  have key := bound_sin hx1 hx2,
  have cospos : (cos x)^(2*n) ≥ 0,
  {
    rw [mul_comm, pow_mul],
    apply pow_two_nonneg,
  },
  have h : x^2 ≤ real.pi^2 / 4 * (sin x)^2,
  {
    rw [div_mul_eq_mul_div, div_le_iff pi_pos] at key,
    nlinarith,
  },
  dsimp,
  nlinarith,
end

lemma BA_aux {n : ℕ} :
  ∫ (x : ℝ) in 0..real.pi / 2, x ^ 2 * cos x ^ (2 * n) <
  ∫ (x : ℝ) in
    0..real.pi / 2,
    (real.pi ^ 2 / 4) * (sin x ^ 2 * cos x ^ (2 * n)) :=
begin
  have hsq2' : sqrt 2^2 = 2 := sq_sqrt zero_le_two,
  have hsq2 : sqrt 2 ^(2*n) = 2^n := by simp only [pow_mul, hsq2'],
  have pisqpos : 0 < real.pi^2 := pow_pos pi_pos 2,
  apply integral_strictly_monotone_of_cont,
  { show_continuous },
  { show_continuous },
  { exact pi_div_two_pos },
  { apply key_inequality },
  {
    use real.pi/4,
    repeat {split},
    all_goals { try { linarith [pi_pos]}},
    {
      simp only [cos_pi_div_four, sin_pi_div_four, hsq2, hsq2',
        algebra.id.smul_eq_mul, div_pow],
      rw [←mul_assoc, mul_lt_mul_right],
      all_goals {discrete_field},
    },
  }
end

lemma B_in_terms_of_A (n : ℕ) : B n < real.pi^2 / (8 * (n + 1)) * A n :=
begin
  have hh := first_lemma_cor n,
  calc
  B n = ∫ x in 0..(real.pi/2), x^2 * (cos x)^(2*n) : by {refl}
  ... < ∫ x in 0..(real.pi/2), (real.pi^2/ 4) • ((sin x)^2 * (cos x)^(2*n)) : by {exact BA_aux}
  ... = (real.pi^2/4) * (A (n+1) / (2*n + 1)) : by {rw [interval_integral.integral_smul,first_lemma'], discrete_field }
  ... = (real.pi^2) / (8 * (n+1)) * (A n) : by {discrete_field}
end

lemma B_in_terms_of_A' (n : ℕ) : 2 * B n / A n < real.pi ^ 2 / (4 *(n + 1)) :=
begin
  have h2 : 0 < (2:ℝ) := zero_lt_two,
  calc
  2 * B n / A n = 2 * (B n / A n) : by {exact mul_div_assoc,}
  ... < 2 * (real.pi ^ 2 / (8 * (n + 1))) :
    by {simp only [mul_lt_mul_left h2, div_lt_iff A_pos, B_in_terms_of_A n]}
  ... = real.pi ^ 2 / (4 *(n + 1)) :  by {discrete_field}
end

/-
Bound the partial sums by a harmonic sequence.
-/
lemma error_estimate {n : ℕ}:
  (-real.pi^2/4/(n+1) + real.pi^2/6) ≤ (∑ k in finset.range n, ((1:ℝ)/ (k+1)^2))
    ∧
  (∑ k in finset.range n, ((1:ℝ)/ (k+1)^2)) ≤ real.pi^2/4/(n+1) + real.pi^2/6 :=
begin
  rw [telescoping n, eval_A0, eval_B0],
  have quo_pos : 0 < 2 * B n / A n,
  {
    rw mul_div_assoc,
    exact mul_pos zero_lt_two (div_pos B_pos A_pos),
  },
  have h := B_in_terms_of_A' n,
  have pi_ne_zero := pi_ne_zero,
  have : 2 * (real.pi ^ 3 / 24) / (real.pi / 2) = real.pi^2 / 6 := by {discrete_field},
  rw this,
  field_simp *,
  split,
  all_goals {apply le_of_lt},
  {
    calc (-(real.pi ^ 2 * 6) / (4 * (↑n + 1)) + real.pi ^ 2) / 6
      = -(real.pi^2 / (4*((n:ℝ) + 1))) + real.pi^2 / 6 : by {discrete_field}
    ... < -(2 * B n / A n) + real.pi^2 / 6 : by {linarith [h]}
    ... = (real.pi ^ 2 - 6 * (2 * B n) / A n) / 6 : by {ring_exp}
  },
  {
    calc (real.pi ^ 2 - 6 * (2 * B n) / A n) / 6
      =  real.pi ^ 2/ 6- (2 * B n / A n): by {discrete_field}
    ... <  real.pi ^ 2 / (4 * (↑n + 1)) + real.pi ^ 2 / 6 : by {nlinarith}
    ... = (real.pi ^ 2 * 6 / (4 * (↑n + 1)) + real.pi ^ 2) / 6 : by {discrete_field}
  }
end

lemma tendsto_const_div_add_at_top_nhds_0_nat {C : ℝ} :
  tendsto (λ n : ℕ, (C / ((n : ℝ) + 1))) at_top (𝓝 0) :=
suffices tendsto (λ n : ℕ, C / (↑(n + 1) : ℝ)) at_top (𝓝 0), by simpa,
(tendsto_add_at_top_iff_nat 1).2 (tendsto_const_div_at_top_nhds_0_nat C)

lemma limit_below : tendsto (λ (n:ℕ),-real.pi^2/4/(n+1) + real.pi^2/6) at_top (𝓝 (real.pi^2/6)) :=
begin
  nth_rewrite 0 ←zero_add (real.pi^2/6),
  apply tendsto.add_const,
  apply tendsto_const_div_add_at_top_nhds_0_nat,
end

lemma limit_above : tendsto (λ (n:ℕ), real.pi^2/4/(n+1) + real.pi^2/6) at_top (𝓝 (real.pi^2/6)) :=
begin
  nth_rewrite 0 ←zero_add (real.pi^2/6),
  apply tendsto.add_const,
  apply tendsto_const_div_add_at_top_nhds_0_nat,
end

theorem euler_summation : tendsto (λ (n:ℕ), (∑ k in finset.range n, ((1:ℝ)/ (k+1)^2))) at_top (nhds (real.pi^2 / 6)) :=
begin
  apply tendsto_of_tendsto_of_tendsto_of_le_of_le limit_below limit_above,
  all_goals {rw pi.le_def, intro n},
  exact error_estimate.1,
  exact error_estimate.2,
end


/-
Copyright (c) 2021 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Riccardo Brasca

! This file was ported from Lean 3 source module analysis.normed.group.quotient
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Basic
import Mathbin.Analysis.Normed.Group.Hom
import Mathbin.RingTheory.Ideal.QuotientOperations

/-!
# Quotients of seminormed groups

For any `seminormed_add_comm_group M` and any `S : add_subgroup M`, we provide a
`seminormed_add_comm_group`, the group quotient `M ⧸ S`.
If `S` is closed, we provide `normed_add_comm_group (M ⧸ S)` (regardless of whether `M` itself is
separated). The two main properties of these structures are the underlying topology is the quotient
topology and the projection is a normed group homomorphism which is norm non-increasing
(better, it has operator norm exactly one unless `S` is dense in `M`). The corresponding
universal property is that every normed group hom defined on `M` which vanishes on `S` descends
to a normed group hom defined on `M ⧸ S`.

This file also introduces a predicate `is_quotient` characterizing normed group homs that
are isomorphic to the canonical projection onto a normed group quotient.

In addition, this file also provides normed structures for quotients of modules by submodules, and
of (commutative) rings by ideals. The `seminormed_add_comm_group` and `normed_add_comm_group`
instances described above are transferred directly, but we also define instances of `normed_space`,
`semi_normed_comm_ring`, `normed_comm_ring` and `normed_algebra` under appropriate type class
assumptions on the original space. Moreover, while `quotient_add_group.complete_space` works
out-of-the-box for quotients of `normed_add_comm_group`s by `add_subgroup`s, we need to transfer
this instance in `submodule.quotient.complete_space` so that it applies to these other quotients.

## Main definitions

We use `M` and `N` to denote seminormed groups and `S : add_subgroup M`.
All the following definitions are in the `add_subgroup` namespace. Hence we can access
`add_subgroup.normed_mk S` as `S.normed_mk`.

* `seminormed_add_comm_group_quotient` : The seminormed group structure on the quotient by
    an additive subgroup. This is an instance so there is no need to explictly use it.

* `normed_add_comm_group_quotient` : The normed group structure on the quotient by
    a closed additive subgroup. This is an instance so there is no need to explictly use it.

* `normed_mk S` : the normed group hom from `M` to `M ⧸ S`.

* `lift S f hf`: implements the universal property of `M ⧸ S`. Here
    `(f : normed_add_group_hom M N)`, `(hf : ∀ s ∈ S, f s = 0)` and
    `lift S f hf : normed_add_group_hom (M ⧸ S) N`.

* `is_quotient`: given `f : normed_add_group_hom M N`, `is_quotient f` means `N` is isomorphic
    to a quotient of `M` by a subgroup, with projection `f`. Technically it asserts `f` is
    surjective and the norm of `f x` is the infimum of the norms of `x + m` for `m` in `f.ker`.

## Main results

* `norm_normed_mk` : the operator norm of the projection is `1` if the subspace is not dense.

* `is_quotient.norm_lift`: Provided `f : normed_hom M N` satisfies `is_quotient f`, for every
     `n : N` and positive `ε`, there exists `m` such that `f m = n ∧ ‖m‖ < ‖n‖ + ε`.

## Implementation details

For any `seminormed_add_comm_group M` and any `S : add_subgroup M` we define a norm on `M ⧸ S` by
`‖x‖ = Inf (norm '' {m | mk' S m = x})`. This formula is really an implementation detail, it
shouldn't be needed outside of this file setting up the theory.

Since `M ⧸ S` is automatically a topological space (as any quotient of a topological space),
one needs to be careful while defining the `seminormed_add_comm_group` instance to avoid having two
different topologies on this quotient. This is not purely a technological issue.
Mathematically there is something to prove. The main point is proved in the auxiliary lemma
`quotient_nhd_basis` that has no use beyond this verification and states that zero in the quotient
admits as basis of neighborhoods in the quotient topology the sets `{x | ‖x‖ < ε}` for positive `ε`.

Once this mathematical point it settled, we have two topologies that are propositionaly equal. This
is not good enough for the type class system. As usual we ensure *definitional* equality
using forgetful inheritance, see Note [forgetful inheritance]. A (semi)-normed group structure
includes a uniform space structure which includes a topological space structure, together
with propositional fields asserting compatibility conditions.
The usual way to define a `seminormed_add_comm_group` is to let Lean build a uniform space structure
using the provided norm, and then trivially build a proof that the norm and uniform structure are
compatible. Here the uniform structure is provided using `topological_add_group.to_uniform_space`
which uses the topological structure and the group structure to build the uniform structure. This
uniform structure induces the correct topological structure by construction, but the fact that it
is compatible with the norm is not obvious; this is where the mathematical content explained in
the previous paragraph kicks in.

-/

noncomputable section

open quotientAddGroup Metric Set

open Topology NNReal

variable {M N : Type _} [SeminormedAddCommGroup M] [SeminormedAddCommGroup N]

/-- The definition of the norm on the quotient by an additive subgroup. -/
noncomputable instance normOnQuotient (S : AddSubgroup M) : Norm (M ⧸ S)
    where norm x := infₛ (norm '' { m | mk' S m = x })
#align norm_on_quotient normOnQuotient

theorem AddSubgroup.quotient_norm_eq {S : AddSubgroup M} (x : M ⧸ S) :
    ‖x‖ = infₛ (norm '' { m : M | (m : M ⧸ S) = x }) :=
  rfl
#align add_subgroup.quotient_norm_eq AddSubgroup.quotient_norm_eq

theorem image_norm_nonempty {S : AddSubgroup M} :
    ∀ x : M ⧸ S, (norm '' { m | mk' S m = x }).Nonempty :=
  by
  rintro ⟨m⟩
  rw [Set.nonempty_image_iff]
  use m
  change mk' S m = _
  rfl
#align image_norm_nonempty image_norm_nonempty

theorem bddBelow_image_norm (s : Set M) : BddBelow (norm '' s) :=
  by
  use 0
  rintro _ ⟨x, hx, rfl⟩
  apply norm_nonneg
#align bdd_below_image_norm bddBelow_image_norm

/-- The norm on the quotient satisfies `‖-x‖ = ‖x‖`. -/
theorem quotient_norm_neg {S : AddSubgroup M} (x : M ⧸ S) : ‖-x‖ = ‖x‖ :=
  by
  suffices norm '' { m | mk' S m = x } = norm '' { m | mk' S m = -x } by simp only [this, norm]
  ext r
  constructor
  · rintro ⟨m, rfl : mk' S m = x, rfl⟩
    rw [← norm_neg]
    exact ⟨-m, by simp only [(mk' S).map_neg, Set.mem_setOf_eq], rfl⟩
  · rintro ⟨m, hm : mk' S m = -x, rfl⟩
    exact ⟨-m, by simpa using neg_eq_iff_eq_neg.mpr ((mk'_apply _ _).symm.trans hm)⟩
#align quotient_norm_neg quotient_norm_neg

theorem quotient_norm_sub_rev {S : AddSubgroup M} (x y : M ⧸ S) : ‖x - y‖ = ‖y - x‖ := by
  rw [show x - y = -(y - x) by abel, quotient_norm_neg]
#align quotient_norm_sub_rev quotient_norm_sub_rev

/-- The norm of the projection is smaller or equal to the norm of the original element. -/
theorem quotient_norm_mk_le (S : AddSubgroup M) (m : M) : ‖mk' S m‖ ≤ ‖m‖ :=
  by
  apply cinfₛ_le
  use 0
  · rintro _ ⟨n, h, rfl⟩
    apply norm_nonneg
  · apply Set.mem_image_of_mem
    rw [Set.mem_setOf_eq]
#align quotient_norm_mk_le quotient_norm_mk_le

/-- The norm of the projection is smaller or equal to the norm of the original element. -/
theorem quotient_norm_mk_le' (S : AddSubgroup M) (m : M) : ‖(m : M ⧸ S)‖ ≤ ‖m‖ :=
  quotient_norm_mk_le S m
#align quotient_norm_mk_le' quotient_norm_mk_le'

/-- The norm of the image under the natural morphism to the quotient. -/
theorem quotient_norm_mk_eq (S : AddSubgroup M) (m : M) :
    ‖mk' S m‖ = infₛ ((fun x => ‖m + x‖) '' S) :=
  by
  change Inf _ = _
  congr 1
  ext r
  simp_rw [coe_mk', eq_iff_sub_mem]
  constructor
  · rintro ⟨y, h, rfl⟩
    use y - m, h
    simp
  · rintro ⟨y, h, rfl⟩
    use m + y
    simpa using h
#align quotient_norm_mk_eq quotient_norm_mk_eq

/-- The quotient norm is nonnegative. -/
theorem quotient_norm_nonneg (S : AddSubgroup M) : ∀ x : M ⧸ S, 0 ≤ ‖x‖ :=
  by
  rintro ⟨m⟩
  change 0 ≤ ‖mk' S m‖
  apply le_cinfₛ (image_norm_nonempty _)
  rintro _ ⟨n, h, rfl⟩
  apply norm_nonneg
#align quotient_norm_nonneg quotient_norm_nonneg

/-- The quotient norm is nonnegative. -/
theorem norm_mk_nonneg (S : AddSubgroup M) (m : M) : 0 ≤ ‖mk' S m‖ :=
  quotient_norm_nonneg S _
#align norm_mk_nonneg norm_mk_nonneg

/-- The norm of the image of `m : M` in the quotient by `S` is zero if and only if `m` belongs
to the closure of `S`. -/
theorem quotient_norm_eq_zero_iff (S : AddSubgroup M) (m : M) :
    ‖mk' S m‖ = 0 ↔ m ∈ closure (S : Set M) :=
  by
  have : 0 ≤ ‖mk' S m‖ := norm_mk_nonneg S m
  rw [← this.le_iff_eq, quotient_norm_mk_eq, Real.infₛ_le_iff]
  simp_rw [zero_add]
  · calc
      (∀ ε > (0 : ℝ), ∃ r ∈ (fun x => ‖m + x‖) '' (S : Set M), r < ε) ↔
          ∀ ε > 0, ∃ x ∈ S, ‖m + x‖ < ε :=
        by simp [Set.bex_image_iff]
      _ ↔ ∀ ε > 0, ∃ x ∈ S, ‖m + -x‖ < ε := _
      _ ↔ ∀ ε > 0, ∃ x ∈ S, x ∈ Metric.ball m ε := by
        simp [dist_eq_norm, ← sub_eq_add_neg, norm_sub_rev]
      _ ↔ m ∈ closure ↑S := by simp [Metric.mem_closure_iff, dist_comm]

    refine' forall₂_congr fun ε ε_pos => _
    rw [← S.exists_neg_mem_iff_exists_mem]
    simp
  · use 0
    rintro _ ⟨x, x_in, rfl⟩
    apply norm_nonneg
  rw [Set.nonempty_image_iff]
  use 0, S.zero_mem
#align quotient_norm_eq_zero_iff quotient_norm_eq_zero_iff

/-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `mk' S m = x`
and `‖m‖ < ‖x‖ + ε`. -/
theorem norm_mk_lt {S : AddSubgroup M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) :
    ∃ m : M, mk' S m = x ∧ ‖m‖ < ‖x‖ + ε :=
  by
  obtain ⟨_, ⟨m : M, H : mk' S m = x, rfl⟩, hnorm : ‖m‖ < ‖x‖ + ε⟩ :=
    Real.lt_infₛ_add_pos (image_norm_nonempty x) hε
  subst H
  exact ⟨m, rfl, hnorm⟩
#align norm_mk_lt norm_mk_lt

/-- For any `m : M` and any `0 < ε`, there is `s ∈ S` such that `‖m + s‖ < ‖mk' S m‖ + ε`. -/
theorem norm_mk_lt' (S : AddSubgroup M) (m : M) {ε : ℝ} (hε : 0 < ε) :
    ∃ s ∈ S, ‖m + s‖ < ‖mk' S m‖ + ε :=
  by
  obtain ⟨n : M, hn : mk' S n = mk' S m, hn' : ‖n‖ < ‖mk' S m‖ + ε⟩ :=
    norm_mk_lt (QuotientAddGroup.mk' S m) hε
  erw [eq_comm, QuotientAddGroup.eq] at hn
  use -m + n, hn
  rwa [add_neg_cancel_left]
#align norm_mk_lt' norm_mk_lt'

/-- The quotient norm satisfies the triangle inequality. -/
theorem quotient_norm_add_le (S : AddSubgroup M) (x y : M ⧸ S) : ‖x + y‖ ≤ ‖x‖ + ‖y‖ :=
  by
  refine' le_of_forall_pos_le_add fun ε hε => _
  replace hε := half_pos hε
  obtain ⟨m, rfl, hm : ‖m‖ < ‖mk' S m‖ + ε / 2⟩ := norm_mk_lt x hε
  obtain ⟨n, rfl, hn : ‖n‖ < ‖mk' S n‖ + ε / 2⟩ := norm_mk_lt y hε
  calc
    ‖mk' S m + mk' S n‖ = ‖mk' S (m + n)‖ := by rw [(mk' S).map_add]
    _ ≤ ‖m + n‖ := (quotient_norm_mk_le S (m + n))
    _ ≤ ‖m‖ + ‖n‖ := (norm_add_le _ _)
    _ ≤ ‖mk' S m‖ + ‖mk' S n‖ + ε := by linarith

#align quotient_norm_add_le quotient_norm_add_le

/-- The quotient norm of `0` is `0`. -/
theorem norm_mk_zero (S : AddSubgroup M) : ‖(0 : M ⧸ S)‖ = 0 :=
  by
  erw [quotient_norm_eq_zero_iff]
  exact subset_closure S.zero_mem
#align norm_mk_zero norm_mk_zero

/-- If `(m : M)` has norm equal to `0` in `M ⧸ S` for a closed subgroup `S` of `M`, then
`m ∈ S`. -/
theorem norm_zero_eq_zero (S : AddSubgroup M) (hS : IsClosed (S : Set M)) (m : M)
    (h : ‖mk' S m‖ = 0) : m ∈ S := by rwa [quotient_norm_eq_zero_iff, hS.closure_eq] at h
#align norm_zero_eq_zero norm_zero_eq_zero

theorem quotient_nhd_basis (S : AddSubgroup M) :
    (𝓝 (0 : M ⧸ S)).HasBasis (fun ε : ℝ => 0 < ε) fun ε => { x | ‖x‖ < ε } :=
  ⟨by
    intro U
    constructor
    · intro U_in
      rw [← (mk' S).map_zero] at U_in
      have := preimage_nhds_coinduced U_in
      rcases metric.mem_nhds_iff.mp this with ⟨ε, ε_pos, H⟩
      use ε / 2, half_pos ε_pos
      intro x x_in
      dsimp at x_in
      rcases norm_mk_lt x (half_pos ε_pos) with ⟨y, rfl, ry⟩
      apply H
      rw [ball_zero_eq]
      dsimp
      linarith
    · rintro ⟨ε, ε_pos, h⟩
      have : mk' S '' ball (0 : M) ε ⊆ { x | ‖x‖ < ε } :=
        by
        rintro _ ⟨x, x_in, rfl⟩
        rw [mem_ball_zero_iff] at x_in
        exact lt_of_le_of_lt (quotient_norm_mk_le S x) x_in
      apply Filter.mem_of_superset _ (Set.Subset.trans this h)
      clear h U this
      apply IsOpen.mem_nhds
      · change IsOpen (mk' S ⁻¹' _)
        erw [QuotientAddGroup.preimage_image_mk]
        apply isOpen_unionᵢ
        rintro ⟨s, s_in⟩
        exact (continuous_add_right s).isOpen_preimage _ is_open_ball
      · exact ⟨(0 : M), mem_ball_self ε_pos, (mk' S).map_zero⟩⟩
#align quotient_nhd_basis quotient_nhd_basis

/-- The seminormed group structure on the quotient by an additive subgroup. -/
noncomputable instance AddSubgroup.seminormedAddCommGroupQuotient (S : AddSubgroup M) :
    SeminormedAddCommGroup (M ⧸ S) where
  dist x y := ‖x - y‖
  dist_self x := by simp only [norm_mk_zero, sub_self]
  dist_comm := quotient_norm_sub_rev
  dist_triangle x y z := by
    unfold dist
    have : x - z = x - y + (y - z) := by abel
    rw [this]
    exact quotient_norm_add_le S (x - y) (y - z)
  dist_eq x y := rfl
  toUniformSpace := TopologicalAddGroup.toUniformSpace (M ⧸ S)
  uniformity_dist := by
    rw [uniformity_eq_comap_nhds_zero']
    have := (quotient_nhd_basis S).comap fun p : (M ⧸ S) × M ⧸ S => p.2 - p.1
    apply this.eq_of_same_basis
    have :
      ∀ ε : ℝ,
        (fun p : (M ⧸ S) × M ⧸ S => p.snd - p.fst) ⁻¹' { x | ‖x‖ < ε } =
          { p : (M ⧸ S) × M ⧸ S | ‖p.fst - p.snd‖ < ε } :=
      by
      intro ε
      ext x
      dsimp
      rw [quotient_norm_sub_rev]
    rw [funext this]
    refine' Filter.hasBasis_binfᵢ_principal _ Set.nonempty_Ioi
    rintro ε (ε_pos : 0 < ε) η (η_pos : 0 < η)
    refine' ⟨min ε η, lt_min ε_pos η_pos, _, _⟩
    · suffices ∀ a b : M ⧸ S, ‖a - b‖ < ε → ‖a - b‖ < η → ‖a - b‖ < ε by simpa
      exact fun a b h h' => h
    · simp
#align add_subgroup.seminormed_add_comm_group_quotient AddSubgroup.seminormedAddCommGroupQuotient

-- This is a sanity check left here on purpose to ensure that potential refactors won't destroy
-- this important property.
example (S : AddSubgroup M) :
    (Quotient.topologicalSpace : TopologicalSpace <| M ⧸ S) =
      S.seminormedAddCommGroupQuotient.toUniformSpace.toTopologicalSpace :=
  rfl

/-- The quotient in the category of normed groups. -/
noncomputable instance AddSubgroup.normedAddCommGroupQuotient (S : AddSubgroup M)
    [IsClosed (S : Set M)] : NormedAddCommGroup (M ⧸ S) :=
  { AddSubgroup.seminormedAddCommGroupQuotient S with
    eq_of_dist_eq_zero := by
      rintro ⟨m⟩ ⟨m'⟩ (h : ‖mk' S m - mk' S m'‖ = 0)
      erw [← (mk' S).map_sub, quotient_norm_eq_zero_iff, ‹IsClosed _›.closure_eq, ←
        QuotientAddGroup.eq_iff_sub_mem] at h
      exact h }
#align add_subgroup.normed_add_comm_group_quotient AddSubgroup.normedAddCommGroupQuotient

-- This is a sanity check left here on purpose to ensure that potential refactors won't destroy
-- this important property.
example (S : AddSubgroup M) [IsClosed (S : Set M)] :
    S.seminormedAddCommGroupQuotient = NormedAddCommGroup.toSeminormedAddCommGroup :=
  rfl

namespace AddSubgroup

open NormedAddGroupHom

/-- The morphism from a seminormed group to the quotient by a subgroup. -/
noncomputable def normedMk (S : AddSubgroup M) : NormedAddGroupHom M (M ⧸ S) :=
  { QuotientAddGroup.mk' S with
    bound' := ⟨1, fun m => by simpa [one_mul] using quotient_norm_mk_le _ m⟩ }
#align add_subgroup.normed_mk AddSubgroup.normedMk

/-- `S.normed_mk` agrees with `quotient_add_group.mk' S`. -/
@[simp]
theorem normedMk.apply (S : AddSubgroup M) (m : M) : normedMk S m = QuotientAddGroup.mk' S m :=
  rfl
#align add_subgroup.normed_mk.apply AddSubgroup.normedMk.apply

/-- `S.normed_mk` is surjective. -/
theorem surjective_normedMk (S : AddSubgroup M) : Function.Surjective (normedMk S) :=
  surjective_quot_mk _
#align add_subgroup.surjective_normed_mk AddSubgroup.surjective_normedMk

/-- The kernel of `S.normed_mk` is `S`. -/
theorem ker_normedMk (S : AddSubgroup M) : S.normedMk.ker = S :=
  QuotientAddGroup.ker_mk' _
#align add_subgroup.ker_normed_mk AddSubgroup.ker_normedMk

/-- The operator norm of the projection is at most `1`. -/
theorem norm_normedMk_le (S : AddSubgroup M) : ‖S.normedMk‖ ≤ 1 :=
  NormedAddGroupHom.opNorm_le_bound _ zero_le_one fun m => by simp [quotient_norm_mk_le']
#align add_subgroup.norm_normed_mk_le AddSubgroup.norm_normedMk_le

/-- The operator norm of the projection is `1` if the subspace is not dense. -/
theorem norm_normedMk (S : AddSubgroup M) (h : (S.topologicalClosure : Set M) ≠ univ) :
    ‖S.normedMk‖ = 1 := by
  obtain ⟨x, hx⟩ := Set.nonempty_compl.2 h
  let y := S.normed_mk x
  have hy : ‖y‖ ≠ 0 := by
    intro h0
    exact Set.not_mem_of_mem_compl hx ((quotient_norm_eq_zero_iff S x).1 h0)
  refine' le_antisymm (norm_normed_mk_le S) (le_of_forall_pos_le_add fun ε hε => _)
  suffices 1 ≤ ‖S.normed_mk‖ + min ε ((1 : ℝ) / 2) by
    exact le_add_of_le_add_left this (min_le_left ε ((1 : ℝ) / 2))
  have hδ := sub_pos.mpr (lt_of_le_of_lt (min_le_right ε ((1 : ℝ) / 2)) one_half_lt_one)
  have hδpos : 0 < min ε ((1 : ℝ) / 2) := lt_min hε one_half_pos
  have hδnorm := mul_pos (div_pos hδpos hδ) (lt_of_le_of_ne (norm_nonneg y) hy.symm)
  obtain ⟨m, hm, hlt⟩ := norm_mk_lt y hδnorm
  have hrw :
    ‖y‖ + min ε (1 / 2) / (1 - min ε (1 / 2)) * ‖y‖ =
      ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) :=
    by ring
  rw [hrw] at hlt
  have hm0 : ‖m‖ ≠ 0 := by
    intro h0
    have hnorm := quotient_norm_mk_le S m
    rw [h0, hm] at hnorm
    replace hnorm := le_antisymm hnorm (norm_nonneg _)
    simpa [hnorm] using hy
  replace hlt := (div_lt_div_right (lt_of_le_of_ne (norm_nonneg m) hm0.symm)).2 hlt
  simp only [hm0, div_self, Ne.def, not_false_iff] at hlt
  have hrw₁ :
    ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) / ‖m‖ =
      ‖y‖ / ‖m‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) :=
    by ring
  rw [hrw₁] at hlt
  replace hlt := (inv_pos_lt_iff_one_lt_mul (lt_trans (div_pos hδpos hδ) (lt_one_add _))).2 hlt
  suffices ‖S.normed_mk‖ ≥ 1 - min ε (1 / 2) by exact sub_le_iff_le_add.mp this
  calc
    ‖S.normed_mk‖ ≥ ‖S.normed_mk m‖ / ‖m‖ := ratio_le_op_norm S.normed_mk m
    _ = ‖y‖ / ‖m‖ := by rw [normed_mk.apply, hm]
    _ ≥ (1 + min ε (1 / 2) / (1 - min ε (1 / 2)))⁻¹ := (le_of_lt hlt)
    _ = 1 - min ε (1 / 2) := by field_simp [(ne_of_lt hδ).symm]

#align add_subgroup.norm_normed_mk AddSubgroup.norm_normedMk

/-- The operator norm of the projection is `0` if the subspace is dense. -/
theorem norm_trivial_quotient_mk (S : AddSubgroup M)
    (h : (S.topologicalClosure : Set M) = Set.univ) : ‖S.normedMk‖ = 0 :=
  by
  refine' le_antisymm (op_norm_le_bound _ le_rfl fun x => _) (norm_nonneg _)
  have hker : x ∈ S.normed_mk.ker.topologicalClosure :=
    by
    rw [S.ker_normed_mk]
    exact Set.mem_of_eq_of_mem h trivial
  rw [ker_normed_mk] at hker
  simp only [(quotient_norm_eq_zero_iff S x).mpr hker, normed_mk.apply, MulZeroClass.zero_mul]
#align add_subgroup.norm_trivial_quotient_mk AddSubgroup.norm_trivial_quotient_mk

end AddSubgroup

namespace NormedAddGroupHom

/-- `is_quotient f`, for `f : M ⟶ N` means that `N` is isomorphic to the quotient of `M`
by the kernel of `f`. -/
structure IsQuotient (f : NormedAddGroupHom M N) : Prop where
  Surjective : Function.Surjective f
  norm : ∀ x, ‖f x‖ = infₛ ((fun m => ‖x + m‖) '' f.ker)
#align normed_add_group_hom.is_quotient NormedAddGroupHom.IsQuotient

/-- Given  `f : normed_add_group_hom M N` such that `f s = 0` for all `s ∈ S`, where,
`S : add_subgroup M` is closed, the induced morphism `normed_add_group_hom (M ⧸ S) N`. -/
noncomputable def lift {N : Type _} [SeminormedAddCommGroup N] (S : AddSubgroup M)
    (f : NormedAddGroupHom M N) (hf : ∀ s ∈ S, f s = 0) : NormedAddGroupHom (M ⧸ S) N :=
  { QuotientAddGroup.lift S f.toAddMonoidHom hf with
    bound' := by
      obtain ⟨c : ℝ, hcpos : (0 : ℝ) < c, hc : ∀ x, ‖f x‖ ≤ c * ‖x‖⟩ := f.bound
      refine' ⟨c, fun mbar => le_of_forall_pos_le_add fun ε hε => _⟩
      obtain ⟨m : M, rfl : mk' S m = mbar, hmnorm : ‖m‖ < ‖mk' S m‖ + ε / c⟩ :=
        norm_mk_lt mbar (div_pos hε hcpos)
      calc
        ‖f m‖ ≤ c * ‖m‖ := hc m
        _ ≤ c * (‖mk' S m‖ + ε / c) := ((mul_lt_mul_left hcpos).mpr hmnorm).le
        _ = c * ‖mk' S m‖ + ε := by rw [mul_add, mul_div_cancel' _ hcpos.ne.symm]
         }
#align normed_add_group_hom.lift NormedAddGroupHom.lift

theorem lift_mk {N : Type _} [SeminormedAddCommGroup N] (S : AddSubgroup M)
    (f : NormedAddGroupHom M N) (hf : ∀ s ∈ S, f s = 0) (m : M) :
    lift S f hf (S.normedMk m) = f m :=
  rfl
#align normed_add_group_hom.lift_mk NormedAddGroupHom.lift_mk

theorem lift_unique {N : Type _} [SeminormedAddCommGroup N] (S : AddSubgroup M)
    (f : NormedAddGroupHom M N) (hf : ∀ s ∈ S, f s = 0) (g : NormedAddGroupHom (M ⧸ S) N) :
    g.comp S.normedMk = f → g = lift S f hf :=
  by
  intro h
  ext
  rcases AddSubgroup.surjective_normedMk _ x with ⟨x, rfl⟩
  change g.comp S.normed_mk x = _
  simpa only [h]
#align normed_add_group_hom.lift_unique NormedAddGroupHom.lift_unique

/-- `S.normed_mk` satisfies `is_quotient`. -/
theorem isQuotientQuotient (S : AddSubgroup M) : IsQuotient S.normedMk :=
  ⟨S.surjective_normedMk, fun m => by simpa [S.ker_normed_mk] using quotient_norm_mk_eq _ m⟩
#align normed_add_group_hom.is_quotient_quotient NormedAddGroupHom.isQuotientQuotient

theorem IsQuotient.norm_lift {f : NormedAddGroupHom M N} (hquot : IsQuotient f) {ε : ℝ} (hε : 0 < ε)
    (n : N) : ∃ m : M, f m = n ∧ ‖m‖ < ‖n‖ + ε :=
  by
  obtain ⟨m, rfl⟩ := hquot.surjective n
  have nonemp : ((fun m' => ‖m + m'‖) '' f.ker).Nonempty :=
    by
    rw [Set.nonempty_image_iff]
    exact ⟨0, f.ker.zero_mem⟩
  rcases Real.lt_infₛ_add_pos nonemp hε with
    ⟨_, ⟨⟨x, hx, rfl⟩, H : ‖m + x‖ < Inf ((fun m' : M => ‖m + m'‖) '' f.ker) + ε⟩⟩
  exact
    ⟨m + x, by rw [map_add, (NormedAddGroupHom.mem_ker f x).mp hx, add_zero], by rwa [hquot.norm]⟩
#align normed_add_group_hom.is_quotient.norm_lift NormedAddGroupHom.IsQuotient.norm_lift

theorem IsQuotient.norm_le {f : NormedAddGroupHom M N} (hquot : IsQuotient f) (m : M) :
    ‖f m‖ ≤ ‖m‖ := by
  rw [hquot.norm]
  apply cinfₛ_le
  · use 0
    rintro _ ⟨m', hm', rfl⟩
    apply norm_nonneg
  · exact ⟨0, f.ker.zero_mem, by simp⟩
#align normed_add_group_hom.is_quotient.norm_le NormedAddGroupHom.IsQuotient.norm_le

theorem lift_norm_le {N : Type _} [SeminormedAddCommGroup N] (S : AddSubgroup M)
    (f : NormedAddGroupHom M N) (hf : ∀ s ∈ S, f s = 0) {c : ℝ≥0} (fb : ‖f‖ ≤ c) :
    ‖lift S f hf‖ ≤ c := by
  apply op_norm_le_bound _ c.coe_nonneg
  intro x
  by_cases hc : c = 0
  · simp only [hc, NNReal.coe_zero, MulZeroClass.zero_mul] at fb⊢
    obtain ⟨x, rfl⟩ := surjective_quot_mk _ x
    show ‖f x‖ ≤ 0
    calc
      ‖f x‖ ≤ 0 * ‖x‖ := f.le_of_op_norm_le fb x
      _ = 0 := MulZeroClass.zero_mul _

  · replace hc : 0 < c := pos_iff_ne_zero.mpr hc
    apply le_of_forall_pos_le_add
    intro ε hε
    have aux : 0 < ε / c := div_pos hε hc
    obtain ⟨x, rfl, Hx⟩ : ∃ x', S.normed_mk x' = x ∧ ‖x'‖ < ‖x‖ + ε / c :=
      (is_quotient_quotient _).norm_lift aux _
    rw [lift_mk]
    calc
      ‖f x‖ ≤ c * ‖x‖ := f.le_of_op_norm_le fb x
      _ ≤ c * (‖S.normed_mk x‖ + ε / c) := ((mul_le_mul_left _).mpr Hx.le)
      _ = c * _ + ε := _

    · exact_mod_cast hc
    · rw [mul_add, mul_div_cancel']
      exact_mod_cast hc.ne'
#align normed_add_group_hom.lift_norm_le NormedAddGroupHom.lift_norm_le

theorem lift_normNoninc {N : Type _} [SeminormedAddCommGroup N] (S : AddSubgroup M)
    (f : NormedAddGroupHom M N) (hf : ∀ s ∈ S, f s = 0) (fb : f.NormNoninc) :
    (lift S f hf).NormNoninc := fun x =>
  by
  have fb' : ‖f‖ ≤ (1 : ℝ≥0) := norm_noninc.norm_noninc_iff_norm_le_one.mp fb
  simpa using le_of_op_norm_le _ (f.lift_norm_le _ _ fb') _
#align normed_add_group_hom.lift_norm_noninc NormedAddGroupHom.lift_normNoninc

end NormedAddGroupHom

/-!
### Submodules and ideals

In what follows, the norm structures created above for quotients of (semi)`normed_add_comm_group`s
by `add_subgroup`s are transferred via definitional equality to quotients of modules by submodules,
and of rings by ideals, thereby preserving the definitional equality for the topological group and
uniform structures worked for above. Completeness is also transferred via this definitional
equality.

In addition, instances are constructed for `normed_space`, `semi_normed_comm_ring`,
`normed_comm_ring` and `normed_algebra` under the appropriate hypotheses. Currently, we do not
have quotients of rings by two-sided ideals, hence the commutativity hypotheses are required.
 -/

section Submodule

variable {R : Type _} [Ring R] [Module R M] (S : Submodule R M)

instance Submodule.Quotient.seminormedAddCommGroup : SeminormedAddCommGroup (M ⧸ S) :=
  AddSubgroup.seminormedAddCommGroupQuotient S.toAddSubgroup
#align submodule.quotient.seminormed_add_comm_group Submodule.Quotient.seminormedAddCommGroup

instance Submodule.Quotient.normedAddCommGroup [hS : IsClosed (S : Set M)] :
    NormedAddCommGroup (M ⧸ S) :=
  @AddSubgroup.normedAddCommGroupQuotient _ _ S.toAddSubgroup hS
#align submodule.quotient.normed_add_comm_group Submodule.Quotient.normedAddCommGroup

instance Submodule.Quotient.completeSpace [CompleteSpace M] : CompleteSpace (M ⧸ S) :=
  QuotientAddGroup.completeSpace M S.toAddSubgroup
#align submodule.quotient.complete_space Submodule.Quotient.completeSpace

/-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `submodule.quotient.mk m = x`
and `‖m‖ < ‖x‖ + ε`. -/
theorem Submodule.Quotient.norm_mk_lt {S : Submodule R M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) :
    ∃ m : M, Submodule.Quotient.mk m = x ∧ ‖m‖ < ‖x‖ + ε :=
  norm_mk_lt x hε
#align submodule.quotient.norm_mk_lt Submodule.Quotient.norm_mk_lt

theorem Submodule.Quotient.norm_mk_le (m : M) : ‖(Submodule.Quotient.mk m : M ⧸ S)‖ ≤ ‖m‖ :=
  quotient_norm_mk_le S.toAddSubgroup m
#align submodule.quotient.norm_mk_le Submodule.Quotient.norm_mk_le

instance Submodule.Quotient.normedSpace (𝕜 : Type _) [NormedField 𝕜] [NormedSpace 𝕜 M] [SMul 𝕜 R]
    [IsScalarTower 𝕜 R M] : NormedSpace 𝕜 (M ⧸ S) :=
  { Submodule.Quotient.module' S with
    norm_smul_le := fun k x =>
      le_of_forall_pos_le_add fun ε hε =>
        by
        have :=
          (nhds_basis_ball.tendsto_iff nhds_basis_ball).mp
            ((@Real.uniformContinuous_const_mul ‖k‖).Continuous.Tendsto ‖x‖) ε hε
        simp only [mem_ball, exists_prop, dist, abs_sub_lt_iff] at this
        rcases this with ⟨δ, hδ, h⟩
        obtain ⟨a, rfl, ha⟩ := Submodule.Quotient.norm_mk_lt x hδ
        specialize h ‖a‖ ⟨by linarith, by linarith [Submodule.Quotient.norm_mk_le S a]⟩
        calc
          _ ≤ ‖k‖ * ‖a‖ := (quotient_norm_mk_le S.to_add_subgroup (k • a)).trans_eq (norm_smul k a)
          _ ≤ _ := (sub_lt_iff_lt_add'.mp h.1).le
           }
#align submodule.quotient.normed_space Submodule.Quotient.normedSpace

end Submodule

section Ideal

variable {R : Type _} [SeminormedCommRing R] (I : Ideal R)

theorem Ideal.Quotient.norm_mk_lt {I : Ideal R} (x : R ⧸ I) {ε : ℝ} (hε : 0 < ε) :
    ∃ r : R, Ideal.Quotient.mk I r = x ∧ ‖r‖ < ‖x‖ + ε :=
  norm_mk_lt x hε
#align ideal.quotient.norm_mk_lt Ideal.Quotient.norm_mk_lt

theorem Ideal.Quotient.norm_mk_le (r : R) : ‖Ideal.Quotient.mk I r‖ ≤ ‖r‖ :=
  quotient_norm_mk_le I.toAddSubgroup r
#align ideal.quotient.norm_mk_le Ideal.Quotient.norm_mk_le

instance Ideal.Quotient.semiNormedCommRing : SeminormedCommRing (R ⧸ I) :=
  {
    Submodule.Quotient.seminormedAddCommGroup
      I with
    mul_comm := mul_comm
    norm_mul := fun x y =>
      le_of_forall_pos_le_add fun ε hε =>
        by
        have :=
          ((nhds_basis_ball.prod_nhds nhds_basis_ball).tendsto_iffₓ nhds_basis_ball).mp
            (real.continuous_mul.tendsto (‖x‖, ‖y‖)) ε hε
        simp only [Set.mem_prod, mem_ball, and_imp, Prod.forall, exists_prop, Prod.exists] at this
        rcases this with ⟨ε₁, ε₂, ⟨h₁, h₂⟩, h⟩
        obtain ⟨⟨a, rfl, ha⟩, ⟨b, rfl, hb⟩⟩ := Ideal.Quotient.norm_mk_lt x h₁,
          Ideal.Quotient.norm_mk_lt y h₂
        simp only [dist, abs_sub_lt_iff] at h
        specialize
          h ‖a‖ ‖b‖ ⟨by linarith, by linarith [Ideal.Quotient.norm_mk_le I a]⟩
            ⟨by linarith, by linarith [Ideal.Quotient.norm_mk_le I b]⟩
        calc
          _ ≤ ‖a‖ * ‖b‖ := (Ideal.Quotient.norm_mk_le I (a * b)).trans (norm_mul_le a b)
          _ ≤ _ := (sub_lt_iff_lt_add'.mp h.1).le
           }
#align ideal.quotient.semi_normed_comm_ring Ideal.Quotient.semiNormedCommRing

instance Ideal.Quotient.normedCommRing [IsClosed (I : Set R)] : NormedCommRing (R ⧸ I) :=
  { Ideal.Quotient.semiNormedCommRing I, Submodule.Quotient.normedAddCommGroup I with }
#align ideal.quotient.normed_comm_ring Ideal.Quotient.normedCommRing

variable (𝕜 : Type _) [NormedField 𝕜]

instance Ideal.Quotient.normedAlgebra [NormedAlgebra 𝕜 R] : NormedAlgebra 𝕜 (R ⧸ I) :=
  { Submodule.Quotient.normedSpace I 𝕜, Ideal.Quotient.algebra 𝕜 with }
#align ideal.quotient.normed_algebra Ideal.Quotient.normedAlgebra

end Ideal


import logic.spaceship
import logic.funrel

--- Inductively defined finite sets
inductive finord : ℕ → Type
  | fz {n : ℕ} : finord (n+1)
  | fs {n : ℕ} : finord n → finord (n+1)

--- finord has a decidable equality
instance {n : ℕ} : decidable_eq (finord n) :=
  begin
    simp [decidable_eq, decidable_rel],
    intros a b,
    induction a with m m a ha,
    all_goals {
      cases b with n n b,
      try { exact decidable.is_true rfl },
      try { exact decidable.is_false (not.intro (λ h, finord.no_confusion h)) }
    },
    cases ha b,
    case decidable.is_false {
      apply decidable.is_false,
      apply not.intro,
      intros hyp,
      have : a = b, by injection hyp,
      contradiction
    },
    case decidable.is_true {
      rw h,
      exact decidable.is_true rfl
    }
  end

namespace finord

--- finord 0 is empty
lemma zero_empty : finord 0 → false := by intros k; cases k

--- Injectivity of the constructors
lemma fz_not_fs {n : ℕ} : ∀ {k : finord n}, fs k ≠ fz :=
  begin
    intros k hk,
    injection hk
  end

--- `fs` is injective.
lemma fs_inj {n : ℕ} : function.injective (@finord.fs n) :=
  begin
    intros k l h,
    injection h
  end

--- Strict comparison on finite ordinals
attribute [reducible]
protected
definition lt : ∀ {n}, finord n → finord n → Prop
| _ _ fz := false
| _ fz (fs _) := true
| _ (fs i) (fs j) := lt i j

instance {n} : has_lt (finord n) :=
  has_lt.mk (@finord.lt n)

--- The standard strict orders on finite ordinals are decidable.
protected
lemma lt_decidable : ∀ {n}, decidable_rel (@finord.lt n)
| _ i fz := by cases i; exact is_false false.elim
| _ fz (fs _) := is_true true.intro
| _ (fs i) (fs j) := lt_decidable i j

--- The standard strict orders on finite ordinals are irreflexive.
protected
lemma lt_irrefl {n} : ∀ (i : finord n), ¬ i.lt i :=
  begin
    intros i,
    induction i with n' n' i hi,
    case finord.fz { dunfold finord.lt; exact false.elim },
    case finord.fs {
      dunfold finord.lt,
      exact hi
    }
  end

--- The standard strict orders on finite ordinals are asymmetric.
protected
lemma lt_asymm {n} : ∀ {i j : finord n}, i.lt j → ¬ j.lt i :=
  begin
    intros i j hab,
    induction i with _ n' i hi,
    case finord.fz {
      cases j; exact false.elim
    },
    case finord.fs {
      cases j with j' _ j',
      case finord.fz {
        dunfold finord.lt at hab,
        contradiction
      },
      case finord.fs {
        dunfold finord.lt,
        dunfold finord.lt at hab,
        exact hi hab
      }
    }
  end

--- With respect to the standard strict orders on finite ordinals, incomparability implies equality.
protected
lemma lt_incomp_eq {n} : ∀ {i j : finord n}, ¬ i.lt j → ¬ j.lt i → i=j :=
  begin
    intros i j hij hji,
    induction i with n' n' i hi_ind,
    case finord.fz {
      cases j with _ _ j',
      case finord.fz { trivial },
      case finord.fs {
        dunfold finord.lt at hij,
        exact false.elim (hij true.intro)
      }
    },
    case finord.fs {
      cases j with _ _ j',
      case finord.fz {
        dunfold finord.lt at hji,
        exact false.elim (hji true.intro)
      },
      case finord.fs {
        apply congr (@rfl _ finord.fs),
        dunfold finord.lt at hij hji,
        exact hi_ind hij hji
      }
    }
  end

--- The standard strict orders on finite ordinals are transitive.
attribute [trans]
protected
lemma lt_trans {n} : ∀ {i j k : finord n}, i.lt j → j.lt k → i.lt k :=
  begin
    intros i j k hij hjk,
    induction k with n' n' k hk_ind,
    case finord.fz { cases j; dunfold finord.lt at hjk; contradiction },
    -- In the following, we may assume `k = fs _`
    cases i with n' n' i',
    case finord.fz { dunfold finord.lt; trivial },
    case finord.fs {
      cases j with n' n' j',
      case finord.fz { dunfold finord.lt at *; contradiction },
      case finord.fs { dunfold finord.lt at *; exact hk_ind hij hjk }
    }
  end

--- The standard strict orders on finite ordinals are transitive.
protected
lemma lt_trichotomous {n} : ∀ {i j : finord n}, i.lt j ∨ i=j ∨ j.lt i :=
  begin
    intros i j,
    induction i with n' n' i' hi_ind,
    case finord.fz {
      cases j with _ _ j',
      case finord.fz { right; left; refl },
      case finord.fs { left; dunfold finord.lt; trivial }
    },
    case finord.fs {
      cases j with _ _ j',
      case finord.fz { right; right; simp [finord.lt] },
      case finord.fs {
        dunfold finord.lt,
        refine or.imp id (or.imp (congr rfl) id) hi_ind,
      }
    }
  end

instance {n} : is_irrefl (finord n) finord.lt :=
  is_irrefl.mk (@finord.lt_irrefl n)
instance {n} : is_asymm (finord n) finord.lt :=
  is_asymm.mk (@finord.lt_asymm n)
instance {n} : is_trans (finord n) finord.lt :=
  is_trans.mk (@finord.lt_trans n)
instance {n} : is_strict_order (finord n) finord.lt :=
  { /- auto-generated -/ }
instance {n} : is_incomp_trans (finord n) finord.lt :=
  begin
    constructor,
    intros i j k hij hjk,
    have : i=k,
      by calc
        i = j : finord.lt_incomp_eq hij.left hij.right
        ... = k : finord.lt_incomp_eq hjk.left hjk.right,
    rw [this],
    split; exact finord.lt_irrefl k
  end
instance {n} : is_strict_weak_order (finord n) finord.lt :=
  { /- auto-generated -/ }
instance {n} : is_trichotomous (finord n) finord.lt :=
  is_trichotomous.mk (@finord.lt_trichotomous n)
instance {n} : is_strict_total_order (finord n) finord.lt :=
  { /- auto-generated -/ }

--- Injection into the successor ordinal that preserves element representation; e.g. fz ↦ fz and fs n ↦ fs n
definition inject_succ : Π {m}, finord m → finord m.succ
| _ fz := fz
| _ (fs k) := fs (inject_succ k)

--- Iterated version of injection
definition inject {m : ℕ} : Π (k : ℕ), finord m → finord (m+k)
| 0 := id
| 1 := inject_succ -- this assures the definitional equality inject 1 = inject_succ
| (k+2) := inject_succ ∘ inject (k+1)

--- Convert into fin
definition to_fin : Π {n : ℕ}, finord n → fin n
| 0 k := (zero_empty k).elim
| (n+1) fz := ⟨0,nat.zero_lt_succ n⟩
| (n+1) (fs k) := (to_fin k).succ

--- to_fin transforms finord.fs into fin.succ
theorem to_fs_succ : ∀ {n : ℕ} (k : finord n), to_fin k.fs = (to_fin k).succ :=
  begin
    intros,
    cases k with k n k,
    case finord.fz {
      dunfold to_fin,
      refl
    },
    case finord.fs {
      dunfold to_fin,
      refl
    }
  end

--- Convert from fin
definition from_fin : Π {n : ℕ}, fin n → finord n
| 0 ⟨k,hk⟩ := (nat.not_lt_zero k hk).elim
| (n+1) ⟨0,_⟩ := fz
| (n+1) ⟨k+1,hk⟩ := fs (from_fin ⟨k, nat.lt_of_succ_lt_succ hk⟩)

--- from_fin transforms fin.succ into finord.fs
theorem from_succ_fs : ∀ {n : ℕ} (k : fin n), from_fin k.succ = (from_fin k).fs :=
  begin
    intros n k,
    cases k with kv hkv,
    dsimp [fin.succ,from_fin],
    refl
  end

theorem fromto_id {n : ℕ} (k : finord n) : from_fin (to_fin k) = k :=
  begin
    induction n with n hind,
    case nat.zero {
      cases k,
    },
    case nat.succ {
      cases k with _ _ k,
      case finord.fz {
        dsimp [finord.to_fin, finord.from_fin],
        refl
      },
      case finord.fs {
        dunfold finord.to_fin,
        by calc
          from_fin k.to_fin.succ
              = (from_fin k.to_fin).fs : from_succ_fs _
          ... = k.fs : by rw [hind k]
      }
    }
  end

theorem tofrom_id {n : ℕ} (k : fin n) : to_fin (from_fin k) = k :=
  begin
    cases k with kv hkv,
    apply subtype.eq; dsimp [subtype.val],
    revert kv hkv,
    induction n with n hind; intros,
    case nat.zero {
      exact (nat.not_lt_zero kv hkv).elim
    },
    case nat.succ {
      cases kv with kv,
      case nat.zero {
        dsimp [from_fin, to_fin, subtype.val],
        refl
      },
      case nat.succ {
        dsimp [from_fin, to_fin],
        have : ∀ (m : fin n), m.succ.val = m.val.succ :=
          by intros; cases m; trivial,
        rw [this],
        suffices : (from_fin ⟨kv, _⟩).to_fin.val = kv,
          by rw [this],
        apply hind
      }
    }
  end

--- The number of elements that satisfy a decidable predicator
definition card_of : Π {n : ℕ} (p : finord n → Prop) [decidable_pred p], ℕ
| 0 _ _ := 0
| (k+1) p h :=
  let i := @card_of k (p ∘ finord.fs) (λ x, h (fs x))
  in @ite _ (p finord.fz) (h _) (1+i) i

end finord


universe u
constant vec : Type u → ℕ → Type u

namespace vec
  constant empty : Π α : Type u, vec α 0
  constant cons :
    Π {α : Type u} {n : ℕ}, α → vec α n → vec α (n + 1)
  constant append :
    Π {α : Type u} {n m : ℕ},  vec α m → vec α n → vec α (n + m)
end vec

#check vec

-- Above, we used the example vec α n for vectors of elements of type α of
-- length n. Declare a constant vec_add that could represent a function
-- that adds two vectors of natural numbers of the same length, and a constant
-- vec_reverse that can represent a function that reverses its argument.
-- Use implicit arguments for parameters that can be inferred. Declare some
-- variables and check some expressions involving the constants that you have
-- declared.
constant vec_add : Π {α : Type u} {n : ℕ}, vec α n → vec α n → vec α n
#reduce vec.cons 456 (vec.cons 123 (vec.empty _))
#check vec_add (vec.cons 456 (vec.cons 123 (vec.empty _))) (vec.cons 456 (vec.cons 123 (vec.empty _)))

constant vec_reverse : Π {α : Type u} {n : ℕ}, vec α n → vec α n
#check vec_reverse (vec.cons 456 (vec.cons 123 (vec.empty _)))

-- Similarly, declare a constant matrix so that matrix α m n could represent the
-- type of m by n matrices. Declare some constants to represent functions on
-- this type, such as matrix addition and multiplication, and (using vec)
-- multiplication of a matrix by a vector. Once again, declare some variables
-- and check some expressions involving the constants that you have declared.

constant matrix : Type u → ℕ → ℕ → Type u
constant matrix_add : Π {α : Type u} {n m : ℕ}, matrix α n m → matrix α n m
constant matrix_mul : Π {α : Type u} {n m k : ℕ}, matrix α n m → matrix α m k → matrix α n k
constant matrix_vec_mul : Π {α : Type u} {n m : ℕ}, matrix α n m → vec α m → vec α n


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov
-/
import algebra.group.prod
import algebra.group.type_tags
import algebra.group.pi
import algebra.pointwise
import data.equiv.basic
import data.set.finite

/-!
# Torsors of additive group actions

This file defines torsors of additive group actions.

## Notations

The group elements are referred to as acting on points.  This file
defines the notation `+ᵥ` for adding a group element to a point and
`-ᵥ` for subtracting two points to produce a group element.

## Implementation notes

Affine spaces are the motivating example of torsors of additive group actions. It may be appropriate
to refactor in terms of the general definition of group actions, via `to_additive`, when there is a
use for multiplicative torsors (currently mathlib only develops the theory of group actions for
multiplicative group actions).

## Notations

* `v +ᵥ p` is a notation for `has_vadd.vadd`, the left action of an additive monoid;

* `p₁ -ᵥ p₂` is a notation for `has_vsub.vsub`, difference between two points in an additive torsor
  as an element of the corresponding additive group;

## References

* https://en.wikipedia.org/wiki/Principal_homogeneous_space
* https://en.wikipedia.org/wiki/Affine_space

-/

/-- Type class for the `-ᵥ` notation. -/
class has_vsub (G : out_param Type*) (P : Type*) :=
(vsub : P → P → G)

infix ` -ᵥ `:65 := has_vsub.vsub

/-- An `add_torsor G P` gives a structure to the nonempty type `P`,
acted on by an `add_group G` with a transitive and free action given
by the `+ᵥ` operation and a corresponding subtraction given by the
`-ᵥ` operation. In the case of a vector space, it is an affine
space. -/
class add_torsor (G : out_param Type*) (P : Type*) [out_param $ add_group G]
  extends add_action G P, has_vsub G P :=
[nonempty : nonempty P]
(vsub_vadd' : ∀ (p1 p2 : P), (p1 -ᵥ p2 : G) +ᵥ p2 = p1)
(vadd_vsub' : ∀ (g : G) (p : P), g +ᵥ p -ᵥ p = g)

attribute [instance, priority 100, nolint dangerous_instance] add_torsor.nonempty
attribute [nolint dangerous_instance] add_torsor.to_has_vsub

/-- An `add_group G` is a torsor for itself. -/
@[nolint instance_priority]
instance add_group_is_add_torsor (G : Type*) [add_group G] :
  add_torsor G G :=
{ vsub := has_sub.sub,
  vsub_vadd' := sub_add_cancel,
  vadd_vsub' := add_sub_cancel }

/-- Simplify subtraction for a torsor for an `add_group G` over
itself. -/
@[simp] lemma vsub_eq_sub {G : Type*} [add_group G] (g1 g2 : G) : g1 -ᵥ g2 = g1 - g2 :=
rfl

section general

variables {G : Type*} {P : Type*} [add_group G] [T : add_torsor G P]
include T

/-- Adding the result of subtracting from another point produces that
point. -/
@[simp] lemma vsub_vadd (p1 p2 : P) : p1 -ᵥ p2 +ᵥ p2 = p1 :=
add_torsor.vsub_vadd' p1 p2

/-- Adding a group element then subtracting the original point
produces that group element. -/
@[simp] lemma vadd_vsub (g : G) (p : P) : g +ᵥ p -ᵥ p = g :=
add_torsor.vadd_vsub' g p

/-- If the same point added to two group elements produces equal
results, those group elements are equal. -/
lemma vadd_right_cancel {g1 g2 : G} (p : P) (h : g1 +ᵥ p = g2 +ᵥ p) : g1 = g2 :=
by rw [←vadd_vsub g1, h, vadd_vsub]

@[simp] lemma vadd_right_cancel_iff {g1 g2 : G} (p : P) :  g1 +ᵥ p = g2 +ᵥ p ↔ g1 = g2 :=
⟨vadd_right_cancel p, λ h, h ▸ rfl⟩

/-- Adding a group element to the point `p` is an injective
function. -/
lemma vadd_right_injective (p : P) : function.injective ((+ᵥ p) : G → P) :=
λ g1 g2, vadd_right_cancel p

/-- Adding a group element to a point, then subtracting another point,
produces the same result as subtracting the points then adding the
group element. -/
lemma vadd_vsub_assoc (g : G) (p1 p2 : P) : g +ᵥ p1 -ᵥ p2 = g + (p1 -ᵥ p2) :=
begin
  apply vadd_right_cancel p2,
  rw [vsub_vadd, add_vadd, vsub_vadd]
end

/-- Subtracting a point from itself produces 0. -/
@[simp] lemma vsub_self (p : P) : p -ᵥ p = (0 : G) :=
by rw [←zero_add (p -ᵥ p), ←vadd_vsub_assoc, vadd_vsub]

/-- If subtracting two points produces 0, they are equal. -/
lemma eq_of_vsub_eq_zero {p1 p2 : P} (h : p1 -ᵥ p2 = (0 : G)) : p1 = p2 :=
by rw [←vsub_vadd p1 p2, h, zero_vadd]

/-- Subtracting two points produces 0 if and only if they are
equal. -/
@[simp] lemma vsub_eq_zero_iff_eq {p1 p2 : P} : p1 -ᵥ p2 = (0 : G) ↔ p1 = p2 :=
iff.intro eq_of_vsub_eq_zero (λ h, h ▸ vsub_self _)

/-- Cancellation adding the results of two subtractions. -/
@[simp] lemma vsub_add_vsub_cancel (p1 p2 p3 : P) : p1 -ᵥ p2 + (p2 -ᵥ p3) = (p1 -ᵥ p3) :=
begin
  apply vadd_right_cancel p3,
  rw [add_vadd, vsub_vadd, vsub_vadd, vsub_vadd]
end

/-- Subtracting two points in the reverse order produces the negation
of subtracting them. -/
@[simp] lemma neg_vsub_eq_vsub_rev (p1 p2 : P) : -(p1 -ᵥ p2) = (p2 -ᵥ p1) :=
begin
  refine neg_eq_of_add_eq_zero (vadd_right_cancel p1 _),
  rw [vsub_add_vsub_cancel, vsub_self],
end

/-- Subtracting the result of adding a group element produces the same result
as subtracting the points and subtracting that group element. -/
lemma vsub_vadd_eq_vsub_sub (p1 p2 : P) (g : G) : p1 -ᵥ (g +ᵥ p2) = (p1 -ᵥ p2) - g :=
by rw [←add_right_inj (p2 -ᵥ p1 : G), vsub_add_vsub_cancel, ←neg_vsub_eq_vsub_rev, vadd_vsub,
       ←add_sub_assoc, ←neg_vsub_eq_vsub_rev, neg_add_self, zero_sub]

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_right (p1 p2 p3 : P) :
  (p1 -ᵥ p3) - (p2 -ᵥ p3) = (p1 -ᵥ p2) :=
by rw [←vsub_vadd_eq_vsub_sub, vsub_vadd]

/-- Convert between an equality with adding a group element to a point
and an equality of a subtraction of two points with a group
element. -/
lemma eq_vadd_iff_vsub_eq (p1 : P) (g : G) (p2 : P) : p1 = g +ᵥ p2 ↔ p1 -ᵥ p2 = g :=
⟨λ h, h.symm ▸ vadd_vsub _ _, λ h, h ▸ (vsub_vadd _ _).symm⟩

lemma vadd_eq_vadd_iff_neg_add_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ - v₁ + v₂ = p₁ -ᵥ p₂ :=
by rw [eq_vadd_iff_vsub_eq, vadd_vsub_assoc, ← add_right_inj (-v₁), neg_add_cancel_left, eq_comm]

namespace set

instance has_vsub : has_vsub (set G) (set P) := ⟨set.image2 (-ᵥ)⟩

section vsub

variables (s t : set P)

@[simp] lemma vsub_empty : s -ᵥ ∅ = ∅ := set.image2_empty_right

@[simp] lemma empty_vsub : ∅ -ᵥ s = ∅ := set.image2_empty_left

@[simp] lemma singleton_vsub (p : P) : {p} -ᵥ s = ((-ᵥ) p) '' s :=
image2_singleton_left

@[simp] lemma vsub_singleton (p : P) : s -ᵥ {p} = (-ᵥ p) '' s :=
image2_singleton_right

@[simp] lemma singleton_vsub_self (p : P) : ({p} : set P) -ᵥ {p} = {(0:G)} :=
by simp

variables {s t}

/-- `vsub` of a finite set is finite. -/
lemma finite.vsub (hs : finite s) (ht : finite t) : finite (s -ᵥ t) :=
hs.image2 _ ht

/-- Each pairwise difference is in the `vsub` set. -/
lemma vsub_mem_vsub {ps pt : P} (hs : ps ∈ s) (ht : pt ∈ t) :
  (ps -ᵥ pt) ∈ s -ᵥ t :=
mem_image2_of_mem hs ht

/-- `s -ᵥ t` is monotone in both arguments. -/
@[mono] lemma vsub_subset_vsub {s' t' : set P} (hs : s ⊆ s') (ht : t ⊆ t') :
  s -ᵥ t ⊆ s' -ᵥ t' :=
image2_subset hs ht

lemma vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t := vsub_subset_vsub h h

lemma vsub_subset_iff {u : set G} : s -ᵥ t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x -ᵥ y ∈ u :=
image2_subset_iff

end vsub

instance add_action : add_action (set G) (set P) :=
{ vadd := set.image2 (+ᵥ),
  zero_vadd := λ s, by simp [← singleton_zero],
  add_vadd := λ s t p, by { apply image2_assoc, intros, apply add_vadd } }

variables {s s' : set G} {t t' : set P}

@[mono] lemma vadd_subset_vadd (hs : s ⊆ s') (ht : t ⊆ t') : s +ᵥ t ⊆ s' +ᵥ t' :=
image2_subset hs ht

@[simp] lemma vadd_singleton (s : set G) (p : P) : s +ᵥ {p} = (+ᵥ p) '' s := image2_singleton_right

@[simp] lemma singleton_vadd (v : G) (s : set P) : ({v} : set G) +ᵥ s = ((+ᵥ) v) '' s :=
image2_singleton_left

lemma finite.vadd (hs : finite s) (ht : finite t) : finite (s +ᵥ t) := hs.image2 _ ht

end set

@[simp] lemma vadd_vsub_vadd_cancel_right (v₁ v₂ : G) (p : P) :
  (v₁ +ᵥ p) -ᵥ (v₂ +ᵥ p) = v₁ - v₂ :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, vsub_self, add_zero]

/-- If the same point subtracted from two points produces equal
results, those points are equal. -/
lemma vsub_left_cancel {p1 p2 p : P} (h : p1 -ᵥ p = p2 -ᵥ p) : p1 = p2 :=
by rwa [←sub_eq_zero, vsub_sub_vsub_cancel_right, vsub_eq_zero_iff_eq] at h

/-- The same point subtracted from two points produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_left_cancel_iff {p1 p2 p : P} : (p1 -ᵥ p) = p2 -ᵥ p ↔ p1 = p2 :=
⟨vsub_left_cancel, λ h, h ▸ rfl⟩

/-- Subtracting the point `p` is an injective function. -/
lemma vsub_left_injective (p : P) : function.injective ((-ᵥ p) : P → G) :=
λ p2 p3, vsub_left_cancel

/-- If subtracting two points from the same point produces equal
results, those points are equal. -/
lemma vsub_right_cancel {p1 p2 p : P} (h : p -ᵥ p1 = p -ᵥ p2) : p1 = p2 :=
begin
  refine vadd_left_cancel (p -ᵥ p2) _,
  rw [vsub_vadd, ← h, vsub_vadd]
end

/-- Subtracting two points from the same point produces equal results
if and only if those points are equal. -/
@[simp] lemma vsub_right_cancel_iff {p1 p2 p : P} : p -ᵥ p1 = p -ᵥ p2 ↔ p1 = p2 :=
⟨vsub_right_cancel, λ h, h ▸ rfl⟩

/-- Subtracting a point from the point `p` is an injective
function. -/
lemma vsub_right_injective (p : P) : function.injective ((-ᵥ) p : P → G) :=
λ p2 p3, vsub_right_cancel

end general

section comm

variables {G : Type*} {P : Type*} [add_comm_group G] [add_torsor G P]

include G

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] lemma vsub_sub_vsub_cancel_left (p1 p2 p3 : P) :
  (p3 -ᵥ p2) - (p3 -ᵥ p1) = (p1 -ᵥ p2) :=
by rw [sub_eq_add_neg, neg_vsub_eq_vsub_rev, add_comm, vsub_add_vsub_cancel]

@[simp] lemma vadd_vsub_vadd_cancel_left (v : G) (p1 p2 : P) :
  (v +ᵥ p1) -ᵥ (v +ᵥ p2) = p1 -ᵥ p2 :=
by rw [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_sub_cancel']

lemma vsub_vadd_comm (p1 p2 p3 : P) : (p1 -ᵥ p2 : G) +ᵥ p3 = p3 -ᵥ p2 +ᵥ p1 :=
begin
  rw [←@vsub_eq_zero_iff_eq G, vadd_vsub_assoc, vsub_vadd_eq_vsub_sub],
  simp
end

lemma vadd_eq_vadd_iff_sub_eq_vsub {v₁ v₂ : G} {p₁ p₂ : P} :
  v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂ :=
by rw [vadd_eq_vadd_iff_neg_add_eq_vsub, neg_add_eq_sub]

lemma vsub_sub_vsub_comm (p₁ p₂ p₃ p₄ : P) :
  (p₁ -ᵥ p₂) - (p₃ -ᵥ p₄) = (p₁ -ᵥ p₃) - (p₂ -ᵥ p₄) :=
by rw [← vsub_vadd_eq_vsub_sub, vsub_vadd_comm, vsub_vadd_eq_vsub_sub]

end comm

namespace prod

variables {G : Type*} {P : Type*} {G' : Type*} {P' : Type*} [add_group G] [add_group G']
  [add_torsor G P] [add_torsor G' P']

instance : add_torsor (G × G') (P × P') :=
{ vadd := λ v p, (v.1 +ᵥ p.1, v.2 +ᵥ p.2),
  zero_vadd := λ p, by simp,
  add_vadd := by simp [add_vadd],
  vsub := λ p₁ p₂, (p₁.1 -ᵥ p₂.1, p₁.2 -ᵥ p₂.2),
  nonempty := prod.nonempty,
  vsub_vadd' := λ p₁ p₂, show (p₁.1 -ᵥ p₂.1 +ᵥ p₂.1, _) = p₁, by simp,
  vadd_vsub' := λ v p, show (v.1 +ᵥ p.1 -ᵥ p.1, v.2 +ᵥ p.2 -ᵥ p.2)  =v, by simp }

@[simp] lemma fst_vadd (v : G × G') (p : P × P') : (v +ᵥ p).1 = v.1 +ᵥ p.1 := rfl
@[simp] lemma snd_vadd (v : G × G') (p : P × P') : (v +ᵥ p).2 = v.2 +ᵥ p.2 := rfl
@[simp] lemma mk_vadd_mk (v : G) (v' : G') (p : P) (p' : P') :
  (v, v') +ᵥ (p, p') = (v +ᵥ p, v' +ᵥ p') := rfl

@[simp] lemma fst_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').1 = p₁.1 -ᵥ p₂.1 := rfl
@[simp] lemma snd_vsub (p₁ p₂ : P × P') : (p₁ -ᵥ p₂ : G × G').2 = p₁.2 -ᵥ p₂.2 := rfl
@[simp] lemma mk_vsub_mk (p₁ p₂ : P) (p₁' p₂' : P') :
  ((p₁, p₁') -ᵥ (p₂, p₂') : G × G') = (p₁ -ᵥ p₂, p₁' -ᵥ p₂') := rfl

end prod

namespace pi

universes u v w
variables {I : Type u} {fg : I → Type v} [∀ i, add_group (fg i)] {fp : I → Type w}

open add_action add_torsor

/-- A product of `add_torsor`s is an `add_torsor`. -/
instance [T : ∀ i, add_torsor (fg i) (fp i)] : add_torsor (Π i, fg i) (Π i, fp i) :=
{ vadd := λ g p, λ i, g i +ᵥ p i,
  zero_vadd := λ p, funext $ λ i, zero_vadd (fg i) (p i),
  add_vadd := λ g₁ g₂ p, funext $ λ i, add_vadd (g₁ i) (g₂ i) (p i),
  vsub := λ p₁ p₂, λ i, p₁ i -ᵥ p₂ i,
  nonempty := ⟨λ i, classical.choice (T i).nonempty⟩,
  vsub_vadd' := λ p₁ p₂, funext $ λ i, vsub_vadd (p₁ i) (p₂ i),
  vadd_vsub' := λ g p, funext $ λ i, vadd_vsub (g i) (p i) }

/-- Addition in a product of `add_torsor`s. -/
@[simp] lemma vadd_apply [T : ∀ i, add_torsor (fg i) (fp i)] (x : Π i, fg i) (y : Π i, fp i)
  {i : I} : (x +ᵥ y) i = x i +ᵥ y i
:= rfl

end pi

namespace equiv

variables {G : Type*} {P : Type*} [add_group G] [add_torsor G P]

include G

/-- `v ↦ v +ᵥ p` as an equivalence. -/
def vadd_const (p : P) : G ≃ P :=
{ to_fun := λ v, v +ᵥ p,
  inv_fun := λ p', p' -ᵥ p,
  left_inv := λ v, vadd_vsub _ _,
  right_inv := λ p', vsub_vadd _ _ }

@[simp] lemma coe_vadd_const (p : P) : ⇑(vadd_const p) = λ v, v+ᵥ p := rfl

@[simp] lemma coe_vadd_const_symm (p : P) : ⇑(vadd_const p).symm = λ p', p' -ᵥ p := rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (p : P) : P ≃ G :=
{ to_fun := (-ᵥ) p,
  inv_fun := λ v, -v +ᵥ p,
  left_inv := λ p', by simp,
  right_inv := λ v, by simp [vsub_vadd_eq_vsub_sub] }

@[simp] lemma coe_const_vsub (p : P) : ⇑(const_vsub p) = (-ᵥ) p := rfl

@[simp] lemma coe_const_vsub_symm (p : P) : ⇑(const_vsub p).symm = λ v, -v +ᵥ p := rfl

variables (P)

/-- The permutation given by `p ↦ v +ᵥ p`. -/
def const_vadd (v : G) : equiv.perm P :=
{ to_fun := (+ᵥ) v,
  inv_fun := (+ᵥ) (-v),
  left_inv := λ p, by simp [vadd_vadd],
  right_inv := λ p, by simp [vadd_vadd] }

@[simp] lemma coe_const_vadd (v : G) : ⇑(const_vadd P v) = (+ᵥ) v := rfl

variable (G)

@[simp] lemma const_vadd_zero : const_vadd P (0:G) = 1 := ext $ zero_vadd G

variable {G}

@[simp] lemma const_vadd_add (v₁ v₂ : G) :
  const_vadd P (v₁ + v₂) = const_vadd P v₁ * const_vadd P v₂ :=
ext $ add_vadd v₁ v₂

/-- `equiv.const_vadd` as a homomorphism from `multiplicative G` to `equiv.perm P` -/
def const_vadd_hom : multiplicative G →* equiv.perm P :=
{ to_fun := λ v, const_vadd P v.to_add,
  map_one' := const_vadd_zero G P,
  map_mul' := const_vadd_add P }

variable {P}

open function

/-- Point reflection in `x` as a permutation. -/
def point_reflection (x : P) : perm P := (const_vsub x).trans (vadd_const x)

lemma point_reflection_apply (x y : P) : point_reflection x y = x -ᵥ y +ᵥ x := rfl

@[simp] lemma point_reflection_symm (x : P) : (point_reflection x).symm = point_reflection x :=
ext $ by simp [point_reflection]

@[simp] lemma point_reflection_self (x : P) : point_reflection x x = x := vsub_vadd _ _

lemma point_reflection_involutive (x : P) : involutive (point_reflection x : P → P) :=
λ y, (equiv.apply_eq_iff_eq_symm_apply _).2 $ by rw point_reflection_symm

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
lemma point_reflection_fixed_iff_of_injective_bit0 {x y : P} (h : injective (bit0 : G → G)) :
  point_reflection x y = y ↔ y = x :=
by rw [point_reflection_apply, eq_comm, eq_vadd_iff_vsub_eq, ← neg_vsub_eq_vsub_rev,
  neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero, h.eq_iff, vsub_eq_zero_iff_eq, eq_comm]

omit G

lemma injective_point_reflection_left_of_injective_bit0 {G P : Type*} [add_comm_group G]
  [add_torsor G P] (h : injective (bit0 : G → G)) (y : P) :
  injective (λ x : P, point_reflection x y) :=
λ x₁ x₂ (hy : point_reflection x₁ y = point_reflection x₂ y),
  by rwa [point_reflection_apply, point_reflection_apply, vadd_eq_vadd_iff_sub_eq_vsub,
    vsub_sub_vsub_cancel_right, ← neg_vsub_eq_vsub_rev, neg_eq_iff_add_eq_zero, ← bit0, ← bit0_zero,
    h.eq_iff, vsub_eq_zero_iff_eq] at hy

end equiv


variable (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  ⟨
    λ h : ∀ x, p x ∧ q x =>
      ⟨ λ x : α => (h x).left,
        λ x : α => (h x).right ⟩,
    λ h : (∀ x, p x) ∧ (∀ x, q x) =>
      λ x : α =>
        ⟨ h.left x , h.right x⟩
  ⟩

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  fun h1 : (∀ x, p x → q x) =>
    fun h2 : (∀ x, p x) =>
      fun x : α => (h1 x) (h2 x)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  fun h : (∀ x, p x) ∨ (∀ x, q x) =>
    fun x : α =>
      h.elim
        (fun hl : (∀ x, p x) =>
          Or.inl (hl x))
        (fun hr : (∀ x, q x) =>
          Or.inr (hr x))

variable (r : Prop)

open Classical

example : α → ((∀ _ : α, r) ↔ r) :=
  fun a : α =>
    ⟨
      fun x : (∀ _ : α, r) => x a,
      fun y : r =>
        fun _ : α => y
    ⟩

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  ⟨
    fun h : (∀ x, p x ∨ r) =>
      show (∀ x, p x) ∨ r from
      Or.elim (em r)
        (fun hr : r => Or.inr hr)
        (fun hnr : ¬r =>
          Or.inl fun ha : α =>
            Or.elim (h ha)
              (fun hpx : (p ha) => hpx)
              (fun hr : r => absurd hr hnr)),
    fun h : (∀ x, p x) ∨ r =>
      show (∀ x, p x ∨ r) from
      fun a : α =>
        Or.elim h
          (fun hl : (∀ x, p x) => Or.inl (hl a))
          (fun hr : r => Or.inr hr)
  ⟩

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  ⟨
    λ h : (∀ x, r → p x) =>
      show (r → ∀ x, p x) from
      λ hr : r =>
        λ ha : α =>
          h ha hr,
    λ h : r → ∀ x, p x =>
      show (∀ x, r → p x) from
      λ ha : α =>
        λ hr : r =>
          h hr ha
  ⟩

variable (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  have h2 : shaves barber barber ↔ ¬ shaves barber barber := h barber
  Or.elim (em (shaves barber barber))
    (fun h3 : shaves barber barber =>
      (h2.mp h3) h3)
    (fun h3 : ¬(shaves barber barber) =>
      h3 (h2.mpr h3))

def divides (n m : Nat) : Prop :=
  ∃ (k : Nat), k * n = m

def even (n : Nat) : Prop :=
  divides 2 n

def prime (n : Nat) : Prop :=
  ∀ (k : Nat), k != n ∧ k != n → ¬(divides k n)

def infinitely_many_primes : Prop :=
  ∀ (n : Nat), ∃ (k : Nat), k > n ∧ prime k

def Fermat_prime (n : Nat) : Prop :=
  prime n ∧ ∃ (k : Nat), (2^k + 1= n)

def infinitely_many_Fermat_primes : Prop :=
  ∀ (n : Nat), ∃ (k : Nat), k > n ∧ Fermat_prime k

def goldbach_conjecture : Prop :=
  ∀ (n : Nat), n > 2 ∧ even n → ∃ (p q : Nat), prime p ∧ prime q ∧ p + q = n

def Goldbach's_weak_conjecture : Prop :=
  ∀ (n : Nat), n > 2 ∧ even n →
    ∃ (p q r : Nat), prime p ∧ prime q ∧ prime r ∧
      p + q + r = n

def Fermat's_last_theorem : Prop :=
  ∀ (n : Nat), n > 2 →
    ¬∃ (a b c : Nat), a^n + b^n = c^n

example : (∃ _ : α, r) → r :=
  fun h : (∃ _ : α, r) =>
    h.elim (fun _: α => fun hw: r => hw)

example (a : α) : r → (∃ _ : α, r) :=
  fun h: r =>
    Exists.intro a h

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  Iff.intro
    (fun h: (∃ x, p x ∧ r) =>
      h.elim (fun w : α => fun hw : p w ∧ r =>
        ⟨Exists.intro w (hw).left, (hw).right⟩))
    (fun ⟨⟨w, hw⟩, hr⟩ =>
      ⟨w, hw, hr⟩)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  Iff.intro
    (fun h : (∃ x, p x ∨ q x) =>
      match h with
      | ⟨w, hw⟩ => Or.elim hw
        (fun hpw : p w => Or.inl ⟨w, hpw⟩)
        (fun hqw : q w => Or.inr ⟨w, hqw⟩))
    (fun h : (∃ x, p x) ∨ (∃ x, q x) =>
      Or.elim h
        (fun h1 : (∃ x, p x) =>
          let ⟨w, h1w⟩ := h1
          ⟨w, Or.inl h1w⟩)
        (fun h1 : (∃ x, q x) =>
          let ⟨w, h1w⟩ := h1
          ⟨w, Or.inr h1w⟩))

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  Iff.intro
    (fun h: (∀ x, p x) =>
      fun h2: (∃ x, ¬ p x) =>
        let ⟨w, wh2⟩ := h2
        wh2 (h w))
    (fun h: ¬(∃ x, ¬ p x) =>
      fun z: α =>
        Or.elim (em (p z))
          (fun hpz: p z => hpz)
          (fun hnpz: ¬(p z) => absurd ⟨z, hnpz⟩ h))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  Iff.intro
    (fun h: (∃ x, p x) =>
      let ⟨w, wh⟩ := h
      fun h2: (∀ x, ¬ p x) =>
        (h2 w) wh)
    (fun h: ¬(∀ x, ¬ p x) =>
      byContradiction
        fun h2 : ¬(∃ x, p x) =>
          h fun x : α =>
            fun hx : p x =>
              h2 ⟨x, hx⟩)

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  Iff.intro
    (fun h: (¬ ∃ x, p x) =>
      fun x : α =>
        fun hx : p x =>
          h ⟨x, hx⟩ )
    (fun h: (∀ x, ¬ p x) =>
      fun h2: (∃ x, p x) =>
        let ⟨w, hw⟩ := h2
        (h w) hw)

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  Iff.intro
    (fun h: (¬ ∀ x, p x) =>
      byContradiction
        fun h2 : ¬(∃ x, ¬ p x) =>
          h fun x : α =>
            Or.elim (em (p x))
              (fun hpx : p x => hpx)
              (fun hnpx : ¬(p x) => absurd ⟨x, hnpx⟩ h2 ))
    (fun h: (∃ x, ¬ p x) =>
      fun h2: (∀ x, p x) =>
        let ⟨w, hw⟩ := h
        hw (h2 w) )

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  Iff.intro
    (fun h : (∀ x, p x → r) =>
      fun h2 : (∃ x, p x) =>
        let ⟨w, hw⟩ := h2
        (h w) hw)
    (fun h : (∃ x, p x) → r =>
      fun w : α =>
        fun hw : p w =>
          h ⟨w, hw⟩ )

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  Iff.intro
    (fun ⟨b, (hb : p b → r)⟩ =>
     fun h2 : ∀ x, p x =>
     show r from hb (h2 b))
    (fun h1 : (∀ x, p x) → r =>
     show ∃ x, p x → r from
       byCases
         (fun hap : ∀ x, p x => ⟨a, λ _ => h1 hap⟩)
         (fun hnap : ¬ ∀ x, p x =>
          byContradiction
            (fun hnex : ¬ ∃ x, p x → r =>
              have hap : ∀ x, p x :=
                fun x =>
                byContradiction
                  (fun hnp : ¬ p x =>
                    have hex : ∃ x, p x → r := ⟨x, (fun hp => absurd hp hnp)⟩
                    show False from hnex hex)
              show False from hnap hap)))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  Iff.intro
    (fun h : (∃ x, r → p x) =>
      fun hr : r =>
        let ⟨w, hw⟩ := h
        ⟨w, hw hr⟩ )
    (fun h : (r → ∃ x, p x) =>
      byCases
        (fun hr : r =>
          let ⟨w, hw⟩ := h hr
          ⟨w, λ _ => hw⟩  )
        (fun hnr : ¬r =>
          ⟨a, fun hr : r =>
            absurd hr hnr⟩ ))


/- CONJUNCTION -/
variable (p q : Prop)

-- `and.intro h1 h2` builds proof of `p ∧ q` using proofs `h1 : p` and `h2 : p`
  -- is described as the AND-INTRODUCTION rule\
  example (hp : p) (hq : q) : p ∧ q := And.intro hp hq
  #check fun (hp : p) (hq : q) => And.intro hp hq

-- `example` command states a theorem w/o naming or storing permanently - convinient for illustration

/-left and right AND-ELIMINATION rules-/
  -- `and.left h` creates proof of `p` from proof `h : p ∧ q`
  -- `and.right h` is proof of `q`
    example (h : p ∧ q) : p := And.left h
    example (h : p ∧ q) : q := And.right h

    example (h : p ∧ q) : q ∧ p :=
    And.intro (And.right h) (And.left h)

-- note: and-introduction and end-elimination are similar to pairing and projection operations for cartesian product.
-- difference is given `hp : p` and `hq : q`:
  -- `And.intro hp hq` has type `p ∧ q : Prop`
  -- `Prod hp hq` has type `p × q : Type`
-- similarity between ∧ and × is another instance of the Curry-Howard isomorphism tho treated separatedly in Lean.

-- certain types in lean are STRUCTURES: defined w single conanical CONSTRUCTOR which builds an element of the type from a sequence of suitable arguments
  -- ie. For every `p q : Prop`, `p ∧ q` is an example
    -- canonical way to construct is to apply `And.intro` to suitable args `hp : p` amd `hq : q`
    -- lean lets us use anonymous constructor notation notation `⟨arg1, arg2, ...⟩` when relevant type is inductive type and can be inferred from context
    -- in particular, can often write `⟨hp, hq⟩` instead of `And.intro hp hq`
    variable (hp : p) (hq : q)
    #check (⟨hp, hq⟩ : p ∧ q)

-- thus given shorthand syntax, can rewrite as
  variable (p q : Prop)
  example (h : p ∧ q) : q ∧ p :=
    ⟨h.right, h.left⟩

3


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import algebra.iterate_hom
import data.polynomial.eval

/-!
# The derivative map on polynomials

## Main definitions
 * `polynomial.derivative`: The formal derivative of polynomials, expressed as a linear map.

-/

noncomputable theory

open finset
open_locale big_operators classical

namespace polynomial
universes u v w y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type y} {A : Type z} {a b : R} {n : ℕ}

section derivative

section semiring
variables [semiring R]

/-- `derivative p` is the formal derivative of the polynomial `p` -/
def derivative : polynomial R →ₗ[R] polynomial R :=
{ to_fun := λ p, p.sum (λ n a, C (a * n) * X^(n-1)),
  map_add' := λ p q, by rw sum_add_index;
    simp only [add_mul, forall_const, ring_hom.map_add,
      eq_self_iff_true, zero_mul, ring_hom.map_zero],
  map_smul' := λ a p, by dsimp; rw sum_smul_index;
    simp only [mul_sum, ← C_mul', mul_assoc, coeff_C_mul, ring_hom.map_mul, forall_const,
      zero_mul, ring_hom.map_zero, sum] }

lemma derivative_apply (p : polynomial R) :
  derivative p = p.sum (λn a, C (a * n) * X^(n - 1)) := rfl

lemma coeff_derivative (p : polynomial R) (n : ℕ) :
  coeff (derivative p) n = coeff p (n + 1) * (n + 1) :=
begin
  rw [derivative_apply],
  simp only [coeff_X_pow, coeff_sum, coeff_C_mul],
  rw [sum, finset.sum_eq_single (n + 1)],
  simp only [nat.add_succ_sub_one, add_zero, mul_one, if_true, eq_self_iff_true], norm_cast,
  { assume b, cases b,
    { intros, rw [nat.cast_zero, mul_zero, zero_mul], },
    { intros _ H, rw [nat.succ_sub_one b, if_neg (mt (congr_arg nat.succ) H.symm), mul_zero] } },
  { rw [if_pos (add_tsub_cancel_right n 1).symm, mul_one, nat.cast_add, nat.cast_one,
      mem_support_iff],
    intro h, push_neg at h, simp [h], },
end

@[simp]
lemma derivative_zero : derivative (0 : polynomial R) = 0 :=
derivative.map_zero

@[simp]
lemma iterate_derivative_zero {k : ℕ} : derivative^[k] (0 : polynomial R) = 0 :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih], },
end

@[simp]
lemma derivative_monomial (a : R) (n : ℕ) : derivative (monomial n a) = monomial (n - 1) (a * n) :=
by { rw [derivative_apply, sum_monomial_index, C_mul_X_pow_eq_monomial], simp }

lemma derivative_C_mul_X_pow (a : R) (n : ℕ) : derivative (C a * X ^ n) = C (a * n) * X^(n - 1) :=
by rw [C_mul_X_pow_eq_monomial, C_mul_X_pow_eq_monomial, derivative_monomial]

@[simp] lemma derivative_X_pow (n : ℕ) :
  derivative (X ^ n : polynomial R) = (n : polynomial R) * X ^ (n - 1) :=
by convert derivative_C_mul_X_pow (1 : R) n; simp

@[simp] lemma derivative_C {a : R} : derivative (C a) = 0 :=
by simp [derivative_apply]

@[simp] lemma derivative_X : derivative (X : polynomial R) = 1 :=
(derivative_monomial _ _).trans $ by simp

@[simp] lemma derivative_one : derivative (1 : polynomial R) = 0 :=
derivative_C

@[simp] lemma derivative_bit0 {a : polynomial R} : derivative (bit0 a) = bit0 (derivative a) :=
by simp [bit0]

@[simp] lemma derivative_bit1 {a : polynomial R} : derivative (bit1 a) = bit0 (derivative a) :=
by simp [bit1]

@[simp] lemma derivative_add {f g : polynomial R} :
  derivative (f + g) = derivative f + derivative g :=
derivative.map_add f g

@[simp] lemma iterate_derivative_add {f g : polynomial R} {k : ℕ} :
  derivative^[k] (f + g) = (derivative^[k] f) + (derivative^[k] g) :=
derivative.to_add_monoid_hom.iterate_map_add _ _ _

@[simp] lemma derivative_neg {R : Type*} [ring R] (f : polynomial R) :
  derivative (-f) = - derivative f :=
linear_map.map_neg derivative f

@[simp] lemma iterate_derivative_neg {R : Type*} [ring R] {f : polynomial R} {k : ℕ} :
  derivative^[k] (-f) = - (derivative^[k] f) :=
(@derivative R _).to_add_monoid_hom.iterate_map_neg _ _

@[simp] lemma derivative_sub {R : Type*} [ring R] {f g : polynomial R} :
  derivative (f - g) = derivative f - derivative g :=
linear_map.map_sub derivative f g

@[simp] lemma iterate_derivative_sub {R : Type*} [ring R] {k : ℕ} {f g : polynomial R} :
  derivative^[k] (f - g) = (derivative^[k] f) - (derivative^[k] g) :=
begin
  induction k with k ih generalizing f g,
  { simp [nat.iterate], },
  { simp [nat.iterate, ih], }
end

@[simp] lemma derivative_sum {s : finset ι} {f : ι → polynomial R} :
  derivative (∑ b in s, f b) = ∑ b in s, derivative (f b) :=
derivative.map_sum

@[simp] lemma derivative_smul (r : R) (p : polynomial R) : derivative (r • p) = r • derivative p :=
derivative.map_smul _ _

@[simp] lemma iterate_derivative_smul (r : R) (p : polynomial R) (k : ℕ) :
  derivative^[k] (r • p) = r • (derivative^[k] p) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih], },
end

/-- We can't use `derivative_mul` here because
we want to prove this statement also for noncommutative rings.-/
@[simp]
lemma derivative_C_mul (a : R) (p : polynomial R) : derivative (C a * p) = C a * derivative p :=
by convert derivative_smul a p; apply C_mul'

@[simp]
lemma iterate_derivative_C_mul (a : R) (p : polynomial R) (k : ℕ) :
  derivative^[k] (C a * p) = C a * (derivative^[k] p) :=
by convert iterate_derivative_smul a p k; apply C_mul'

end semiring

section comm_semiring
variables [comm_semiring R]

lemma derivative_eval (p : polynomial R) (x : R) :
  p.derivative.eval x = p.sum (λ n a, (a * n)*x^(n-1)) :=
by simp only [derivative_apply, eval_sum, eval_pow, eval_C, eval_X, eval_nat_cast, eval_mul]

@[simp] lemma derivative_mul {f g : polynomial R} :
  derivative (f * g) = derivative f * g + f * derivative g :=
calc derivative (f * g) = f.sum (λn a, g.sum (λm b, C ((a * b) * (n + m : ℕ)) * X^((n + m) - 1))) :
  begin
    rw mul_eq_sum_sum,
    transitivity, exact derivative_sum,
    transitivity, { apply finset.sum_congr rfl, assume x hx, exact derivative_sum },
    apply finset.sum_congr rfl, assume n hn, apply finset.sum_congr rfl, assume m hm,
    transitivity,
    { apply congr_arg, exact monomial_eq_C_mul_X },
    exact derivative_C_mul_X_pow _ _
  end
  ... = f.sum (λn a, g.sum (λm b,
      (C (a * n) * X^(n - 1)) * (C b * X^m) + (C a * X^n) * (C (b * m) * X^(m - 1)))) :
    sum_congr rfl $ assume n hn, sum_congr rfl $ assume m hm,
      by simp only [nat.cast_add, mul_add, add_mul, C_add, C_mul];
      cases n; simp only [nat.succ_sub_succ, pow_zero];
      cases m; simp only [nat.cast_zero, C_0, nat.succ_sub_succ, zero_mul, mul_zero, nat.add_succ,
        tsub_zero, pow_zero, pow_add, one_mul, pow_succ, mul_comm, mul_left_comm]
  ... = derivative f * g + f * derivative g :
    begin
      conv { to_rhs, congr,
        { rw [← sum_C_mul_X_eq g] },
        { rw [← sum_C_mul_X_eq f] } },
      simp only [sum, sum_add_distrib, finset.mul_sum, finset.sum_mul, derivative_apply]
    end

theorem derivative_pow_succ (p : polynomial R) (n : ℕ) :
  (p ^ (n + 1)).derivative = (n + 1) * (p ^ n) * p.derivative :=
nat.rec_on n (by rw [pow_one, nat.cast_zero, zero_add, one_mul, pow_zero, one_mul]) $ λ n ih,
by rw [pow_succ', derivative_mul, ih, mul_right_comm, ← add_mul,
    add_mul (n.succ : polynomial R), one_mul, pow_succ', mul_assoc, n.cast_succ]

theorem derivative_pow (p : polynomial R) (n : ℕ) :
  (p ^ n).derivative = n * (p ^ (n - 1)) * p.derivative :=
nat.cases_on n (by rw [pow_zero, derivative_one, nat.cast_zero, zero_mul, zero_mul]) $ λ n,
by rw [p.derivative_pow_succ n, n.succ_sub_one, n.cast_succ]

lemma derivative_comp (p q : polynomial R) :
  (p.comp q).derivative = q.derivative * p.derivative.comp q :=
begin
  apply polynomial.induction_on' p,
  { intros p₁ p₂ h₁ h₂, simp [h₁, h₂, mul_add], },
  { intros n r,
    simp only [derivative_pow, derivative_mul, monomial_comp, derivative_monomial, derivative_C,
      zero_mul, C_eq_nat_cast, zero_add, ring_hom.map_mul],
    -- is there a tactic for this? (a multiplicative `abel`):
    rw [mul_comm (derivative q)],
    simp only [mul_assoc], }
end

@[simp]
theorem derivative_map [comm_semiring S] (p : polynomial R) (f : R →+* S) :
  (p.map f).derivative = p.derivative.map f :=
polynomial.induction_on p
  (λ r, by rw [map_C, derivative_C, derivative_C, map_zero])
  (λ p q ihp ihq, by rw [map_add, derivative_add, ihp, ihq, derivative_add, map_add])
  (λ n r ih, by rw [map_mul, map_C, map_pow, map_X,
      derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one,
      derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one,
      map_mul, map_C, map_mul, map_pow, map_add, map_nat_cast, map_one, map_X])

@[simp]
theorem iterate_derivative_map [comm_semiring S] (p : polynomial R) (f : R →+* S) (k : ℕ):
  polynomial.derivative^[k] (p.map f) = (polynomial.derivative^[k] p).map f :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih], },
end

/-- Chain rule for formal derivative of polynomials. -/
theorem derivative_eval₂_C (p q : polynomial R) :
  (p.eval₂ C q).derivative = p.derivative.eval₂ C q * q.derivative :=
polynomial.induction_on p
  (λ r, by rw [eval₂_C, derivative_C, eval₂_zero, zero_mul])
  (λ p₁ p₂ ih₁ ih₂, by rw [eval₂_add, derivative_add, ih₁, ih₂, derivative_add, eval₂_add, add_mul])
  (λ n r ih, by rw [pow_succ', ← mul_assoc, eval₂_mul, eval₂_X, derivative_mul, ih,
      @derivative_mul _ _ _ X, derivative_X, mul_one, eval₂_add, @eval₂_mul _ _ _ _ X, eval₂_X,
      add_mul, mul_right_comm])

theorem derivative_prod {s : multiset ι} {f : ι → polynomial R} :
  (multiset.map f s).prod.derivative =
  (multiset.map (λ i, (multiset.map f (s.erase i)).prod * (f i).derivative) s).sum :=
begin
  refine multiset.induction_on s (by simp) (λ i s h, _),
  rw [multiset.map_cons, multiset.prod_cons, derivative_mul, multiset.map_cons _ i s,
    multiset.sum_cons, multiset.erase_cons_head, mul_comm (f i).derivative],
  congr,
  rw [h, ← add_monoid_hom.coe_mul_left, (add_monoid_hom.mul_left (f i)).map_multiset_sum _,
    add_monoid_hom.coe_mul_left],
  simp only [function.comp_app, multiset.map_map],
  congr' 1,
  refine multiset.map_congr (λ j hj, _),
  simp only [function.comp_app],
  rw [← mul_assoc, ← multiset.prod_cons, ← multiset.map_cons],
  congr' 1,
  by_cases hij : i = j,
  { simp [hij, ← multiset.prod_cons, ← multiset.map_cons, multiset.cons_erase hj] },
  { simp [hij] }
end

theorem of_mem_support_derivative {p : polynomial R} {n : ℕ} (h : n ∈ p.derivative.support) :
  n + 1 ∈ p.support :=
mem_support_iff.2 $ λ (h1 : p.coeff (n+1) = 0), mem_support_iff.1 h $
show p.derivative.coeff n = 0, by rw [coeff_derivative, h1, zero_mul]

theorem degree_derivative_lt {p : polynomial R} (hp : p ≠ 0) : p.derivative.degree < p.degree :=
(finset.sup_lt_iff $ bot_lt_iff_ne_bot.2 $ mt degree_eq_bot.1 hp).2 $ λ n hp, lt_of_lt_of_le
(with_bot.some_lt_some.2 n.lt_succ_self) $ finset.le_sup $ of_mem_support_derivative hp

theorem nat_degree_derivative_lt {p : polynomial R} (hp : p.derivative ≠ 0) :
  p.derivative.nat_degree < p.nat_degree :=
have hp1 : p ≠ 0, from λ h, hp $ by rw [h, derivative_zero],
with_bot.some_lt_some.1 $
begin
  rw [nat_degree, option.get_or_else_of_ne_none $ mt degree_eq_bot.1 hp, nat_degree,
    option.get_or_else_of_ne_none $ mt degree_eq_bot.1 hp1],
  exact degree_derivative_lt hp1
end

theorem degree_derivative_le {p : polynomial R} : p.derivative.degree ≤ p.degree :=
if H : p = 0 then le_of_eq $ by rw [H, derivative_zero] else le_of_lt $ degree_derivative_lt H

/-- The formal derivative of polynomials, as linear homomorphism. -/
def derivative_lhom (R : Type*) [comm_ring R] : polynomial R →ₗ[R] polynomial R :=
{ to_fun    := derivative,
  map_add'  := λ p q, derivative_add,
  map_smul' := λ r p, derivative_smul r p }

@[simp] lemma derivative_lhom_coe {R : Type*} [comm_ring R] :
  (polynomial.derivative_lhom R : polynomial R → polynomial R) = polynomial.derivative :=
rfl

@[simp] lemma derivative_cast_nat {n : ℕ} : derivative (n : polynomial R) = 0 :=
begin
  rw ← C.map_nat_cast n,
  exact derivative_C,
end

@[simp] lemma iterate_derivative_cast_nat_mul {n k : ℕ} {f : polynomial R} :
  derivative^[k] (n * f) = n * (derivative^[k] f) :=
begin
  induction k with k ih generalizing f,
  { simp [nat.iterate], },
  { simp [nat.iterate, ih], }
end

end comm_semiring

section comm_ring
variables [comm_ring R]

lemma derivative_comp_one_sub_X (p : polynomial R) :
  (p.comp (1-X)).derivative = -p.derivative.comp (1-X) :=
by simp [derivative_comp]

@[simp]
lemma iterate_derivative_comp_one_sub_X (p : polynomial R) (k : ℕ) :
  derivative^[k] (p.comp (1-X)) = (-1)^k * (derivative^[k] p).comp (1-X) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih p.derivative, iterate_derivative_neg, derivative_comp, pow_succ], },
end

end comm_ring

section is_domain
variables [ring R] [is_domain R]

lemma mem_support_derivative [char_zero R] (p : polynomial R) (n : ℕ) :
  n ∈ (derivative p).support ↔ n + 1 ∈ p.support :=
suffices (¬(coeff p (n + 1) = 0 ∨ ((n + 1:ℕ) : R) = 0)) ↔ coeff p (n + 1) ≠ 0,
  by simpa only [mem_support_iff, coeff_derivative, ne.def, mul_eq_zero],
by { rw [nat.cast_eq_zero], simp only [nat.succ_ne_zero, or_false] }

@[simp] lemma degree_derivative_eq [char_zero R] (p : polynomial R) (hp : 0 < nat_degree p) :
  degree (derivative p) = (nat_degree p - 1 : ℕ) :=
begin
  have h0 : p ≠ 0,
  { contrapose! hp,
    simp [hp] },
  apply le_antisymm,
  { rw derivative_apply,
    apply le_trans (degree_sum_le _ _) (sup_le (λ n hn, _)),
    apply le_trans (degree_C_mul_X_pow_le _ _) (with_bot.coe_le_coe.2 (tsub_le_tsub_right _ _)),
    apply le_nat_degree_of_mem_supp _ hn },
  { refine le_sup _,
    rw [mem_support_derivative, tsub_add_cancel_of_le, mem_support_iff],
    { show ¬ leading_coeff p = 0,
      rw [leading_coeff_eq_zero],
      assume h, rw [h, nat_degree_zero] at hp,
      exact lt_irrefl 0 (lt_of_le_of_lt (zero_le _) hp), },
    exact hp }
end

theorem nat_degree_eq_zero_of_derivative_eq_zero
  [char_zero R] {f : polynomial R} (h : f.derivative = 0) :
  f.nat_degree = 0 :=
begin
  by_cases hf : f = 0,
  { exact (congr_arg polynomial.nat_degree hf).trans rfl },
  { rw nat_degree_eq_zero_iff_degree_le_zero,
    by_contra absurd,
    have f_nat_degree_pos : 0 < f.nat_degree,
    { rwa [not_le, ←nat_degree_pos_iff_degree_pos] at absurd },
    let m := f.nat_degree - 1,
    have hm : m + 1 = f.nat_degree := tsub_add_cancel_of_le f_nat_degree_pos,
    have h2 := coeff_derivative f m,
    rw polynomial.ext_iff at h,
    rw [h m, coeff_zero, zero_eq_mul] at h2,
    cases h2,
    { rw [hm, ←leading_coeff, leading_coeff_eq_zero] at h2,
      exact hf h2, },
    { norm_cast at h2 } }
end

end is_domain

end derivative
end polynomial


/- Propositional tableaux prover from Jeremy Avigad's lecture notes. -/

open expr tactic classical

variables {p q r s : Prop}
variables {a b c d e : Prop}

section

local attribute [instance] classical.prop_decidable

  theorem not_or_of_imp (h : a → b) : ¬ a ∨ b :=
  if ha : a then or.inr (h ha) else or.inl ha

  theorem imp_iff_not_or : (a → b) ↔ (¬ a ∨ b) :=
  ⟨not_or_of_imp, or.neg_resolve_left⟩

  theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
  iff_iff_implies_and_implies _ _

  theorem not_not : ¬¬a ↔ a :=
  iff.intro by_contradiction not_not_intro

  theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
  ⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
   λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩

  theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b)
  | ⟨ha, hb⟩ := or.elim h (absurd ha) (absurd hb)

  theorem not_and_distrib : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
  ⟨λ h, if ha : a then or.inr (λ hb, h ⟨ha, hb⟩) else or.inl ha, not_and_of_not_or_not⟩

end

meta def normalize : tactic unit :=
`[ try { simp only
   [ not_or_distrib,
     not_and_distrib,
     not_not,
     imp_iff_not_or,
     not_true_iff,
     not_false_iff,
     iff_def ] at * } ]

meta def find_conj : list expr → tactic expr
| []        := failed
| (e :: es) := do t ← infer_type e,
                  match t with
                  | `(%%a ∧ %%b) := return e
                  | _            := find_conj es
                  end

meta def find_disj : list expr → tactic expr
| []        := failed
| (e :: es) := do t ← infer_type e,
                  match t with
                  | `(%%a ∨ %%b) := return e
                  | _            := find_disj es
                  end

meta def split_conj : tactic unit :=
do l ← local_context,
   e ← find_conj l,
   cases e,
   skip

meta def split_conjs : tactic unit :=
repeat split_conj

meta def split_disj : tactic unit :=
do l ← local_context,
   e ← find_disj l,
   cases e,
   skip

meta def proof_by_contradiction : tactic unit :=
do refine ``(classical.by_contradiction _),
   intro `_,
   skip

meta def tab_aux : tactic unit :=
do split_conjs,
   contradiction <|>
     (split_disj >> tab_aux >> tab_aux)

meta def tab : tactic unit :=
do proof_by_contradiction,
   normalize,
   tab_aux

example : a ∧ b → b ∧ a := by tab
example : a ∧ (a → b) → b := by tab

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by tab
example : p ∨ q ↔ q ∨ p := by tab

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by tab
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by tab

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by tab
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by tab

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by tab
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by tab
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by tab
example : ¬p ∨ ¬q → ¬(p ∧ q) := by tab
example : ¬(p ∧ ¬p) := by tab
example : p ∧ ¬q → ¬(p → q) := by tab
example : ¬p → (p → q) := by tab
example : (¬p ∨ q) → (p → q) := by tab
example : p ∨ false ↔ p := by tab
example : p ∧ false ↔ false := by tab
example : ¬(p ↔ ¬p) := by tab
example : (p → q) → (¬q → ¬p) := by tab

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by tab
example : ¬(p ∧ q) → ¬p ∨ ¬q := by tab
example : ¬(p → q) → p ∧ ¬q := by tab
example : (p → q) → (¬p ∨ q) := by tab
example : (¬q → ¬p) → (p → q) := by tab
example : p ∨ ¬p := by tab
example : (((p → q) → p) → p) := by tab

example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∨ c := by tab

example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∧ ¬ c := by tab

example : ((a → b) → a) → a := by tab

example : (a → b) ∧ (b → c) → a → c := by tab

example (α : Type) (x y z w : α) :
  x = y ∧ (x = y → z = w) → z = w := by tab

example : ¬ (a ↔ ¬ a) := by tab


theorem succ_eq_succ_iff (a b : ℕ) : nat.succ a = nat.succ b ↔ a = b :=
begin
    split,
    intro h,
    exact nat.succ.inj h,
    intro f,
    repeat {rw nat.succ_eq_add_one},
    rw f,
end


import basic_defs_world.level1 -- hide

/- Axiom : A set A is the neighborhood of a point x if there is an open U such that x ∈ U ⊆ A.
is_neighborhood : ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ A
-/

/- Axiom : A point x is an interior point of A if A is a neighborhood of x.
is_interior_point : is_neighborhood x A
-/

/- Axiom : The interior of a set A is the set of all its interior points.
interior := { x : X | is_interior_point x A }
-/

/-
In this world we will end up having three alternative definitions of the interior of a set.
This will be very useful, because at any point we will be able to choose the one that better fits our needs.

First of all we need to figure out what properties does the interior of an arbitrary set have... So we start with an easy one:

# Level 1: The interior is contained in the original set

-/
variables {X : Type} -- hide
variables [topological_space X] (x : X)  (A : set X) -- hide

namespace topological_space -- hide

@[simp]  -- hide
/- Lemma
The interior of any set A is contained in the set A.
-/
lemma interior_is_subset: interior A ⊆ A :=
begin
  rintros x ⟨_, _⟩,
  tauto,

end

end topological_space -- hide


/-
The goal of this file is to express basis coordinates in terms of the inner product.

-- Checked over by:
-- Hans
-/

import analysis.inner_product_space.pi_L2

notation `ℂ^` n := euclidean_space ℂ (fin n)

open_locale big_operators

variables {n : ℕ} (b : basis (fin n) ℂ ℂ^n) (v : ℂ^n) (hon : orthonormal ℂ b)

/-
Basis coordinates are given by the inner product.
-/
lemma onb_coords_eq_inner (i : fin n) (hon : orthonormal ℂ b) :
  (b.repr v) i = ⟪ b i, v ⟫_ℂ :=
begin
  rw orthonormal_iff_ite at hon,
  specialize hon i,
  conv
  begin
    to_rhs,
    rw ← b.sum_repr v,
    rw inner_sum,
    congr,
    skip,
    funext,
    rw inner_smul_right,
    rw hon,
    simp,
  end,
  rw finset.sum_ite,
  simp only [add_zero, finset.sum_const_zero, finset.filter_congr_decidable, finset.sum_congr],
  rw finset.filter_eq,
  simp only [finset.mem_univ, if_true, eq_self_iff_true, finset.sum_singleton, finset.sum_congr],
end

/-
Basis coordinates are given by the inner product.
-/
lemma onb_sum_repr (hon : orthonormal ℂ b):
  v = ∑ (i : (fin n)), ⟪b i, v⟫_ℂ • (b i) :=
begin
  conv
  begin
    congr,
    skip,
    congr,
    skip,
    funext,
    rw ← onb_coords_eq_inner b v i hon,
  end,
  symmetry,
  apply basis.sum_repr,
end


import tactic --hide

/-
## `left` and `right`

If your lemma has the goal:

```
⊢ P ∨ Q
```

then   <mark style ="background-color : #ebdef0 ">`left`</mark>  changes the goal to `⊢ P`.
Similarly,  <mark style ="background-color : #ebdef0 ">`right`</mark>  changes the goal to `⊢ Q`.
-/

/-Hint : Why does this work?
The logic is that `P` implies `P ∨ Q` so it is enough to prove `P`.

-/

/-Lemma
Let $P,Q$ be logical statements and assume $P$ is true, then $P ∨ Q$ is true.
-/
lemma left_example (P Q : Prop) (p : P) : P ∨ Q :=
begin
  left,
  exact p,
end

/- Tactic : left and right

If your lemma has the goal:

```
⊢ P ∨ Q
```

then `left` changes the goal to `⊢ P`. Similarly `right` changes the goal to `⊢ Q`.

-/