/-
Copyright (c) 2015 Haitao Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Author : Haitao Zhang
-/

import data algebra.group algebra.group_power .finsubg .hom .perm

open function finset
open eq.ops

namespace group_theory

section cyclic
open nat fin list
local attribute madd [reducible]

variable {A : Type}
variable [ambG : group A]
include ambG

lemma pow_mod {a : A} {n m : nat} : a ^ m = 1 → a ^ n = a ^ (n % m) :=
assume Pid,
have a ^ (n / m * m) = 1, from calc
  a ^ (n / m * m) = a ^ (m * (n / m))   : by rewrite (mul.comm (n / m) m)
                ... = (a ^ m) ^ (n / m) : by rewrite pow_mul
                ... = 1 ^ (n / m)       : by rewrite Pid
                ... = 1                 : one_pow (n / m),
calc a ^ n = a ^ (n / m * m + n % m)       : by rewrite -(eq_div_mul_add_mod n m)
       ... = a ^ (n / m * m) * a ^ (n % m) : by rewrite pow_add
       ... = 1 * a ^ (n % m)               : by rewrite this
       ... = a ^ (n % m)                   : by rewrite one_mul

lemma pow_sub_eq_one_of_pow_eq {a : A} {i j : nat} :
  a^i = a^j → a^(i - j) = 1 :=
assume Pe, or.elim (lt_or_ge i j)
  (assume Piltj, begin rewrite [sub_eq_zero_of_le (nat.le_of_lt Piltj)] end)
  (assume Pigej, begin rewrite [pow_sub a Pigej, Pe, mul.right_inv] end)

lemma pow_dist_eq_one_of_pow_eq {a : A} {i j : nat} :
  a^i = a^j → a^(dist i j) = 1 :=
assume Pe, or.elim (lt_or_ge i j)
  (suppose i < j, by rewrite [dist_eq_sub_of_lt this]; exact pow_sub_eq_one_of_pow_eq (eq.symm Pe))
  (suppose i ≥ j, by rewrite [dist_eq_sub_of_ge this]; exact pow_sub_eq_one_of_pow_eq Pe)

lemma pow_madd {a : A} {n : nat} {i j : fin (succ n)} :
  a^(succ n) = 1 → a^(val (i + j)) = a^i * a^j :=
assume Pe, calc
a^(val (i + j)) = a^((i + j) % (succ n)) : rfl
            ... = a^(val i + val j)      : by rewrite [-pow_mod Pe]
            ... = a^i * a^j              : by rewrite pow_add

lemma mk_pow_mod {a : A} {n m : nat} : a ^ (succ m) = 1 → a ^ n = a ^ (mk_mod m n) :=
assume Pe, pow_mod Pe

variable [finA : fintype A]
include finA

open fintype

variable [deceqA : decidable_eq A]
include deceqA

lemma exists_pow_eq_one (a : A) : ∃ n, n < card A ∧ a ^ (succ n) = 1 :=
let f := (λ i : fin (succ (card A)), a ^ i) in
have Pninj : ¬(injective f), from assume Pinj,
  absurd (card_le_of_inj _ _ (exists.intro f Pinj))
    (begin rewrite [card_fin], apply not_succ_le_self end),
obtain i₁ P₁, from exists_not_of_not_forall Pninj,
obtain i₂ P₂, from exists_not_of_not_forall P₁,
obtain Pfe Pne, from and_not_of_not_implies P₂,
have Pvne : val i₁ ≠ val i₂, from assume Pveq, absurd (eq_of_veq Pveq) Pne,
exists.intro (pred (dist i₁ i₂)) (begin
  rewrite [succ_pred_of_pos (dist_pos_of_ne Pvne)], apply and.intro,
    apply lt_of_succ_lt_succ,
    rewrite [succ_pred_of_pos (dist_pos_of_ne Pvne)],
    apply nat.lt_of_le_of_lt dist_le_max (max_lt i₁ i₂),
    apply pow_dist_eq_one_of_pow_eq Pfe
  end)

-- Another possibility is to generate a list of powers and use find to get the first
-- unity.
-- The bound on bex is arbitrary as long as it is large enough (at least card A). Making
-- it larger simplifies some proofs, such as a ∈ cyc a.
definition cyc (a : A) : finset A := {x ∈ univ | bex (succ (card A)) (λ n, a ^ n = x)}

definition order (a : A) := card (cyc a)

definition pow_fin (a : A) (n : nat) (i : fin (order a)) := a ^ (i + n)

definition cyc_pow_fin (a : A) (n : nat) : finset A := image (pow_fin a n) univ

lemma order_le_group_order {a : A} : order a ≤ card A :=
card_le_card_of_subset !subset_univ

lemma cyc_has_one (a : A) : 1 ∈ cyc a :=
begin
  apply mem_sep_of_mem !mem_univ,
  existsi 0, apply and.intro,
    apply zero_lt_succ,
    apply pow_zero
end

lemma order_pos (a : A) : 0 < order a :=
length_pos_of_mem (cyc_has_one a)

lemma cyc_mul_closed (a : A) : finset_mul_closed_on (cyc a) :=
take g h, assume Pgin Phin,
obtain n Plt Pe, from exists_pow_eq_one a,
obtain i Pilt Pig, from of_mem_sep Pgin,
obtain j Pjlt Pjh, from of_mem_sep Phin,
begin
  rewrite [-Pig, -Pjh, -pow_add, pow_mod Pe],
  apply mem_sep_of_mem !mem_univ,
  existsi ((i + j) % (succ n)), apply and.intro,
    apply nat.lt_trans (mod_lt (i+j) !zero_lt_succ) (succ_lt_succ Plt),
    apply rfl
end

lemma cyc_has_inv (a : A) : finset_has_inv (cyc a) :=
take g, assume Pgin,
obtain n Plt Pe, from exists_pow_eq_one a,
obtain i Pilt Pig, from of_mem_sep Pgin,
let ni := -(mk_mod n i) in
have Pinv : g*a^ni = 1, by
  rewrite [-Pig, mk_pow_mod Pe, -(pow_madd Pe), add.right_inv],
begin
  rewrite [inv_eq_of_mul_eq_one Pinv],
  apply mem_sep_of_mem !mem_univ,
  existsi ni, apply and.intro,
    apply nat.lt_trans (is_lt ni) (succ_lt_succ Plt),
    apply rfl
end

lemma self_mem_cyc (a : A) : a ∈ cyc a :=
mem_sep_of_mem !mem_univ
  (exists.intro (1 : nat) (and.intro (succ_lt_succ card_pos) !pow_one))

lemma mem_cyc (a : A) : ∀ {n : nat}, a^n ∈ cyc a
| 0        := cyc_has_one a
| (succ n) :=
  begin rewrite pow_succ', apply cyc_mul_closed a, exact mem_cyc, apply self_mem_cyc end

lemma order_le {a : A} {n : nat} : a^(succ n) = 1 → order a ≤ succ n :=
assume Pe, let s := image (pow_nat a) (upto (succ n)) in
have Psub: cyc a ⊆ s, from subset_of_forall
  (take g, assume Pgin, obtain i Pilt Pig, from of_mem_sep Pgin, begin
  rewrite [-Pig, pow_mod Pe],
  apply mem_image,
    apply mem_upto_of_lt (mod_lt i !zero_lt_succ),
    exact rfl end),
#nat calc order a ≤ card s               : card_le_card_of_subset Psub
              ... ≤ card (upto (succ n)) : !card_image_le
              ... = succ n               : card_upto (succ n)

lemma pow_ne_of_lt_order {a : A} {n : nat} : succ n < order a → a^(succ n) ≠ 1 :=
assume Plt, not_imp_not_of_imp order_le (not_le_of_gt Plt)

lemma eq_zero_of_pow_eq_one {a : A} : ∀ {n : nat}, a^n = 1 → n < order a → n = 0
| 0        := assume Pe Plt, rfl
| (succ n) := assume Pe Plt, absurd Pe (pow_ne_of_lt_order Plt)

lemma pow_fin_inj (a : A) (n : nat) : injective (pow_fin a n) :=
take i j : fin (order a),
suppose a^(i + n) = a^(j + n),
have    a^(dist i j) = 1, begin apply !dist_add_add_right ▸ (pow_dist_eq_one_of_pow_eq this) end,
have    dist i j = 0,     from
  eq_zero_of_pow_eq_one this (nat.lt_of_le_of_lt dist_le_max (max_lt i j)),
eq_of_veq (eq_of_dist_eq_zero this)

lemma cyc_eq_cyc (a : A) (n : nat) : cyc_pow_fin a n = cyc a :=
have Psub : cyc_pow_fin a n ⊆ cyc a, from subset_of_forall
  (take g, assume Pgin,
  obtain i Pin Pig, from exists_of_mem_image Pgin, by rewrite [-Pig]; apply mem_cyc),
eq_of_card_eq_of_subset (begin apply eq.trans,
    apply card_image_eq_of_inj_on,
      rewrite [to_set_univ, -set.injective_iff_inj_on_univ], exact pow_fin_inj a n,
    rewrite [card_fin] end) Psub

lemma pow_order (a : A) : a^(order a) = 1 :=
obtain i Pin Pone, from exists_of_mem_image (eq.symm (cyc_eq_cyc a 1) ▸ cyc_has_one a),
or.elim (eq_or_lt_of_le (succ_le_of_lt (is_lt i)))
  (assume P, P ▸ Pone) (assume P, absurd Pone (pow_ne_of_lt_order P))

lemma eq_one_of_order_eq_one {a : A} : order a = 1 → a = 1 :=
assume Porder,
calc a = a^1         : by rewrite (pow_one a)
   ... = a^(order a) : by rewrite Porder
   ... = 1           : by rewrite pow_order

lemma order_of_min_pow {a : A} {n : nat}
  (Pone : a^(succ n) = 1) (Pmin : ∀ i, i < n → a^(succ i) ≠ 1) : order a = succ n :=
or.elim (eq_or_lt_of_le (order_le Pone)) (λ P, P)
  (λ P : order a < succ n, begin
  have Pn : a^(order a) ≠ 1,
  begin
    rewrite [-(succ_pred_of_pos (order_pos a))],
    apply Pmin, apply nat.lt_of_succ_lt_succ,
    rewrite [succ_pred_of_pos !order_pos], assumption
  end,
  exact absurd (pow_order a) Pn end)

lemma order_dvd_of_pow_eq_one {a : A} {n : nat} (Pone : a^n = 1) : order a ∣ n :=
have Pe : a^(n % order a) = 1, from
  begin
    revert Pone,
    rewrite [eq_div_mul_add_mod n (order a) at {1}, pow_add, mul.comm _ (order a), pow_mul, pow_order, one_pow, one_mul],
    intros, assumption
  end,
dvd_of_mod_eq_zero (eq_zero_of_pow_eq_one Pe (mod_lt n !order_pos))

definition cyc_is_finsubg [instance] (a : A) : is_finsubg (cyc a) :=
is_finsubg.mk (cyc_has_one a) (cyc_mul_closed a) (cyc_has_inv a)

lemma order_dvd_group_order (a : A) : order a ∣ card A :=
dvd.intro (eq.symm (!mul.comm ▸ lagrange_theorem (subset_univ (cyc a))))

definition pow_fin' (a : A) (i : fin (succ (pred (order a)))) := pow_nat a i

local attribute group_of_add_group [instance]

lemma pow_fin_hom (a : A) : homomorphic (pow_fin' a) :=
take i j : fin (succ (pred (order a))),
begin
  rewrite [↑pow_fin'],
  apply pow_madd,
  rewrite [succ_pred_of_pos !order_pos],
  exact pow_order a
end

definition pow_fin_is_iso (a : A) : is_iso_class (pow_fin' a) :=
is_iso_class.mk (pow_fin_hom a)
  (have H : injective (λ (i : fin (order a)), a ^ (val i + 0)), from pow_fin_inj a 0,
    begin rewrite [↑pow_fin', succ_pred_of_pos !order_pos]; exact H end)

end cyclic

section rot
open nat list
open fin fintype list

section
local attribute group_of_add_group [instance]
lemma pow_eq_mul {n : nat} {i : fin (succ n)} : ∀ {k : nat}, i^k = mk_mod n (i*k)
| 0        := by rewrite [pow_zero]
| (succ k) := begin
  have Psucc : i^(succ k) = madd (i^k) i, by apply pow_succ',
  rewrite [Psucc, pow_eq_mul],
  apply eq_of_veq,
  rewrite [mul_succ, val_madd, ↑mk_mod, mod_add_mod]
  end

end

definition rotl : ∀ {n : nat} m : nat, fin n → fin n
| 0        := take m i, elim0 i
| (succ n) := take m, madd (mk_mod n (n*m))

definition rotr : ∀ {n : nat} m : nat, fin n → fin n
| 0        := take m i, elim0 i
| (succ n) := take m, madd (-(mk_mod n (n*m)))

lemma rotl_succ' {n m : nat} : rotl m = madd (mk_mod n (n*m)) := rfl

lemma rotl_zero : ∀ {n : nat}, @rotl n 0 = id
| 0        := funext take i, elim0 i
| (nat.succ n) := funext take i, begin rewrite [↑rotl, mul_zero, mk_mod_zero_eq, zero_madd] end

lemma rotl_id : ∀ {n : nat}, @rotl n n = id
| 0        := funext take i, elim0 i
| (nat.succ n) :=
  have P : mk_mod n (n * succ n) = mk_mod n 0,
    from eq_of_veq (by rewrite [↑mk_mod, mul_mod_left]),
  begin rewrite [rotl_succ', P], apply rotl_zero end

lemma rotl_to_zero {n i : nat} : rotl i (mk_mod n i) = 0 :=
eq_of_veq begin rewrite [↑rotl, val_madd], esimp [mk_mod], rewrite [ mod_add_mod, add_mod_mod, -succ_mul, mul_mod_right] end

lemma rotl_compose : ∀ {n : nat} {j k : nat}, (@rotl n j) ∘ (rotl k) = rotl (j + k)
| 0        := take j k, funext take i, elim0 i
| (succ n) :=  take j k, funext take i, eq.symm begin
  rewrite [*rotl_succ', left_distrib, -(@madd_mk_mod n (n*j)), madd_assoc],
  end

lemma rotr_rotl : ∀ {n : nat} (m : nat) {i : fin n}, rotr m (rotl m i) = i
| 0            := take m i, elim0 i
| (nat.succ n) := take m i, calc (-(mk_mod n (n*m))) + ((mk_mod n (n*m)) + i) = i : by rewrite neg_add_cancel_left

lemma rotl_rotr : ∀ {n : nat} (m : nat), (@rotl n m) ∘ (rotr m) = id
| 0            := take m, funext take i, elim0 i
| (nat.succ n) := take m, funext take i, calc (mk_mod n (n*m)) + (-(mk_mod n (n*m)) + i) = i : add_neg_cancel_left

lemma rotl_succ {n : nat} : (rotl 1) ∘ (@succ n) = lift_succ :=
funext (take i, eq_of_veq (begin rewrite [↑comp, ↑rotl, ↑madd, mul_one n, ↑mk_mod, mod_add_mod, ↑lift_succ, val_succ, -succ_add_eq_succ_add, add_mod_self_left, mod_eq_of_lt (lt.trans (is_lt i) !lt_succ_self), -val_lift] end))

definition list.rotl {A : Type} : ∀ l : list A, list A
| []     := []
| (a::l) := l++[a]

lemma rotl_cons {A : Type} {a : A} {l} : list.rotl (a::l) = l++[a] := rfl

lemma rotl_map {A B : Type} {f : A → B} : ∀ {l : list A}, list.rotl (map f l) = map f (list.rotl l)
| []     := rfl
| (a::l) := begin rewrite [map_cons, *rotl_cons, map_append] end

lemma rotl_eq_rotl : ∀ {n : nat}, map (rotl 1) (upto n) = list.rotl (upto n)
| 0        := rfl
| (succ n) := begin
  rewrite [upto_step at {1}, fin.upto_succ, rotl_cons, map_append],
  congruence,
    rewrite [map_map], congruence, exact rotl_succ,
    rewrite [map_singleton], congruence, rewrite [↑rotl, mul_one n, ↑mk_mod, ↑maxi, ↑madd],
      congruence, rewrite [ mod_add_mod, val_zero, add_zero, mod_eq_of_lt !lt_succ_self ]
  end

definition seq [reducible] (A : Type) (n : nat) := fin n → A

variable {A : Type}

definition rotl_fun {n : nat} (m : nat) (f : seq A n) : seq A n := f ∘ (rotl m)
definition rotr_fun {n : nat} (m : nat) (f : seq A n) : seq A n := f ∘ (rotr m)

lemma rotl_seq_zero {n : nat} : rotl_fun 0 = @id (seq A n) :=
funext take f, begin rewrite [↑rotl_fun, rotl_zero] end

lemma rotl_seq_ne_id : ∀ {n : nat}, (∃ a b : A, a ≠ b) → ∀ i, i < n → rotl_fun (succ i) ≠ (@id (seq A (succ n)))
| 0            := assume Pex, take i, assume Piltn, absurd Piltn !not_lt_zero
| (nat.succ n) := assume Pex, obtain a b Pne, from Pex, take i, assume Pilt,
  let f := (λ j : fin (succ (succ n)), if j = 0 then a else b),
      fi := mk_mod (succ n) (succ i) in
  have Pfne : rotl_fun (succ i) f fi ≠ f fi,
    from begin rewrite [↑rotl_fun, rotl_to_zero, mk_mod_of_lt (succ_lt_succ Pilt), if_pos rfl, if_neg mk_succ_ne_zero], assumption end,
  have P : rotl_fun (succ i) f ≠ f, from
    assume Peq, absurd (congr_fun Peq fi) Pfne,
  assume Peq, absurd (congr_fun Peq f) P

lemma rotr_rotl_fun {n : nat} (m : nat) (f : seq A n) : rotr_fun m (rotl_fun m f) = f :=
calc f ∘ (rotl m) ∘ (rotr m) = f ∘ ((rotl m) ∘ (rotr m)) : by rewrite -comp.assoc
                         ... = f ∘ id                    : by rewrite (rotl_rotr m)

lemma rotl_fun_inj {n : nat} {m : nat} : @injective (seq A n) (seq A n) (rotl_fun m) :=
injective_of_has_left_inverse (exists.intro (rotr_fun m) (rotr_rotl_fun m))

lemma seq_rotl_eq_list_rotl {n : nat} (f : seq A n) :
  fun_to_list (rotl_fun 1 f) = list.rotl (fun_to_list f) :=
begin
  rewrite [↑fun_to_list, ↑rotl_fun, -map_map, rotl_map],
  congruence, exact rotl_eq_rotl
end

end rot

section rotg
open nat fin fintype

definition rotl_perm [reducible] (A : Type) [finA : fintype A] [deceqA : decidable_eq A] (n : nat) (m : nat) : perm (seq A n) :=
perm.mk (rotl_fun m) rotl_fun_inj

variable {A : Type}
variable [finA : fintype A]
variable [deceqA : decidable_eq A]
variable {n : nat}
include finA deceqA

lemma rotl_perm_mul {i j : nat} : (rotl_perm A n i) * (rotl_perm A n j) = rotl_perm A n (j+i) :=
eq_of_feq (funext take f, calc
  f ∘ (rotl j) ∘ (rotl i) = f ∘ ((rotl j) ∘ (rotl i)) : by rewrite -comp.assoc
                      ... = f ∘ (rotl (j+i))          : by rewrite rotl_compose)

lemma rotl_perm_pow_eq : ∀ {i : nat}, (rotl_perm A n 1) ^ i = rotl_perm A n i
| 0        := begin rewrite [pow_zero, ↑rotl_perm, perm_one, -eq_iff_feq], esimp, rewrite rotl_seq_zero  end
| (succ i) := begin rewrite [pow_succ', rotl_perm_pow_eq, rotl_perm_mul, one_add] end

lemma rotl_perm_pow_eq_one : (rotl_perm A n 1) ^ n = 1 :=
eq.trans rotl_perm_pow_eq (eq_of_feq begin esimp [rotl_perm], rewrite [↑rotl_fun, rotl_id] end)

lemma rotl_perm_mod {i : nat} : rotl_perm A n i = rotl_perm A n (i % n) :=
calc rotl_perm A n i = (rotl_perm A n 1) ^ i       : by rewrite rotl_perm_pow_eq
                 ... = (rotl_perm A n 1) ^ (i % n) : by rewrite (pow_mod rotl_perm_pow_eq_one)
                 ... = rotl_perm A n (i % n)       : by rewrite rotl_perm_pow_eq

-- needs A to have at least two elements!
lemma rotl_perm_pow_ne_one (Pex : ∃ a b : A, a ≠ b) : ∀ i, i < n → (rotl_perm A (succ n) 1)^(succ i) ≠ 1 :=
take i, assume Piltn, begin
  intro P, revert P, rewrite [rotl_perm_pow_eq, -eq_iff_feq, perm_one, *perm.f_mk],
  intro P, exact absurd P (rotl_seq_ne_id Pex i Piltn)
end

lemma rotl_perm_order (Pex : ∃ a b : A, a ≠ b) : order (rotl_perm A (succ n) 1) = (succ n) :=
order_of_min_pow rotl_perm_pow_eq_one (rotl_perm_pow_ne_one Pex)

end rotg
end group_theory


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Patrick Stevens
-/
import data.nat.choose.basic
import tactic.linarith
import algebra.big_operators.ring
import algebra.big_operators.intervals
import algebra.big_operators.order
/-!
# Sums of binomial coefficients

This file includes variants of the binomial theorem and other results on sums of binomial
coefficients. Theorems whose proofs depend on such sums may also go in this file for import
reasons.

-/
open nat
open finset

open_locale big_operators

variables {R : Type*}

/-- A version of the binomial theorem for noncommutative semirings. -/
theorem commute.add_pow [semiring R] {x y : R} (h : commute x y) (n : ℕ) :
  (x + y) ^ n = ∑ m in range (n + 1), x ^ m * y ^ (n - m) * choose n m :=
begin
  let t : ℕ → ℕ → R := λ n m, x ^ m * (y ^ (n - m)) * (choose n m),
  change (x + y) ^ n = ∑ m in range (n + 1), t n m,
  have h_first : ∀ n, t n 0 = y ^ n :=
    λ n, by { dsimp [t], rw [choose_zero_right, pow_zero, nat.cast_one, mul_one, one_mul] },
  have h_last : ∀ n, t n n.succ = 0 :=
    λ n, by { dsimp [t], rw [choose_succ_self, nat.cast_zero, mul_zero] },
  have h_middle : ∀ (n i : ℕ), (i ∈ range n.succ) →
   ((t n.succ) ∘ nat.succ) i = x * (t n i) + y * (t n i.succ) :=
  begin
    intros n i h_mem,
    have h_le : i ≤ n := nat.le_of_lt_succ (mem_range.mp h_mem),
    dsimp [t],
    rw [choose_succ_succ, nat.cast_add, mul_add],
    congr' 1,
    { rw [pow_succ x, succ_sub_succ, mul_assoc, mul_assoc, mul_assoc] },
    { rw [← mul_assoc y, ← mul_assoc y, (h.symm.pow_right i.succ).eq],
      by_cases h_eq : i = n,
      { rw [h_eq, choose_succ_self, nat.cast_zero, mul_zero, mul_zero] },
      { rw [succ_sub (lt_of_le_of_ne h_le h_eq)],
        rw [pow_succ y, mul_assoc, mul_assoc, mul_assoc, mul_assoc] } }
  end,
  induction n with n ih,
  { rw [pow_zero, sum_range_succ, range_zero, sum_empty, zero_add],
    dsimp [t], rw [pow_zero, pow_zero, choose_self, nat.cast_one, mul_one, mul_one] },
  { rw [sum_range_succ', h_first],
    rw [sum_congr rfl (h_middle n), sum_add_distrib, add_assoc],
    rw [pow_succ (x + y), ih, add_mul, mul_sum, mul_sum],
    congr' 1,
    rw [sum_range_succ', sum_range_succ, h_first, h_last,
       mul_zero, add_zero, pow_succ] }
end

/-- The binomial theorem -/
theorem add_pow [comm_semiring R] (x y : R) (n : ℕ) :
  (x + y) ^ n = ∑ m in range (n + 1), x ^ m * y ^ (n - m) * choose n m :=
(commute.all x y).add_pow n

namespace nat

/-- The sum of entries in a row of Pascal's triangle -/
theorem sum_range_choose (n : ℕ) :
  ∑ m in range (n + 1), choose n m = 2 ^ n :=
by simpa using (add_pow 1 1 n).symm

lemma sum_range_choose_halfway (m : nat) :
  ∑ i in range (m + 1), choose (2 * m + 1) i = 4 ^ m :=
have ∑ i in range (m + 1), choose (2 * m + 1) (2 * m + 1 - i) =
  ∑ i in range (m + 1), choose (2 * m + 1) i,
from sum_congr rfl $ λ i hi, choose_symm $ by linarith [mem_range.1 hi],
(nat.mul_right_inj zero_lt_two).1 $
calc 2 * (∑ i in range (m + 1), choose (2 * m + 1) i) =
  (∑ i in range (m + 1), choose (2 * m + 1) i) +
    ∑ i in range (m + 1), choose (2 * m + 1) (2 * m + 1 - i) :
  by rw [two_mul, this]
... = (∑ i in range (m + 1), choose (2 * m + 1) i) +
  ∑ i in Ico (m + 1) (2 * m + 2), choose (2 * m + 1) i : begin
    rw [range_eq_Ico, sum_Ico_reflect],
    { congr,
      have A : m + 1 ≤ 2 * m + 1, by linarith,
      rw [add_comm, nat.add_sub_assoc A, ← add_comm],
      congr,
      rw nat.sub_eq_iff_eq_add A,
      ring, },
   { linarith }
  end
... = ∑ i in range (2 * m + 2), choose (2 * m + 1) i : sum_range_add_sum_Ico _ (by linarith)
... = 2^(2 * m + 1) : sum_range_choose (2 * m + 1)
... = 2 * 4^m : by { rw [pow_succ, pow_mul], refl }

lemma choose_middle_le_pow (n : ℕ) : choose (2 * n + 1) n ≤ 4 ^ n :=
begin
  have t : choose (2 * n + 1) n ≤ ∑ i in range (n + 1), choose (2 * n + 1) i :=
    single_le_sum (λ x _, by linarith) (self_mem_range_succ n),
  simpa [sum_range_choose_halfway n] using t
end

lemma four_pow_le_two_mul_add_one_mul_central_binom (n : ℕ) :
  4 ^ n ≤ (2 * n + 1) * choose (2 * n) n :=
calc 4 ^ n = (1 + 1) ^ (2 * n) : by norm_num [pow_mul]
...        = ∑ m in range (2 * n + 1), choose (2 * n) m : by simp [add_pow]
...        ≤ ∑ m in range (2 * n + 1), choose (2 * n) (2 * n / 2) :
  sum_le_sum (λ i hi, choose_le_middle i (2 * n))
...        = (2 * n + 1) * choose (2 * n) n : by simp

end nat

theorem int.alternating_sum_range_choose {n : ℕ} :
  ∑ m in range (n + 1), ((-1) ^ m * ↑(choose n m) : ℤ) = if n = 0 then 1 else 0 :=
begin
  cases n, { simp },
  have h := add_pow (-1 : ℤ) 1 n.succ,
  simp only [one_pow, mul_one, add_left_neg, int.nat_cast_eq_coe_nat] at h,
  rw [← h, zero_pow (nat.succ_pos n), if_neg (nat.succ_ne_zero n)],
end

theorem int.alternating_sum_range_choose_of_ne {n : ℕ} (h0 : n ≠ 0) :
  ∑ m in range (n + 1), ((-1) ^ m * ↑(choose n m) : ℤ) = 0 :=
by rw [int.alternating_sum_range_choose, if_neg h0]

namespace finset

theorem sum_powerset_apply_card {α β : Type*} [add_comm_monoid α] (f : ℕ → α) {x : finset β} :
  ∑ m in x.powerset, f m.card = ∑ m in range (x.card + 1), (x.card.choose m) • f m :=
begin
  transitivity ∑ m in range (x.card + 1), ∑ j in x.powerset.filter (λ z, z.card = m), f j.card,
  { refine (sum_fiberwise_of_maps_to _ _).symm,
    intros y hy,
    rw [mem_range, nat.lt_succ_iff],
    rw mem_powerset at hy,
    exact card_le_of_subset hy },
  { refine sum_congr rfl (λ y hy, _),
    rw [← card_powerset_len, ← sum_const],
    refine sum_congr powerset_len_eq_filter.symm (λ z hz, _),
    rw (mem_powerset_len.1 hz).2 }
end

theorem sum_powerset_neg_one_pow_card {α : Type*} [decidable_eq α] {x : finset α} :
  ∑ m in x.powerset, (-1 : ℤ) ^ m.card = if x = ∅ then 1 else 0 :=
begin
  rw sum_powerset_apply_card,
  simp only [nsmul_eq_mul', ← card_eq_zero],
  convert int.alternating_sum_range_choose,
  ext,
  simp,
end

theorem sum_powerset_neg_one_pow_card_of_nonempty {α : Type*} {x : finset α}
  (h0 : x.nonempty) :
  ∑ m in x.powerset, (-1 : ℤ) ^ m.card = 0 :=
begin
  classical,
  rw [sum_powerset_neg_one_pow_card, if_neg],
  rw [← ne.def, ← nonempty_iff_ne_empty],
  apply h0,
end

end finset


/-
Copyright (c) 2020 Johan Commelin, Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Damiano Testa
-/
import data.equiv.basic
import logic.nontrivial
import order.basic

/-!
# Initial lemmas to work with the `order_dual`

## Definitions
`to_dual` and `of_dual` the order reversing identity maps, bundled as equivalences.

## Basic Lemmas to convert between an order and its dual

This file is similar to algebra/group/type_tags.lean
-/

open function

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}

namespace order_dual

instance [nontrivial α] : nontrivial (order_dual α) := by delta order_dual; assumption

/-- `to_dual` is the identity function to the `order_dual` of a linear order.  -/
def to_dual : α ≃ order_dual α := ⟨id, id, λ h, rfl, λ h, rfl⟩

/-- `of_dual` is the identity function from the `order_dual` of a linear order.  -/
def of_dual : order_dual α ≃ α := to_dual.symm

@[simp] lemma to_dual_symm_eq : (@to_dual α).symm = of_dual := rfl

@[simp] lemma of_dual_symm_eq : (@of_dual α).symm = to_dual := rfl

@[simp] lemma to_dual_of_dual (a : order_dual α) : to_dual (of_dual a) = a := rfl
@[simp] lemma of_dual_to_dual (a : α) : of_dual (to_dual a) = a := rfl

@[simp] lemma to_dual_inj {a b : α} :
  to_dual a = to_dual b ↔ a = b := iff.rfl

@[simp] lemma to_dual_le_to_dual [has_le α] {a b : α} :
  to_dual a ≤ to_dual b ↔ b ≤ a := iff.rfl

@[simp] lemma to_dual_lt_to_dual [has_lt α] {a b : α} :
  to_dual a < to_dual b ↔ b < a := iff.rfl

@[simp] lemma of_dual_inj {a b : order_dual α} :
  of_dual a = of_dual b ↔ a = b := iff.rfl

@[simp] lemma of_dual_le_of_dual [has_le α] {a b : order_dual α} :
  of_dual a ≤ of_dual b ↔ b ≤ a := iff.rfl

@[simp] lemma of_dual_lt_of_dual [has_lt α] {a b : order_dual α} :
  of_dual a < of_dual b ↔ b < a := iff.rfl

lemma le_to_dual [has_le α] {a : order_dual α} {b : α} :
  a ≤ to_dual b ↔ b ≤ of_dual a := iff.rfl

lemma lt_to_dual [has_lt α] {a : order_dual α} {b : α} :
  a < to_dual b ↔ b < of_dual a := iff.rfl

lemma to_dual_le [has_le α] {a : α} {b : order_dual α} :
  to_dual a ≤ b ↔ of_dual b ≤ a := iff.rfl

lemma to_dual_lt [has_lt α] {a : α} {b : order_dual α} :
  to_dual a < b ↔ of_dual b < a := iff.rfl

/-- Recursor for `order_dual α`. -/
@[elab_as_eliminator]
protected def rec {C : order_dual α → Sort*} (h₂ : Π (a : α), C (to_dual a)) :
  Π (a : order_dual α), C a := h₂

@[simp] protected lemma «forall» {p : order_dual α → Prop} : (∀ a, p a) ↔ ∀ a, p (to_dual a) :=
iff.rfl

@[simp] protected lemma «exists» {p : order_dual α → Prop} : (∃ a, p a) ↔ ∃ a, p (to_dual a) :=
iff.rfl

end order_dual

alias order_dual.to_dual_lt_to_dual ↔ _ has_lt.lt.dual
alias order_dual.to_dual_le_to_dual ↔ _ has_le.le.dual


theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : mynat) (h : a * b = 0) :
  a = 0 ∨ b = 0 :=
begin
cases a with a,
left,
refl,
cases b with b,
right,
refl,
exfalso,
rw mul_succ at h,
rw add_succ at h,
exact succ_ne_zero _ h,
end


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.integral.interval_integral
import analysis.normed_space.pointwise
import analysis.special_functions.non_integrable
import analysis.analytic.basic

/-!
# Integral over a circle in `ℂ`

In this file we define `∮ z in C(c, R), f z` to be the integral $\oint_{|z-c|=|R|} f(z)\,dz$ and
prove some properties of this integral. We give definition and prove most lemmas for a function
`f : ℂ → E`, where `E` is a complex Banach space. For this reason,
some lemmas use, e.g., `(z - c)⁻¹ • f z` instead of `f z / (z - c)`.

## Main definitions

* `circle_map c R`: the exponential map $θ ↦ c + R e^{θi}$;

* `circle_integrable f c R`: a function `f : ℂ → E` is integrable on the circle with center `c` and
  radius `R` if `f ∘ circle_map c R` is integrable on `[0, 2π]`;

* `circle_integral f c R`: the integral $\oint_{|z-c|=|R|} f(z)\,dz$, defined as
  $\int_{0}^{2π}(c + Re^{θ i})' f(c+Re^{θ i})\,dθ$;

* `cauchy_power_series f c R`: the power series that is equal to
  $\sum_{n=0}^{\infty} \oint_{|z-c|=R} \left(\frac{w-c}{z - c}\right)^n \frac{1}{z-c}f(z)\,dz$ at
  `w - c`. The coefficients of this power series depend only on `f ∘ circle_map c R`, and the power
  series converges to `f w` if `f` is differentiable on the closed ball `metric.closed_ball c R`
  and `w` belongs to the corresponding open ball.

## Main statements

* `has_fpower_series_on_cauchy_integral`: for any circle integrable function `f`, the power series
  `cauchy_power_series f c R`, `R > 0`, converges to the Cauchy integral
  `(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z` on the open disc `metric.ball c R`;

* `circle_integral.integral_sub_zpow_of_undef`, `circle_integral.integral_sub_zpow_of_ne`, and
  `circle_integral.integral_sub_inv_of_mem_ball`: formulas for `∮ z in C(c, R), (z - w) ^ n`,
  `n : ℤ`. These lemmas cover the following cases:

  - `circle_integral.integral_sub_zpow_of_undef`, `n < 0` and `|w - c| = |R|`: in this case the
    function is not integrable, so the integral is equal to its default value (zero);

  - `circle_integral.integral_sub_zpow_of_ne`, `n ≠ -1`: in the cases not covered by the previous
    lemma, we have `(z - w) ^ n = ((z - w) ^ (n + 1) / (n + 1))'`, thus the integral equals zero;

  - `circle_integral.integral_sub_inv_of_mem_ball`, `n = -1`, `|w - c| < R`: in this case the
    integral is equal to `2πi`.

  The case `n = -1`, `|w -c| > R` is not covered by these lemmas. While it is possible to construct
  an explicit primitive, it is easier to apply Cauchy theorem, so we postpone the proof till we have
  this theorem (see #10000).

## Notation

- `∮ z in C(c, R), f z`: notation for the integral $\oint_{|z-c|=|R|} f(z)\,dz$, defined as
  $\int_{0}^{2π}(c + Re^{θ i})' f(c+Re^{θ i})\,dθ$.

## Tags

integral, circle, Cauchy integral
-/

variables {E : Type*} [normed_add_comm_group E]

noncomputable theory

open_locale real nnreal interval pointwise topology
open complex measure_theory topological_space metric function set filter asymptotics

/-!
### `circle_map`, a parametrization of a circle
-/

/-- The exponential map $θ ↦ c + R e^{θi}$. The range of this map is the circle in `ℂ` with center
`c` and radius `|R|`. -/
def circle_map (c : ℂ) (R : ℝ) : ℝ → ℂ := λ θ, c + R * exp (θ * I)

/-- `circle_map` is `2π`-periodic. -/
lemma periodic_circle_map (c : ℂ) (R : ℝ) : periodic (circle_map c R) (2 * π) :=
λ θ, by simp [circle_map, add_mul, exp_periodic _]

lemma set.countable.preimage_circle_map {s : set ℂ} (hs : s.countable) (c : ℂ)
  {R : ℝ} (hR : R ≠ 0) : (circle_map c R ⁻¹' s).countable :=
show (coe ⁻¹' ((* I) ⁻¹' (exp ⁻¹' ((*) R ⁻¹' ((+) c ⁻¹' s))))).countable,
  from (((hs.preimage (add_right_injective _)).preimage $ mul_right_injective₀ $ of_real_ne_zero.2
    hR).preimage_cexp.preimage $ mul_left_injective₀ I_ne_zero).preimage of_real_injective

@[simp] lemma circle_map_sub_center (c : ℂ) (R : ℝ) (θ : ℝ) :
  circle_map c R θ - c = circle_map 0 R θ :=
by simp [circle_map]

lemma circle_map_zero (R θ : ℝ) : circle_map 0 R θ = R * exp (θ * I) := zero_add _

@[simp] lemma abs_circle_map_zero (R : ℝ) (θ : ℝ) : abs (circle_map 0 R θ) = |R| :=
by simp [circle_map]

lemma circle_map_mem_sphere' (c : ℂ) (R : ℝ) (θ : ℝ) : circle_map c R θ ∈ sphere c (|R|) :=
by simp

lemma circle_map_mem_sphere (c : ℂ) {R : ℝ} (hR : 0 ≤ R) (θ : ℝ) : circle_map c R θ ∈ sphere c R :=
by simpa only [_root_.abs_of_nonneg hR] using circle_map_mem_sphere' c R θ

lemma circle_map_mem_closed_ball (c : ℂ) {R : ℝ} (hR : 0 ≤ R) (θ : ℝ) :
  circle_map c R θ ∈ closed_ball c R :=
sphere_subset_closed_ball (circle_map_mem_sphere c hR θ)

lemma circle_map_not_mem_ball (c : ℂ) (R : ℝ) (θ : ℝ) : circle_map c R θ ∉ ball c R :=
by simp [dist_eq, le_abs_self]

lemma circle_map_ne_mem_ball {c : ℂ} {R : ℝ} {w : ℂ} (hw : w ∈ ball c R) (θ : ℝ) :
  circle_map c R θ ≠ w :=
(ne_of_mem_of_not_mem hw (circle_map_not_mem_ball _ _ _)).symm

/-- The range of `circle_map c R` is the circle with center `c` and radius `|R|`. -/
@[simp] lemma range_circle_map (c : ℂ) (R : ℝ) : range (circle_map c R) = sphere c (|R|) :=
calc range (circle_map c R) = c +ᵥ R • range (λ θ : ℝ, exp (θ * I)) :
  by simp only [← image_vadd, ← image_smul, ← range_comp, vadd_eq_add, circle_map, (∘), real_smul]
... = sphere c (|R|) : by simp [smul_sphere R (0 : ℂ) zero_le_one]

/-- The image of `(0, 2π]` under `circle_map c R` is the circle with center `c` and radius `|R|`. -/
@[simp] lemma image_circle_map_Ioc (c : ℂ) (R : ℝ) :
  circle_map c R '' Ioc 0 (2 * π) = sphere c (|R|) :=
by rw [← range_circle_map, ← (periodic_circle_map c R).image_Ioc real.two_pi_pos 0, zero_add]

@[simp] lemma circle_map_eq_center_iff {c : ℂ} {R : ℝ} {θ : ℝ} : circle_map c R θ = c ↔ R = 0 :=
by simp [circle_map, exp_ne_zero]

@[simp] lemma circle_map_zero_radius (c : ℂ) : circle_map c 0 = const ℝ c :=
funext $ λ θ, circle_map_eq_center_iff.2 rfl

lemma circle_map_ne_center {c : ℂ} {R : ℝ} (hR : R ≠ 0) {θ : ℝ} : circle_map c R θ ≠ c :=
mt circle_map_eq_center_iff.1 hR

lemma has_deriv_at_circle_map (c : ℂ) (R : ℝ) (θ : ℝ) :
  has_deriv_at (circle_map c R) (circle_map 0 R θ * I) θ :=
by simpa only [mul_assoc, one_mul, of_real_clm_apply, circle_map, of_real_one, zero_add]
 using ((of_real_clm.has_deriv_at.mul_const I).cexp.const_mul (R : ℂ)).const_add c

/- TODO: prove `cont_diff ℝ (circle_map c R)`. This needs a version of `cont_diff.mul`
for multiplication in a normed algebra over the base field. -/

lemma differentiable_circle_map (c : ℂ) (R : ℝ) :
  differentiable ℝ (circle_map c R) :=
λ θ, (has_deriv_at_circle_map c R θ).differentiable_at

@[continuity] lemma continuous_circle_map (c : ℂ) (R : ℝ) : continuous (circle_map c R) :=
(differentiable_circle_map c R).continuous

@[measurability] lemma measurable_circle_map (c : ℂ) (R : ℝ) : measurable (circle_map c R) :=
(continuous_circle_map c R).measurable

@[simp] lemma deriv_circle_map (c : ℂ) (R : ℝ) (θ : ℝ) :
  deriv (circle_map c R) θ = circle_map 0 R θ * I :=
(has_deriv_at_circle_map _ _ _).deriv

lemma deriv_circle_map_eq_zero_iff {c : ℂ} {R : ℝ} {θ : ℝ} :
  deriv (circle_map c R) θ = 0 ↔ R = 0 :=
by simp [I_ne_zero]

lemma deriv_circle_map_ne_zero {c : ℂ} {R : ℝ} {θ : ℝ} (hR : R ≠ 0) :
  deriv (circle_map c R) θ ≠ 0 :=
mt deriv_circle_map_eq_zero_iff.1 hR

lemma lipschitz_with_circle_map (c : ℂ) (R : ℝ) :
  lipschitz_with R.nnabs (circle_map c R) :=
lipschitz_with_of_nnnorm_deriv_le (differentiable_circle_map _ _) $ λ θ,
  nnreal.coe_le_coe.1 $ by simp

lemma continuous_circle_map_inv {R : ℝ} {z w : ℂ} (hw : w ∈ ball z R) :
 continuous (λ θ, (circle_map z R θ - w)⁻¹) :=
begin
  have : ∀ θ, circle_map z R θ - w ≠ 0,
  { simp_rw sub_ne_zero, exact λ θ, circle_map_ne_mem_ball hw θ, },
  continuity,
end

/-!
### Integrability of a function on a circle
-/

/-- We say that a function `f : ℂ → E` is integrable on the circle with center `c` and radius `R` if
the function `f ∘ circle_map c R` is integrable on `[0, 2π]`.

Note that the actual function used in the definition of `circle_integral` is
`(deriv (circle_map c R) θ) • f (circle_map c R θ)`. Integrability of this function is equivalent
to integrability of `f ∘ circle_map c R` whenever `R ≠ 0`. -/
def circle_integrable (f : ℂ → E) (c : ℂ) (R : ℝ) : Prop :=
interval_integrable (λ θ : ℝ, f (circle_map c R θ)) volume 0 (2 * π)

@[simp] lemma circle_integrable_const (a : E) (c : ℂ) (R : ℝ) :
  circle_integrable (λ _, a) c R :=
interval_integrable_const

namespace circle_integrable

variables {f g : ℂ → E} {c : ℂ} {R : ℝ}

lemma add (hf : circle_integrable f c R) (hg : circle_integrable g c R) :
  circle_integrable (f + g) c R :=
hf.add hg

lemma neg (hf : circle_integrable f c R) : circle_integrable (-f) c R := hf.neg

/-- The function we actually integrate over `[0, 2π]` in the definition of `circle_integral` is
integrable. -/
lemma out [normed_space ℂ E] (hf : circle_integrable f c R) :
  interval_integrable (λ θ : ℝ, deriv (circle_map c R) θ • f (circle_map c R θ)) volume 0 (2 * π) :=
begin
  simp only [circle_integrable, deriv_circle_map, interval_integrable_iff] at *,
  refine (hf.norm.const_mul (|R|)).mono' _ _,
  { exact ((continuous_circle_map _ _).ae_strongly_measurable.mul_const I).smul
      hf.ae_strongly_measurable },
  { simp [norm_smul] }
end

end circle_integrable

@[simp] lemma circle_integrable_zero_radius {f : ℂ → E} {c : ℂ} : circle_integrable f c 0 :=
by simp [circle_integrable]

lemma circle_integrable_iff [normed_space ℂ E]
  {f : ℂ → E} {c : ℂ} (R : ℝ) : circle_integrable f c R ↔
  interval_integrable (λ θ : ℝ, deriv (circle_map c R) θ • f (circle_map c R θ)) volume 0 (2 * π) :=
begin
  by_cases h₀ : R = 0,
  { simp [h₀], },
  refine ⟨λ h, h.out, λ h, _⟩,
  simp only [circle_integrable, interval_integrable_iff, deriv_circle_map] at h ⊢,
  refine (h.norm.const_mul (|R|⁻¹)).mono' _ _,
  { have H : ∀ {θ}, circle_map 0 R θ * I ≠ 0 := λ θ, by simp [h₀, I_ne_zero],
    simpa only [inv_smul_smul₀ H]
      using (((continuous_circle_map 0 R).ae_strongly_measurable).mul_const I).ae_measurable
        .inv.ae_strongly_measurable.smul h.ae_strongly_measurable },
  { simp [norm_smul, h₀] },
end

lemma continuous_on.circle_integrable' {f : ℂ → E} {c : ℂ} {R : ℝ}
  (hf : continuous_on f (sphere c (|R|))) :
  circle_integrable f c R :=
(hf.comp_continuous (continuous_circle_map _ _)
  (circle_map_mem_sphere' _ _)).interval_integrable _ _

lemma continuous_on.circle_integrable {f : ℂ → E} {c : ℂ} {R : ℝ} (hR : 0 ≤ R)
  (hf : continuous_on f (sphere c R)) :
  circle_integrable f c R :=
continuous_on.circle_integrable' $ (_root_.abs_of_nonneg hR).symm ▸ hf

/-- The function `λ z, (z - w) ^ n`, `n : ℤ`, is circle integrable on the circle with center `c` and
radius `|R|` if and only if `R = 0` or `0 ≤ n`, or `w` does not belong to this circle. -/
@[simp] lemma circle_integrable_sub_zpow_iff {c w : ℂ} {R : ℝ} {n : ℤ} :
  circle_integrable (λ z, (z - w) ^ n) c R ↔ R = 0 ∨ 0 ≤ n ∨ w ∉ sphere c (|R|) :=
begin
  split,
  { intro h, contrapose! h, rcases h with ⟨hR, hn, hw⟩,
    simp only [circle_integrable_iff R, deriv_circle_map],
    rw ← image_circle_map_Ioc at hw, rcases hw with ⟨θ, hθ, rfl⟩,
    replace hθ : θ ∈ [0, 2 * π], from Icc_subset_uIcc (Ioc_subset_Icc_self hθ),
    refine not_interval_integrable_of_sub_inv_is_O_punctured _ real.two_pi_pos.ne hθ,
    set f : ℝ → ℂ := λ θ', circle_map c R θ' - circle_map c R θ,
    have : ∀ᶠ θ' in 𝓝[≠] θ, f θ' ∈ ball (0 : ℂ) 1 \ {0},
    { suffices : ∀ᶠ z in 𝓝[≠] (circle_map c R θ), z - circle_map c R θ ∈ ball (0 : ℂ) 1 \ {0},
        from ((differentiable_circle_map c R θ).has_deriv_at.tendsto_punctured_nhds
          (deriv_circle_map_ne_zero hR)).eventually this,
      filter_upwards [self_mem_nhds_within,
        mem_nhds_within_of_mem_nhds (ball_mem_nhds _ zero_lt_one)],
      simp only [dist_eq, sub_eq_zero, mem_compl_iff, mem_singleton_iff, mem_ball, mem_diff,
                 mem_ball_zero_iff, norm_eq_abs, not_false_iff, and_self, implies_true_iff]
                {contextual := tt} },
    refine ((((has_deriv_at_circle_map c R θ).is_O_sub).mono inf_le_left).inv_rev
      (this.mono (λ θ' h₁ h₂, absurd h₂ h₁.2))).trans _,
    refine is_O.of_bound (|R|)⁻¹ (this.mono $ λ θ' hθ', _),
    set x := abs (f θ'),
    suffices : x⁻¹ ≤ x ^ n,
    by simpa only [inv_mul_cancel_left₀, abs_eq_zero.not.2 hR, norm_eq_abs, map_inv₀,
                   algebra.id.smul_eq_mul, map_mul, abs_circle_map_zero, abs_I, mul_one,
                   abs_zpow, ne.def, not_false_iff] using this,
    have : x ∈ Ioo (0 : ℝ) 1, by simpa [and.comm, x] using hθ',
    rw ← zpow_neg_one,
    refine (zpow_strict_anti this.1 this.2).le_iff_le.2 (int.lt_add_one_iff.1 _), exact hn },
  { rintro (rfl|H),
    exacts [circle_integrable_zero_radius,
      ((continuous_on_id.sub continuous_on_const).zpow₀ _ $ λ z hz, H.symm.imp_left $
        λ hw, sub_ne_zero.2 $ ne_of_mem_of_not_mem hz hw).circle_integrable'] },
end

@[simp] lemma circle_integrable_sub_inv_iff {c w : ℂ} {R : ℝ} :
  circle_integrable (λ z, (z - w)⁻¹) c R ↔ R = 0 ∨ w ∉ sphere c (|R|) :=
by { simp only [← zpow_neg_one, circle_integrable_sub_zpow_iff], norm_num }

variables [normed_space ℂ E] [complete_space E]

/-- Definition for $\oint_{|z-c|=R} f(z)\,dz$. -/
def circle_integral (f : ℂ → E) (c : ℂ) (R : ℝ) : E :=
∫ (θ : ℝ) in 0..2 * π, deriv (circle_map c R) θ • f (circle_map c R θ)

notation `∮` binders ` in ` `C(` c `, ` R `)` `, ` r:(scoped:60 f, circle_integral f c R) := r

lemma circle_integral_def_Icc (f : ℂ → E) (c : ℂ) (R : ℝ) :
  ∮ z in C(c, R), f z = ∫ θ in Icc 0 (2 * π), deriv (circle_map c R) θ • f (circle_map c R θ) :=
by simp only [circle_integral, interval_integral.integral_of_le real.two_pi_pos.le,
  measure.restrict_congr_set Ioc_ae_eq_Icc]

namespace circle_integral

@[simp] lemma integral_radius_zero (f : ℂ → E) (c : ℂ) : ∮ z in C(c, 0), f z = 0 :=
by simp [circle_integral]

lemma integral_congr {f g : ℂ → E} {c : ℂ} {R : ℝ} (hR : 0 ≤ R) (h : eq_on f g (sphere c R)) :
  ∮ z in C(c, R), f z = ∮ z in C(c, R), g z :=
interval_integral.integral_congr $ λ θ hθ, by simp only [h (circle_map_mem_sphere _ hR _)]

lemma integral_sub_inv_smul_sub_smul (f : ℂ → E) (c w : ℂ) (R : ℝ) :
  ∮ z in C(c, R), (z - w)⁻¹ • (z - w) • f z = ∮ z in C(c, R), f z :=
begin
  rcases eq_or_ne R 0 with rfl|hR, { simp only [integral_radius_zero] },
  have : (circle_map c R ⁻¹' {w}).countable, from (countable_singleton _).preimage_circle_map c hR,
  refine interval_integral.integral_congr_ae ((this.ae_not_mem _).mono $ λ θ hθ hθ', _),
  change circle_map c R θ ≠ w at hθ,
  simp only [inv_smul_smul₀ (sub_ne_zero.2 $ hθ)]
end

lemma integral_undef {f : ℂ → E} {c : ℂ} {R : ℝ} (hf : ¬circle_integrable f c R) :
  ∮ z in C(c, R), f z = 0 :=
interval_integral.integral_undef (mt (circle_integrable_iff R).mpr hf)

lemma integral_sub {f g : ℂ → E} {c : ℂ} {R : ℝ} (hf : circle_integrable f c R)
  (hg : circle_integrable g c R) :
  ∮ z in C(c, R), f z - g z = (∮ z in C(c, R), f z) - ∮ z in C(c, R), g z :=
by simp only [circle_integral, smul_sub, interval_integral.integral_sub hf.out hg.out]

lemma norm_integral_le_of_norm_le_const' {f : ℂ → E} {c : ℂ} {R C : ℝ}
  (hf : ∀ z ∈ sphere c (|R|), ‖f z‖ ≤ C) :
  ‖∮ z in C(c, R), f z‖ ≤ 2 * π * |R| * C :=
calc ‖∮ z in C(c, R), f z‖ ≤ |R| * C * |2 * π - 0| :
  interval_integral.norm_integral_le_of_norm_le_const $ λ θ _,
    (calc ‖deriv (circle_map c R) θ • f (circle_map c R θ)‖ = |R| * ‖f (circle_map c R θ)‖ :
      by simp [norm_smul]
    ... ≤ |R| * C : mul_le_mul_of_nonneg_left (hf _ $ circle_map_mem_sphere' _ _ _)
      (_root_.abs_nonneg _))
... = 2 * π * |R| * C :
  by { rw [sub_zero, _root_.abs_of_pos real.two_pi_pos], ac_refl }

lemma norm_integral_le_of_norm_le_const {f : ℂ → E} {c : ℂ} {R C : ℝ} (hR : 0 ≤ R)
  (hf : ∀ z ∈ sphere c R, ‖f z‖ ≤ C) :
  ‖∮ z in C(c, R), f z‖ ≤ 2 * π * R * C :=
have |R| = R, from _root_.abs_of_nonneg hR,
calc ‖∮ z in C(c, R), f z‖ ≤ 2 * π * |R| * C :
  norm_integral_le_of_norm_le_const' $ by rwa this
... = 2 * π * R * C : by rw this

/-- If `f` is continuous on the circle `|z - c| = R`, `R > 0`, the `‖f z‖` is less than or equal to
`C : ℝ` on this circle, and this norm is strictly less than `C` at some point `z` of the circle,
then `‖∮ z in C(c, R), f z‖ < 2 * π * R * C`. -/
lemma norm_integral_lt_of_norm_le_const_of_lt {f : ℂ → E} {c : ℂ} {R C : ℝ} (hR : 0 < R)
  (hc : continuous_on f (sphere c R)) (hf : ∀ z ∈ sphere c R, ‖f z‖ ≤ C)
  (hlt : ∃ z ∈ sphere c R, ‖f z‖ < C) :
  ‖∮ z in C(c, R), f z‖ < 2 * π * R * C :=
begin
  rw [← _root_.abs_of_pos hR, ← image_circle_map_Ioc] at hlt,
  rcases hlt with ⟨_, ⟨θ₀, hmem, rfl⟩, hlt⟩,
  calc ‖∮ z in C(c, R), f z‖ ≤ ∫ θ in 0..2 * π, ‖deriv (circle_map c R) θ • f (circle_map c R θ)‖ :
    interval_integral.norm_integral_le_integral_norm real.two_pi_pos.le
  ... < ∫ θ in 0..2 * π, R * C :
    begin
      simp only [norm_smul, deriv_circle_map, norm_eq_abs, map_mul, abs_I, mul_one,
        abs_circle_map_zero, abs_of_pos hR],
      refine interval_integral.integral_lt_integral_of_continuous_on_of_le_of_exists_lt
        real.two_pi_pos _ continuous_on_const (λ θ hθ, _) ⟨θ₀, Ioc_subset_Icc_self hmem, _⟩,
      { exact continuous_on_const.mul (hc.comp (continuous_circle_map _ _).continuous_on
          (λ θ hθ, circle_map_mem_sphere _ hR.le _)).norm },
      { exact mul_le_mul_of_nonneg_left (hf _ $ circle_map_mem_sphere _ hR.le _) hR.le },
      { exact (mul_lt_mul_left hR).2 hlt }
    end
  ... = 2 * π * R * C : by simp [mul_assoc]
end

@[simp] lemma integral_smul {𝕜 : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] [smul_comm_class 𝕜 ℂ E]
  (a : 𝕜) (f : ℂ → E) (c : ℂ) (R : ℝ) :
  ∮ z in C(c, R), a • f z = a • ∮ z in C(c, R), f z :=
by simp only [circle_integral, ← smul_comm a, interval_integral.integral_smul]

@[simp] lemma integral_smul_const (f : ℂ → ℂ) (a : E) (c : ℂ) (R : ℝ) :
  ∮ z in C(c, R), (f z • a) = (∮ z in C(c, R), f z) • a :=
by simp only [circle_integral, interval_integral.integral_smul_const, ← smul_assoc]

@[simp] lemma integral_const_mul (a : ℂ) (f : ℂ → ℂ) (c : ℂ) (R : ℝ) :
  ∮ z in C(c, R), a * f z = a * ∮ z in C(c, R), f z :=
integral_smul a f c R

@[simp] lemma integral_sub_center_inv (c : ℂ) {R : ℝ} (hR : R ≠ 0) :
  ∮ z in C(c, R), (z - c)⁻¹ = 2 * π * I :=
by simp [circle_integral, ← div_eq_mul_inv, mul_div_cancel_left _ (circle_map_ne_center hR)]

/-- If `f' : ℂ → E` is a derivative of a complex differentiable function on the circle
`metric.sphere c |R|`, then `∮ z in C(c, R), f' z = 0`. -/
lemma integral_eq_zero_of_has_deriv_within_at' {f f' : ℂ → E} {c : ℂ} {R : ℝ}
  (h : ∀ z ∈ sphere c (|R|), has_deriv_within_at f (f' z) (sphere c (|R|)) z) :
  ∮ z in C(c, R), f' z = 0 :=
begin
  by_cases hi : circle_integrable f' c R,
  { rw ← sub_eq_zero.2 ((periodic_circle_map c R).comp f).eq,
    refine interval_integral.integral_eq_sub_of_has_deriv_at (λ θ hθ, _) hi.out,
    exact (h _ (circle_map_mem_sphere' _ _ _)).scomp_has_deriv_at θ
      (differentiable_circle_map _ _ _).has_deriv_at (circle_map_mem_sphere' _ _) },
  { exact integral_undef hi }
end

/-- If `f' : ℂ → E` is a derivative of a complex differentiable function on the circle
`metric.sphere c R`, then `∮ z in C(c, R), f' z = 0`. -/
lemma integral_eq_zero_of_has_deriv_within_at {f f' : ℂ → E} {c : ℂ} {R : ℝ} (hR : 0 ≤ R)
  (h : ∀ z ∈ sphere c R, has_deriv_within_at f (f' z) (sphere c R) z) :
  ∮ z in C(c, R), f' z = 0 :=
integral_eq_zero_of_has_deriv_within_at' $ (_root_.abs_of_nonneg hR).symm.subst h

/-- If `n < 0` and `|w - c| = |R|`, then `(z - w) ^ n` is not circle integrable on the circle with
center `c` and radius `(|R|)`, so the integral `∮ z in C(c, R), (z - w) ^ n` is equal to zero. -/
lemma integral_sub_zpow_of_undef {n : ℤ} {c w : ℂ} {R : ℝ} (hn : n < 0) (hw : w ∈ sphere c (|R|)) :
  ∮ z in C(c, R), (z - w) ^ n = 0 :=
begin
  rcases eq_or_ne R 0 with rfl|h0, { apply integral_radius_zero },
  apply integral_undef,
  simp [circle_integrable_sub_zpow_iff, *]
end

/-- If `n ≠ -1` is an integer number, then the integral of `(z - w) ^ n` over the circle equals
zero. -/
lemma integral_sub_zpow_of_ne {n : ℤ} (hn : n ≠ -1) (c w : ℂ) (R : ℝ) :
  ∮ z in C(c, R), (z - w) ^ n = 0 :=
begin
  rcases em (w ∈ sphere c (|R|) ∧ n < -1) with ⟨hw, hn⟩|H,
  { exact integral_sub_zpow_of_undef (hn.trans dec_trivial) hw },
  push_neg at H,
  have hd : ∀ z, (z ≠ w ∨ -1 ≤ n) → has_deriv_at (λ z, (z - w) ^ (n + 1) / (n + 1)) ((z - w) ^ n) z,
  { intros z hne,
    convert ((has_deriv_at_zpow (n + 1) _ (hne.imp _ _)).comp z
      ((has_deriv_at_id z).sub_const w)).div_const _ using 1,
    { have hn' : (n + 1 : ℂ) ≠ 0,
        by rwa [ne, ← eq_neg_iff_add_eq_zero, ← int.cast_one, ← int.cast_neg, int.cast_inj],
      simp [mul_assoc, mul_div_cancel_left _ hn'] },
    exacts [sub_ne_zero.2, neg_le_iff_add_nonneg.1] },
  refine integral_eq_zero_of_has_deriv_within_at' (λ z hz, (hd z _).has_deriv_within_at),
  exact (ne_or_eq z w).imp_right (λ h, H $ h ▸ hz)
end

end circle_integral

/-- The power series that is equal to
$\sum_{n=0}^{\infty} \oint_{|z-c|=R} \left(\frac{w-c}{z - c}\right)^n \frac{1}{z-c}f(z)\,dz$ at
`w - c`. The coefficients of this power series depend only on `f ∘ circle_map c R`, and the power
series converges to `f w` if `f` is differentiable on the closed ball `metric.closed_ball c R` and
`w` belongs to the corresponding open ball. For any circle integrable function `f`, this power
series converges to the Cauchy integral for `f`. -/
def cauchy_power_series (f : ℂ → E) (c : ℂ) (R : ℝ) :
  formal_multilinear_series ℂ ℂ E :=
λ n, continuous_multilinear_map.mk_pi_field ℂ _ $
  (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - c)⁻¹ ^ n • (z - c)⁻¹ • f z

lemma cauchy_power_series_apply (f : ℂ → E) (c : ℂ) (R : ℝ) (n : ℕ) (w : ℂ) :
  cauchy_power_series f c R n (λ _, w) =
    (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (w / (z - c)) ^ n • (z - c)⁻¹ • f z :=
by simp only [cauchy_power_series, continuous_multilinear_map.mk_pi_field_apply, fin.prod_const,
  div_eq_mul_inv, mul_pow, mul_smul, circle_integral.integral_smul, ← smul_comm (w ^ n)]

lemma norm_cauchy_power_series_le (f : ℂ → E) (c : ℂ) (R : ℝ) (n : ℕ) :
  ‖cauchy_power_series f c R n‖ ≤
    (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖) * (|R|⁻¹) ^ n :=
calc ‖cauchy_power_series f c R n‖
    = (2 * π)⁻¹ * ‖∮ z in C(c, R), (z - c)⁻¹ ^ n • (z - c)⁻¹ • f z‖ :
  by simp [cauchy_power_series, norm_smul, real.pi_pos.le]
... ≤ (2 * π)⁻¹ * ∫ θ in 0..2*π, ‖deriv (circle_map c R) θ • (circle_map c R θ - c)⁻¹ ^ n •
  (circle_map c R θ - c)⁻¹ • f (circle_map c R θ)‖ :
  mul_le_mul_of_nonneg_left (interval_integral.norm_integral_le_integral_norm real.two_pi_pos.le)
    (by simp [real.pi_pos.le])
... = (2 * π)⁻¹ * (|R|⁻¹ ^ n * (|R| * (|R|⁻¹ * ∫ (x : ℝ) in 0..2 * π, ‖f (circle_map c R x)‖))) :
  by simp [norm_smul, mul_left_comm (|R|)]
... ≤ (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖) * |R|⁻¹ ^ n :
  begin
    rcases eq_or_ne R 0 with rfl|hR,
    { cases n; simp [-mul_inv_rev, real.two_pi_pos] },
    { rw [mul_inv_cancel_left₀, mul_assoc, mul_comm (|R|⁻¹ ^ n)],
      rwa [ne.def, _root_.abs_eq_zero] }
  end

lemma le_radius_cauchy_power_series (f : ℂ → E) (c : ℂ) (R : ℝ≥0) :
  ↑R ≤ (cauchy_power_series f c R).radius :=
begin
  refine (cauchy_power_series f c R).le_radius_of_bound
    ((2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖)) (λ n, _),
  refine (mul_le_mul_of_nonneg_right (norm_cauchy_power_series_le _ _ _ _)
    (pow_nonneg R.coe_nonneg _)).trans _,
  rw [_root_.abs_of_nonneg R.coe_nonneg],
  cases eq_or_ne (R ^ n : ℝ) 0 with hR hR,
  { rw [hR, mul_zero],
    exact mul_nonneg (inv_nonneg.2 real.two_pi_pos.le)
      (interval_integral.integral_nonneg real.two_pi_pos.le (λ _ _, norm_nonneg _)) },
  { rw [inv_pow, inv_mul_cancel_right₀ hR] }
end

/-- For any circle integrable function `f`, the power series `cauchy_power_series f c R` multiplied
by `2πI` converges to the integral `∮ z in C(c, R), (z - w)⁻¹ • f z` on the open disc
`metric.ball c R`. -/
lemma has_sum_two_pi_I_cauchy_power_series_integral {f : ℂ → E} {c : ℂ} {R : ℝ} {w : ℂ}
  (hf : circle_integrable f c R) (hw : abs w < R) :
  has_sum (λ n : ℕ, ∮ z in C(c, R), (w / (z - c)) ^ n • (z - c)⁻¹ • f z)
    (∮ z in C(c, R), (z - (c + w))⁻¹ • f z) :=
begin
  have hR : 0 < R := (complex.abs.nonneg w).trans_lt hw,
  have hwR : abs w / R ∈ Ico (0 : ℝ) 1,
    from ⟨div_nonneg (complex.abs.nonneg w) hR.le, (div_lt_one hR).2 hw⟩,
  refine interval_integral.has_sum_integral_of_dominated_convergence
    (λ n θ, ‖f (circle_map c R θ)‖ * (abs w / R) ^ n) (λ n, _) (λ n, _) _ _ _,
  { simp only [deriv_circle_map],
    apply_rules [ae_strongly_measurable.smul, hf.def.1];
    { apply measurable.ae_strongly_measurable, measurability } },
  { simp [norm_smul, abs_of_pos hR, mul_left_comm R, mul_inv_cancel_left₀ hR.ne', mul_comm (‖_‖)] },
  { exact eventually_of_forall (λ _ _, (summable_geometric_of_lt_1 hwR.1 hwR.2).mul_left _) },
  { simpa only [tsum_mul_left, tsum_geometric_of_lt_1 hwR.1 hwR.2]
      using hf.norm.mul_continuous_on continuous_on_const },
  { refine eventually_of_forall (λ θ hθ, has_sum.const_smul _ _),
    simp only [smul_smul],
    refine has_sum.smul_const _ _,
    have : ‖w / (circle_map c R θ - c)‖ < 1, by simpa [abs_of_pos hR] using hwR.2,
    convert (has_sum_geometric_of_norm_lt_1 this).mul_right _,
    simp [← sub_sub, ← mul_inv, sub_mul, div_mul_cancel _ (circle_map_ne_center hR.ne')] }
end

/-- For any circle integrable function `f`, the power series `cauchy_power_series f c R`, `R > 0`,
converges to the Cauchy integral `(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z` on the open
disc `metric.ball c R`. -/
lemma has_sum_cauchy_power_series_integral {f : ℂ → E} {c : ℂ} {R : ℝ} {w : ℂ}
  (hf : circle_integrable f c R) (hw : abs w < R) :
  has_sum (λ n, cauchy_power_series f c R n (λ _, w))
    ((2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - (c + w))⁻¹ • f z) :=
begin
  simp only [cauchy_power_series_apply],
  exact (has_sum_two_pi_I_cauchy_power_series_integral hf hw).const_smul _
end

/-- For any circle integrable function `f`, the power series `cauchy_power_series f c R`, `R > 0`,
converges to the Cauchy integral `(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z` on the open
disc `metric.ball c R`. -/
lemma sum_cauchy_power_series_eq_integral {f : ℂ → E} {c : ℂ} {R : ℝ} {w : ℂ}
  (hf : circle_integrable f c R) (hw : abs w < R) :
  (cauchy_power_series f c R).sum w =
    ((2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - (c + w))⁻¹ • f z) :=
(has_sum_cauchy_power_series_integral hf hw).tsum_eq

/-- For any circle integrable function `f`, the power series `cauchy_power_series f c R`, `R > 0`,
converges to the Cauchy integral `(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z` on the open
disc `metric.ball c R`. -/
lemma has_fpower_series_on_cauchy_integral {f : ℂ → E} {c : ℂ} {R : ℝ≥0}
  (hf : circle_integrable f c R) (hR : 0 < R) :
  has_fpower_series_on_ball
    (λ w, (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z)
    (cauchy_power_series f c R) c R :=
{ r_le := le_radius_cauchy_power_series _ _ _,
  r_pos := ennreal.coe_pos.2 hR,
  has_sum := λ y hy,
    begin
      refine has_sum_cauchy_power_series_integral hf _,
      rw [← norm_eq_abs, ← coe_nnnorm, nnreal.coe_lt_coe, ← ennreal.coe_lt_coe],
      exact mem_emetric_ball_zero_iff.1 hy
    end }

namespace circle_integral

/-- Integral $\oint_{|z-c|=R} \frac{dz}{z-w}=2πi$ whenever $|w-c|<R$. -/
lemma integral_sub_inv_of_mem_ball {c w : ℂ} {R : ℝ} (hw : w ∈ ball c R) :
  ∮ z in C(c, R), (z - w)⁻¹ = 2 * π * I :=
begin
  have hR : 0 < R := dist_nonneg.trans_lt hw,
  suffices H : has_sum (λ n : ℕ, ∮ z in C(c, R), ((w - c) / (z - c)) ^ n * (z - c)⁻¹) (2 * π * I),
  { have A : circle_integrable (λ _, (1 : ℂ)) c R, from continuous_on_const.circle_integrable',
    refine (H.unique _).symm,
    simpa only [smul_eq_mul, mul_one, add_sub_cancel'_right]
      using has_sum_two_pi_I_cauchy_power_series_integral A hw },
  have H : ∀ n : ℕ, n ≠ 0 → ∮ z in C(c, R), (z - c) ^ (-n - 1 : ℤ) = 0,
  { refine λ n hn, integral_sub_zpow_of_ne _ _ _ _, simpa },
  have : ∮ z in C(c, R), ((w - c) / (z - c)) ^ 0 * (z - c)⁻¹ = 2 * π * I, by simp [hR.ne'],
  refine this ▸ has_sum_single _ (λ n hn, _),
  simp only [div_eq_mul_inv, mul_pow, integral_const_mul, mul_assoc],
  rw [(integral_congr hR.le (λ z hz, _)).trans (H n hn), mul_zero],
  rw [← pow_succ', ← zpow_coe_nat, inv_zpow, ← zpow_neg, int.coe_nat_succ, neg_add,
    sub_eq_add_neg _ (1 : ℤ)]
end

end circle_integral


variables A B C D P Q R: Prop

example : A ∧ (A → B) → B :=
assume ⟨ hA, hAimpB ⟩, hAimpB hA

example : A → ¬ (¬ A ∧ B) :=
assume : A,
  show ¬ (¬ A ∧ B), from
    assume ⟨ hnotA, hB ⟩, show false, from hnotA ‹A›

example : ¬ (A ∧ B) → (A → ¬ B) :=
assume : ¬ (A ∧ B),
  show (A → ¬ B), from
    assume : A, show ¬ B, from
      assume : B, show false, from
        ‹¬ (A ∧ B)› ⟨ ‹A› , ‹B› ⟩

example (h₁ : A ∨ B) (h₂ : A → C) (h₃ : B → D) : C ∨ D :=
show C ∨ D, from
or.elim h₁
  (assume : A, show C ∨ D, from or.inl (h₂ ‹A›))
  (assume : B, show C ∨ D, from or.inr (h₃ ‹B›))

example : ¬ (A ↔ ¬ A) :=
assume : (A ↔ ¬ A), show false, from
have ¬ A, from assume : A, show false, from have ¬ A, from iff.elim_left ‹A ↔ ¬ A› ‹A›, ‹¬ A› ‹A›,
have A, from iff.elim_right ‹A ↔ ¬ A› ‹¬ A›,
‹¬ A› ‹A›

open classical
------------------------------------------------------------

example (h : ¬ A ∧ ¬ B) : ¬ (A ∨ B) :=
have ¬ A, from h.left,
have ¬ B, from h.right,
show ¬ (A ∨ B), from
  assume : (A ∨ B), show false, from
  or.elim ‹A ∨ B› (assume : A, (‹¬ A› ‹A›)) (assume : B, (‹¬ B› ‹B›))

example (h: ¬ (A ∨ B)) : (¬ A ∧ ¬ B) :=
have ¬ A, from assume : A, show false, from have (A ∨ B), from or.inl ‹A›, ‹¬ (A ∨ B)› ‹A ∨ B›,
have ¬ B, from assume : B, show false, from have (A ∨ B), from or.inr ‹B›, ‹¬ (A ∨ B)› ‹A ∨ B›,
⟨ ‹¬ A› , ‹¬ B› ⟩

------------------------------------------------------------

example (h: ¬ A ∨ ¬ B) : ¬ (A ∧ B) :=
or.elim h
  (assume : ¬ A, show ¬ (A ∧ B), from assume h1: (A ∧ B), ‹¬ A› h1.left)
  (assume : ¬ B, show ¬ (A ∧ B), from assume h1: (A ∧ B), ‹¬ B› h1.right)

example (h: ¬ (A ∧ B)) : ¬ A ∨ ¬ B := by_contradiction(
assume h1: ¬ (¬ A ∨ ¬ B),
have A, from by_contradiction(assume : ¬ A, have h2: ¬ A ∨ ¬ B, from or.inl ‹¬ A›, h1 h2),
have B, from by_contradiction(assume : ¬ B, have h2: ¬ A ∨ ¬ B, from or.inr ‹¬ B›, h1 h2),
h ⟨ ‹A›, ‹B› ⟩
)
------------------------------------------------------------

-- Also known as em A
example : A ∨ ¬ A := by_contradiction(
assume h: ¬ (A ∨ ¬ A),
have ¬ A, from assume : A, show false, from have (A ∨ ¬ A), from or.inl ‹A›, h ‹A ∨ ¬ A›,
have ¬ ¬ A, from assume : ¬ A, show false, from have (A ∨ ¬ A), from or.inr ‹¬ A›, h ‹A ∨ ¬ A›,
‹¬ ¬ A› ‹¬ A›
)

example (h: ¬ ¬ A) : A := by_contradiction(assume h1 : ¬ A, h h1)
example (h: A) : ¬ ¬ A := show ¬ ¬ A, from assume : ¬ A, ‹¬ A› ‹A›

------------------------------------------------------------

example (h: A → B) : ¬ A ∨ B :=
or.elim (em A)
  (assume : A, show ¬ A ∨ B, from or.inr (h ‹A›))
  (assume : ¬ A, show ¬ A ∨ B, from or.inl ‹¬ A›)

example (h: ¬ A ∨ B) : A → B :=
assume : A, or.elim h
  (assume : ¬ A, show B, from false.elim (‹¬ A› ‹A›))
  (assume : B, ‹B›)

------------------------------------------------------------

example (h: A → B) : ¬ B → ¬ A :=
assume : ¬ B, show ¬ A, from assume : A, ‹¬ B› (h ‹A›)

example (h: ¬ B → ¬ A) : A → B :=
assume : A, or.elim (em B)
  (assume : B, ‹B›)
  (assume : ¬ B, show B, from false.elim ((h ‹¬ B›) ‹A›))

------------------------------------------------------------

example (h: ¬ P → (Q ∨ R)) (h1: ¬ Q) (h2: ¬ R) : P :=
or.elim (em P)
  (assume : P, ‹P›)
  (assume : ¬ P, show P, from false.elim
    (or.elim (h ‹¬ P›) (assume : Q, h1 ‹Q›) (assume : R, h2 ‹R›)))

example : A → ((A ∧ B) ∨ (A ∧ ¬ B)) :=
assume : A, or.elim (em B)
  (assume : B, show ((A ∧ B) ∨ (A ∧ ¬ B)), from or.inl ⟨‹A›,‹B›⟩)
  (assume : ¬ B, show ((A ∧ B) ∨ (A ∧ ¬ B)), from or.inr ⟨‹A›,‹¬ B›⟩)


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.constructions.borel_space
import order.filter.ennreal

/-!
# Essential supremum and infimum
We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
`μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
almost everywhere.

TODO: The essential supremum of functions `α → ℝ≥0∞` is used in particular to define the norm in
the `L∞` space (see measure_theory/lp_space.lean).

There is a different quantity which is sometimes also called essential supremum: the least
upper-bound among measurable functions of a family of measurable functions (in an almost-everywhere
sense). We do not define that quantity here, which is simply the supremum of a map with values in
`α →ₘ[μ] β` (see measure_theory/ae_eq_fun.lean).

## Main definitions

* `ess_sup f μ := μ.ae.limsup f`
* `ess_inf f μ := μ.ae.liminf f`
-/

open measure_theory filter topological_space
open_locale ennreal measure_theory

variables {α β : Type*} {m : measurable_space α} {μ ν : measure α}

section conditionally_complete_lattice
variable [conditionally_complete_lattice β]

/-- Essential supremum of `f` with respect to measure `μ`: the smallest `c : β` such that
`f x ≤ c` a.e. -/
def ess_sup {m : measurable_space α} (f : α → β) (μ : measure α) := μ.ae.limsup f

/-- Essential infimum of `f` with respect to measure `μ`: the greatest `c : β` such that
`c ≤ f x` a.e. -/
def ess_inf {m : measurable_space α} (f : α → β) (μ : measure α) := μ.ae.liminf f

lemma ess_sup_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) : ess_sup f μ = ess_sup g μ :=
limsup_congr hfg

lemma ess_inf_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) :  ess_inf f μ = ess_inf g μ :=
@ess_sup_congr_ae α βᵒᵈ _ _ _ _ _ hfg

end conditionally_complete_lattice

section conditionally_complete_linear_order
variable [conditionally_complete_linear_order β]

lemma ess_sup_eq_Inf {m : measurable_space α} (μ : measure α) (f : α → β) :
  ess_sup f μ = Inf {a | μ {x | a < f x} = 0} :=
begin
  dsimp [ess_sup, limsup, Limsup],
  congr,
  ext a,
  simp [eventually_map, ae_iff],
end

end conditionally_complete_linear_order

section complete_lattice
variable [complete_lattice β]

@[simp] lemma ess_sup_measure_zero {m : measurable_space α} {f : α → β} :
  ess_sup f (0 : measure α) = ⊥ :=
le_bot_iff.mp (Inf_le (by simp [set.mem_set_of_eq, eventually_le, ae_iff]))

@[simp] lemma ess_inf_measure_zero {m : measurable_space α} {f : α → β} :
  ess_inf f (0 : measure α) = ⊤ :=
@ess_sup_measure_zero α βᵒᵈ _ _ _

lemma ess_sup_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_sup f μ ≤ ess_sup g μ :=
limsup_le_limsup hfg

lemma ess_inf_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_inf f μ ≤ ess_inf g μ :=
liminf_le_liminf hfg

lemma ess_sup_const (c : β) (hμ : μ ≠ 0) : ess_sup (λ x : α, c) μ = c :=
begin
  haveI hμ_ne_bot : μ.ae.ne_bot, { rwa [ne_bot_iff, ne.def, ae_eq_bot] },
  exact limsup_const c,
end

lemma ess_sup_le_of_ae_le {f : α → β} (c : β) (hf : f ≤ᵐ[μ] (λ _, c)) : ess_sup f μ ≤ c :=
begin
  refine (ess_sup_mono_ae hf).trans _,
  by_cases hμ : μ = 0,
  { simp [hμ], },
  { rwa ess_sup_const, },
end

lemma ess_inf_const (c : β) (hμ : μ ≠ 0) : ess_inf (λ x : α, c) μ = c :=
@ess_sup_const α βᵒᵈ _ _ _ _ hμ

lemma le_ess_inf_of_ae_le {f : α → β} (c : β) (hf : (λ _, c) ≤ᵐ[μ] f) : c ≤ ess_inf f μ :=
@ess_sup_le_of_ae_le α βᵒᵈ _ _ _ _ c hf

lemma ess_sup_const_bot : ess_sup (λ x : α, (⊥ : β)) μ = (⊥ : β) :=
limsup_const_bot

lemma ess_inf_const_top : ess_inf (λ x : α, (⊤ : β)) μ = (⊤ : β) :=
liminf_const_top

lemma order_iso.ess_sup_apply {m : measurable_space α} {γ} [complete_lattice γ]
  (f : α → β) (μ : measure α) (g : β ≃o γ) :
  g (ess_sup f μ) = ess_sup (λ x, g (f x)) μ :=
begin
  refine order_iso.limsup_apply g _ _ _ _,
  all_goals { is_bounded_default, },
end

lemma order_iso.ess_inf_apply {m : measurable_space α} {γ} [complete_lattice γ]
  (f : α → β) (μ : measure α) (g : β ≃o γ) :
  g (ess_inf f μ) = ess_inf (λ x, g (f x)) μ :=
@order_iso.ess_sup_apply α βᵒᵈ _ _  γᵒᵈ _ _ _ g.dual

lemma ess_sup_mono_measure {f : α → β} (hμν : ν ≪ μ) : ess_sup f ν ≤ ess_sup f μ :=
begin
  refine limsup_le_limsup_of_le (measure.ae_le_iff_absolutely_continuous.mpr hμν) _ _,
  all_goals { is_bounded_default, },
end

lemma ess_sup_mono_measure' {α : Type*} {β : Type*} {m : measurable_space α}
  {μ ν : measure_theory.measure α} [complete_lattice β] {f : α → β} (hμν : ν ≤ μ) :
  ess_sup f ν ≤ ess_sup f μ := ess_sup_mono_measure (measure.absolutely_continuous_of_le hμν)

lemma ess_inf_antitone_measure {f : α → β} (hμν : μ ≪ ν) : ess_inf f ν ≤ ess_inf f μ :=
begin
  refine liminf_le_liminf_of_le (measure.ae_le_iff_absolutely_continuous.mpr hμν) _ _,
  all_goals { is_bounded_default, },
end

lemma ess_sup_smul_measure {f : α → β} {c : ℝ≥0∞} (hc : c ≠ 0) :
  ess_sup f (c • μ) = ess_sup f μ :=
begin
  simp_rw ess_sup,
  suffices h_smul : (c • μ).ae = μ.ae, by rw h_smul,
  ext1,
  simp_rw mem_ae_iff,
  simp [hc],
end

section topological_space

variables {γ : Type*} {mγ : measurable_space γ} {f : α → γ} {g : γ → β}

include mγ

lemma ess_sup_comp_le_ess_sup_map_measure (hf : ae_measurable f μ) :
  ess_sup (g ∘ f) μ ≤ ess_sup g (measure.map f μ) :=
begin
  refine Limsup_le_Limsup_of_le (λ t, _) (by is_bounded_default) (by is_bounded_default),
  simp_rw filter.mem_map,
  have : (g ∘ f) ⁻¹' t = f ⁻¹' (g ⁻¹' t), by { ext1 x, simp_rw set.mem_preimage, },
  rw this,
  exact λ h, mem_ae_of_mem_ae_map hf h,
end

lemma _root_.measurable_embedding.ess_sup_map_measure (hf : measurable_embedding f) :
  ess_sup g (measure.map f μ) = ess_sup (g ∘ f) μ :=
begin
  refine le_antisymm _ (ess_sup_comp_le_ess_sup_map_measure hf.measurable.ae_measurable),
  refine Limsup_le_Limsup (by is_bounded_default) (by is_bounded_default) (λ c h_le, _),
  rw eventually_map at h_le ⊢,
  exact hf.ae_map_iff.mpr h_le,
end

variables [measurable_space β] [topological_space β] [second_countable_topology β]
  [order_closed_topology β] [opens_measurable_space β]

lemma ess_sup_map_measure_of_measurable (hg : measurable g) (hf : ae_measurable f μ) :
  ess_sup g (measure.map f μ) = ess_sup (g ∘ f) μ :=
begin
  refine le_antisymm _ (ess_sup_comp_le_ess_sup_map_measure hf),
  refine Limsup_le_Limsup (by is_bounded_default) (by is_bounded_default) (λ c h_le, _),
  rw eventually_map at h_le ⊢,
  rw ae_map_iff hf (measurable_set_le hg measurable_const),
  exact h_le,
end

lemma ess_sup_map_measure (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
  ess_sup g (measure.map f μ) = ess_sup (g ∘ f) μ :=
begin
  rw [ess_sup_congr_ae hg.ae_eq_mk, ess_sup_map_measure_of_measurable hg.measurable_mk hf],
  refine ess_sup_congr_ae _,
  have h_eq := ae_of_ae_map hf hg.ae_eq_mk,
  rw ← eventually_eq at h_eq,
  exact h_eq.symm,
end

omit mγ

end topological_space

end complete_lattice

section complete_linear_order
variable [complete_linear_order β]

lemma ae_lt_of_ess_sup_lt {f : α → β} {x : β} (hf : ess_sup f μ < x) : ∀ᵐ y ∂μ, f y < x :=
filter.eventually_lt_of_limsup_lt hf

lemma ae_lt_of_lt_ess_inf {f : α → β} {x : β} (hf : x < ess_inf f μ) : ∀ᵐ y ∂μ, x < f y :=
@ae_lt_of_ess_sup_lt α βᵒᵈ _ _ _ _ _ hf

lemma ess_sup_indicator_eq_ess_sup_restrict [has_zero β] {s : set α}
  {f : α → β} (hf : 0 ≤ᵐ[μ.restrict s] f) (hs : measurable_set s) (hs_not_null : μ s ≠ 0) :
  ess_sup (s.indicator f) μ = ess_sup f (μ.restrict s) :=
begin
  refine le_antisymm _ (Limsup_le_Limsup_of_le (map_restrict_ae_le_map_indicator_ae hs)
    (by is_bounded_default) (by is_bounded_default)),
  refine Limsup_le_Limsup (by is_bounded_default) (by is_bounded_default) (λ c h_restrict_le, _),
  rw eventually_map at h_restrict_le ⊢,
  rw ae_restrict_iff' hs at h_restrict_le,
  have hc : 0 ≤ c,
  { rsuffices ⟨x, hx⟩ : ∃ x, 0 ≤ f x ∧ f x ≤ c, from hx.1.trans hx.2,
    refine frequently.exists _,
    { exact μ.ae, },
    rw [eventually_le, ae_restrict_iff' hs] at hf,
    have hs' : ∃ᵐ x ∂μ, x ∈ s,
    { contrapose! hs_not_null,
      rw [not_frequently, ae_iff] at hs_not_null,
      suffices : {a : α | ¬a ∉ s} = s, by rwa ← this,
      simp, },
    refine hs'.mp (hf.mp (h_restrict_le.mono (λ x hxs_imp_c hxf_nonneg hxs, _))),
    rw pi.zero_apply at hxf_nonneg,
    exact ⟨hxf_nonneg hxs, hxs_imp_c hxs⟩, },
  refine h_restrict_le.mono (λ x hxc, _),
  by_cases hxs : x ∈ s,
  { simpa [hxs] using hxc hxs, },
  { simpa [hxs] using hc, },
end

end complete_linear_order

namespace ennreal

variables {f : α → ℝ≥0∞}

lemma ae_le_ess_sup (f : α → ℝ≥0∞) : ∀ᵐ y ∂μ, f y ≤ ess_sup f μ :=
eventually_le_limsup f

@[simp] lemma ess_sup_eq_zero_iff : ess_sup f μ = 0 ↔ f =ᵐ[μ] 0 :=
limsup_eq_zero_iff

lemma ess_sup_const_mul {a : ℝ≥0∞} : ess_sup (λ (x : α), a * (f x)) μ = a * ess_sup f μ :=
limsup_const_mul

lemma ess_sup_mul_le (f g : α → ℝ≥0∞) : ess_sup (f * g) μ ≤ ess_sup f μ * ess_sup g μ :=
limsup_mul_le f g

lemma ess_sup_add_le (f g : α → ℝ≥0∞) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
limsup_add_le f g

lemma ess_sup_liminf_le {ι} [countable ι] [linear_order ι] (f : ι → α → ℝ≥0∞) :
  ess_sup (λ x, at_top.liminf (λ n, f n x)) μ ≤ at_top.liminf (λ n, ess_sup (λ x, f n x) μ) :=
by { simp_rw ess_sup, exact ennreal.limsup_liminf_le_liminf_limsup (λ a b, f b a), }

end ennreal


/-
Copyright (c) 2020 Mathieu Guay-Paquet. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mathieu Guay-Paquet
-/
import order.ideal

/-!
# Order filters

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections
require more structure, such as a bottom element, a top element, or
a join-semilattice structure.

- `order.pfilter P`: The type of nonempty, downward directed, upward closed
               subsets of `P`. This is dual to `order.ideal`, so it
               simply wraps `order.ideal (order_dual P)`.
- `order.is_pfilter P`: a predicate for when a `set P` is a filter.

Note the relation between `order/filter` and `order/pfilter`: for any
type `α`, `filter α` represents the same mathematical object as
`pfilter (set α)`.

## References

- <https://en.wikipedia.org/wiki/Filter_(mathematics)>

## Tags

pfilter, filter, ideal, dual

-/

namespace order

variables {P : Type*}

/-- A filter on a preorder `P` is a subset of `P` that is
  - nonempty
  - downward directed
  - upward closed. -/
structure pfilter (P) [preorder P] :=
(dual : ideal (order_dual P))

/-- A predicate for when a subset of `P` is a filter. -/
def is_pfilter [preorder P] (F : set P) : Prop :=
@is_ideal (order_dual P) _ F

/-- Create an element of type `order.pfilter` from a set satisfying the predicate
`order.is_pfilter`. -/
def is_pfilter.to_pfilter [preorder P] {F : set P} (h : is_pfilter F) : pfilter P :=
⟨h.to_ideal⟩

namespace pfilter

section preorder
variables [preorder P] {x y : P} (F : pfilter P)

/-- A filter on `P` is a subset of `P`. -/
instance : has_coe (pfilter P) (set P) := ⟨λ F, F.dual.carrier⟩

/-- For the notation `x ∈ F`. -/
instance : has_mem P (pfilter P) := ⟨λ x F, x ∈ (F : set P)⟩

@[simp] lemma mem_coe : x ∈ (F : set P) ↔ x ∈ F := iff_of_eq rfl

lemma is_pfilter : is_pfilter (F : set P) :=
F.dual.is_ideal

lemma nonempty : (F : set P).nonempty := F.dual.nonempty

lemma directed : directed_on (≥) (F : set P) := F.dual.directed

lemma mem_of_le {F : pfilter P} : x ≤ y → x ∈ F → y ∈ F := λ h, F.dual.mem_of_le h

/-- The smallest filter containing a given element. -/
def principal (p : P) : pfilter P := ⟨ideal.principal p⟩

instance [inhabited P] : inhabited (pfilter P) := ⟨⟨default _⟩⟩

/-- Two filters are equal when their underlying sets are equal. -/
@[ext] lemma ext : ∀ (F G : pfilter P), (F : set P) = G → F = G
| ⟨⟨_, _, _, _⟩⟩ ⟨⟨_, _, _, _⟩⟩ rfl := rfl

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (pfilter P) := partial_order.lift coe ext

@[trans] lemma mem_of_mem_of_le {F G : pfilter P} : x ∈ F → F ≤ G → x ∈ G :=
ideal.mem_of_mem_of_le

@[simp] lemma principal_le_iff {F : pfilter P} : principal x ≤ F ↔ x ∈ F :=
ideal.principal_le_iff

end preorder

section order_top
variables [order_top P] {F : pfilter P}

/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp] lemma top_mem : ⊤ ∈ F :=
ideal.bot_mem

/-- There is a bottom filter when `P` has a top element. -/
instance : order_bot (pfilter P) :=
{ bot := ⟨⊥⟩,
  bot_le := λ F, (bot_le : ⊥ ≤ F.dual),
  .. pfilter.partial_order }

end order_top

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [order_bot P] : order_top (pfilter P) :=
{ top := ⟨⊤⟩,
  le_top := λ F, (le_top : F.dual ≤ ⊤),
  .. pfilter.partial_order }

section semilattice_inf
variables [semilattice_inf P] {x y : P} {F : pfilter P}

/-- A specific witness of `pfilter.directed` when `P` has meets. -/
lemma inf_mem (x y ∈ F) : x ⊓ y ∈ F :=
ideal.sup_mem x y ‹x ∈ F› ‹y ∈ F›

@[simp] lemma inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
ideal.sup_mem_iff

end semilattice_inf

end pfilter

end order


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.calculus.deriv
import linear_algebra.affine_space.slope

/-!
# Slope of a differentiable function

Given a function `f : 𝕜 → E` from a nontrivially normed field to a normed space over this field,
`dslope f a b` is defined as `slope f a b = (b - a)⁻¹ • (f b - f a)` for `a ≠ b` and as `deriv f a`
for `a = b`.

In this file we define `dslope` and prove some basic lemmas about its continuity and
differentiability.
-/

open_locale classical topology filter
open function set filter

variables {𝕜 E : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]

/-- `dslope f a b` is defined as `slope f a b = (b - a)⁻¹ • (f b - f a)` for `a ≠ b` and
`deriv f a` for `a = b`. -/
noncomputable def dslope (f : 𝕜 → E) (a : 𝕜) : 𝕜 → E := update (slope f a) a (deriv f a)

@[simp] lemma dslope_same (f : 𝕜 → E) (a : 𝕜) : dslope f a a = deriv f a := update_same _ _ _

variables {f : 𝕜 → E} {a b : 𝕜} {s : set 𝕜}

lemma dslope_of_ne (f : 𝕜 → E) (h : b ≠ a) : dslope f a b = slope f a b :=
update_noteq h _ _

lemma continuous_linear_map.dslope_comp {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
  (f : E →L[𝕜] F) (g : 𝕜 → E) (a b : 𝕜) (H : a = b → differentiable_at 𝕜 g a) :
  dslope (f ∘ g) a b = f (dslope g a b) :=
begin
  rcases eq_or_ne b a with rfl|hne,
  { simp only [dslope_same],
    exact (f.has_fderiv_at.comp_has_deriv_at b (H rfl).has_deriv_at).deriv },
  { simpa only [dslope_of_ne _ hne] using f.to_linear_map.slope_comp g a b }
end

lemma eq_on_dslope_slope (f : 𝕜 → E) (a : 𝕜) : eq_on (dslope f a) (slope f a) {a}ᶜ :=
λ b, dslope_of_ne f

lemma dslope_eventually_eq_slope_of_ne (f : 𝕜 → E) (h : b ≠ a) : dslope f a =ᶠ[𝓝 b] slope f a :=
(eq_on_dslope_slope f a).eventually_eq_of_mem (is_open_ne.mem_nhds h)

lemma dslope_eventually_eq_slope_punctured_nhds (f : 𝕜 → E) : dslope f a =ᶠ[𝓝[≠] a] slope f a :=
(eq_on_dslope_slope f a).eventually_eq_of_mem self_mem_nhds_within

@[simp] lemma sub_smul_dslope (f : 𝕜 → E) (a b : 𝕜) : (b - a) • dslope f a b = f b - f a :=
by rcases eq_or_ne b a with rfl | hne; simp [dslope_of_ne, *]

lemma dslope_sub_smul_of_ne (f : 𝕜 → E) (h : b ≠ a) : dslope (λ x, (x - a) • f x) a b = f b :=
by rw [dslope_of_ne _ h, slope_sub_smul _ h.symm]

lemma eq_on_dslope_sub_smul (f : 𝕜 → E) (a : 𝕜) : eq_on (dslope (λ x, (x - a) • f x) a) f {a}ᶜ :=
λ b, dslope_sub_smul_of_ne f

lemma dslope_sub_smul [decidable_eq 𝕜] (f : 𝕜 → E) (a : 𝕜) :
  dslope (λ x, (x - a) • f x) a = update f a (deriv (λ x, (x - a) • f x) a) :=
eq_update_iff.2 ⟨dslope_same _ _, eq_on_dslope_sub_smul f a⟩

@[simp] lemma continuous_at_dslope_same : continuous_at (dslope f a) a ↔ differentiable_at 𝕜 f a :=
by simp only [dslope, continuous_at_update_same, ← has_deriv_at_deriv_iff,
  has_deriv_at_iff_tendsto_slope]

lemma continuous_within_at.of_dslope (h : continuous_within_at (dslope f a) s b) :
  continuous_within_at f s b :=
have continuous_within_at (λ x, (x - a) • dslope f a x + f a) s b,
  from ((continuous_within_at_id.sub continuous_within_at_const).smul h).add
    continuous_within_at_const,
by simpa only [sub_smul_dslope, sub_add_cancel] using this

lemma continuous_at.of_dslope (h : continuous_at (dslope f a) b) : continuous_at f b :=
(continuous_within_at_univ _ _).1 h.continuous_within_at.of_dslope

lemma continuous_on.of_dslope (h : continuous_on (dslope f a) s) : continuous_on f s :=
λ x hx, (h x hx).of_dslope

lemma continuous_within_at_dslope_of_ne (h : b ≠ a) :
  continuous_within_at (dslope f a) s b ↔ continuous_within_at f s b :=
begin
  refine ⟨continuous_within_at.of_dslope, λ hc, _⟩,
  simp only [dslope, continuous_within_at_update_of_ne h],
  exact ((continuous_within_at_id.sub continuous_within_at_const).inv₀
      (sub_ne_zero.2 h)).smul (hc.sub continuous_within_at_const)
end

lemma continuous_at_dslope_of_ne (h : b ≠ a) : continuous_at (dslope f a) b ↔ continuous_at f b :=
by simp only [← continuous_within_at_univ, continuous_within_at_dslope_of_ne h]

lemma continuous_on_dslope (h : s ∈ 𝓝 a) :
  continuous_on (dslope f a) s ↔ continuous_on f s ∧ differentiable_at 𝕜 f a :=
begin
  refine ⟨λ hc, ⟨hc.of_dslope, continuous_at_dslope_same.1 $ hc.continuous_at h⟩, _⟩,
  rintro ⟨hc, hd⟩ x hx,
  rcases eq_or_ne x a with rfl | hne,
  exacts [(continuous_at_dslope_same.2 hd).continuous_within_at,
    (continuous_within_at_dslope_of_ne hne).2 (hc x hx)]
end

lemma differentiable_within_at.of_dslope (h : differentiable_within_at 𝕜 (dslope f a) s b) :
  differentiable_within_at 𝕜 f s b :=
by simpa only [id, sub_smul_dslope f a, sub_add_cancel]
  using ((differentiable_within_at_id.sub_const a).smul h).add_const (f a)

lemma differentiable_at.of_dslope (h : differentiable_at 𝕜 (dslope f a) b) :
  differentiable_at 𝕜 f b :=
differentiable_within_at_univ.1 h.differentiable_within_at.of_dslope

lemma differentiable_on.of_dslope (h : differentiable_on 𝕜 (dslope f a) s) :
  differentiable_on 𝕜 f s :=
λ x hx, (h x hx).of_dslope

lemma differentiable_within_at_dslope_of_ne (h : b ≠ a) :
  differentiable_within_at 𝕜 (dslope f a) s b ↔ differentiable_within_at 𝕜 f s b :=
begin
  refine ⟨differentiable_within_at.of_dslope, λ hd, _⟩,
  refine (((differentiable_within_at_id.sub_const a).inv
    (sub_ne_zero.2 h)).smul (hd.sub_const (f a))).congr_of_eventually_eq _ (dslope_of_ne _ h),
  refine (eq_on_dslope_slope _ _).eventually_eq_of_mem _,
  exact mem_nhds_within_of_mem_nhds (is_open_ne.mem_nhds h)
end

lemma differentiable_on_dslope_of_nmem (h : a ∉ s) :
  differentiable_on 𝕜 (dslope f a) s ↔ differentiable_on 𝕜 f s :=
forall_congr $ λ x, forall_congr $ λ hx, differentiable_within_at_dslope_of_ne $
  ne_of_mem_of_not_mem hx h

lemma differentiable_at_dslope_of_ne (h : b ≠ a) :
  differentiable_at 𝕜 (dslope f a) b ↔ differentiable_at 𝕜 f b :=
by simp only [← differentiable_within_at_univ,
  differentiable_within_at_dslope_of_ne h]


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import linear_algebra.quotient
import linear_algebra.prod

/-!
# Projection to a subspace

In this file we define
* `linear_proj_of_is_compl (p q : submodule R E) (h : is_compl p q)`: the projection of a module `E`
  to a submodule `p` along its complement `q`; it is the unique linear map `f : E → p` such that
  `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`.
* `is_compl_equiv_proj p`: equivalence between submodules `q` such that `is_compl p q` and
  projections `f : E → p`, `∀ x ∈ p, f x = x`.

We also provide some lemmas justifying correctness of our definitions.

## Tags

projection, complement subspace
-/

section ring

variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F]
  {G : Type*} [add_comm_group G] [module R G] (p q : submodule R E)
variables {S : Type*} [semiring S] {M : Type*} [add_comm_monoid M] [module S M] (m : submodule S M)

noncomputable theory

namespace linear_map

variable {p}

open submodule

lemma ker_id_sub_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  ker (id - p.subtype.comp f) = p :=
begin
  ext x,
  simp only [comp_apply, mem_ker, subtype_apply, sub_apply, id_apply, sub_eq_zero],
  exact ⟨λ h, h.symm ▸ submodule.coe_mem _, λ hx, by erw [hf ⟨x, hx⟩, subtype.coe_mk]⟩
end

lemma range_eq_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  range f = ⊤ :=
range_eq_top.2 $ λ x, ⟨x, hf x⟩

lemma is_compl_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
  is_compl p f.ker :=
begin
  split,
  { rintros x ⟨hpx, hfx⟩,
    erw [set_like.mem_coe, mem_ker, hf ⟨x, hpx⟩, mk_eq_zero] at hfx,
    simp only [hfx, set_like.mem_coe, zero_mem] },
  { intros x hx,
    rw [mem_sup'],
    refine ⟨f x, ⟨x - f x, _⟩, add_sub_cancel'_right _ _⟩,
    rw [mem_ker, linear_map.map_sub, hf, sub_self] }
end

end linear_map

namespace submodule

open linear_map

/-- If `q` is a complement of `p`, then `M/p ≃ q`. -/
def quotient_equiv_of_is_compl (h : is_compl p q) : (E ⧸ p) ≃ₗ[R] q :=
linear_equiv.symm $ linear_equiv.of_bijective (p.mkq.comp q.subtype)
  (by simp only [← ker_eq_bot, ker_comp, ker_mkq, disjoint_iff_comap_eq_bot.1 h.symm.disjoint])
  (by simp only [← range_eq_top, range_comp, range_subtype, map_mkq_eq_top, h.sup_eq_top])

@[simp] lemma quotient_equiv_of_is_compl_symm_apply (h : is_compl p q) (x : q) :
  (quotient_equiv_of_is_compl p q h).symm x = quotient.mk x := rfl

@[simp] lemma quotient_equiv_of_is_compl_apply_mk_coe (h : is_compl p q) (x : q) :
  quotient_equiv_of_is_compl p q h (quotient.mk x) = x :=
(quotient_equiv_of_is_compl p q h).apply_symm_apply x

@[simp] lemma mk_quotient_equiv_of_is_compl_apply (h : is_compl p q) (x : E ⧸ p) :
  (quotient.mk (quotient_equiv_of_is_compl p q h x) : E ⧸ p) = x :=
(quotient_equiv_of_is_compl p q h).symm_apply_apply x

/-- If `q` is a complement of `p`, then `p × q` is isomorphic to `E`. It is the unique
linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x ∈ q`. -/
def prod_equiv_of_is_compl (h : is_compl p q) : (p × q) ≃ₗ[R] E :=
begin
  apply linear_equiv.of_bijective (p.subtype.coprod q.subtype),
  { simp only [←ker_eq_bot, ker_eq_bot', prod.forall, subtype_apply, prod.mk_eq_zero, coprod_apply],
    -- TODO: if I add `submodule.forall`, it unfolds the outer `∀` but not the inner one.
    rintros ⟨x, hx⟩ ⟨y, hy⟩,
    simp only [coe_mk, mk_eq_zero, ← eq_neg_iff_add_eq_zero],
    rintro rfl,
    rw [neg_mem_iff] at hx,
    simp [disjoint_def.1 h.disjoint y hx hy] },
  { rw [← range_eq_top, ← sup_eq_range, h.sup_eq_top] }
end

@[simp] lemma coe_prod_equiv_of_is_compl (h : is_compl p q) :
  (prod_equiv_of_is_compl p q h : (p × q) →ₗ[R] E) = p.subtype.coprod q.subtype := rfl

@[simp] lemma coe_prod_equiv_of_is_compl' (h : is_compl p q) (x : p × q) :
  prod_equiv_of_is_compl p q h x = x.1 + x.2 := rfl

@[simp] lemma prod_equiv_of_is_compl_symm_apply_left (h : is_compl p q) (x : p) :
  (prod_equiv_of_is_compl p q h).symm x = (x, 0) :=
(prod_equiv_of_is_compl p q h).symm_apply_eq.2 $ by simp

@[simp] lemma prod_equiv_of_is_compl_symm_apply_right (h : is_compl p q) (x : q) :
  (prod_equiv_of_is_compl p q h).symm x = (0, x) :=
(prod_equiv_of_is_compl p q h).symm_apply_eq.2 $ by simp

@[simp] lemma prod_equiv_of_is_compl_symm_apply_fst_eq_zero (h : is_compl p q) {x : E} :
  ((prod_equiv_of_is_compl p q h).symm x).1 = 0 ↔ x ∈ q :=
begin
  conv_rhs { rw [← (prod_equiv_of_is_compl p q h).apply_symm_apply x] },
  rw [coe_prod_equiv_of_is_compl', submodule.add_mem_iff_left _ (submodule.coe_mem _),
    mem_right_iff_eq_zero_of_disjoint h.disjoint]
end

@[simp] lemma prod_equiv_of_is_compl_symm_apply_snd_eq_zero (h : is_compl p q) {x : E} :
  ((prod_equiv_of_is_compl p q h).symm x).2 = 0 ↔ x ∈ p :=
begin
  conv_rhs { rw [← (prod_equiv_of_is_compl p q h).apply_symm_apply x] },
  rw [coe_prod_equiv_of_is_compl', submodule.add_mem_iff_right _ (submodule.coe_mem _),
    mem_left_iff_eq_zero_of_disjoint h.disjoint]
end

@[simp]
lemma prod_comm_trans_prod_equiv_of_is_compl (h : is_compl p q) :
  linear_equiv.prod_comm R q p ≪≫ₗ prod_equiv_of_is_compl p q h =
    prod_equiv_of_is_compl q p h.symm :=
linear_equiv.ext $ λ _, add_comm _ _

/-- Projection to a submodule along its complement. -/
def linear_proj_of_is_compl (h : is_compl p q) :
  E →ₗ[R] p :=
(linear_map.fst R p q) ∘ₗ ↑(prod_equiv_of_is_compl p q h).symm

variables {p q}

@[simp] lemma linear_proj_of_is_compl_apply_left (h : is_compl p q) (x : p) :
  linear_proj_of_is_compl p q h x = x :=
by simp [linear_proj_of_is_compl]

@[simp] lemma linear_proj_of_is_compl_range (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).range = ⊤ :=
range_eq_of_proj (linear_proj_of_is_compl_apply_left h)

@[simp] lemma linear_proj_of_is_compl_apply_eq_zero_iff (h : is_compl p q) {x : E} :
  linear_proj_of_is_compl p q h x = 0 ↔ x ∈ q:=
by simp [linear_proj_of_is_compl]

lemma linear_proj_of_is_compl_apply_right' (h : is_compl p q) (x : E) (hx : x ∈ q) :
  linear_proj_of_is_compl p q h x = 0 :=
(linear_proj_of_is_compl_apply_eq_zero_iff h).2 hx

@[simp] lemma linear_proj_of_is_compl_apply_right (h : is_compl p q) (x : q) :
  linear_proj_of_is_compl p q h x = 0 :=
linear_proj_of_is_compl_apply_right' h x x.2

@[simp] lemma linear_proj_of_is_compl_ker (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).ker = q :=
ext $ λ x, mem_ker.trans (linear_proj_of_is_compl_apply_eq_zero_iff h)

lemma linear_proj_of_is_compl_comp_subtype (h : is_compl p q) :
  (linear_proj_of_is_compl p q h).comp p.subtype = id :=
linear_map.ext $ linear_proj_of_is_compl_apply_left h

lemma linear_proj_of_is_compl_idempotent (h : is_compl p q) (x : E) :
  linear_proj_of_is_compl p q h (linear_proj_of_is_compl p q h x) =
    linear_proj_of_is_compl p q h x :=
linear_proj_of_is_compl_apply_left h _

lemma exists_unique_add_of_is_compl_prod (hc : is_compl p q) (x : E) :
  ∃! (u : p × q), (u.fst : E) + u.snd = x :=
(prod_equiv_of_is_compl _ _ hc).to_equiv.bijective.exists_unique _

lemma exists_unique_add_of_is_compl (hc : is_compl p q) (x : E) :
  ∃ (u : p) (v : q), ((u : E) + v = x ∧ ∀ (r : p) (s : q),
    (r : E) + s = x → r = u ∧ s = v) :=
let ⟨u, hu₁, hu₂⟩ := exists_unique_add_of_is_compl_prod hc x in
  ⟨u.1, u.2, hu₁, λ r s hrs, prod.eq_iff_fst_eq_snd_eq.1 (hu₂ ⟨r, s⟩ hrs)⟩

lemma linear_proj_add_linear_proj_of_is_compl_eq_self (hpq : is_compl p q) (x : E) :
  (p.linear_proj_of_is_compl q hpq x + q.linear_proj_of_is_compl p hpq.symm x : E) = x :=
begin
  dunfold linear_proj_of_is_compl,
  rw ←prod_comm_trans_prod_equiv_of_is_compl _ _ hpq,
  exact (prod_equiv_of_is_compl _ _ hpq).apply_symm_apply x,
end

end submodule

namespace linear_map

open submodule

/-- Given linear maps `φ` and `ψ` from complement submodules, `of_is_compl` is
the induced linear map over the entire module. -/
def of_is_compl {p q : submodule R E} (h : is_compl p q)
  (φ : p →ₗ[R] F) (ψ : q →ₗ[R] F) : E →ₗ[R] F :=
(linear_map.coprod φ ψ) ∘ₗ ↑(submodule.prod_equiv_of_is_compl _ _ h).symm

variables {p q}

@[simp] lemma of_is_compl_left_apply
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (u : p) :
  of_is_compl h φ ψ (u : E) = φ u := by simp [of_is_compl]

@[simp] lemma of_is_compl_right_apply
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (v : q) :
  of_is_compl h φ ψ (v : E) = ψ v := by simp [of_is_compl]

lemma of_is_compl_eq (h : is_compl p q)
  {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
  (hφ : ∀ u, φ u = χ u) (hψ : ∀ u, ψ u = χ u) :
  of_is_compl h φ ψ = χ :=
begin
  ext x,
  obtain ⟨_, _, rfl, _⟩ := exists_unique_add_of_is_compl h x,
  simp [of_is_compl, hφ, hψ]
end

lemma of_is_compl_eq' (h : is_compl p q)
  {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} {χ : E →ₗ[R] F}
  (hφ : φ = χ.comp p.subtype) (hψ : ψ = χ.comp q.subtype) :
  of_is_compl h φ ψ = χ :=
of_is_compl_eq h (λ _, hφ.symm ▸ rfl) (λ _, hψ.symm ▸ rfl)

@[simp] lemma of_is_compl_zero (h : is_compl p q) :
  (of_is_compl h 0 0 : E →ₗ[R] F) = 0 :=
of_is_compl_eq _ (λ _, rfl) (λ _, rfl)

@[simp] lemma of_is_compl_add (h : is_compl p q)
  {φ₁ φ₂ : p →ₗ[R] F} {ψ₁ ψ₂ : q →ₗ[R] F} :
  of_is_compl h (φ₁ + φ₂) (ψ₁ + ψ₂) = of_is_compl h φ₁ ψ₁ + of_is_compl h φ₂ ψ₂ :=
of_is_compl_eq _ (by simp) (by simp)

@[simp] lemma of_is_compl_smul
  {R : Type*} [comm_ring R] {E : Type*} [add_comm_group E] [module R E]
  {F : Type*} [add_comm_group F] [module R F] {p q : submodule R E}
  (h : is_compl p q) {φ : p →ₗ[R] F} {ψ : q →ₗ[R] F} (c : R) :
  of_is_compl h (c • φ) (c • ψ) = c • of_is_compl h φ ψ :=
of_is_compl_eq _ (by simp) (by simp)

section

variables {R₁ : Type*} [comm_ring R₁] [module R₁ E] [module R₁ F]

/-- The linear map from `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` to `E →ₗ[R₁] F`. -/
def of_is_compl_prod {p q : submodule R₁ E} (h : is_compl p q) :
  ((p →ₗ[R₁] F) × (q →ₗ[R₁] F)) →ₗ[R₁] (E →ₗ[R₁] F) :=
{ to_fun := λ φ, of_is_compl h φ.1 φ.2,
  map_add' := by { intros φ ψ, rw [prod.snd_add, prod.fst_add, of_is_compl_add] },
  map_smul' := by { intros c φ, simp [prod.smul_snd, prod.smul_fst, of_is_compl_smul] } }

@[simp] lemma of_is_compl_prod_apply {p q : submodule R₁ E} (h : is_compl p q)
  (φ : (p →ₗ[R₁] F) × (q →ₗ[R₁] F)) : of_is_compl_prod h φ = of_is_compl h φ.1 φ.2 := rfl

/-- The natural linear equivalence between `(p →ₗ[R₁] F) × (q →ₗ[R₁] F)` and `E →ₗ[R₁] F`. -/
def of_is_compl_prod_equiv {p q : submodule R₁ E} (h : is_compl p q) :
  ((p →ₗ[R₁] F) × (q →ₗ[R₁] F)) ≃ₗ[R₁] (E →ₗ[R₁] F) :=
{ inv_fun := λ φ, ⟨φ.dom_restrict p, φ.dom_restrict q⟩,
  left_inv :=
    begin
      intros φ, ext,
      { exact of_is_compl_left_apply h x },
      { exact of_is_compl_right_apply h x }
    end,
  right_inv :=
    begin
      intro φ, ext,
      obtain ⟨a, b, hab, _⟩ := exists_unique_add_of_is_compl h x,
      rw [← hab], simp,
    end, .. of_is_compl_prod h }

end

@[simp] lemma linear_proj_of_is_compl_of_proj (f : E →ₗ[R] p) (hf : ∀ x : p, f x = x) :
  p.linear_proj_of_is_compl f.ker (is_compl_of_proj hf) = f :=
begin
  ext x,
  have : x ∈ p ⊔ f.ker,
  { simp only [(is_compl_of_proj hf).sup_eq_top, mem_top] },
  rcases mem_sup'.1 this with ⟨x, y, rfl⟩,
  simp [hf]
end

/-- If `f : E →ₗ[R] F` and `g : E →ₗ[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃ₗ[R] F × G`. -/
def equiv_prod_of_surjective_of_is_compl (f : E →ₗ[R] F) (g : E →ₗ[R] G) (hf : f.range = ⊤)
  (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
  E ≃ₗ[R] F × G :=
linear_equiv.of_bijective (f.prod g) (by simp [← ker_eq_bot, hfg.inf_eq_bot])
  (by simp [← range_eq_top, range_prod_eq hfg.sup_eq_top, *])

@[simp] lemma coe_equiv_prod_of_surjective_of_is_compl {f : E →ₗ[R] F} {g : E →ₗ[R] G}
  (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
  (equiv_prod_of_surjective_of_is_compl f g hf hg hfg : E →ₗ[R] F × G) = f.prod g :=
rfl

@[simp] lemma equiv_prod_of_surjective_of_is_compl_apply {f : E →ₗ[R] F} {g : E →ₗ[R] G}
  (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) (x : E):
  equiv_prod_of_surjective_of_is_compl f g hf hg hfg x = (f x, g x) :=
rfl

end linear_map

namespace submodule

open linear_map

/-- Equivalence between submodules `q` such that `is_compl p q` and linear maps `f : E →ₗ[R] p`
such that `∀ x : p, f x = x`. -/
def is_compl_equiv_proj :
  {q // is_compl p q} ≃ {f : E →ₗ[R] p // ∀ x : p, f x = x} :=
{ to_fun := λ q, ⟨linear_proj_of_is_compl p q q.2, linear_proj_of_is_compl_apply_left q.2⟩,
  inv_fun := λ f, ⟨(f : E →ₗ[R] p).ker, is_compl_of_proj f.2⟩,
  left_inv := λ ⟨q, hq⟩, by simp only [linear_proj_of_is_compl_ker, subtype.coe_mk],
  right_inv := λ ⟨f, hf⟩, subtype.eq $ f.linear_proj_of_is_compl_of_proj hf }

@[simp] lemma coe_is_compl_equiv_proj_apply (q : {q // is_compl p q}) :
  (p.is_compl_equiv_proj q : E →ₗ[R] p) = linear_proj_of_is_compl p q q.2 := rfl

@[simp] lemma coe_is_compl_equiv_proj_symm_apply (f : {f : E →ₗ[R] p // ∀ x : p, f x = x}) :
  (p.is_compl_equiv_proj.symm f : submodule R E) = (f : E →ₗ[R] p).ker := rfl

end submodule

namespace linear_map

open submodule

/--
A linear endomorphism of a module `E` is a projection onto a submodule `p` if it sends every element
of `E` to `p` and fixes every element of `p`.
The definition allow more generally any `fun_like` type and not just linear maps, so that it can be
used for example with `continuous_linear_map` or `matrix`.
-/
structure is_proj {F : Type*} [fun_like F M (λ _, M)] (f : F) : Prop :=
(map_mem : ∀ x, f x ∈ m)
(map_id : ∀ x ∈ m, f x = x)

lemma is_proj_iff_idempotent (f : M →ₗ[S] M) : (∃ p : submodule S M, is_proj p f) ↔ f ∘ₗ f = f :=
begin
  split,
  { intro h, obtain ⟨p, hp⟩ := h, ext, rw comp_apply, exact hp.map_id (f x) (hp.map_mem x), },
  { intro h, use f.range, split,
    { intro x, exact mem_range_self f x, },
    { intros x hx, obtain ⟨y, hy⟩ := mem_range.1 hx, rw [←hy, ←comp_apply, h], }, },
end

namespace is_proj

variables {p m}

/--
Restriction of the codomain of a projection of onto a subspace `p` to `p` instead of the whole
space.
-/
def cod_restrict {f : M →ₗ[S] M} (h : is_proj m f) : M →ₗ[S] m :=
f.cod_restrict m h.map_mem

@[simp]
lemma cod_restrict_apply {f : M →ₗ[S] M} (h : is_proj m f) (x : M) :
  ↑(h.cod_restrict x) = f x := f.cod_restrict_apply m x

@[simp]
lemma cod_restrict_apply_cod {f : M →ₗ[S] M} (h : is_proj m f) (x : m) :
  h.cod_restrict x = x :=
by {ext, rw [cod_restrict_apply], exact h.map_id x x.2}

lemma cod_restrict_ker {f : M →ₗ[S] M} (h : is_proj m f) :
  h.cod_restrict.ker = f.ker := f.ker_cod_restrict m _

lemma is_compl {f : E →ₗ[R] E} (h : is_proj p f) : is_compl p f.ker :=
by { rw ←cod_restrict_ker, exact is_compl_of_proj h.cod_restrict_apply_cod, }

lemma eq_conj_prod_map' {f : E →ₗ[R] E} (h : is_proj p f) :
  f = (p.prod_equiv_of_is_compl f.ker h.is_compl).to_linear_map ∘ₗ prod_map id 0 ∘ₗ
    (p.prod_equiv_of_is_compl f.ker h.is_compl).symm.to_linear_map :=
begin
  refine (linear_map.cancel_right
    (p.prod_equiv_of_is_compl f.ker h.is_compl).surjective).1 _,
  ext,
  { simp only [coe_comp, linear_equiv.coe_to_linear_map, coe_inl, function.comp_app,
  linear_equiv.of_top_apply, linear_equiv.of_injective_apply, coprod_apply, submodule.coe_subtype,
  coe_zero, add_zero, prod_equiv_of_is_compl_symm_apply_left, prod_map_apply, id_coe, id.def,
  zero_apply, coe_prod_equiv_of_is_compl', h.map_id x x.2], },
  {simp only [coe_comp, linear_equiv.coe_to_linear_map, coe_inr, function.comp_app,
  linear_equiv.of_top_apply, linear_equiv.of_injective_apply, coprod_apply, submodule.coe_subtype,
  coe_zero, zero_add, map_coe_ker, prod_equiv_of_is_compl_symm_apply_right, prod_map_apply, id_coe,
  id.def, zero_apply, coe_prod_equiv_of_is_compl'], }
end

end is_proj

end linear_map

end ring

section comm_ring

namespace linear_map

variables {R : Type*} [comm_ring R] {E : Type*} [add_comm_group E] [module R E]  {p : submodule R E}

lemma is_proj.eq_conj_prod_map {f : E →ₗ[R] E} (h : is_proj p f) :
  f = (p.prod_equiv_of_is_compl f.ker h.is_compl).conj (prod_map id 0) :=
by {rw linear_equiv.conj_apply, exact h.eq_conj_prod_map'}

end linear_map

end comm_ring


theorem add_le_add_right {a b : mynat} : a ≤ b → ∀ t, (a + t) ≤ (b + t) :=
begin
intro h,
intro t,
cases h with c hc,
use c,
rw hc,
apply add_right_comm,
end