/-
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.measure.complex_lebesgue
import measure_theory.integral.divergence_theorem
import measure_theory.integral.circle_integral
import analysis.calculus.dslope
import analysis.analytic.basic
import analysis.complex.re_im_topology
import analysis.calculus.diff_cont_on_cl
import data.real.cardinality

/-!
# Cauchy integral formula

In this file we prove the Cauchy-Goursat theorem and the Cauchy integral formula for integrals over
circles. Most results are formulated for a function `f : ℂ → E` that takes values in a complex
Banach space with second countable topology.

## Main statements

In the following theorems, if the name ends with `off_countable`, then the actual theorem assumes
differentiability at all but countably many points of the set mentioned below.

* `complex.integral_boundary_rect_of_has_fderiv_within_at_real_off_countable`: If a function
  `f : ℂ → E` is continuous on a closed rectangle and *real* differentiable on its interior, then
  its integral over the boundary of this rectangle is equal to the integral of
  `I • f' (x + y * I) 1 - f' (x + y * I) I` over the rectangle, where `f' z w : E` is the derivative
  of `f` at `z` in the direction `w` and `I = complex.I` is the imaginary unit.

* `complex.integral_boundary_rect_eq_zero_of_differentiable_on_off_countable`: If a function
  `f : ℂ → E` is continuous on a closed rectangle and is *complex* differentiable on its interior,
  then its integral over the boundary of this rectangle is equal to zero.

* `complex.circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable`: If a
  function `f : ℂ → E` is continuous on a closed annulus `{z | r ≤ |z - c| ≤ R}` and is complex
  differentiable on its interior `{z | r < |z - c| < R}`, then the integrals of `(z - c)⁻¹ • f z`
  over the outer boundary and over the inner boundary are equal.

* `complex.circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendsto`,
  `complex.circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable`:
  If a function `f : ℂ → E` is continuous on a punctured closed disc `{z | |z - c| ≤ R ∧ z ≠ c}`, is
  complex differentiable on the corresponding punctured open disc, and tends to `y` as `z → c`,
  `z ≠ c`, then the integral of `(z - c)⁻¹ • f z` over the circle `|z - c| = R` is equal to
  `2πiy`. In particular, if `f` is continuous on the whole closed disc and is complex differentiable
  on the corresponding open disc, then this integral is equal to `2πif(c)`.

* `complex.circle_integral_sub_inv_smul_of_differentiable_on_off_countable`,
  `complex.two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable`
  **Cauchy integral formula**: if `f : ℂ → E` is continuous on a closed disc of radius `R` and is
  complex differentiable on the corresponding open disc, then for any `w` in the corresponding open
  disc the integral of `(z - w)⁻¹ • f z` over the boundary of the disc is equal to `2πif(w)`.
  Two versions of the lemma put the multiplier `2πi` at the different sides of the equality.

* `complex.has_fpower_series_on_ball_of_differentiable_off_countable`: If `f : ℂ → E` is continuous
  on a closed disc of positive radius and is complex differentiable on the corresponding open disc,
  then it is analytic on the corresponding open disc, and the coefficients of the power series are
  given by Cauchy integral formulas.

* `differentiable_on.has_fpower_series_on_ball`: If `f : ℂ → E` is complex differentiable on a
  closed disc of positive radius, then it is analytic on the corresponding open disc, and the
  coefficients of the power series are given by Cauchy integral formulas.

* `differentiable_on.analytic_at`, `differentiable.analytic_at`: If `f : ℂ → E` is differentiable
  on a neighborhood of a point, then it is analytic at this point. In particular, if `f : ℂ → E`
  is differentiable on the whole `ℂ`, then it is analytic at every point `z : ℂ`.

* `differentiable.has_power_series_on_ball`: If `f : ℂ → E` is differentiable everywhere then the
  `cauchy_power_series f z R` is a formal power series representing `f` at `z` with infinite
  radius of convergence (this holds for any choice of `0 < R`).

## Implementation details

The proof of the Cauchy integral formula in this file is based on a very general version of the
divergence theorem, see `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`
(a version for functions defined on `fin (n + 1) → ℝ`),
`measure_theory.integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le`, and
`measure_theory.integral2_divergence_prod_of_has_fderiv_within_at_off_countable` (versions for
functions defined on `ℝ × ℝ`).

Usually, the divergence theorem is formulated for a $C^1$ smooth function. The theorems formulated
above deal with a function that is

* continuous on a closed box/rectangle;
* differentiable at all but countably many points of its interior;
* have divergence integrable over the closed box/rectangle.

First, we reformulate the theorem for a *real*-differentiable map `ℂ → E`, and relate the integral
of `f` over the boundary of a rectangle in `ℂ` to the integral of the derivative
$\frac{\partial f}{\partial \bar z}$ over the interior of this box. In particular, for a *complex*
differentiable function, the latter derivative is zero, hence the integral over the boundary of a
rectangle is zero. Thus we get the Cauchy-Goursat theorem for a rectangle in `ℂ`.

Next, we apply the this theorem to the function $F(z)=f(c+e^{z})$ on the rectangle
$[\ln r, \ln R]\times [0, 2\pi]$ to prove that
$$
  \oint_{|z-c|=r}\frac{f(z)\,dz}{z-c}=\oint_{|z-c|=R}\frac{f(z)\,dz}{z-c}
$$
provided that `f` is continuous on the closed annulus `r ≤ |z - c| ≤ R` and is complex
differentiable on its interior `r < |z - c| < R` (possibly, at all but countably many points).

Here and below, we write $\frac{f(z)}{z-c}$ in the documentation while the actual lemmas use
`(z - c)⁻¹ • f z` because `f z` belongs to some Banach space over `ℂ` and `f z / (z - c)` is
undefined.

Taking the limit of this equality as `r` tends to `𝓝[>] 0`, we prove
$$
  \oint_{|z-c|=R}\frac{f(z)\,dz}{z-c}=2\pi if(c)
$$
provided that `f` is continuous on the closed disc `|z - c| ≤ R` and is differentiable at all but
countably many points of its interior. This is the Cauchy integral formula for the center of a
circle. In particular, if we apply this function to `F z = (z - c) • f z`, then we get
$$
  \oint_{|z-c|=R} f(z)\,dz=0.
$$

In order to deduce the Cauchy integral formula for any point `w`, `|w - c| < R`, we consider the
slope function `g : ℂ → E` given by `g z = (z - w)⁻¹ • (f z - f w)` if `z ≠ w` and `g w = f' w`.
This function satisfies assumptions of the previous theorem, so we have
$$
  \oint_{|z-c|=R} \frac{f(z)\,dz}{z-w}=\oint_{|z-c|=R} \frac{f(w)\,dz}{z-w}=
  \left(\oint_{|z-c|=R} \frac{dz}{z-w}\right)f(w).
$$
The latter integral was computed in `circle_integral.integral_sub_inv_of_mem_ball` and is equal to
`2 * π * complex.I`.

There is one more step in the actual proof. Since we allow `f` to be non-differentiable on a
countable set `s`, we cannot immediately claim that `g` is continuous at `w` if `w ∈ s`. So, we use
the proof outlined in the previous paragraph for `w ∉ s` (see
`complex.circle_integral_sub_inv_smul_of_differentiable_on_off_countable_aux`), then use continuity
of both sides of the formula and density of `sᶜ` to prove the formula for all points of the open
ball, see `complex.circle_integral_sub_inv_smul_of_differentiable_on_off_countable`.

Finally, we use the properties of the Cauchy integrals established elsewhere (see
`has_fpower_series_on_cauchy_integral`) and Cauchy integral formula to prove that the original
function is analytic on the open ball.

## Tags

Cauchy-Goursat theorem, Cauchy integral formula
-/

open topological_space set measure_theory interval_integral metric filter function
open_locale interval real nnreal ennreal topology big_operators

noncomputable theory

universes u

variables {E : Type u} [normed_add_comm_group E] [normed_space ℂ E] [complete_space E]

namespace complex

/-- Suppose that a function `f : ℂ → E` is continuous on a closed rectangle with opposite corners at
`z w : ℂ`, is *real* differentiable at all but countably many points of the corresponding open
rectangle, and $\frac{\partial f}{\partial \bar z}$ is integrable on this rectangle. Then the
integral of `f` over the boundary of the rectangle is equal to the integral of
$2i\frac{\partial f}{\partial \bar z}=i\frac{\partial f}{\partial x}-\frac{\partial f}{\partial y}$
over the rectangle. -/
lemma integral_boundary_rect_of_has_fderiv_at_real_off_countable (f : ℂ → E)
  (f' : ℂ → ℂ →L[ℝ] E) (z w : ℂ) (s : set ℂ) (hs : s.countable)
  (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im]))
  (Hd : ∀ x ∈ (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im)) \ s,
    has_fderiv_at f (f' x) x)
  (Hi : integrable_on (λ z, I • f' z 1 - f' z I) ([z.re, w.re] ×ℂ [z.im, w.im])) :
  (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) +
    (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) - I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) =
    ∫ x : ℝ in z.re..w.re, ∫ y : ℝ in z.im..w.im, I • f' (x + y * I) 1 - f' (x + y * I) I :=
begin
  set e : (ℝ × ℝ) ≃L[ℝ] ℂ := equiv_real_prod_clm.symm,
  have he : ∀ x y : ℝ, ↑x + ↑y * I = e (x, y), from λ x y, (mk_eq_add_mul_I x y).symm,
  have he₁ : e (1, 0) = 1 := rfl, have he₂ : e (0, 1) = I := rfl,
  simp only [he] at *,
  set F : (ℝ × ℝ) → E := f ∘ e,
  set F' : (ℝ × ℝ) → (ℝ × ℝ) →L[ℝ] E := λ p, (f' (e p)).comp (e : (ℝ × ℝ) →L[ℝ] ℂ),
  have hF' : ∀ p : ℝ × ℝ, (-(I • F' p)) (1, 0) + F' p (0, 1) = -(I • f' (e p) 1 - f' (e p) I),
  { rintro ⟨x, y⟩,
    simp only [continuous_linear_map.neg_apply, continuous_linear_map.smul_apply, F',
      continuous_linear_map.comp_apply, continuous_linear_equiv.coe_coe, he₁, he₂,
      neg_add_eq_sub, neg_sub], },
  set R : set (ℝ × ℝ) := [z.re, w.re] ×ˢ [w.im, z.im],
  set t : set (ℝ × ℝ) := e ⁻¹' s,
  rw [uIcc_comm z.im] at Hc Hi, rw [min_comm z.im, max_comm z.im] at Hd,
  have hR : e ⁻¹' ([z.re, w.re] ×ℂ [w.im, z.im]) = R := rfl,
  have htc : continuous_on F R, from Hc.comp e.continuous_on hR.ge,
  have htd : ∀ p ∈ Ioo (min z.re w.re) (max z.re w.re) ×ˢ Ioo (min w.im z.im) (max w.im z.im) \ t,
    has_fderiv_at F (F' p) p := λ p hp, (Hd (e p) hp).comp p e.has_fderiv_at,
  simp_rw [← interval_integral.integral_smul, interval_integral.integral_symm w.im z.im,
    ← interval_integral.integral_neg, ← hF'],
  refine (integral2_divergence_prod_of_has_fderiv_within_at_off_countable
      (λ p, -(I • F p)) F (λ p, - (I • F' p)) F' z.re w.im w.re z.im t (hs.preimage e.injective)
      (htc.const_smul _).neg htc (λ p hp, ((htd p hp).const_smul I).neg) htd _).symm,
  rw [← (volume_preserving_equiv_real_prod.symm _).integrable_on_comp_preimage
    (measurable_equiv.measurable_embedding _)] at Hi,
  simpa only [hF'] using Hi.neg
end

/-- Suppose that a function `f : ℂ → E` is continuous on a closed rectangle with opposite corners at
`z w : ℂ`, is *real* differentiable on the corresponding open rectangle, and
$\frac{\partial f}{\partial \bar z}$ is integrable on this rectangle. Then the integral of `f` over
the boundary of the rectangle is equal to the integral of
$2i\frac{\partial f}{\partial \bar z}=i\frac{\partial f}{\partial x}-\frac{\partial f}{\partial y}$
over the rectangle. -/
lemma integral_boundary_rect_of_continuous_on_of_has_fderiv_at_real (f : ℂ → E)
  (f' : ℂ → ℂ →L[ℝ] E) (z w : ℂ)
  (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im]))
  (Hd : ∀ x ∈ (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im)),
    has_fderiv_at f (f' x) x)
  (Hi : integrable_on (λ z, I • f' z 1 - f' z I) ([z.re, w.re] ×ℂ [z.im, w.im])) :
  (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) +
    (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) - I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) =
    ∫ x : ℝ in z.re..w.re, ∫ y : ℝ in z.im..w.im, I • f' (x + y * I) 1 - f' (x + y * I) I :=
integral_boundary_rect_of_has_fderiv_at_real_off_countable f f' z w ∅ countable_empty Hc
  (λ x hx, Hd x hx.1) Hi

/-- Suppose that a function `f : ℂ → E` is *real* differentiable on a closed rectangle with opposite
corners at `z w : ℂ` and $\frac{\partial f}{\partial \bar z}$ is integrable on this rectangle. Then
the integral of `f` over the boundary of the rectangle is equal to the integral of
$2i\frac{\partial f}{\partial \bar z}=i\frac{\partial f}{\partial x}-\frac{\partial f}{\partial y}$
over the rectangle. -/
lemma integral_boundary_rect_of_differentiable_on_real (f : ℂ → E) (z w : ℂ)
  (Hd : differentiable_on ℝ f ([z.re, w.re] ×ℂ [z.im, w.im]))
  (Hi : integrable_on (λ z, I • fderiv ℝ f z 1 - fderiv ℝ f z I) ([z.re, w.re] ×ℂ [z.im, w.im])) :
  (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) +
    (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) - I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) =
    ∫ x : ℝ in z.re..w.re, ∫ y : ℝ in z.im..w.im,
      I • fderiv ℝ f (x + y * I) 1 - fderiv ℝ f (x + y * I) I :=
integral_boundary_rect_of_has_fderiv_at_real_off_countable f (fderiv ℝ f) z w ∅ countable_empty
  Hd.continuous_on
  (λ x hx, Hd.has_fderiv_at $ by simpa only [← mem_interior_iff_mem_nhds,
    interior_re_prod_im, uIcc, interior_Icc] using hx.1) Hi

/-- **Cauchy-Goursat theorem** for a rectangle: the integral of a complex differentiable function
over the boundary of a rectangle equals zero. More precisely, if `f` is continuous on a closed
rectangle and is complex differentiable at all but countably many points of the corresponding open
rectangle, then its integral over the boundary of the rectangle equals zero. -/
lemma integral_boundary_rect_eq_zero_of_differentiable_on_off_countable (f : ℂ → E)
  (z w : ℂ) (s : set ℂ) (hs : s.countable) (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im]))
  (Hd : ∀ x ∈ (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im)) \ s,
    differentiable_at ℂ f x) :
  (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) +
    (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) -
      I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) = 0 :=
by refine (integral_boundary_rect_of_has_fderiv_at_real_off_countable f
  (λ z, (fderiv ℂ f z).restrict_scalars ℝ) z w s hs Hc
  (λ x hx, (Hd x hx).has_fderiv_at.restrict_scalars ℝ) _).trans _;
    simp [← continuous_linear_map.map_smul]

/-- **Cauchy-Goursat theorem for a rectangle**: the integral of a complex differentiable function
over the boundary of a rectangle equals zero. More precisely, if `f` is continuous on a closed
rectangle and is complex differentiable on the corresponding open rectangle, then its integral over
the boundary of the rectangle equals zero. -/
lemma integral_boundary_rect_eq_zero_of_continuous_on_of_differentiable_on (f : ℂ → E) (z w : ℂ)
  (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im]))
  (Hd : differentiable_on ℂ f
    (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im))) :
  (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) +
    (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) -
      I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) = 0 :=
integral_boundary_rect_eq_zero_of_differentiable_on_off_countable f z w ∅ countable_empty
  Hc $ λ x hx, Hd.differentiable_at $ (is_open_Ioo.re_prod_im is_open_Ioo).mem_nhds hx.1

/-- **Cauchy-Goursat theorem** for a rectangle: the integral of a complex differentiable function
over the boundary of a rectangle equals zero. More precisely, if `f` is complex differentiable on a
closed rectangle, then its integral over the boundary of the rectangle equals zero. -/

/-- If `f : ℂ → E` is continuous the closed annulus `r ≤ ‖z - c‖ ≤ R`, `0 < r ≤ R`, and is complex
differentiable at all but countably many points of its interior, then the integrals of
`f z / (z - c)` (formally, `(z - c)⁻¹ • f z`) over the circles `‖z - c‖ = r` and `‖z - c‖ = R` are
equal to each other. -/
lemma circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable
  {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : s.countable)
  (hc : continuous_on f (closed_ball c R \ ball c r))
  (hd : ∀ z ∈ ball c R \ closed_ball c r \ s, differentiable_at ℂ f z) :
  ∮ z in C(c, R), (z - c)⁻¹ • f z = ∮ z in C(c, r), (z - c)⁻¹ • f z :=
begin
  /- We apply the previous lemma to `λ z, f (c + exp z)` on the rectangle
  `[log r, log R] × [0, 2 * π]`. -/
  set A := closed_ball c R \ ball c r,
  obtain ⟨a, rfl⟩ : ∃ a, real.exp a = r, from ⟨real.log r, real.exp_log h0⟩,
  obtain ⟨b, rfl⟩ : ∃ b, real.exp b = R, from ⟨real.log R, real.exp_log (h0.trans_le hle)⟩,
  rw [real.exp_le_exp] at hle,
  -- Unfold definition of `circle_integral` and cancel some terms.
  suffices : ∫ θ in 0..2 * π, I • f (circle_map c (real.exp b) θ) =
    ∫ θ in 0..2 * π, I • f (circle_map c (real.exp a) θ),
    by simpa only [circle_integral, add_sub_cancel', of_real_exp, ← exp_add, smul_smul,
      ← div_eq_mul_inv, mul_div_cancel_left _ (circle_map_ne_center (real.exp_pos _).ne'),
      circle_map_sub_center, deriv_circle_map],
  set R := [a, b] ×ℂ [0, 2 * π],
  set g : ℂ → ℂ := (+) c ∘ exp,
  have hdg : differentiable ℂ g := differentiable_exp.const_add _,
  replace hs : (g ⁻¹' s).countable := (hs.preimage (add_right_injective c)).preimage_cexp,
  have h_maps : maps_to g R A,
  { rintro z ⟨h, -⟩, simpa [dist_eq, g, abs_exp, hle] using h.symm },
  replace hc : continuous_on (f ∘ g) R, from hc.comp hdg.continuous.continuous_on h_maps,
  replace hd : ∀ z ∈ (Ioo (min a b) (max a b) ×ℂ Ioo (min 0 (2 * π)) (max 0 (2 * π))) \ g ⁻¹' s,
    differentiable_at ℂ (f ∘ g) z,
  { refine λ z hz, (hd (g z) ⟨_, hz.2⟩).comp z (hdg _),
    simpa [g, dist_eq, abs_exp, hle, and.comm] using hz.1.1 },
  simpa [g, circle_map, exp_periodic _, sub_eq_zero, ← exp_add]
    using integral_boundary_rect_eq_zero_of_differentiable_on_off_countable _ ⟨a, 0⟩ ⟨b, 2 * π⟩
      _ hs hc hd
end

/-- **Cauchy-Goursat theorem** for an annulus. If `f : ℂ → E` is continuous on the closed annulus
`r ≤ ‖z - c‖ ≤ R`, `0 < r ≤ R`, and is complex differentiable at all but countably many points of
its interior, then the integrals of `f` over the circles `‖z - c‖ = r` and `‖z - c‖ = R` are equal
to each other. -/
lemma circle_integral_eq_of_differentiable_on_annulus_off_countable
  {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : s.countable)
  (hc : continuous_on f (closed_ball c R \ ball c r))
  (hd : ∀ z ∈ ball c R \ closed_ball c r \ s, differentiable_at ℂ f z) :
  ∮ z in C(c, R), f z = ∮ z in C(c, r), f z :=
calc ∮ z in C(c, R), f z = ∮ z in C(c, R), (z - c)⁻¹ • (z - c) • f z :
  (circle_integral.integral_sub_inv_smul_sub_smul _ _ _ _).symm
... = ∮ z in C(c, r), (z - c)⁻¹ • (z - c) • f z :
  circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable h0 hle hs
    ((continuous_on_id.sub continuous_on_const).smul hc)
    (λ z hz, (differentiable_at_id.sub_const _).smul (hd z hz))
... = ∮ z in C(c, r), f z : circle_integral.integral_sub_inv_smul_sub_smul _ _ _ _

/-- **Cauchy integral formula** for the value at the center of a disc. If `f` is continuous on a
punctured closed disc of radius `R`, is differentiable at all but countably many points of the
interior of this disc, and has a limit `y` at the center of the disc, then the integral
$\oint_{‖z-c‖=R} \frac{f(z)}{z-c}\,dz$ is equal to $2πiy`. -/
lemma circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendsto
  {c : ℂ} {R : ℝ} (h0 : 0 < R) {f : ℂ → E} {y : E} {s : set ℂ} (hs : s.countable)
  (hc : continuous_on f (closed_ball c R \ {c}))
  (hd : ∀ z ∈ ball c R \ {c} \ s, differentiable_at ℂ f z) (hy : tendsto f (𝓝[{c}ᶜ] c) (𝓝 y)) :
  ∮ z in C(c, R), (z - c)⁻¹ • f z = (2 * π * I : ℂ) • y :=
begin
  rw [← sub_eq_zero, ← norm_le_zero_iff],
  refine le_of_forall_le_of_dense (λ ε ε0, _),
  obtain ⟨δ, δ0, hδ⟩ :
    ∃ δ > (0 : ℝ), ∀ z ∈ closed_ball c δ \ {c}, dist (f z) y < ε / (2 * π),
    from ((nhds_within_has_basis nhds_basis_closed_ball _).tendsto_iff nhds_basis_ball).1 hy _
      (div_pos ε0 real.two_pi_pos),
  obtain ⟨r, hr0, hrδ, hrR⟩ : ∃ r, 0 < r ∧ r ≤ δ ∧ r ≤ R :=
    ⟨min δ R, lt_min δ0 h0, min_le_left _ _, min_le_right _ _⟩,
  have hsub : closed_ball c R \ ball c r ⊆ closed_ball c R \ {c},
    from diff_subset_diff_right (singleton_subset_iff.2 $ mem_ball_self hr0),
  have hsub' : ball c R \ closed_ball c r ⊆ ball c R \ {c},
    from diff_subset_diff_right (singleton_subset_iff.2 $ mem_closed_ball_self hr0.le),
  have hzne : ∀ z ∈ sphere c r, z ≠ c,
    from λ z hz, ne_of_mem_of_not_mem hz (λ h, hr0.ne' $ dist_self c ▸ eq.symm h),
  /- The integral `∮ z in C(c, r), f z / (z - c)` does not depend on `0 < r ≤ R` and tends to
  `2πIy` as `r → 0`. -/
  calc ‖(∮ z in C(c, R), (z - c)⁻¹ • f z) - (2 * ↑π * I) • y‖
      = ‖(∮ z in C(c, r), (z - c)⁻¹ • f z) - ∮ z in C(c, r), (z - c)⁻¹ • y‖ :
    begin
      congr' 2,
      { exact circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable
          hr0 hrR hs (hc.mono hsub) (λ z hz, hd z ⟨hsub' hz.1, hz.2⟩) },
      { simp [hr0.ne'] }
    end
  ... = ‖∮ z in C(c, r), (z - c)⁻¹ • (f z - y)‖ :
    begin
      simp only [smul_sub],
      have hc' : continuous_on (λ z, (z - c)⁻¹) (sphere c r),
        from (continuous_on_id.sub continuous_on_const).inv₀ (λ z hz, sub_ne_zero.2 $ hzne _ hz),
      rw circle_integral.integral_sub; refine (hc'.smul _).circle_integrable hr0.le,
      { exact hc.mono (subset_inter (sphere_subset_closed_ball.trans $
          closed_ball_subset_closed_ball hrR) hzne) },
      { exact continuous_on_const }
    end
  ... ≤ 2 * π * r * (r⁻¹ * (ε / (2 * π))) :
    begin
      refine circle_integral.norm_integral_le_of_norm_le_const hr0.le (λ z hz, _),
      specialize hzne z hz,
      rw [mem_sphere, dist_eq_norm] at hz,
      rw [norm_smul, norm_inv, hz, ← dist_eq_norm],
      refine mul_le_mul_of_nonneg_left (hδ _ ⟨_, hzne⟩).le (inv_nonneg.2 hr0.le),
      rwa [mem_closed_ball_iff_norm, hz]
    end
  ... = ε : by { field_simp [hr0.ne', real.two_pi_pos.ne'], ac_refl }
end

/-- **Cauchy integral formula** for the value at the center of a disc. If `f : ℂ → E` is continuous
on a closed disc of radius `R` and is complex differentiable at all but countably many points of its
interior, then the integral $\oint_{|z-c|=R} \frac{f(z)}{z-c}\,dz$ is equal to $2πiy`. -/
lemma circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable {R : ℝ} (h0 : 0 < R)
  {f : ℂ → E} {c : ℂ} {s : set ℂ} (hs : s.countable)
  (hc : continuous_on f (closed_ball c R)) (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) :
  ∮ z in C(c, R), (z - c)⁻¹ • f z = (2 * π * I : ℂ) • f c :=
circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendsto h0 hs
  (hc.mono $ diff_subset _ _) (λ z hz, hd z ⟨hz.1.1, hz.2⟩)
  (hc.continuous_at $ closed_ball_mem_nhds _ h0).continuous_within_at

/-- **Cauchy-Goursat theorem** for a disk: if `f : ℂ → E` is continuous on a closed disk
`{z | ‖z - c‖ ≤ R}` and is complex differentiable at all but countably many points of its interior,
then the integral $\oint_{|z-c|=R}f(z)\,dz$ equals zero. -/
lemma circle_integral_eq_zero_of_differentiable_on_off_countable {R : ℝ} (h0 : 0 ≤ R) {f : ℂ → E}
  {c : ℂ} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R))
  (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) :
  ∮ z in C(c, R), f z = 0 :=
begin
  rcases h0.eq_or_lt with rfl|h0, { apply circle_integral.integral_radius_zero },
  calc ∮ z in C(c, R), f z = ∮ z in C(c, R), (z - c)⁻¹ • (z - c) • f z :
    (circle_integral.integral_sub_inv_smul_sub_smul _ _ _ _).symm
  ... = (2 * ↑π * I : ℂ) • (c - c) • f c :
    circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable h0 hs
      ((continuous_on_id.sub continuous_on_const).smul hc)
      (λ z hz, (differentiable_at_id.sub_const _).smul (hd z hz))
  ... = 0 : by rw [sub_self, zero_smul, smul_zero]
end

/-- An auxiliary lemma for
`complex.circle_integral_sub_inv_smul_of_differentiable_on_off_countable`. This lemma assumes
`w ∉ s` while the main lemma drops this assumption. -/
lemma circle_integral_sub_inv_smul_of_differentiable_on_off_countable_aux {R : ℝ} {c w : ℂ}
  {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R \ s)
  (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) :
  ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w :=
begin
  have hR : 0 < R := dist_nonneg.trans_lt hw.1,
  set F : ℂ → E := dslope f w,
  have hws : (insert w s).countable := hs.insert w,
  have hnhds : closed_ball c R ∈ 𝓝 w, from closed_ball_mem_nhds_of_mem hw.1,
  have hcF : continuous_on F (closed_ball c R),
    from (continuous_on_dslope $ closed_ball_mem_nhds_of_mem hw.1).2 ⟨hc, hd _ hw⟩,
  have hdF : ∀ z ∈ ball (c : ℂ) R \ (insert w s), differentiable_at ℂ F z,
    from λ z hz, (differentiable_at_dslope_of_ne
      (ne_of_mem_of_not_mem (mem_insert _ _) hz.2).symm).2
      (hd _ (diff_subset_diff_right (subset_insert _ _) hz)),
  have HI := circle_integral_eq_zero_of_differentiable_on_off_countable hR.le hws hcF hdF,
  have hne : ∀ z ∈ sphere c R, z ≠ w, from λ z hz, ne_of_mem_of_not_mem hz (ne_of_lt hw.1),
  have hFeq : eq_on F (λ z, (z - w)⁻¹ • f z - (z - w)⁻¹ • f w) (sphere c R),
  { intros z hz,
    calc F z = (z - w)⁻¹ • (f z - f w) : update_noteq (hne z hz) _ _
    ... = (z - w)⁻¹ • f z - (z - w)⁻¹ • f w : smul_sub _ _ _ },
  have hc' : continuous_on (λ z, (z - w)⁻¹) (sphere c R),
    from (continuous_on_id.sub continuous_on_const).inv₀ (λ z hz, sub_ne_zero.2 $ hne z hz),
  rw [← circle_integral.integral_sub_inv_of_mem_ball hw.1, ← circle_integral.integral_smul_const,
    ← sub_eq_zero, ← circle_integral.integral_sub, ← circle_integral.integral_congr hR.le hFeq, HI],
  exacts [(hc'.smul (hc.mono sphere_subset_closed_ball)).circle_integrable hR.le,
    (hc'.smul continuous_on_const).circle_integrable hR.le]
end

/-- **Cauchy integral formula**: if `f : ℂ → E` is continuous on a closed disc of radius `R` and is
complex differentiable at all but countably many points of its interior, then for any `w` in this
interior we have $\frac{1}{2πi}\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=f(w)$.
-/
lemma two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable
  {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R)
  (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) :
  (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z = f w :=
begin
  have hR : 0 < R := dist_nonneg.trans_lt hw,
  suffices : w ∈ closure (ball c R \ s),
  { lift R to ℝ≥0 using hR.le,
    have A : continuous_at (λ w, (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z) w,
    { have := has_fpower_series_on_cauchy_integral
      ((hc.mono sphere_subset_closed_ball).circle_integrable R.coe_nonneg) hR,
      refine this.continuous_on.continuous_at (emetric.is_open_ball.mem_nhds _),
      rwa metric.emetric_ball_nnreal },
    have B : continuous_at f w, from hc.continuous_at (closed_ball_mem_nhds_of_mem hw),
    refine tendsto_nhds_unique_of_frequently_eq A B ((mem_closure_iff_frequently.1 this).mono _),
    intros z hz,
    rw [circle_integral_sub_inv_smul_of_differentiable_on_off_countable_aux hs hz hc hd,
      inv_smul_smul₀],
    simp [real.pi_ne_zero, I_ne_zero] },
  refine mem_closure_iff_nhds.2 (λ t ht, _),
  -- TODO: generalize to any vector space over `ℝ`
  set g : ℝ → ℂ := λ x, w + x,
  have : tendsto g (𝓝 0) (𝓝 w),
    from (continuous_const.add continuous_of_real).tendsto' 0 w (add_zero _),
  rcases mem_nhds_iff_exists_Ioo_subset.1 (this $ inter_mem ht $ is_open_ball.mem_nhds hw)
    with ⟨l, u, hlu₀, hlu_sub⟩,
  obtain ⟨x, hx⟩ : (Ioo l u \ g ⁻¹' s).nonempty,
  { refine nonempty_diff.2 (λ hsub, _),
    have : (Ioo l u).countable,
      from (hs.preimage ((add_right_injective w).comp of_real_injective)).mono hsub,
    rw [← cardinal.le_aleph_0_iff_set_countable,
      cardinal.mk_Ioo_real (hlu₀.1.trans hlu₀.2)] at this,
    exact this.not_lt cardinal.aleph_0_lt_continuum },
  exact ⟨g x, (hlu_sub hx.1).1, (hlu_sub hx.1).2, hx.2⟩
end

/-- **Cauchy integral formula**: if `f : ℂ → E` is continuous on a closed disc of radius `R` and is
complex differentiable at all but countably many points of its interior, then for any `w` in this
interior we have $\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=2πif(w)$.
-/
lemma circle_integral_sub_inv_smul_of_differentiable_on_off_countable
  {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R)
  (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) :
  ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w :=
by { rw [← two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable
  hs hw hc hd, smul_inv_smul₀], simp [real.pi_ne_zero, I_ne_zero] }

/-- **Cauchy integral formula**: if `f : ℂ → E` is complex differentiable on an open disc and is
continuous on its closure, then for any `w` in this open ball we have
$\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=2πif(w)$. -/
lemma _root_.diff_cont_on_cl.circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ} {f : ℂ → E}
  (h : diff_cont_on_cl ℂ f (ball c R)) (hw : w ∈ ball c R) :
  ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w :=
circle_integral_sub_inv_smul_of_differentiable_on_off_countable countable_empty hw
  h.continuous_on_ball $ λ x hx, h.differentiable_at is_open_ball hx.1

/-- **Cauchy integral formula**: if `f : ℂ → E` is complex differentiable on an open disc and is
continuous on its closure, then for any `w` in this open ball we have
$\frac{1}{2πi}\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=f(w)$. -/
lemma _root_.diff_cont_on_cl.two_pi_I_inv_smul_circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ}
  {f : ℂ → E} (hf : diff_cont_on_cl ℂ f (ball c R)) (hw : w ∈ ball c R) :
  (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z = f w :=
begin
  have hR : 0 < R := not_le.mp (ball_eq_empty.not.mp (nonempty_of_mem hw).ne_empty),
  refine two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable
    countable_empty hw _ _,
  { simpa only [closure_ball c hR.ne.symm] using hf.continuous_on },
  { simpa only [diff_empty] using λ z hz, hf.differentiable_at is_open_ball hz }
end

/-- **Cauchy integral formula**: if `f : ℂ → E` is complex differentiable on a closed disc of radius
`R`, then for any `w` in its interior we have $\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=2πif(w)$. -/
lemma _root_.differentiable_on.circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ} {f : ℂ → E}
  (hd : differentiable_on ℂ f (closed_ball c R)) (hw : w ∈ ball c R)  :
  ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w :=
(hd.mono closure_ball_subset_closed_ball).diff_cont_on_cl.circle_integral_sub_inv_smul hw

/-- **Cauchy integral formula**: if `f : ℂ → ℂ` is continuous on a closed disc of radius `R` and is
complex differentiable at all but countably many points of its interior, then for any `w` in this
interior we have $\oint_{|z-c|=R}\frac{f(z)}{z-w}dz=2\pi i\,f(w)$.
-/
lemma circle_integral_div_sub_of_differentiable_on_off_countable {R : ℝ} {c w : ℂ} {s : set ℂ}
  (hs : s.countable) (hw : w ∈ ball c R) {f : ℂ → ℂ} (hc : continuous_on f (closed_ball c R))
  (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) :
  ∮ z in C(c, R), f z / (z - w) = 2 * π * I * f w :=
by simpa only [smul_eq_mul, div_eq_inv_mul]
  using circle_integral_sub_inv_smul_of_differentiable_on_off_countable hs hw hc hd

/-- If `f : ℂ → E` is continuous on a closed ball of positive radius and is differentiable at all
but countably many points of the corresponding open ball, then it is analytic on the open ball with
coefficients of the power series given by Cauchy integral formulas. -/
lemma has_fpower_series_on_ball_of_differentiable_off_countable {R : ℝ≥0} {c : ℂ} {f : ℂ → E}
  {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R))
  (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) (hR : 0 < R) :
  has_fpower_series_on_ball f (cauchy_power_series f c R) c R :=
{ r_le := le_radius_cauchy_power_series _ _ _,
  r_pos := ennreal.coe_pos.2 hR,
  has_sum := λ w hw,
    begin
      have hw' : c + w ∈ ball c R,
        by simpa only [add_mem_ball_iff_norm, ← coe_nnnorm, mem_emetric_ball_zero_iff,
          nnreal.coe_lt_coe, ennreal.coe_lt_coe] using hw,
      rw ← two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable hs
        hw' hc hd,
      exact (has_fpower_series_on_cauchy_integral
        ((hc.mono sphere_subset_closed_ball).circle_integrable R.2) hR).has_sum hw
    end }

/-- If `f : ℂ → E` is complex differentiable on an open disc of positive radius and is continuous
on its closure, then it is analytic on the open disc with coefficients of the power series given by
Cauchy integral formulas. -/
lemma _root_.diff_cont_on_cl.has_fpower_series_on_ball {R : ℝ≥0} {c : ℂ} {f : ℂ → E}
  (hf : diff_cont_on_cl ℂ f (ball c R)) (hR : 0 < R) :
  has_fpower_series_on_ball f (cauchy_power_series f c R) c R :=
has_fpower_series_on_ball_of_differentiable_off_countable countable_empty hf.continuous_on_ball
  (λ z hz, hf.differentiable_at is_open_ball hz.1) hR

/-- If `f : ℂ → E` is complex differentiable on a closed disc of positive radius, then it is
analytic on the corresponding open disc, and the coefficients of the power series are given by
Cauchy integral formulas. See also
`complex.has_fpower_series_on_ball_of_differentiable_off_countable` for a version of this lemma with
weaker assumptions. -/
protected lemma _root_.differentiable_on.has_fpower_series_on_ball {R : ℝ≥0} {c : ℂ} {f : ℂ → E}
  (hd : differentiable_on ℂ f (closed_ball c R)) (hR : 0 < R) :
  has_fpower_series_on_ball f (cauchy_power_series f c R) c R :=
(hd.mono closure_ball_subset_closed_ball).diff_cont_on_cl.has_fpower_series_on_ball hR

/-- If `f : ℂ → E` is complex differentiable on some set `s`, then it is analytic at any point `z`
such that `s ∈ 𝓝 z` (equivalently, `z ∈ interior s`). -/
protected lemma _root_.differentiable_on.analytic_at {s : set ℂ} {f : ℂ → E} {z : ℂ}
  (hd : differentiable_on ℂ f s) (hz : s ∈ 𝓝 z) : analytic_at ℂ f z :=
begin
  rcases nhds_basis_closed_ball.mem_iff.1 hz with ⟨R, hR0, hRs⟩,
  lift R to ℝ≥0 using hR0.le,
  exact ((hd.mono hRs).has_fpower_series_on_ball hR0).analytic_at
end

lemma _root_.differentiable_on.analytic_on {s : set ℂ} {f : ℂ → E} (hd : differentiable_on ℂ f s)
  (hs : is_open s) : analytic_on ℂ f s :=
λ z hz, hd.analytic_at (hs.mem_nhds hz)

/-- A complex differentiable function `f : ℂ → E` is analytic at every point. -/
protected lemma _root_.differentiable.analytic_at {f : ℂ → E} (hf : differentiable ℂ f) (z : ℂ) :
  analytic_at ℂ f z :=
hf.differentiable_on.analytic_at univ_mem

/-- When `f : ℂ → E` is differentiable, the `cauchy_power_series f z R` represents `f` as a power
series centered at `z` in the entirety of `ℂ`, regardless of `R : ℝ≥0`, with  `0 < R`. -/
protected lemma _root_.differentiable.has_fpower_series_on_ball {f : ℂ → E}
  (h : differentiable ℂ f) (z : ℂ) {R : ℝ≥0} (hR : 0 < R) :
  has_fpower_series_on_ball f (cauchy_power_series f z R) z ∞ :=
(h.differentiable_on.has_fpower_series_on_ball hR).r_eq_top_of_exists $ λ r hr,
  ⟨_, h.differentiable_on.has_fpower_series_on_ball hr⟩

end complex


import game.order.level09
import data.real.basic -- imports the real numbers ℝ

namespace xena -- hide

-- World name : Sup and Inf

/-
# Chapter 3 : Sup and Inf

## Level 1 : Upper bounds
-/

/-
Let $X$ be a set of real numbers.

We say a real number $b$ is an *upper bound* for $X$ if every $x \in X$ is at most $b$.
-/

definition is_upper_bound (S : set ℝ) (x : ℝ) := ∀ s ∈ S, s ≤ x

/-
Here is an easy fact about upper bounds, which we shall prove below:
If $X \subseteq Y$ are two sets of reals, and $b$ is an upper bound for $Y$,
then it's also an upper bound for $X$.

You can prove this easily in Lean using the `change` tactic.
-/

/- Lemma
If $X \subseteq Y$ are two sets of reals, and $b$ is an upper bound for $Y$,
then it's also an upper bound for $X$.
-/
lemma upper_bounds_mono (X Y : set ℝ) (h1 : X ⊆ Y) (b : ℝ) : is_upper_bound Y b → is_upper_bound X b :=
begin
  intro h2,
  intro a,
  intro ha,
  apply h2,
  change ∀ a, a ∈ X → a ∈ Y at h1,
--  unfold has_subset.subset set.subset at h1,
  apply h1,
  exact ha,
end

end xena -- hide


import tactic.ring
import tactic.pi_instances
import analysis.complex.basic
import ring_theory.coprime.basic
import ring_theory.int.basic
import data.complex.basic
import analysis.p_series
import data.real.nnreal
import analysis.special_functions.pow

universes u v

open complex

open_locale big_operators

noncomputable theory

/-! ### Riemann zeta function -/

def rie (k : ℝ): ℕ → ℝ :=
λ x, 1/((x: ℝ)^k)

/--The `Riemann zeta function` defined on the real numbers.
It is defined as the infinite sum of the reciprocals of the naturals to the power `k`. We check it is summable at the end for real `k` greater than 1.-/

def Riemann_zeta (k : ℝ): ℝ :=
 ∑' (x : ℕ), (rie k x)

lemma Riemann_zeta_is_summmable (k: ℝ) (h: 1 < k): summable (rie k):=
begin
rw rie,

have h2:=nnreal.summable_one_div_rpow.2 h, simp only [one_div, real.summable_nat_rpow_inv], exact h,
end

lemma int_Riemann_zeta_is_summmable (k: ℤ) (h: 1 < k): summable (rie k):=
begin
apply Riemann_zeta_is_summmable, norm_cast, exact h,
end

lemma Riemann_zeta_pos (k : ℝ) (h: 1 < k) : 0 < Riemann_zeta k :=
begin
  rw Riemann_zeta,
  apply tsum_pos (Riemann_zeta_is_summmable k h) _ 1,
  rw rie,
  simp,
  intro b,
  simp_rw rie,
  simp,
  apply real.rpow_nonneg_of_nonneg,
  norm_cast,
  linarith,
end


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

open_locale classical

#check @half_pos
#check @abs_sub_comm
#check @abs_sub_le
#check @add_halves

-- BEGIN
theorem converges_to_unique {s : ℕ → ℝ} {a b : ℝ}
    (sa : converges_to s a) (sb : converges_to s b) :
  a = b :=
begin
  by_contradiction abne,
  have : abs (a - b) > 0 := abs_pos.mpr (sub_ne_zero_of_ne abne),
  let ε := abs (a - b) / 2,
  have εpos : ε > 0 := half_pos this,
  cases sa ε εpos with Na hNa,
  cases sb ε εpos with Nb hNb,
  let N := max Na Nb,
  have absa : abs (s N - a) < ε := hNa N (le_max_left Na Nb),
  have absb : abs (s N - b) < ε := hNb N (le_max_right Na Nb),
  have : abs (a - b) < abs (a - b),
  { nth_rewrite 1 (by simp : |a - b| = ε + ε),
    -- OR: nth_rewrite 1 ← add_halves (abs (a - b)),
    rw abs_sub_comm at absa,
    linarith only [absa, absb, abs_sub_le a (s N) b], },
  exact lt_irrefl _ this
end
-- END


/- Lecture 1.1: Basics — Specifications -/

/- Natural numbers -/

namespace my_nat

inductive nat
| zero : nat
| succ : nat → nat

#check nat
#check nat.zero
#check nat.succ

#print nat

def add : nat → nat → nat
| m nat.zero     := m
| m (nat.succ n) := nat.succ (add m n)

#reduce add (nat.succ nat.zero) (nat.succ nat.zero)

lemma add_comm (m n : nat) : add m n = add n m :=
_

lemma add_assoc (l m n : nat) : add (add l m) n = add l (add m n) :=
_

def mul : nat → nat → nat
| _ nat.zero     := nat.zero
| m (nat.succ n) := add m (mul m n)

#reduce mul (nat.succ (nat.succ nat.zero)) (nat.succ (nat.succ nat.zero))

lemma mul_comm (m n : nat) : mul m n = mul n m :=
begin
induction n,
simp[mul],
induction m,
simp[mul],
rw[m_ih],
end

lemma mul_assoc (l m n : nat) : mul (mul l m) n = mul l (mul m n) :=
_

lemma mul_add (l m n : nat) : mul l (add m n) = add (mul l m) (mul l n) :=
_

#print mul
#print mul._main

-- illegal
def evil : nat → nat
| n := nat.succ (evil n)

end my_nat

def power : ℕ → ℕ → ℕ
| _ 0            := 1
| m (nat.succ n) := m * power m n

#reduce power 2 5

def power' (m : ℕ) : ℕ → ℕ
| 0            := 1
| (nat.succ n) := m * power' n

#reduce power' 2 5

def iter (α : Type) (z : α) (f : α → α) : ℕ → α
| 0            := z
| (nat.succ n) := f (iter n)

#check iter

def power'' (m n : ℕ) :=
iter _ 1 (λl, m * l) n

#reduce power'' 2 5

/- Lists -/

namespace my_list

inductive list (α : Type)
| nil : list
| cons : α → list → list

#check list.nil
#check list.cons
#check @list.cons

def append (α : Type) : list α → list α → list α
| (list.nil _)     ys := ys
| (list.cons x xs) ys := list.cons x (append xs ys)

#check append
#reduce append _ (list.cons 1 (list.nil _)) (list.cons 2 (list.nil _))

def append' {α : Type} : list α → list α → list α
| (list.nil _)     ys := ys
| (list.cons x xs) ys := list.cons x (append' xs ys)

#check append'
#reduce append' (list.cons 1 (list.nil _)) (list.cons 2 (list.nil _))

end my_list

#print list

def reverse {α : Type} : list α → list α
| []        := []
| (x :: xs) := reverse xs ++ [x]

lemma reverse_reverse {α : Type} (xs : list α) : reverse (reverse xs) = xs :=
begin
induction xs,
refl,
rw[<-xs_ih],
simp[list.append_assoc]
end

lemma reverse_concat {α: Type} {β: Type} (xs : list α) (ls : list α): reverse (append xs ls) = append (reverse xs) (reverse ls) :=
begin
simp[append],
simp

end

/- Some basic types -/

#print bool

#reduce ff || tt

#print prod
#print sum

#print empty

#check (ℕ → ℕ) → list ℕ → list ℕ
#check Πα β, (α → β) → list α → list β

/- RGB values -/

structure rgb :=
(red green blue : ℕ)

structure rgba extends rgb :=
(alpha : ℕ)

#print rgb
#print rgba

#reduce rgb.mk 0xff 0xcc 0xff
#reduce ({red := 0xff, green := 0xcc, blue := 0xff} : rgb)
#reduce ({red := 0xff, green := 0xcc, blue := 0xff, alpha := 0x7f} : rgba)

def red : rgb := {red := 0xff, green := 0x00, blue := 0x00}
def semitransparent_red : rgba := {alpha := 0x7f, ..red}
def green : rgb := ⟨0x00, 0xff, 0x00⟩

#print red
#print semitransparent_red
#print green

def shuffle (c : rgb) : rgb :=
{red := c.green, green := c.blue, blue := c.red}

lemma shuffle_shuffle_shuffle (c : rgb) : shuffle (shuffle (shuffle c)) = c :=
by cases c; refl


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Instantiate the complex numbers as a normed space, by temporarily making it an inner product space
over the reals.
-/
import theories.analysis.inner_product data.complex
open nat real complex analysis classical
noncomputable theory

namespace complex
  namespace real_inner_product_space
    definition smul (a : ℝ) (z : ℂ) : ℂ := complex.mk (a * re z) (a * im z)

    definition ip (z w : ℂ) : ℝ := re z * re w + im z * im w

    proposition smul_left_distrib (a : ℝ) (z w : ℂ) : smul a (z + w) = smul a z + smul a w :=
    by rewrite [↑smul, *re_add, *im_add, *left_distrib]

    proposition smul_right_distrib (a b : ℝ) (z : ℂ) : smul (a + b) z = smul a z + smul b z :=
    by rewrite [↑smul, *right_distrib]

    proposition mul_smul (a b : ℝ) (z : ℂ) : smul (a * b) z = smul a (smul b z) :=
    by rewrite [↑smul, *mul.assoc]

    proposition one_smul (z : ℂ) : smul 1 z = z := by rewrite [↑smul, *one_mul, complex.eta]

    proposition inner_add_left (x y z : ℂ) : ip (x + y) z = ip x z + ip y z :=
    by rewrite [↑ip, re_add, im_add, *right_distrib, *add.assoc, add.left_comm (re y * re z)]

    proposition inner_smul_left (a : ℝ) (x y : ℂ) : ip (smul a x) y = a * ip x y :=
    by rewrite [↑ip, ↑smul, left_distrib, *mul.assoc]

    proposition inner_comm (x y : ℂ) : ip x y = ip y x :=
    by rewrite [↑ip, mul.comm, mul.comm (im x)]

    proposition inner_self_nonneg (x : ℂ) : ip x x ≥ 0 :=
    add_nonneg (mul_self_nonneg (re x)) (mul_self_nonneg (im x))

    proposition eq_zero_of_inner_self_eq_zero {x : ℂ} (H : ip x x = 0) : x = 0 :=
    have re x = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero H,
    have im x = 0, from eq_zero_of_mul_self_add_mul_self_eq_zero
                         (by rewrite [↑ip at H, add.comm at H]; exact H),
    by rewrite [-complex.eta, `re x = 0`, `im x = 0`]
  end real_inner_product_space

  protected definition real_inner_product_space [reducible] : inner_product_space ℂ :=
  ⦃ inner_product_space, complex.discrete_field,
    smul               := real_inner_product_space.smul,
    inner              := real_inner_product_space.ip,
    smul_left_distrib  := real_inner_product_space.smul_left_distrib,
    smul_right_distrib := real_inner_product_space.smul_right_distrib,
    mul_smul           := real_inner_product_space.mul_smul,
    one_smul           := real_inner_product_space.one_smul,
    inner_add_left     := real_inner_product_space.inner_add_left,
    inner_smul_left    := real_inner_product_space.inner_smul_left,
    inner_comm         := real_inner_product_space.inner_comm,
    inner_self_nonneg  := real_inner_product_space.inner_self_nonneg,
    eq_zero_of_inner_self_eq_zero := @real_inner_product_space.eq_zero_of_inner_self_eq_zero
  ⦄

  local attribute complex.real_inner_product_space [trans_instance]

  protected definition normed_vector_space [trans_instance] : normed_vector_space ℂ :=
  _

  theorem norm_squared_eq_cmod (z : ℂ) : ∥ z ∥^2 = cmod z := by rewrite norm_squared
end complex


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import data.nat.gcd
import logic.function.iterate
import tactic.ring

/-!
# The Fibonacci Sequence

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `fib` returns the stream of Fibonacci numbers.

## Main Statements

- `fib_add_two` : shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `fib_gcd`     : `fib n` is a strong divisibility sequence.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

namespace nat

/--
Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
@[pp_nodot]
def fib (n : ℕ) : ℕ := ((λ p : ℕ × ℕ, (p.snd, p.fst + p.snd))^[n] (0, 1)).fst

@[simp] lemma fib_zero : fib 0 = 0 := rfl
@[simp] lemma fib_one : fib 1 = 1 := rfl
@[simp] lemma fib_two : fib 2 = 1 := rfl

/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
lemma fib_add_two {n : ℕ} : fib (n + 2) = fib n + fib (n + 1) :=
by simp only [fib, function.iterate_succ']

lemma fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := by { cases n; simp [fib_add_two] }

@[mono] lemma fib_mono : monotone fib :=
monotone_nat_of_le_succ $ λ _, fib_le_fib_succ

lemma fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n :=
calc 0 < fib 1 : dec_trivial
   ... ≤ fib n : fib_mono n_pos

lemma fib_lt_fib_succ {n : ℕ} (hn : 2 ≤ n) : fib n < fib (n + 1) :=
begin
  rcases le_iff_exists_add.1 hn with ⟨n, rfl⟩,
  simp only [add_comm 2, fib_add_two], rw add_comm,
  exact lt_add_of_pos_left _ (fib_pos succ_pos')
end

/-- `fib (n + 2)` is strictly monotone. -/
lemma fib_add_two_strict_mono : strict_mono (λ n, fib (n + 2)) :=
begin
  refine strict_mono_nat_of_lt_succ (λ n, _),
  rw add_right_comm,
  exact fib_lt_fib_succ (self_le_add_left _ _)
end

lemma le_fib_self {n : ℕ} (five_le_n : 5 ≤ n) : n ≤ fib n :=
begin
  induction five_le_n with n five_le_n IH,
  { -- 5 ≤ fib 5
    refl },
  { -- n + 1 ≤ fib (n + 1) for 5 ≤ n
    rw succ_le_iff,
    calc n ≤ fib n       : IH
       ... < fib (n + 1) : fib_lt_fib_succ (le_trans dec_trivial five_le_n) }
end

/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
lemma fib_coprime_fib_succ (n : ℕ) : nat.coprime (fib n) (fib (n + 1)) :=
begin
  induction n with n ih,
  { simp },
  { rw [fib_add_two, coprime_add_self_right],
    exact ih.symm }
end

/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
lemma fib_add (m n : ℕ) :
  fib m * fib n + fib (m + 1) * fib (n + 1) = fib (m + n + 1) :=
begin
  induction n with n ih generalizing m,
  { simp },
  { intros,
    specialize ih (m + 1),
    rw [add_assoc m 1 n, add_comm 1 n] at ih,
    simp only [fib_add_two, ← ih],
    ring, }
end

lemma gcd_fib_add_self (m n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) :=
begin
  cases nat.eq_zero_or_pos n,
  { rw h, simp },
  replace h := nat.succ_pred_eq_of_pos h, rw [← h, succ_eq_add_one],
  calc gcd (fib m) (fib (n.pred + 1 + m))
        = gcd (fib m) (fib (n.pred) * (fib m) + fib (n.pred + 1) * fib (m + 1)) :
    by { rw fib_add n.pred _, ring_nf }
    ... = gcd (fib m) (fib (n.pred + 1) * fib (m + 1)) :
    by rw [add_comm, gcd_add_mul_right_right (fib m) _ (fib (n.pred))]
    ... = gcd (fib m) (fib (n.pred + 1)) :
    coprime.gcd_mul_right_cancel_right
      (fib (n.pred + 1)) (coprime.symm (fib_coprime_fib_succ m))
end

lemma gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n)
| 0     := by simp
| (k+1) := by rw [← gcd_fib_add_mul_self k, add_mul, ← add_assoc, one_mul, gcd_fib_add_self _ _]

/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/

lemma fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n :=
by rwa [gcd_eq_left_iff_dvd, ← fib_gcd, gcd_eq_left_iff_dvd.mp]

end nat


/-
This modules defines a type for representing integers modulo a natural number n,
along with the standard commutative ring operations.

The representation uses a canonical form of numbers between 0 and n-1.  Operations
preserve the canonical form.
-/
import galois.nat.div_lemmas

def intmod (n:ℕ) := { x : ℕ // x < n }

namespace intmod

open nat

variable {n : nat}

def of_nat (x:ℕ) : intmod (succ n) :=
 ⟨ x % succ n, nat.mod_lt x (nat.zero_lt_succ _) ⟩

private lemma mlt {b : nat} : ∀ {a}, n > a → b % n < n
| 0     h := nat.mod_lt _ h
| (a+1) h :=
  have n > 0, from lt.trans (nat.zero_lt_succ _) h,
  nat.mod_lt _ this

def zero : intmod (succ n) := ⟨ 0, nat.succ_pos n ⟩
def one  : intmod (succ n) := of_nat 1
def add  : intmod n → intmod n → intmod n
| ⟨x,x_lt⟩ ⟨y,y_lt⟩ :=
  if p:x+y < n then
    ⟨x+y, p⟩
  else
    let q : (x+y)-n < n :=
         begin
           simp [nat.sub_lt_iff'],
           have xy_lt_nn : x + y < n + n := add_lt_add x_lt y_lt,
           have n_le_xy  : n ≤ x + y := le_of_not_gt p,
           cc,
         end in
    ⟨ (x+y)-n, q⟩

def neg  : intmod n → intmod n
| ⟨x,p⟩ :=
  let r := if x = 0 then 0 else n-x in
  let q : (if x = 0 then 0 else n-x) < n :=
    begin
      by_cases x = 0,
      { simp [h],
        simp [h] at p,
        exact p,
      },
      {
        -- Show x > 0
        have x_pos := nat.eq_zero_or_pos x,
        simp [h] at x_pos,
        -- show n - x < n
        simp [h, nat.sub_lt_iff'],
        -- Decompose and
        constructor,
        -- n < n + x
        exact lt_add_of_le_of_pos (le_refl n) x_pos,
        -- show 0 < n
        exact or.inr (lt_trans x_pos p),
      }
    end in
  ⟨r, q ⟩

def sub  : intmod n → intmod n → intmod n
| ⟨x,h⟩ ⟨y,y_lt⟩ :=
  if p : y ≤ x then
    let q : x - y < n :=
      begin
        apply nat.lt_of_le_of_lt,
        apply nat.sub_le,
        exact h,
      end in
    ⟨ x-y, q ⟩
  else
    let q : x + n - y < n :=
          begin
            --have p : x < y := sorry,
            simp [nat.sub_lt_iff'],
            constructor,
            { apply add_lt_add_left,
              -- Enforce h := x < y
              exact lt_of_not_ge p,
            },
            { -- Pick right branch to prove y ≤ n + x
              apply or.inr,
              transitivity,
              exact nat.le_of_lt y_lt,
              apply nat.le_add_right,
            }
          end  in
    ⟨ x+n-y, q ⟩

def mul : intmod n → intmod n → intmod n
| ⟨x,h⟩ ⟨y,_⟩ := ⟨(x*y)%n, mlt h ⟩

instance (n:ℕ) : has_zero (intmod (succ n)) := ⟨ zero ⟩
instance (n:ℕ) : has_one  (intmod (succ n)) := ⟨ one ⟩
instance (n:ℕ) : has_add  (intmod n) := ⟨ add ⟩
instance (n:ℕ) : has_neg  (intmod n) := ⟨ neg ⟩
instance (n:ℕ) : has_sub  (intmod n) := ⟨ sub ⟩
instance (n:ℕ) : has_mul  (intmod n) := ⟨ mul ⟩

theorem zero_val (n : ℕ) : (0 : intmod (succ n)).val = 0 := rfl

theorem one_val (n : ℕ) : (1 : intmod (succ n)).val = 1 % succ n := rfl

theorem add_val (x y : intmod n) : (x + y).val = (x.val + y.val) % n :=
begin
  cases x with xv x_lt,
  cases y with yv y_lt,
  transitivity,
  unfold has_add.add,
  by_cases (xv + yv < n) with p,
  {
    simp [add, p, nat.mod_eq_of_lt],
  },
  {
    -- Show xv + yv ≥ n
    have q : xv + yv ≥ n :=
      or.resolve_left (nat.lt_or_ge (xv + yv) n) p,
    have r : (xv + yv - n) < n,
    { simp [nat.sub_lt_iff'],
      constructor,
      {
        transitivity,
        exact nat.add_lt_add_left  y_lt _,
        exact nat.add_lt_add_right x_lt _,
      },
      -- Show n ≤ x + y
      exact or.inr q,
    },
    simp [add, mod_eq_sub_mod,  mod_eq_of_lt, *],
  },
end

theorem mul_val (x y : intmod n) : (x * y).val = (x.val * y.val) % n :=
begin
  cases x with xv xp,
  cases y with yv yp,
  refl,
end

theorem zero_add (x : intmod (succ n)) : 0 + x = x :=
begin
  apply subtype.eq,
  simp [add_val, zero_val],
  exact nat.mod_eq_of_lt x.property,
end

theorem add_zero (x : intmod (succ n)) : x + 0 = x :=
begin
  apply subtype.eq,
  simp [add_val, zero_val],
  exact nat.mod_eq_of_lt x.property,
end

theorem add_assoc (x y z : intmod n) : (x + y) + z = x + (y + z) :=
begin
  apply subtype.eq,
  simp [add_val, nat.mod_add_right_mod],
end

theorem add_comm (x y : intmod n) : x + y = y + x :=
begin
  apply subtype.eq,
  simp [add_val],
end

 theorem add_left_neg (x : intmod (succ n)) : -x + x = 0 :=
 begin
   cases x with xv x_lt,

   apply subtype.eq,
   simp [add_val, has_neg.neg, neg],
   by_cases (xv = 0) with h,
   {
      simp [h, zero_val],
   },
   {
     have x_le : xv ≤ succ n := nat.le_of_lt x_lt,
     simp only [h, if_false, nat.add_comm xv, ge, *, nat.sub_add_cancel],
     simp [nat.mod_eq_sub_mod, zero_val],
   }
 end

theorem one_mul (x : intmod (succ n)) : 1 * x = x :=
begin
  apply subtype.eq,
  simp [mul_val, one_val, nat.mod_mul_left_mod, nat.mod_mul_right_mod],
  exact nat.mod_eq_of_lt x.property,
end

theorem mul_one (x : intmod (succ n)) : x * 1 = x :=
begin
  apply subtype.eq,
  simp [mul_val, one_val, nat.mod_mul_left_mod, nat.mod_mul_right_mod],
  exact nat.mod_eq_of_lt x.property,
end

theorem mul_assoc (x y z : intmod n) : (x * y) * z = x * (y * z) :=
begin
  apply subtype.eq,
  simp [mul_val, nat.mod_mul_right_mod],
end

theorem mul_comm (x y : intmod n) : x * y = y * x :=
begin
  apply subtype.eq,
  simp [mul_val],
end

theorem left_distrib (a b c : intmod n)
: a * (b + c) = a * b + a * c :=
begin
  apply subtype.eq,
  simp [add_val, mul_val],
  simp [nat.mod_add_right_mod,
        nat.mod_mul_right_mod,
        nat.left_distrib],
end

theorem right_distrib (a b c : intmod n)
: (a + b) * c = a * c + b * c :=
begin
  simp only [mul_comm _ c, left_distrib],
end

instance (n:ℕ) : comm_ring (intmod (succ n)) :=
{ zero := 0
, one  := 1
, add := add
, neg := neg
, mul := mul
, zero_add := zero_add
, add_zero := add_zero
, add_assoc := add_assoc
, add_comm  := add_comm
, add_left_neg := add_left_neg
, one_mul   := one_mul
, mul_one   := mul_one
, mul_assoc := mul_assoc
, mul_comm  := mul_comm
, left_distrib  := left_distrib
, right_distrib := right_distrib
}

end intmod


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Advanced Proposition world

## Level 1: the `constructor` tactic.

The logical symbol `∧` means "and". If `P` and `Q` are propositions, then `P ∧ Q` is the proposition
"`P` and `Q`". If your *goal* is `P ∧ Q` then you can make progress with the [`constructor` tactic](../Tactics/constructor.lean.md).,
which turns one goal `⊢ P ∧ Q` into two goals, namely `⊢ P` and `⊢ Q`. In the level below, after a
`constructor`, you can finish off the two new sub-goals with the `exact` tactic since both `p` and
`q` provide exactly what we need.  You could also use the `assumption` tactic.

## Lemma
If `P` and `Q` are true, then `P ∧ Q` is true.
-/
example (P Q : Prop) (p : P) (q : Q) : P ∧ Q := by
  constructor
  exact p
  exact q
/-!

Next up [Level 2](./Level2.lean.md)
-/


import data.fintype.basic
import tactic
import matroid
import finset
import base_of

variables {α : Type*} [fintype α] [decidable_eq α] {m : matroid α} {A B: finset α}

open finset

namespace matroid

lemma base_eq_card (hA : m.base A) (hB : m.base B) : A.card = B.card :=
  by {rw [←base_of_univ_iff_base] at *, exact base_of_eq_card hA hB}

lemma ind_subset_base : m.ind A → ∃ B, A ⊆ B ∧ m.base B := λ hA, begin
  obtain ⟨B, hAB, h_base⟩ := ind_subset_base_of (subset_univ A) hA,
  rw base_of_univ_iff_base at h_base,
  use [B, hAB, h_base],
end

theorem exists_base : ∃ A, m.base A :=
begin
  obtain ⟨B, _, Bbase⟩ := ind_subset_base m.ind_empty,
  exact ⟨B, Bbase⟩,
end

theorem base_not_subset {A B} : m.base A → m.base B → A ⊆ B → A = B :=
begin
  rintro Abase Bbase h_subset,
  exact eq_of_subset_of_card_le h_subset (ge_of_eq $ base_eq_card Abase Bbase),
end

lemma ind_and_card_eq_card_base_iff_base {A B} (Abase : m.base A) : (m.ind B ∧ A.card = B.card) ↔ m.base B :=
begin
  split, {
    rintro ⟨Bind, Acard⟩,
    use Bind,
    intros x xB h_insert_ind,
    obtain ⟨C, Bsubset, Cbase⟩ := ind_subset_base h_insert_ind,
    replace Bsubset := card_le_of_subset Bsubset,
    rw [base_eq_card Abase Cbase] at Acard,
    rw card_insert_of_not_mem xB at Bsubset,
    linarith,
  }, {
    intro Bbase,
    exact ⟨Bbase.1, base_eq_card Abase Bbase⟩,
  }
end

theorem base_exchange {A B} : m.base A → m.base B → A ≠ B → ∀ x ∈ A \ B, ∃ b ∈ B, b ∉ A ∧ m.base (insert b (A.erase x)) :=
begin
  intros Abase Bbase h_neq x xA,
  rcases m.ind_exchange (A.erase x) B _ Bbase.1 _ with ⟨c, cB, cA, cinsert⟩,
  use [c, cB],
  {
    rw mem_sdiff at xA,
    split, {
      finish,
    }, {
      apply (ind_and_card_eq_card_base_iff_base Abase).1,
      use cinsert,
      rw [card_insert_of_not_mem cA, card_erase_of_mem' xA.1],
    },
  }, {
    exact m.ind_subset _ _ (erase_subset _ _) Abase.1,
  }, {
    rw mem_sdiff at xA,
    rw [← base_eq_card Abase Bbase, card_erase_of_mem xA.1],
    exact nat.pred_lt (card_ne_zero_of_mem xA.1),
  },
end

end matroid


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/

import number_theory.arithmetic_function
import number_theory.lucas_lehmer
import algebra.geom_sum
import ring_theory.multiplicity

/-!
# Perfect Numbers

This file proves Theorem 70 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

The theorem characterizes even perfect numbers.

Euclid proved that if `2 ^ (k + 1) - 1` is prime (these primes are known as Mersenne primes),
  then `2 ^ k * 2 ^ (k + 1) - 1` is perfect.

Euler proved the converse, that if `n` is even and perfect, then there exists `k` such that
  `n = 2 ^ k * 2 ^ (k + 1) - 1` and `2 ^ (k + 1) - 1` is prime.

## References
https://en.wikipedia.org/wiki/Euclid%E2%80%93Euler_theorem
-/

lemma odd_mersenne_succ (k : ℕ) : ¬ 2 ∣ mersenne (k + 1) :=
by simp [← even_iff_two_dvd, ← nat.even_succ, nat.succ_eq_add_one] with parity_simps

namespace nat
open arithmetic_function finset
open_locale arithmetic_function

lemma sigma_two_pow_eq_mersenne_succ (k : ℕ) : σ 1 (2 ^ k) = mersenne (k + 1) :=
by simpa [mersenne, prime_two, ← geom_sum_mul_add 1 (k+1)]

/-- Euclid's theorem that Mersenne primes induce perfect numbers -/
theorem perfect_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  perfect ((2 ^ k) * mersenne (k + 1)) :=
begin
  rw [perfect_iff_sum_divisors_eq_two_mul, ← mul_assoc, ← pow_succ, ← sigma_one_apply, mul_comm,
    is_multiplicative_sigma.map_mul_of_coprime
        (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)),
    sigma_two_pow_eq_mersenne_succ],
  { simp [pr, nat.prime_two] },
  { apply mul_pos (pow_pos _ k) (mersenne_pos (nat.succ_pos k)),
    norm_num }
end

lemma ne_zero_of_prime_mersenne (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  k ≠ 0 :=
begin
  rintro rfl,
  simpa [mersenne, not_prime_one] using pr,
end

theorem even_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) :
  even ((2 ^ k) * mersenne (k + 1)) :=
by simp [ne_zero_of_prime_mersenne k pr] with parity_simps

lemma eq_two_pow_mul_odd {n : ℕ} (hpos : 0 < n) :
  ∃ (k m : ℕ), n = 2 ^ k * m ∧ ¬ even m :=
begin
  have h := (multiplicity.finite_nat_iff.2 ⟨nat.prime_two.ne_one, hpos⟩),
  cases multiplicity.pow_multiplicity_dvd h with m hm,
  use [(multiplicity 2 n).get h, m],
  refine ⟨hm, _⟩,
  rw even_iff_two_dvd,
  have hg := multiplicity.is_greatest' h (nat.lt_succ_self _),
  contrapose! hg,
  rcases hg with ⟨k, rfl⟩,
  apply dvd.intro k,
  rw [pow_succ', mul_assoc, ← hm],
end

/-- Euler's theorem that even perfect numbers can be factored as a
  power of two times a Mersenne prime. -/
theorem eq_two_pow_mul_prime_mersenne_of_even_perfect {n : ℕ} (ev : even n) (perf : perfect n) :
  ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) :=
begin
  have hpos := perf.2,
  rcases eq_two_pow_mul_odd hpos with ⟨k, m, rfl, hm⟩,
  use k,
  rw [perfect_iff_sum_divisors_eq_two_mul hpos, ← sigma_one_apply,
    is_multiplicative_sigma.map_mul_of_coprime (nat.prime_two.coprime_pow_of_not_dvd hm).symm,
    sigma_two_pow_eq_mersenne_succ, ← mul_assoc, ← pow_succ] at perf,
  rcases nat.coprime.dvd_of_dvd_mul_left
    (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)) (dvd.intro _ perf) with ⟨j, rfl⟩,
  rw [← mul_assoc, mul_comm _ (mersenne _), mul_assoc] at perf,
  have h := mul_left_cancel' (ne_of_gt (mersenne_pos (nat.succ_pos _))) perf,
  rw [sigma_one_apply, sum_divisors_eq_sum_proper_divisors_add_self, ← succ_mersenne, add_mul,
    one_mul, add_comm] at h,
  have hj := add_left_cancel h,
  cases sum_proper_divisors_dvd (by { rw hj, apply dvd.intro_left (mersenne (k + 1)) rfl }),
  { have j1 : j = 1 := eq.trans hj.symm h_1,
    rw [j1, mul_one, sum_proper_divisors_eq_one_iff_prime] at h_1,
    simp [h_1, j1] },
  { have jcon := eq.trans hj.symm h_1,
    rw [← one_mul j, ← mul_assoc, mul_one] at jcon,
    have jcon2 := mul_right_cancel' _ jcon,
    { exfalso,
      cases k,
      { apply hm,
        rw [← jcon2, pow_zero, one_mul, one_mul] at ev,
        rw [← jcon2, one_mul],
        exact ev },
      apply ne_of_lt _ jcon2,
      rw [mersenne, ← nat.pred_eq_sub_one, lt_pred_iff, ← pow_one (nat.succ 1)],
      apply pow_lt_pow (nat.lt_succ_self 1) (nat.succ_lt_succ (nat.succ_pos k)) },
    contrapose! hm,
    simp [hm] }
end

/-- The Euclid-Euler theorem characterizing even perfect numbers -/
theorem even_and_perfect_iff {n : ℕ} :
  (even n ∧ perfect n) ↔ ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) :=
begin
  split,
  { rintro ⟨ev, perf⟩,
    exact eq_two_pow_mul_prime_mersenne_of_even_perfect ev perf },
  { rintro ⟨k, pr, rfl⟩,
    exact ⟨even_two_pow_mul_mersenne_of_prime k pr, perfect_two_pow_mul_mersenne_of_prime k pr⟩ }
end

end nat


import data.finset
import data.fin
import data.rat
import data.nat.basic
import data.fintype
import algebra.big_operators
import algebra.group_power
import tactic.omega
import tactic.linarith

open fintype

variables {X : Type*}
variables [fintype X] [decidable_eq X]
variables {r : ℕ}

/-
Define a type for rsets, give an easy constructor of rsets and a lemma for their cardinality.
Also, we can use extensionality on them, and they're a finite type with cardinality a binomial.
-/
section rset
  @[reducible] def rset (r : ℕ) (X) [fintype X] := {x : finset X // x ∈ finset.powerset_len r (elems X)}

  @[reducible]
  def rset_mk (A : finset X) (H : finset.card A = r) : rset r X :=
  begin
    refine ⟨A, _⟩,
    rw finset.mem_powerset_len,
    exact ⟨finset.subset_univ _, H⟩
  end

  @[simp] lemma card_of_rset {x : rset r X} : finset.card x.val = r := (finset.mem_powerset_len.1 x.2).2

  @[reducible] instance : has_mem X (rset r X) := ⟨λ i A, i ∈ A.1⟩

  theorem eq_of_veq : ∀ {s t : rset r X}, s.1 = t.1 → s = t
  | ⟨s, _⟩ ⟨t, _⟩ rfl := rfl

  theorem val_inj {s t : rset r X} : s.1 = t.1 ↔ s = t :=
  ⟨eq_of_veq, congr_arg _⟩

  theorem ext {s₁ s₂ : rset r X} : s₁ = s₂ ↔ (∀ a, a ∈ s₁ ↔ a ∈ s₂) :=
  val_inj.symm.trans finset.ext

  @[ext]
  theorem ext' {s₁ s₂ : rset r X} : (∀ a, a ∈ s₁ ↔ a ∈ s₂) → s₁ = s₂ :=
  ext.2

  instance rset_fintype (r : ℕ) : fintype (rset r X) := finset.subtype.fintype _

  theorem rset_card (r : ℕ) : card (rset r X) = nat.choose (card X) r :=
  begin
    rw card_of_subtype (finset.powerset_len r (elems X)) (λ _, iff.rfl),
    apply finset.card_powerset_len
  end
end rset

-- An example of an rset, and a set system.
#eval elems (rset 3 (fin 5))

def example1 : rset 4 (fin 9) := rset_mk {0,1,4,5} (by trivial)
def example2 : finset (rset 3 (fin 5)) :=
{ rset_mk {0,1,2} (by trivial),
  rset_mk {0,1,3} (by trivial),
  rset_mk {0,2,3} (by trivial),
  rset_mk {0,2,4} (by trivial)
  }

#eval example1
#eval example2

section stretch_and_erase
  def stretch (A : rset r X) (s : X) (h : s ∉ A) : rset (r+1) X :=
  rset_mk (insert s (A.1)) $ by rw [finset.card_insert_of_not_mem h, card_of_rset]

  lemma mem_stretch (A : rset r X) (s : X) {h : s ∉ A} (i : X) : i ∈ stretch A s h ↔ i ∈ A ∨ i = s :=
  by rw [stretch, finset.mem_insert]; tauto

  lemma stretch_subset {A : rset r X} {s : X} (h : s ∉ A) : A.1 ⊆ (stretch A s h).1 :=
  finset.subset_insert _ _

  lemma mem_stretch_self {A : rset r X} {s : X} (h : s ∉ A) : s ∈ stretch A s h :=
  finset.mem_insert_self _ _

  lemma mem_stretch_of_mem {A : rset r X} {s t : X} {p : s ∉ A} : t ∈ A → t ∈ stretch A s p :=
  finset.mem_insert_of_mem

  def erase (A : rset (r+1) X) (s : X) (h : s ∈ A) : rset r X :=
  rset_mk (finset.erase (A.1) s) $ by rw [finset.card_erase_of_mem h, card_of_rset]; trivial

  lemma mem_erase (A : rset (r+1) X) (s : X) (h : s ∈ A) (i : X) : i ∈ erase A s h ↔ i ∈ A ∧ i ≠ s :=
  by rw [erase, finset.mem_erase]; tauto

  lemma mem_of_mem_erase {A : rset (r+1) X} {i s : X} {h : s ∈ A} : i ∈ erase A s h → i ∈ A :=
  finset.mem_of_mem_erase

  lemma subset_erase {A : rset (r+1) X} {s : X} (h : s ∈ A) : (erase A s h).1 ⊆ A.1 :=
  finset.erase_subset _ _

  theorem not_mem_erase_self {A : rset (r+1) X} {s : X} (h : s ∈ A) : s ∉ erase A s h :=
  finset.not_mem_erase _ _

  lemma erase_iff_stretch {A : rset r X} {B : rset (r+1) X} {s : X} {H1 : s ∉ A} {H2 : s ∈ B} : stretch A s H1 = B ↔ erase B s H2 = A:=
  begin
    split,
    all_goals {intros p, ext, rw mem_erase <|> rw mem_stretch, split},
    all_goals {intro k, rw ← p at *},
    { rw mem_stretch at k, finish },
    { split, apply mem_stretch_of_mem k, intro i, exact H1 (i ▸ k) },
    { cases k, exact mem_of_mem_erase k, exact (k.symm ▸ H2) },
    { rw mem_erase, finish }
  end

  lemma erase_stretch (A : rset r X) (s : X) (h : s ∉ A) : erase (stretch A s h) s (mem_stretch_self h) = A :=
  erase_iff_stretch.1 rfl

  lemma stretch_erase (A : rset (r+1) X) (s : X) (h : s ∈ A) : stretch (erase A s h) s (not_mem_erase_self h) = A :=
  erase_iff_stretch.2 rfl

  lemma erase_iff_stretch' {A : rset r X} {B : rset (r+1) X} : (∃ i ∉ A, stretch A i H = B) ↔ (∃ i ∈ B, erase B i H = A) :=
  begin
    split,
    all_goals
    { rintro ⟨i, Hi, t⟩, use i, refine ⟨_, _⟩, rw ← t,
      any_goals {apply mem_stretch_self <|> apply not_mem_erase_self},
      any_goals {rw erase_iff_stretch <|> rw ← erase_iff_stretch},
      exact t }
  end
end stretch_and_erase

lemma card_map {α β} [decidable_eq β] {f : α ↪ β} {s : finset α} : (s.map f).card = s.card :=
begin
  rw finset.map_eq_image,
  rw finset.card_image_of_injective,
  exact f.2
end

def all_removals {r : ℕ} (A : rset (r+1) X) : finset (rset r X) :=
A.1.attach.map ⟨λ i, erase A i.1 i.2, -- prove the function is injective
  begin
    rintro ⟨x1, x1p⟩ ⟨x2, x2p⟩ _, congr, dsimp at a,
    have m : x1 ∉ erase A x1 _ := not_mem_erase_self x1p,
    rw [a, mem_erase] at m, by_contra, apply m, tauto
  end
⟩

def mem_all_removals {r : ℕ} {A : rset (r+1) X} {B : rset r X} : B ∈ all_removals A ↔ ∃ i ∈ A, erase A i H = B :=
by simp [all_removals]

lemma card_all_removals {r : ℕ} {A : rset (r+1) X} : (all_removals A).card = r + 1 :=
by rw [all_removals, card_map, finset.card_attach]; exact card_of_rset

def shadow {r : ℕ} (𝒜 : finset (rset (r+1) X)) : finset (rset r X) :=
𝒜.bind all_removals

reserve prefix `∂`:30
notation ∂𝒜 := shadow 𝒜

#eval ∂example2 -- should be {{0,1}, {0,2}, {0,3}, {0,4}, {1,2}, {1,3}, {2,3}, {2,4}}

def mem_shadow {r : ℕ} {𝒜 : finset (rset (r+1) X)} (B : rset r X) : B ∈ ∂𝒜 ↔ ∃ A ∈ 𝒜, ∃ i ∈ A, erase A i H = B :=
by simp [shadow, all_removals]

def cube_graph : rel (rset r X) (rset (r+1) X) := λ A B, A.1 ⊆ B.1

lemma test {A : rset r X} {B : rset (r+1) X} : finset.card (B.1 \ A.1) = 1 ↔ cube_graph A B :=
begin
  rw cube_graph, dsimp,
  rw [← finset.sdiff_eq_empty_iff_subset, ← finset.card_eq_zero],
  have q: finset.card A.1 + finset.card (B.1 \ A.1) = finset.card B.1 + finset.card (A.1 \ B.1),
    rw [← finset.card_disjoint_union (finset.disjoint_sdiff),
        ← finset.card_disjoint_union (finset.disjoint_sdiff),
        finset.union_sdiff_symm],
  simp [card_of_rset] at q,
  rw [q, nat.one_add, nat.succ_inj']
end

lemma stretch_iff_related {A : rset r X} {B : rset (r+1) X} : cube_graph A B ↔ ∃ (i ∉ A), stretch A i H = B :=
begin
  rw cube_graph,
  split, intro p,
    cases finset.card_eq_one.1 (test.2 p) with i _,
    use i,
    have k' : ∀ a, a ∈ B ∧ a ∉ A ↔ a = i,
      intro a,
      rw [← finset.mem_sdiff, ← finset.mem_singleton, h],
    have k : i ∈ B ∧ i ∉ A := (k' i).2 rfl,
    use k.2, ext, rw mem_stretch,
    refine ⟨λ s, s.elim _ (λ v, v.symm ▸ k.1), λ s, _⟩,
      apply p,
    safe,
  rintros ⟨_, _, k⟩,
  rw ← k,
  apply stretch_subset
end

lemma erase_iff_related (A : rset r X) (B : rset (r+1) X) : cube_graph A B ↔ ∃ (i ∈ B), erase B i H = A :=
iff.trans stretch_iff_related erase_iff_stretch'

lemma all_removals_iff_related {r : ℕ} {A : rset r X} {B : rset (r+1) X} : A ∈ all_removals B ↔ cube_graph A B :=
by rw [erase_iff_related, mem_all_removals]

lemma nat.choose_succ_right_eq {n k : ℕ} : nat.choose n (k + 1) * (k + 1) = nat.choose n k * (n - k) :=
begin
  have e : (n+1) * nat.choose n k = nat.choose n k * (k+1) + nat.choose n (k+1) * (k+1),
    rw [← nat.right_distrib, ← nat.choose_succ_succ, nat.succ_mul_choose_eq],
  rw [← nat.sub_eq_of_eq_add e, mul_comm, ← nat.mul_sub_left_distrib],
  simp
end

theorem div_le_div_iff {α} [linear_ordered_field α] {a b c d : α}
  (hc : 0 < c) (hd : 0 < d) : a / c ≤ b / d ↔ a * d ≤ b * c :=
by rw [le_div_iff hd, div_mul_eq_mul_div, div_le_iff hc]

lemma multiply_out {A B n r : ℕ} (hr1 : 1 ≤ r) (hr2 : r ≤ n)
  (h : A * r ≤ B * (n - r + 1)) :
  (A : ℚ) / (nat.choose n r) ≤ B / nat.choose n (r-1) :=
begin
  rw div_le_div_iff; norm_cast,
  apply le_of_mul_le_mul_right _,
    exact hr1,
  cases r,
    simp,
  rw nat.succ_eq_add_one at *,
  rw [← nat.sub_add_comm hr2, nat.add_sub_add_right] at h,
  rw [nat.add_sub_cancel, mul_assoc B, nat.choose_succ_right_eq, mul_right_comm, ← mul_assoc, mul_right_comm B],
  exact nat.mul_le_mul_right _ h,
  apply nat.choose_pos hr2,
  apply nat.choose_pos (le_trans (nat.pred_le _) hr2)
end

def from_above {n : ℕ} (𝒜 : finset (rset (r+1) (fin n))) : finset (rset (r+1) (fin n) × rset r (fin n)) :=
𝒜.bind $ λ A, (all_removals A).map ⟨λ x, (A, x), λ _ _, by simp⟩

lemma mem_from_above {n : ℕ} {𝒜 : finset (rset (r+1) (fin n))} {A : rset (r+1) (fin n)} {B : rset r (fin n)} :
  (A,B) ∈ from_above 𝒜 ↔ A ∈ 𝒜 ∧ B ∈ all_removals A :=
begin
  rw [from_above, finset.mem_bind],
  split; intro h,
    rcases h with ⟨a, Ha, h⟩,
    rw finset.mem_map at h,
    rcases h with ⟨b, Hb, h⟩,
    injection h with Ah Bh,
    rw [Ah, Bh] at *,
    exact ⟨Ha, Hb⟩,
  use A,
  use h.1,
  rw finset.mem_map,
  use B,
  use h.2,
  refl
end

lemma card_from_above {n : ℕ} (𝒜 : finset (rset (r+1) (fin n))) : (from_above 𝒜).card = 𝒜.card * (r+1) :=
begin
  rw [from_above, finset.card_bind, ← nat.smul_eq_mul, ← finset.sum_const],
    congr, ext,
    rw card_map,
    exact card_all_removals,
  intros,
  rw finset.disjoint_iff_ne,
  finish
end

def from_below {n : ℕ} (𝒜 : finset (rset (r+1) (fin n))) : finset (rset (r+1) (fin n) × rset r (fin n)) :=
begin
  refine (∂𝒜).bind (λ B, _),
  refine (finset.univ \ B.1).attach.map ⟨λ x, (stretch B x.1 (finset.mem_sdiff.1 x.2).2, B), _⟩,
  rintros ⟨x₁, x₁h⟩ ⟨x₂, x₂h⟩ h,
  rw finset.mem_sdiff at x₂h,
  injection h,
  congr,
  have q := mem_stretch_self x₂h.2,
  rw [← h_1, mem_stretch] at q,
  tauto
end

lemma mem_from_below {n : ℕ} {𝒜 : finset (rset (r+1) (fin n))} {A : rset (r+1) (fin n)} {B : rset r (fin n)} :
  A ∈ 𝒜 ∧ (∃ (i ∉ B), stretch B i H = A) → (A,B) ∈ from_below 𝒜 :=
begin
  intro h,
  rw [from_below, finset.mem_bind],
  use B,
  split,
    rw mem_shadow,
    exact ⟨A, h.1, erase_iff_stretch'.1 h.2⟩,
  rw [finset.mem_map],
  rcases h.2 with ⟨_, _, _⟩,
  refine ⟨⟨w, finset.mem_sdiff.2 ⟨complete _, ‹_›⟩⟩, by simp, _⟩,
  dsimp,
  rw ‹stretch B w _ = A›
end

lemma above_sub_below {n : ℕ} {𝒜 : finset (rset (r+1) (fin n))} : from_above 𝒜 ⊆ from_below 𝒜 :=
begin
  rintros ⟨x,y⟩ h,
  apply mem_from_below,
  rwa [← stretch_iff_related, ← all_removals_iff_related, ← mem_from_above]
end

lemma card_from_below {n : ℕ} (𝒜 : finset (rset (r+1) (fin n))) : (from_below 𝒜).card ≤ (∂𝒜).card * (n-r) :=
begin
  rw [from_below],
  transitivity,
    apply finset.card_bind_le,
  apply ge_of_eq,
  rw [← nat.smul_eq_mul, ← finset.sum_const],
  congr,
  ext,
  rw [card_map, finset.card_attach, finset.card_sdiff, card_of_rset, finset.card_univ, fintype.card_fin],
  apply finset.subset_univ
end

lemma finally {n r : ℕ} (hr2 : r + 1 ≤ n) : n - (r + 1) + 1 = n - r := by omega

theorem localLYM {n r : ℕ} (𝒜 : finset (rset (r+1) (fin n))) {hr2 : r + 1 ≤ n} :
  (𝒜.card : ℚ) / nat.choose n (r+1) ≤ (∂𝒜).card / nat.choose n r :=
begin
  apply multiply_out (by simp) hr2,
  rw ← card_from_above,
  transitivity,
    apply finset.card_le_of_subset above_sub_below,
  transitivity,
    apply card_from_below,
  apply nat.mul_le_mul_left,
  omega,
end

theorem localLYM {n r : ℕ} (𝒜 : finset (rset (r+1) (fin n))) {hr2 : r + 1 ≤ n} :
  (𝒜.card : ℚ) / nat.choose n (r+1) ≤ (∂𝒜).card / nat.choose n r :=
begin
  apply main_lemma (by simp) hr2,
  rw [finally hr2],
  exact (
    calc 𝒜.card * (r + 1) = (from_above 𝒜).card : (card_from_above 𝒜).symm
         ... ≤ (from_below 𝒜).card : begin apply finset.card_le_of_subset _, apply above_sub_below end
         ... ≤ finset.card (∂𝒜) * (n - r) : (card_from_below 𝒜)
  )
end


/- Comment -/

-- comment

-- declaring objects
constants m n : nat
constant f : nat → nat
constant p : prod nat nat

#check (m, n)
#check p.1

-- types are objects
#check nat

constants α β : Type
constant F : Type → Type

#check α
#check F α

-- of what type is the type Type?
#check Type
#check Type 1
#check Type 2
--...

-- Prop is a special type
#check Prop

-- Polymorphic types
#check list
#check prod
-- in order to create polymorphic types, one must use universe variables,
-- where these variables range over the level of types
universe u
constant γ : Type u
#check γ

-- besides of application, abstraction (creating functions from other ones) comes into play when dealing with functions
#check λ x : nat, x + 5
#check λ x : nat, x + 7
-- we can rely on type inference
#check λ x, x + 8

-- expressions that are the same up to renaming of bound variables are called alpha equivalent
-- the process of simplifying an expression (λ x, t) s to t[s/x] is known as beta reduction, and
-- two terms that reduce to a common term are called beta equivalent
#reduce (m, n).1

-- important feature of dependent type theory: every term has a computational behaviour, and supports a notion of
-- reduction, or normalization. In principle, two terms that reduce to the same value are called
-- definitionally equal

-- this computation behaviour makes it possible to use Lean as a programming language as well
#eval 1234*1234

-- constant allows to declare objects, but how can we define them?

def foo : (ℕ → ℕ) → ℕ := λ f, f 0

#check foo
#print foo

-- alternative notation
def double (x : ℕ) : ℕ := x + x

-- local definitions, using the let construct
#check let y := 2 in y + y

def bar := (λ a : Type, λ x : a, x) nat -- works, because the expression doesn't depend on the value of a
--def bar := (λ a : Type, λ x : a, x+2) nat -- doesn't work, because x+2 doesn't make sense for every value of a

-- it is better to use variables instead of extending the system with new constants
-- for that, there are the local declarations and the variable and variables constructs
def compose (α β γ : Type) (g : β → γ) (f : α → β) (x : α) : γ :=
    g (f x)

variable k : ℕ
def my_double := 2 * k

-- sections can help to define scopes
-- namespaces can be used to group definitions
-- the construct open allow to use the names inside a namespace

-- dependent type theory: types can depend on parameters
-- Pi type or dependent function type: Π x:α, β x means
-- the type of all functions f which when take a value x
-- of type α, return a value of type β x

namespace hidden

universe v

constant list : Type v → Type v

constant cons : Π α : Type u, α → list α → list α

#check list ℕ

end hidden

-- seamingly, sigma types generalize the notion of products,
-- such that the type of the second element depends on
-- the type of the first element

-- implicit arguments: type inference over dependent types
-- use _ to hide the type and let the type inference mechanism act
-- use { } when declaring a parameter, and this will default to
-- always use the type inference mechanism
-- { } works also on variables/variable declarations

-- tactics mode
-- tactics are instructions that tell Lean how to construct a proof term
-- tactics-style contrasts with term-style
theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
    apply and.intro,
    exact hp,
    apply and.intro,
    exact hq,
    exact hp
end

#print test

-- one can use the by keyword when there is only one
-- step for the proof
-- the include command tells lean to include the indicated variables
-- the omit keywork limit the effect of an include
-- examples of tactics: apply, exact, intro, reflexivity, symmetry, transitivity
-- assumption, repeat, fapply, revert, generalize, sorry, rewrite, left, right,
-- cases, constructor, existsi, split, induction, contradiction
-- it is possible to mix term-style and tactics-style proofs
-- := can be used in place of from

-- tactics combinators allows for the creation of
-- new tactics from old ones
-- examples: the comma, {tactics1,...,tacticsn}
-- t1;t2 (parallel), <|> (orelse) try and backtrack when fail, try,
-- all_goals, any_goals

-- simplifier: a powerful tool for automation, using identities
-- tagged with [simp] attribute
-- uses the simp tactic to iteratively rewrite subterms in an expression
-- keyword at help to simplify a hypothesis


import algebra.ring algebra.group_power group_theory.submonoid order.boolean_algebra
import algebra.geom_sum
import commutative_algebra.nilpotent commutative_algebra.regular
import tactic.ring

universe u
variables {A : Type u} [comm_ring A]

namespace commutative_algebra

def is_idempotent (a : A) := a * a = a

theorem is_idempotent' {a : A} : is_idempotent a ↔ a * (1 - a) = 0 :=
by { dsimp [is_idempotent], rw [mul_sub, mul_one,sub_eq_zero], exact comm}

namespace is_idempotent

/-- 0 and 1 are idempotent, and (1,0) and (0,1) are idempotent in
  a product ring.
-/
theorem zero : is_idempotent (0 : A) := mul_zero 0
theorem one  : is_idempotent (1 : A) := mul_one 1

theorem left {B : Type*} {C : Type*} [comm_ring B] [comm_ring C] :
  is_idempotent (⟨1, 0⟩ : B × C) :=
show  prod.mk ((1 : B) * (1 : B)) ((0 : C) * (0 : C)) = ⟨1, 0⟩,
by { rw [mul_one, mul_zero] }

theorem right {B : Type*} {C : Type*} [comm_ring B] [comm_ring C] :
  is_idempotent (⟨0, 1⟩ : B × C) :=
show  prod.mk ((0 : B) * (0 : B)) ((1 : C) * (1 : C)) = ⟨0, 1⟩,
by { rw [mul_one, mul_zero] }

/-- If a is idempotent, then (1 - 2 * a) ^ 2 = 1 -/
def invol (a : A) := 1 - 2 * a

section one_variable

variables {a : A} (ha : is_idempotent a)
include ha

/-- Positive powers of idempotents are idempotent -/
theorem pow : ∀ (n : ℕ), a ^ (n + 1) = a
| 0 := by { rw [zero_add, pow_one] }
| (n + 1) := by { have : a * a = a := ha, rw [pow_succ, pow n, this] }

/-- If a is idempotent, then so is 1 - a.  We call this (not a),
 because it is the negation operation for a boolean algebra structure
 on the set of idempotents.
-/
theorem not : is_idempotent (1 - a) :=
by { rw [is_idempotent'] at ha ⊢, rw [mul_comm, sub_sub_cancel], exact ha }

/-- 1 is the only regular idempotent -/
theorem regular (hr : is_regular a) : a = 1 :=
by { symmetry, rw [← sub_eq_zero], exact hr _ (is_idempotent'.mp ha) }

/-- 0 is the only nilpotent idempotent -/
theorem nilpotent (hn : is_nilpotent a) : a = 0 :=
by { rcases hn with ⟨n, hn'⟩, rw [← pow ha n, pow_succ, hn', mul_zero] }

theorem mul_self_invol : a * (invol a) = - a :=
by { dsimp [is_idempotent, invol] at *,
    rw [mul_sub, mul_one, two_mul, mul_add, ha],
    rw [← sub_sub, sub_self, zero_sub] }

theorem invol_square : (invol a) * (invol a) = 1 :=
begin
  change (1 - 2 * a) * invol a = 1,
  rw [sub_mul, mul_assoc, mul_self_invol ha, one_mul],
  dsimp [invol],
  rw[mul_neg, sub_sub, add_neg_self, sub_zero]
end

end one_variable

section two_variables
variables {a b : A} (ha : is_idempotent a) (hb : is_idempotent b)
include ha hb

/-- The set of idempotents is a boolean algebra under the
  operations given below.
-/
theorem and  : is_idempotent (a * b) :=
show (a * b) * (a * b) = a * b,
by { dsimp [is_idempotent] at ha hb,
     rw [mul_assoc, mul_comm b, mul_assoc, hb, ← mul_assoc, ha] }

theorem add (hab : a * b = 0) : is_idempotent (a + b) :=
by { dsimp [is_idempotent] at *,
     rw [mul_add, add_mul, add_mul, mul_comm b a, ha, hb, hab,
         zero_add, add_zero] }

theorem or : is_idempotent (a + b - a * b) :=
begin
  have : a + b - a * b = a + (1 - a) * b :=
    by { rw [sub_mul, one_mul, add_sub] },
  rw [this],
  apply add ha (and (not ha) hb),
  rw [← mul_assoc, is_idempotent'.mp ha, zero_mul],
end

theorem xor : is_idempotent (a + b - 2 * a * b) :=
begin
  let u := a * (1 - b),
  let v := (1 - a) * b,
  have : a + b - 2 * a * b = u + v := by { dsimp [u, v], ring },
  rw [this],
  have hu := and ha (not hb),
  have hv := and (not ha) hb,
  have huv : u * v = 0 :=
  by { dsimp [u, v], rw [mul_comm a, mul_assoc, ← mul_assoc a],
       have : a * (1 - a) = 0 := is_idempotent'.mp ha,
       rw [this, zero_mul, mul_zero] },
  exact add hu hv huv
end

end two_variables

/-- Idempotents are equal if their difference is nilpotent -/
theorem eq_of_sub_nilp {e₀ e₁ : A}
  (h₀ : is_idempotent e₀) (h₁ : is_idempotent e₁)
  (h : is_nilpotent (e₀ - e₁)) : e₀ = e₁ :=
begin
  dsimp [is_idempotent] at h₀ h₁,
  let x := e₀ - e₁,
  let u := 1 - 2 * e₀,
  let v := 1 + u * x,
  have hvx := calc
  v * x = (e₀ * e₀ - e₀) * (4 * e₁ - 2 * e₀ - 1) +
          (e₁ * e₁ - e₁) * (1 - 2 * e₀) :
    by { dsimp [v, u, x], ring }
   ... = 0 : by { rw [h₀, h₁, sub_self, sub_self, zero_mul, zero_mul, zero_add] },
 have hv : is_regular v :=
  regular.add_nilpotent_aux (is_regular_one A) (is_nilpotent_smul u h),
 have hx : x = 0 := hv x hvx,
 rw [← sub_eq_zero],
 exact hx,
end

/-- If e * (1 - e) is nilpotent, then there is a unique idempotent
  that is congruent to e mod nilpotents.
-/
def lift : ∀ (e : A) (h : as_nilpotent (e * (1 - e))), A :=
 λ e ⟨n, hx⟩, let y := (1 - e ^ (n + 2) - (1 - e) ^ (n + 2)) in
  e ^ (n + 2) * (finset.range n).sum (λ i, y ^ i)

def lift_spec (e : A) (h : as_nilpotent (e * (1 - e))) :
 pprod (is_idempotent (lift e h)) (as_nilpotent ((lift e h) - e)) :=
begin
 rcases h with ⟨n, hx⟩,
 let x := e * (1 - e), change x ^ n = 0 at hx,
 let y := 1 - e ^ (n + 2) - (1 - e) ^ (n + 2),
 let u := (finset.range n).sum (λ i, y ^ i),
 let e₁ := e ^ (n + 2) * u,
 have : lift e ⟨n, hx⟩ = e₁ := rfl,
 rw [this],
 let f := λ (i : ℕ), e ^ i * (1 - e) ^ (n + 2 - i) * nat.choose (n + 2) i,
 let z := (finset.range (n + 1)).sum
            (λ j, e ^ j * (1 - e) ^ (n - j) * (nat.choose (n + 2) (j + 1))),
 let xz := (finset.range (n + 1)).sum (f ∘ nat.succ),
 have hxz : x * z = xz := by {
   dsimp [xz, x], rw [finset.mul_sum], apply finset.sum_congr rfl, intros i hi,
   replace hi : i ≤ n := nat.le_of_lt_succ (finset.mem_range.mp hi),
   have : (f ∘ nat.succ) i = f (i + 1) := rfl, rw [this], dsimp [f],
   have : n + 2 - (i + 1) = (n - i) + 1 := calc
    n + 2 - (i + 1) = n + 1 - i : by { rw [nat.succ_sub_succ] }
    ... = (i + (n - i)) + 1 - i : by { rw [nat.add_sub_of_le hi] }
    ... = (n - i) + 1 : by { simp only [add_comm, add_assoc, nat.add_sub_cancel_left] },
   rw [this, pow_succ, pow_succ], repeat { rw [mul_assoc] }, congr' 1,
   repeat { rw [← mul_assoc] }, rw [mul_comm (1 - e) (e ^ i)],
 },
 have hf₀ : f 0 = (1 - e) ^ (n + 2) :=
  by { dsimp [f], rw [nat.choose, nat.cast_one, pow_zero, one_mul, mul_one] },
 have hf₁ := finset.sum_range_succ' f (n + 1),
 rw[hf₀] at hf₁,
 have hf₂ : f (n + 2) = e ^ (n + 2) :=
  by { dsimp [f], rw [nat.choose_self, nat.cast_one, nat.sub_self, pow_zero, mul_one, mul_one] },
 have hf₃ := finset.sum_range_succ f (n + 2),
 rw[hf₂] at hf₃,
 have := calc
  (1 : A) = (1 : A) ^ (n + 2) : (one_pow (n + 2)).symm
  ... = (e + (1 - e)) ^ (n + 2) :
   by { congr, rw [add_sub, add_comm, add_sub_cancel] }
  ... = (finset.range (n + 2).succ).sum f : add_pow e (1 - e) (n + 2)
  ... = ((finset.range (n + 2)).sum f)  + e ^ (n + 2): hf₃
  ... = (xz + (1 - e) ^ (n + 2)) + e ^ (n + 2) :  by { rw [hf₁] }
  ... = (x * z + (1 - e) ^ (n + 2)) + e ^ (n + 2) : by { rw [hxz] },
 have hxyz := calc
  y = 1 - e ^ (n + 2) - (1 - e) ^ (n + 2) : rfl
  ... = ((x * z + (1 - e) ^ (n + 2)) + e ^ (n + 2)) - e ^ (n + 2) - (1 - e) ^ (n + 2) :
   by { congr' 2 }
  ... = x * z : by { simp only [sub_eq_add_neg, add_comm, add_left_comm,
                               add_neg_cancel_left, add_neg_cancel_right] },
 have hy : y ^ n = 0 := by { rw [hxyz, mul_pow, hx, zero_mul] },
 have hu : u * (y - 1) = y ^ n - 1 := geom_sum_mul y n,
 rw [mul_comm, hy, zero_sub] at hu, replace hu := congr_arg has_neg.neg hu,
 rw [neg_neg, neg_mul_eq_neg_mul, neg_sub] at hu,
 have : 1 - y = e ^ (n + 2) + (1 - e) ^ (n + 2) :=
  calc 1 - y = 1 - (1 - e ^ (n + 2) - (1 - e) ^ (n + 2)) : by { simp only [y] }
   ... = e ^ (n + 2) + (1 - e) ^ (n + 2) : by rw [sub_sub, sub_sub_cancel],
 let hu' := hu, rw [this] at hu',
 have := calc
  1 - e₁ = (e ^ (n + 2) + (1 - e) ^ (n + 2)) * u - e₁ : by { rw [hu'] }
  ... = e ^ (n + 2) * u + (1 - e) ^ (n + 2) * u - e ^ (n + 2) * u :
   by { rw [add_mul] }
  ... = (1 - e) ^ (n + 2) * u : by { rw [add_comm, add_sub_cancel] },
 have := calc
  e₁ * (1 - e₁) = (e ^ (n + 2) * u) * (1 - e₁) : rfl
  ... = u * (e ^ (n + 2) * (1 - e₁)) : by { rw [mul_comm (e ^ (n + 2))], rw [← mul_assoc] }
  ... = u * (e ^ (n + 2) * (1 - e) ^ (n + 2) * u) : by { rw [this, mul_assoc] }
  ... = u * (x ^ (n + 2) * u) : by { rw [mul_pow, pow_add] }
  ... = 0 : by { rw [pow_add, hx, zero_mul, zero_mul, mul_zero] },
 split, exact is_idempotent'.mpr this,
 let w := geom_sum₂ 1 e (n + 1),
 have hw : x * w = e - e ^ (n + 2) := calc
  x * w = e * (w * (1 - e)) : by { dsimp [x], rw [mul_assoc, mul_comm _ w] }
  ... = e * (1 - e ^ (n + 1)) : by { rw [geom_sum₂_mul 1 e (n + 1), one_pow] }
  ... = e - e ^ (n + 2) : by { rw [mul_sub, mul_one, pow_succ e (n + 1)] },
 have hu'' : u = 1 + x * z * u := by {
   rw [sub_mul, hxyz, one_mul] at hu, rw [← hu, sub_add_cancel],
 },
 have := calc
  e₁ - e = e ^ (n + 2) * u - e : rfl
  ... = e ^ (n + 2) * (1 + x * z * u) - e : by { congr' 2 }
  ... = (e ^ (n + 2) * (x * z * u) + e ^ (n + 2)) - e :
         by { rw [mul_add, mul_one, add_comm] }
  ... = x * (e ^ (n + 2) * z * u) - (e - e ^ (n + 2)) :
         by { rw [← sub_add, sub_eq_add_neg, sub_eq_add_neg],
             rw [← mul_assoc, ← mul_assoc, mul_comm (e ^ (n + 2))],
             repeat { rw [add_assoc] }, rw [add_comm (e ^ (n + 2))],
             repeat { rw [mul_assoc] } }
  ... = x * (e ^ (n + 2) * z * u - w) : by { rw [mul_sub, hw] },
 have : (e₁ - e) ^ n = 0 := by { rw [this, mul_pow, hx, zero_mul] },
 exact ⟨n, this⟩,
end

theorem lift_unique (e e₁ : A)
 (h : as_nilpotent (e * (1 - e))) (hi : is_idempotent e₁)
 (hn : is_nilpotent (e₁ - e)) : e₁ = lift e h :=
begin
 rcases lift_spec e h with ⟨hi', hn'⟩,
 apply eq_of_sub_nilp hi hi',
 have : e₁ - lift e h = (e₁ - e) - (lift e h - e) :=
  by { rw [sub_sub_sub_cancel_right] },
 rw [this], apply is_nilpotent_sub hn ⟨hn'⟩
end

end is_idempotent

namespace is_idempotent

variables {e : A} (he : is_idempotent e)
include he

/-- An idempotent e gives a splitting of the form A ≃ B × C.
  The first factor will be denoted by (axis he), where he
  is the proof that e is idempotent.
-/

def axis := {b : A // b * e = b}

namespace axis

instance : has_coe (axis he) A := ⟨subtype.val⟩

theorem eq (b₁ b₂ : axis he) : (b₁ : A) = (b₂ : A) → b₁ = b₂ := subtype.eq

def mk (b : A) (hb : b * e = b) : axis he := ⟨b, hb⟩

theorem coe_mk {b : A} (hb : b * e = b) : ((mk he b hb) : A) = b := rfl

instance : has_zero (axis he) := ⟨⟨(0 : A), zero_mul e⟩⟩

instance : has_one (axis he) := ⟨⟨e, he⟩⟩

instance : has_neg (axis he) :=
 ⟨λ b, axis.mk he (- b.val) (by { rw [← neg_mul_eq_neg_mul, b.property] })⟩

instance : has_add (axis he) :=
 ⟨λ b₁ b₂, axis.mk he (b₁.val + b₂.val) (by { rw [add_mul, b₁.property, b₂.property] })⟩

instance : has_mul (axis he) :=
 ⟨λ b₁ b₂, axis.mk he (b₁.val * b₂.val) (by { rw [mul_assoc, b₂.property] })⟩

@[simp] theorem zero_coe : ((0 : axis he) : A) = 0 := rfl

@[simp] theorem one_coe  : ((1 : axis he) : A) = e := rfl

@[simp] theorem neg_coe (b : axis he) : (((- b) : axis he) : A) = - b := rfl

@[simp] theorem add_coe (b₁ b₂ : axis he) :
 ((b₁ + b₂ : axis he) : A) = b₁ + b₂ := rfl

@[simp] theorem mul_coe (b₁ b₂ : axis he) :
 ((b₁ * b₂ : axis he) : A) = b₁ * b₂ := rfl

instance : comm_ring (axis he) := begin
  refine_struct {
   zero := has_zero.zero, add := (+), neg := has_neg.neg, sub := λ a b, a + (-b),
   one := has_one.one, mul := (*),
   nsmul := nsmul_rec,
   npow := npow_rec,
   zsmul := zsmul_rec,
   nsmul_zero' := λ x, rfl,
   nsmul_succ' := λ n x, rfl,
   zsmul_zero' := λ x, rfl,
   zsmul_succ' := λ n x, rfl,
   zsmul_neg'  := λ n x, rfl,
   npow_zero'  := λ x, rfl,
   npow_succ'  := λ n x, rfl
 };
 try { rintro a };
 try { rintro b };
 try { rintro c };
 apply eq;
 repeat { rw[add_coe] };
 repeat { rw[neg_coe] };
 repeat { rw[mul_coe] };
 repeat { rw[add_coe] };
 repeat { rw[zero_coe] };
 repeat { rw[one_coe] },
 { rw[add_assoc] },
 { rw[zero_add] },
 { rw[add_zero] },
 { rw[neg_add_self] },
 { rw[add_comm] },
 { rw[mul_assoc] },
 { rw[mul_comm], exact a.property },
 { exact a.property },
 { rw[mul_add] },
 { rw[add_mul] },
 { rw[mul_comm] }
end

def proj : A →+* axis he := {
 to_fun := λ a, ⟨a * e, by { dsimp [is_idempotent] at he, rw [mul_assoc, he] }⟩,
 map_zero' := by { apply eq, change 0 * e = 0, exact zero_mul e },
 map_one' := by { apply eq, change 1 * e = e, exact one_mul e },
 map_add' := λ a b, by { apply eq,
                        change (a + b) * e = a * e + b * e,
                        rw [add_mul] },
 map_mul' := λ a b, by { dsimp [is_idempotent] at he,
                        apply eq,
                        change (a * b) * e = (a * e) * (b * e),
                        rw [mul_assoc a e, ← mul_assoc e b e, mul_comm e b,
                            mul_assoc b e, he, mul_assoc] }
}

def split : A →+* (axis he) × (axis (is_idempotent.not he)) :=
 let he' := is_idempotent.not he in {
 to_fun := λ a, ⟨(proj he a), (proj (is_idempotent.not he) a)⟩,
 map_zero' := by { rw[(proj he).map_zero, (proj _).map_zero], refl },
 map_one' := by { rw[(proj he).map_one, (proj _).map_one], refl },
 map_add' := λ a b, by { rw[(proj he).map_add, (proj _).map_add], refl },
 map_mul' := λ a b, by { rw[(proj he).map_mul, (proj _).map_mul], refl }
}

theorem mul_eq_zero (b : axis he) (c : axis (is_idempotent.not he)) :
 (b : A) * (c : A) = 0 :=
begin
  rcases b with ⟨b, hb⟩,
  rcases c with ⟨c, hc⟩,
  change b * c = 0,
  exact calc
    b * c = (b * e) * (c * (1 - e)) : by rw [hb, hc]
    ... = b * (e * (1 - e)) * c :
      by { rw [mul_comm c, mul_assoc, mul_assoc, mul_assoc] }
    ... = 0 : by { rw [is_idempotent'.mp he, mul_zero, zero_mul] }
end

def combine : (axis he) × (axis (is_idempotent.not he)) →+* A := {
 to_fun := λ bc, (bc.1 : A) + (bc.2 : A),
 map_zero' := by {
   change ((0 : axis he) : A) + ((0 : axis (is_idempotent.not he)) : A) = 0,
   rw[zero_coe, zero_coe, zero_add]
 },
 map_one' := by {
   change e + (1 - e) = 1, rw [add_sub_cancel'_right]
 },
 map_add' := λ bc₁ bc₂, by {
    rcases bc₁ with ⟨⟨b₁, hb₁⟩, ⟨c₁, hc₁⟩⟩,
    rcases bc₂ with ⟨⟨b₂, hb₂⟩, ⟨c₂, hc₂⟩⟩,
    change (b₁ + b₂) + (c₁ + c₂) = (b₁ + c₁) + (b₂ + c₂),
    rw [add_assoc, ← add_assoc b₂, add_comm b₂ c₁, add_assoc, add_assoc] },
  map_mul' := λ bc₁ bc₂, by {
    rcases bc₁ with ⟨⟨b₁, hb₁⟩, ⟨c₁, hc₁⟩⟩,
    rcases bc₂ with ⟨⟨b₂, hb₂⟩, ⟨c₂, hc₂⟩⟩,
    change (b₁ * b₂) + (c₁ * c₂) = (b₁ + c₁) * (b₂ + c₂),
    have ebc : b₁ * c₂ = 0 := mul_eq_zero he ⟨b₁, hb₁⟩ ⟨c₂, hc₂⟩,
    have ecb : b₂ * c₁ = 0 := mul_eq_zero he ⟨b₂, hb₂⟩ ⟨c₁, hc₁⟩,
    rw [mul_comm] at ecb,
    rw [mul_add, add_mul, add_mul, ebc, ecb, zero_add, add_zero] } }

theorem combine_split (a : A) : combine he (split he a) = a :=
by { change a * e + a * (1 - e) = a,
     rw [mul_sub, mul_one, add_sub_cancel'_right] }

theorem split_combine (bc : (axis he) × (axis (is_idempotent.not he))) :
  split he (combine he bc) = bc :=
begin
  have he' : e * (1 - e) = 0 := is_idempotent'.mp he,
  rcases bc with ⟨⟨b, hb⟩, ⟨c, hc⟩⟩,
  ext,
  { change (b + c) * e = b,
    rw [← hc, add_mul, hb, mul_assoc, mul_comm (1 - e), he', mul_zero, add_zero] },
  { change (b + c) * (1 - e) = c,
    rw [← hb, add_mul, hc, mul_assoc, he', mul_zero, zero_add] }
end

end axis

end is_idempotent

variable (A)
def idempotent := {a : A // is_idempotent a}
variable {A}

namespace idempotent

variables (a b c : idempotent A)

instance : has_coe (idempotent A) A := ⟨subtype.val⟩

theorem eq (a₁ a₂ : idempotent A) : (a₁ : A) = (a₂ : A) → a₁ = a₂ :=
subtype.eq

theorem mul_self : (a * a : A) = a := a.property

theorem mul_not : (a * (1 - a) : A) = 0 := is_idempotent'.mp a.property

instance : has_le (idempotent A) := ⟨λ a b, (a * b : A) = a⟩
instance : has_bot (idempotent A) := ⟨⟨0, is_idempotent.zero⟩⟩
instance : has_top (idempotent A) := ⟨⟨1, is_idempotent.one⟩⟩

instance : has_compl (idempotent A) :=
⟨λ a, ⟨((1 - a) : A), is_idempotent.not a.property⟩⟩

instance : has_inf (idempotent A) :=
⟨λ a b, ⟨a * b, is_idempotent.and a.property b.property⟩⟩

instance : has_sup (idempotent A) :=
⟨λ a b, ⟨a + b - a * b, is_idempotent.or a.property b.property⟩⟩

theorem le_iff {a b : idempotent A} : a ≤ b ↔ (a * b : A) = a := by { refl }
theorem bot_coe : ((⊥ : idempotent A) : A) = 0 := rfl
theorem top_coe : ((⊤ : idempotent A) : A) = 1 := rfl

theorem compl_coe : ((aᶜ : idempotent A) : A) = 1 - a := rfl
theorem inf_coe : ((a ⊓ b : idempotent A) : A) = a * b := rfl
theorem sup_coe : ((a ⊔ b : idempotent A) : A) = a + b - a * b := rfl

theorem compl_compl : aᶜᶜ = a :=
by { apply eq, rw [compl_coe, compl_coe, sub_sub_cancel] }

theorem compl_inj {a b : idempotent A} (h : aᶜ = bᶜ) : a = b :=
by { rw [← compl_compl a, ← compl_compl b, h] }

theorem compl_le_compl {a b : idempotent A} : a ≤ b ↔ bᶜ ≤ aᶜ :=
begin
  rw [le_iff, le_iff, compl_coe, compl_coe, mul_sub, sub_mul, sub_mul],
  rw [mul_one, mul_one, one_mul, sub_sub, mul_comm (b : A)],
  rw[sub_right_inj],
  split,
  { intro h, rw [h, sub_self, add_zero] },
  { intro h, symmetry, rw [← sub_eq_zero],
    exact (add_right_inj (b : A)).mp (h.trans (add_zero (b : A)).symm) }
end

theorem compl_bot : (⊥ : idempotent A)ᶜ = ⊤ :=
by { apply eq, rw [compl_coe, bot_coe, top_coe, sub_zero] }

theorem compl_sup : (a ⊔ b)ᶜ = aᶜ ⊓ bᶜ :=
by { apply eq, rw [compl_coe, sup_coe, inf_coe, compl_coe, compl_coe], ring }

theorem compl_top : (⊤ : idempotent A)ᶜ = ⊥ :=
by { apply eq, rw [compl_coe, bot_coe, top_coe, sub_self] }

theorem compl_inf : (a ⊓ b)ᶜ = aᶜ ⊔ bᶜ :=
by { apply compl_inj, rw [compl_sup, compl_compl, compl_compl, compl_compl] }

theorem le_refl : a ≤ a := by { rw [le_iff, a.mul_self] }

theorem le_antisymm {a b : idempotent A} (hab : a ≤ b) (hba : b ≤ a) : a = b :=
by { apply eq, rw [le_iff] at *, rw [mul_comm] at hba, exact hab.symm.trans hba }

theorem le_trans {a b c : idempotent A} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
by { rw [le_iff] at *, exact calc
     ((a * c) : A) = a * b * c : by rw [hab]
      ... = a : by rw [mul_assoc, hbc, hab] }

theorem le_top : a ≤ ⊤ := by rw [le_iff, top_coe, mul_one]

theorem le_inf (hab : a ≤ b) (hac : a ≤ c) : a ≤ b ⊓ c :=
 by { rw [le_iff] at *, rw [inf_coe, ← mul_assoc, hab, hac] }

theorem inf_le_left : a ⊓ b ≤ a :=
 by { rw [le_iff, inf_coe, mul_comm, ← mul_assoc, a.mul_self] }

theorem inf_le_right : a ⊓ b ≤ b :=
 by { rw [le_iff, inf_coe, mul_assoc, b.mul_self] }

theorem bot_le : ⊥ ≤ a :=
 by { rw [le_iff, bot_coe, zero_mul] }

theorem sup_le (hac : a ≤ c) (hbc : b ≤ c) : a ⊔ b ≤ c :=
  by { rw [compl_le_compl] at *, rw [compl_sup], exact le_inf _ _ _ hac hbc }

theorem le_sup_left : a ≤ a ⊔ b :=
 by { rw [compl_le_compl, compl_sup], apply inf_le_left }

theorem le_sup_right : b ≤ a ⊔ b :=
 by { rw [compl_le_compl, compl_sup], apply inf_le_right }

theorem inf_sup_distrib : a ⊓ (b ⊔ c) = (a ⊓ b) ⊔ (a ⊓ c) :=
  by { apply eq, simp only [inf_coe, sup_coe, mul_add, mul_sub],
      congr' 1, rw [← mul_assoc, ← mul_assoc], congr' 1,
      rw [mul_assoc, mul_comm (b : A), ← mul_assoc, a.mul_self] }

theorem sup_inf_distrib : a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) :=
by { apply compl_inj,
     rw [compl_sup, compl_inf], rw[compl_inf, compl_sup, compl_sup, inf_sup_distrib] }

theorem inf_compl_eq_bot (a : idempotent A) : a ⊓ aᶜ = ⊥ :=
by { apply eq, rw [inf_coe, bot_coe, compl_coe, mul_not] }

theorem sup_compl_eq_top (a : idempotent A) : a ⊔ aᶜ = ⊤ :=
by { apply compl_inj, rw [compl_sup, compl_top, inf_compl_eq_bot] }

instance : boolean_algebra (idempotent A) := boolean_algebra.of_core {
  le := has_le.le,
  bot := ⊥,
  top := ⊤,
  sup := has_sup.sup,
  inf := has_inf.inf,
  compl := has_compl.compl,
  le_refl := le_refl,
  le_antisymm := λ a b hab hba, le_antisymm hab hba,
  le_trans := λ a b c hab hbc, le_trans hab hbc,
  bot_le := bot_le,
  le_top := le_top,
  le_inf := le_inf,
  inf_le_left := inf_le_left,
  inf_le_right := inf_le_right,
  sup_le := sup_le,
  le_sup_left := le_sup_left,
  le_sup_right := le_sup_right,
  le_sup_inf := λ a b c, by { rw [sup_inf_distrib] },
  inf_compl_le_bot := λ a, by { rw[inf_compl_eq_bot] },
  top_le_sup_compl := λ a, by { rw[sup_compl_eq_top] }
}

end idempotent

end commutative_algebra