/-
Copyright (c) 2022 Jiale Miao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jiale Miao
-/
import group_theory.group_action.conj_act
import algebra.star.unitary
import linear_algebra.clifford_algebra.star
import linear_algebra.clifford_algebra.even

/-!
# The pin group and the spin group

In this file we define `lipschitz` consisting all the elements in `(clifford_algebra)ˣ` closed
under conjugation and construct `pin_group` based on `lipschitz` and `unitary`, and we construct
`spin_group` based on `pin_group` and `clifford_algebra.even`. Also, we show `pin_group` and
`spin_group` form a group where the inverse is `star`.

## Main definitions

* `lipschitz`: the Lipschitz group with a quadratic form.
* `pin_group`: the Pin group with a quadratic form.
* `spin_group`: the Spin group with a quadratic form.

-/

variables {R : Type*} [field R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {Q : quadratic_form R M}

section pin
open clifford_algebra mul_action
open_locale pointwise

/--
`lipschitz Q` is the subgroup of `(clifford_algebra Q)ˣ` consisting all the elements closed under
conjugation. See `mem_lipschitz_iff`.
-/
def lipschitz (Q : quadratic_form R M): subgroup (clifford_algebra Q)ˣ :=
(stabilizer (conj_act (clifford_algebra Q)ˣ) (ι Q).range).comap
  (conj_act.to_conj_act : (clifford_algebra Q)ˣ ≃* conj_act (clifford_algebra Q)ˣ)

lemma mem_lipschitz_iff {x : (clifford_algebra Q)ˣ} : x ∈ lipschitz Q
  ↔ conj_act.to_conj_act x • (ι Q).range = (ι Q).range := iff.rfl

/--
`pin_group Q` is the submonoid of `clifford_algebra Q` and defined as the infimum of `lipschitz Q`
and `unitary (clifford_algebra)`. See `mem_iff`.
-/
def pin_group (Q : quadratic_form R M) : submonoid (clifford_algebra Q) :=
(lipschitz Q).to_submonoid.map (units.coe_hom $ clifford_algebra Q) ⊓ unitary _

namespace pin_group

/-- An element is in `pin_group Q` if and only if it is in `lipschitz Q` and `unitary _`. -/
lemma mem_iff {x : clifford_algebra Q} : x ∈ pin_group Q ↔
  x ∈ (lipschitz Q).to_submonoid.map (units.coe_hom $ clifford_algebra Q) ∧
    x ∈ unitary (clifford_algebra Q) := iff.rfl
lemma mem_lipschitz {x : clifford_algebra Q} (hx : x ∈ pin_group Q) :
  x ∈ (lipschitz Q).to_submonoid.map (units.coe_hom $ clifford_algebra Q) := hx.1
lemma mem_unitary {x : clifford_algebra Q} (hx : x ∈ pin_group Q) :
  x ∈ unitary (clifford_algebra Q) := hx.2

@[simp] lemma star_mul_self_of_mem {x : clifford_algebra Q}
  (hx : x ∈ pin_group Q) : star x * x = 1 := (hx.2).1
@[simp] lemma mul_star_self_of_mem {x : clifford_algebra Q}
  (hx : x ∈ pin_group Q) : x * star x = 1 := (hx.2).2

/-- See `star_mem_iff` for both directions. -/
lemma star_mem {x : clifford_algebra Q} (hx : x ∈ pin_group Q) :
  star x ∈ pin_group Q :=
begin
  rw mem_iff at hx ⊢,
  refine ⟨_, unitary.star_mem hx.2⟩,
  rcases hx with ⟨⟨y, hy₁, hy₂⟩, hx₂, hx₃⟩,
  simp only [subgroup.coe_to_submonoid, set_like.mem_coe] at hy₁,
  simp only [units.coe_hom_apply] at hy₂,
  simp only [submonoid.mem_map, subgroup.mem_to_submonoid,
    units.coe_hom_apply, exists_prop],
  refine ⟨star y, _, by simp only [hy₂, units.coe_star]⟩,
  rw ← hy₂ at hx₃,
  have hy₃ : y * star y = 1,
  { rw ← units.eq_iff,
    simp only [hx₃, units.coe_mul, units.coe_star, units.coe_one], },
  apply_fun (λ x, y⁻¹ * x) at hy₃,
  simp only [inv_mul_cancel_left, mul_one] at hy₃,
  simp only [hy₃, hy₁, inv_mem_iff],
end

/--
An element is in `pin_group Q` if and only if `star x` is in `pin_group Q`.
See `star_mem` for only one direction.
-/
@[simp] lemma star_mem_iff {x : clifford_algebra Q} :
  star x ∈ pin_group Q ↔ x ∈ pin_group Q :=
begin
  refine ⟨_, star_mem⟩,
  intro hx,
  convert star_mem hx,
  exact (star_star x).symm,
end

instance : has_star (pin_group Q) := ⟨λ x, ⟨star x, star_mem x.prop⟩⟩

@[simp, norm_cast] lemma coe_star {x : pin_group Q} : ↑(star x) = (star x : clifford_algebra Q) := rfl

lemma coe_star_mul_self (x : pin_group Q) :
  (star x : clifford_algebra Q) * x = 1 := star_mul_self_of_mem x.prop
lemma coe_mul_star_self (x : pin_group Q) :
  (x : clifford_algebra Q) * star x = 1 := mul_star_self_of_mem x.prop

@[simp] lemma star_mul_self (x : pin_group Q) : star x * x = 1 := subtype.ext $ coe_star_mul_self x
@[simp] lemma mul_star_self (x : pin_group Q) : x * star x = 1 := subtype.ext $ coe_mul_star_self x

/-- `pin_group Q` forms a group where the inverse is `star`. -/
instance : group (pin_group Q) :=
{ inv := star,
  mul_left_inv := star_mul_self,
  ..submonoid.to_monoid _ }

instance : has_involutive_star (pin_group Q) :=
⟨λ _, by { ext, simp only [coe_star, star_star] }⟩

instance : star_semigroup (pin_group Q) :=
⟨λ _ _, by { ext, simp only [coe_star, submonoid.coe_mul, star_mul] }⟩

instance : inhabited (pin_group Q) := ⟨1⟩

lemma star_eq_inv (x : pin_group Q) : star x = x⁻¹ := rfl

lemma star_eq_inv' : (star : pin_group Q → pin_group Q) = has_inv.inv := rfl

/-- The elements in `pin_group Q` embed into (clifford_algebra Q)ˣ. -/
@[simps]
def to_units : pin_group Q →* (clifford_algebra Q)ˣ :=
{ to_fun := λ x, ⟨x, ↑(x⁻¹), coe_mul_star_self x, coe_star_mul_self x⟩,
  map_one' := units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

lemma to_units_injective : function.injective (to_units : pin_group Q → (clifford_algebra Q)ˣ) :=
λ x y h, subtype.ext $ units.ext_iff.mp h

end pin_group
end pin

section spin
open clifford_algebra mul_action
open_locale pointwise

/--
`spin_group Q` is the submonoid of `clifford_algebra Q` and defined as the infimum of `pin_group Q`
and `clifford_algebra.even Q`. See `mem_iff`.
-/
def spin_group (Q : quadratic_form R M) :=
pin_group Q ⊓ (clifford_algebra.even Q).to_subring.to_submonoid

namespace spin_group

/-- An element is in `spin_group Q` if and only if it is in `pin_group Q` and `even Q`. -/
lemma mem_iff {x : clifford_algebra Q} : x ∈ spin_group Q ↔ x ∈ pin_group Q ∧
  x ∈ clifford_algebra.even Q := iff.rfl
lemma mem_pin {x : clifford_algebra Q} (hx : x ∈ spin_group Q) :
  x ∈ pin_group Q := hx.1
lemma mem_clifford_even {x : clifford_algebra Q} (hx : x ∈ spin_group Q) :
  x ∈ clifford_algebra.even Q := hx.2

@[simp] lemma star_mul_self_of_mem {x : clifford_algebra Q}
  (hx : x ∈ spin_group Q) : star x * x = 1 := ((hx.1).2).1
@[simp] lemma mul_star_self_of_mem {x : clifford_algebra Q}
  (hx : x ∈ spin_group Q) : x * star x = 1 := ((hx.1).2).2

/-- See `star_mem_iff` for both directions. -/
lemma star_mem {x : clifford_algebra Q} (hx : x ∈ spin_group Q) :
  star x ∈ spin_group Q :=
begin
  rw mem_iff at hx ⊢,
  cases hx with hx₁ hx₂,
  refine ⟨pin_group.star_mem hx₁, _⟩,
  dsimp only [clifford_algebra.even] at hx₂ ⊢,
  simp only [submodule.mem_to_subalgebra] at hx₂ ⊢,
  simp only [star_def, reverse_mem_even_odd_iff, involute_mem_even_odd_iff, hx₂],
end

/--
An element is in `spin_group Q` if and only if `star x` is in `spin_group Q`.
See `star_mem` for only one direction.
-/
@[simp] lemma star_mem_iff {x : clifford_algebra Q} :
  star x ∈ spin_group Q ↔ x ∈ spin_group Q :=
begin
  refine ⟨_, star_mem⟩,
  intro hx,
  convert star_mem hx,
  exact (star_star x).symm,
end

instance : has_star (spin_group Q) := ⟨λ x, ⟨star x, star_mem x.prop⟩⟩

@[simp, norm_cast] lemma coe_star {x : spin_group Q} :
  ↑(star x) = (star x : clifford_algebra Q) := rfl

lemma coe_star_mul_self (x : spin_group Q) :
  (star x : clifford_algebra Q) * x = 1 := star_mul_self_of_mem x.prop
lemma coe_mul_star_self (x : spin_group Q) :
  (x : clifford_algebra Q) * star x = 1 := mul_star_self_of_mem x.prop

@[simp] lemma star_mul_self (x : spin_group Q) : star x * x = 1 := subtype.ext $ coe_star_mul_self x
@[simp] lemma mul_star_self (x : spin_group Q) : x * star x = 1 := subtype.ext $ coe_mul_star_self x

/-- `spin_group Q` forms a group where the inverse is `star`. -/
instance : group (spin_group Q) :=
{ inv := star,
  mul_left_inv := star_mul_self,
  ..submonoid.to_monoid _ }

instance : has_involutive_star (spin_group Q) :=
⟨λ _, by { ext, simp only [coe_star, star_star] }⟩

instance : star_semigroup (spin_group Q) :=
⟨λ _ _, by { ext, simp only [coe_star, submonoid.coe_mul, star_mul] }⟩

instance : inhabited (spin_group Q) := ⟨1⟩

lemma star_eq_inv (x : spin_group Q) : star x = x⁻¹ := rfl

lemma star_eq_inv' : (star : spin_group Q → spin_group Q) = has_inv.inv := rfl

/-- The elements in `spin_group Q` embed into (clifford_algebra Q)ˣ. -/
@[simps]
def to_units : spin_group Q →* (clifford_algebra Q)ˣ :=
{ to_fun := λ x, ⟨x, ↑(x⁻¹), coe_mul_star_self x, coe_star_mul_self x⟩,
  map_one' := units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

lemma to_units_injective : function.injective (to_units : spin_group Q → (clifford_algebra Q)ˣ) :=
λ x y h, subtype.ext $ units.ext_iff.mp h

end spin_group
end spin


import data.nat.basic
import data.nat.prime
import data.rat.basic
import algebra.field
import algebra.char_zero
import algebra.char_p
import tactic

lemma char_is_prime_or_zero'
(R : Type*) [semiring R] [no_zero_divisors R] [nontrivial R]
: nat.prime (ring_char R) ∨ ring_char R = 0 :=
begin
  set p := ring_char R with h,
  rw ring_char.eq_iff at h,
  exact char_p.char_is_prime_or_zero R p,
end

example : char_zero ℚ :=
begin
  exact char_p.char_p_to_char_zero ℚ,
end

example : ring_char ℚ = 0 :=
begin
  rw ring_char.eq_iff,
  exact char_p.of_char_zero ℚ,
end

lemma prime_neq_char_is_non_zero
(R : Type*) [semiring R] [nontrivial R]
(q : ℕ) (hq : nat.prime q) (hneq : ring_char R ≠ q) : (q : R) ≠ 0 :=
begin
  intro h0,
  replace h0 := ring_char.dvd h0,
  cases (nat.dvd_prime hq).1 h0 with hp' hp', {
    apply (show (1:R) ≠ 0, from one_ne_zero),
    exact_mod_cast (ring_char.spec R 1).2 (by { rw hp', }),
  },
  exact hneq hp',
end

lemma power_of_prime_neq_char_is_non_zero
(R : Type*) [semiring R] [no_zero_divisors R] [nontrivial R]
(n : ℕ) (q : ℕ) (a : ℕ) (hq : nat.prime q) (hn : n = q^a) (hneq : ring_char R ≠ q) : (n : R) ≠ 0 :=
begin
  have h := prime_neq_char_is_non_zero R q hq hneq,
  rw hn,
  field_simp [h],
end

lemma dvd_char_is_zero_N
{R : Type*} [semiring R] {p : ℕ} (hp : ring_char R = p) (n : ℕ) (hdvd : p ∣ n) : (n : R) = 0 :=
begin
  rw ring_char.eq_iff at hp,
  rw @char_p.cast_eq_zero_iff R _ p hp n,
  exact hdvd,
end

lemma dvd_char_is_zero
{R : Type*} [ring R] {p : ℕ} (hp : ring_char R = p) (n : ℤ) (hdvd : (p : ℤ) ∣ n) : (n : R) = 0 :=
begin
  rw ring_char.eq_iff at hp,
  rw @char_p.int_cast_eq_zero_iff R _ p hp n,
  exact hdvd,
end

lemma ndvd_char_is_non_zero_N
{R : Type*} [semiring R] {p : ℕ} (hp : ring_char R = p) (n : ℕ) (hdvd : ¬ p ∣ n) : (n : R) ≠ 0 :=
begin
  rw ring_char.eq_iff at hp,
  rw [ne.def, @char_p.cast_eq_zero_iff R _ p hp n],
  exact hdvd,
end

lemma ndvd_char_is_non_zero
{R : Type*} [ring R] {p : ℕ} (hp : ring_char R = p) (n : ℤ) (hdvd : ¬ (p : ℤ) ∣ n) : (n : R) ≠ 0 :=
begin
  rw ring_char.eq_iff at hp,
  rw [ne.def, @char_p.int_cast_eq_zero_iff R _ p hp n],
  exact hdvd,
end

lemma cong_char_is_eq_N'
{R : Type*} [semiring R] {p : ℕ} (hp : ring_char R = p) (a b : ℕ) (hleq : a ≤ b) (hdvd : (p : ℤ) ∣ (b - a)) : (a : R) = (b : R) :=
begin
  by_cases hpzero : p = 0, {
    rw hpzero at hdvd,
    simp [sub_eq_zero] at hdvd,
    rw hdvd,
  },
  replace hpzero := pos_iff_ne_zero.mpr hpzero,
  zify at hpzero,
  cases hdvd with c hdvd,
  rw ring_char.eq_iff at hp,
  zify at hleq,
  replace hleq : ((b:ℤ) - a) ≥ 0 := by linarith,
  rw hdvd at hleq,
  simp [hpzero] at hleq,
  lift c to ℕ using hleq,
  replace hdvd : (b:ℤ) = a + p * c := by { rw ← hdvd, ring, },
  norm_cast at hdvd,
  rw hdvd,
  push_cast,
  simp [(@char_p.cast_eq_zero_iff R _ p hp p).2 (dvd_refl p)],
end

lemma cong_char_is_eq_N
{R : Type*} [semiring R] {p : ℕ} (hp : ring_char R = p) (a b : ℕ) (hdvd : (p : ℤ) ∣ (b - a)) : (a : R) = (b : R) :=
begin
  by_cases h : b ≥ a, {
    exact cong_char_is_eq_N' hp a b h hdvd,
  },
  replace h : a ≥ b := by linarith,
  replace hdvd : (p : ℤ) ∣ (a - b) := by {
    cases hdvd with c hdvd,
    use -c,
    replace hdvd : (b:ℤ) = a + p * c := by { rw ← hdvd, ring, },
    rw hdvd,
    ring,
  },
  exact (cong_char_is_eq_N' hp b a h hdvd).symm,
end

lemma cong_char_is_eq
{R : Type*} [ring R] {p : ℕ} (hp : ring_char R = p) (a b : ℤ) (hdvd : (p : ℤ) ∣ (b - a)) : (a : R) = (b : R) :=
begin
  rw ring_char.eq_iff at hp,
  rw @char_p.int_coe_eq_int_coe_iff R _ p hp a b,
  rw int.modeq.modeq_iff_dvd,
  exact hdvd,
end

lemma ncong_char_is_neq
{R : Type*} [ring R] {p : ℕ} (hp : ring_char R = p) (a b : ℤ) (hdvd : ¬ (p : ℤ) ∣ (b - a)) : (a : R) ≠ (b : R) :=
begin
  rw ring_char.eq_iff at hp,
  rw [ne.def, @char_p.int_coe_eq_int_coe_iff R _ p hp a b],
  rw int.modeq.modeq_iff_dvd,
  exact hdvd,
end

section char_specific

  lemma char_two_bit0 {R : Type*} [semiring R] (hchar : ring_char R = 2) (x : R) : bit0 x = 0 := begin
    unfold bit0,
    transitivity (2:R) * x,
    { rw [bit0, add_mul, one_mul], },
    rw ring_char.eq_iff at hchar,
    have := @char_p.cast_eq_zero R _ 2 hchar,
    norm_cast at this,
    rw [this, zero_mul],
  end

  lemma char_two_bit1 {R : Type*} [semiring R] (hchar : ring_char R = 2) (x : R) : bit1 x = 1 := begin
    unfold bit1,
    rw [char_two_bit0 hchar, zero_add],
  end

  example {R : Type*} [semiring R] (hchar : ring_char R = 2) : (35 : R) = 37 := begin
    simp [char_two_bit0 hchar, char_two_bit1 hchar],
  end

  open tactic (get_local infer_type)
  open interactive (parse)
  open lean.parser (ident)
  open interactive (loc.ns)
  open interactive.types (texpr location)

  meta def repeat_at_most : ℕ → tactic unit → tactic unit
  | 0 t := tactic.skip
  | (n+1) t := (do t, repeat_at_most n t) <|> tactic.skip

  meta def ring_char_tactic_internal (s : simp_lemmas) (u : list name) (loc : parse location) : tactic unit :=
  do
    s ← s.add_simp ``pow_zero,
    s ← s.add_simp ``pow_one,
    s ← s.add_simp ``zero_mul,
    s ← s.add_simp ``mul_zero,
    s ← s.add_simp ``zero_pow,
    s ← s.add_simp ``one_pow,
    ns ← loc.get_locals,
    -- FIXME: add a maximal repeat time since sometimes simp will change the goal randomly
    repeat_at_most 4 (do
      ret1 ← tactic.replace_at (
        λ e, do (a1, a2, _) ← tactic.simplify s u e, return (a1, a2)
      ) ns loc.include_goal,
      ret2 ← tactic.replace_at (
        tactic.ring.normalize tactic.transparency.reducible
      ) ns loc.include_goal,
      if ret1 || ret2 then tactic.skip else tactic.failed
    ),
    when loc.include_goal $ tactic.try (tactic.triv <|> tactic.reflexivity <|> tactic.contradiction)

  -- (hchar_ : parse texpr)
  -- hchar ← tactic.i_to_expr hchar_,
  -- `(ring_char _ = 2) ← infer_type hchar,

  /--
  Experimental ring tactic for characteristic 2.
  FIXME: You must provide a `hchar2 : ring_char R = 2` hypothesis.
  -/
  meta def tactic.interactive.ring_char2 (loc : parse location) : tactic unit :=
  do
    hchar ← get_local `hchar2,
    `(ring_char _ = 2) ← infer_type hchar | tactic.fail "hchar2 : ring_char R = 2 is expected",
    (s, u) ← tactic.mk_simp_set ff [] [], -- FIXME: this includes all default simp lemmas into it
    s ← tactic.to_expr ``(char_two_bit0 %%hchar) >>= s.add,
    s ← tactic.to_expr ``(char_two_bit1 %%hchar) >>= s.add,
    ring_char_tactic_internal s u loc

  example {R : Type*} [semiring R] (hchar2 : ring_char R = 2) : (35 : R) = 37 := begin
    ring_char2,
  end

  example {R : Type*} [semiring R] (hchar2 : ring_char R = 2) (x : R) (h : (35 : R) * x = 37) : x = 39 := begin
    ring_char2 at h ⊢,
    exact h,
  end

  /-lemma char_three_2_is_invertible {R : Type*} [semiring R] (hchar : ring_char R = 3) : is_unit (2:R) := begin
    use [(2:R),(2:R)],
    { norm_num, exact_mod_cast cong_char_is_eq_N hchar 4 1 (by norm_num), },
    { norm_num, exact_mod_cast cong_char_is_eq_N hchar 4 1 (by norm_num), },
    fconstructor,
  end-/

  lemma char_three_3_eq_0 {R : Type*} [semiring R] (hchar : ring_char R = 3) : (3:R) = 0 := begin
    exact_mod_cast dvd_char_is_zero_N hchar 3 (by norm_num),
  end

  lemma char_three_4_eq_1 {R : Type*} [semiring R] (hchar : ring_char R = 3) : (4:R) = 1 := begin
    exact_mod_cast cong_char_is_eq_N hchar 4 1 (by norm_num),
  end

  lemma char_three_5_eq_2 {R : Type*} [semiring R] (hchar : ring_char R = 3) : (5:R) = 2 := begin
    exact_mod_cast cong_char_is_eq_N hchar 5 2 (by norm_num),
  end

  example {R : Type*} [semiring R] (hchar : ring_char R = 3) : (34 : R) = 37 := begin
    simp [char_three_3_eq_0 hchar, char_three_4_eq_1 hchar, char_three_5_eq_2 hchar],
  end

  /--
  Experimental ring tactic for characteristic 3.
  FIXME: You must provide a `hchar3 : ring_char R = 3` hypothesis.
  -/
  meta def tactic.interactive.ring_char3 (loc : parse location) : tactic unit :=
  do
    hchar ← get_local `hchar3,
    `(ring_char _ = 3) ← infer_type hchar | tactic.fail "hchar3 : ring_char R = 3 is expected",
    (s, u) ← tactic.mk_simp_set ff [] [], -- FIXME: this includes all default simp lemmas into it
    -- s ← tactic.to_expr ``(char_three_2_is_invertible %%hchar) >>= s.add,
    s ← tactic.to_expr ``(char_three_3_eq_0 %%hchar) >>= s.add,
    s ← tactic.to_expr ``(char_three_4_eq_1 %%hchar) >>= s.add,
    s ← tactic.to_expr ``(char_three_5_eq_2 %%hchar) >>= s.add,
    ring_char_tactic_internal s u loc

  example {R : Type*} [semiring R] (hchar3 : ring_char R = 3) : (34 : R) = 37 := begin
    ring_char3,
  end

  /-example {R : Type*} [semiring R] (hchar3 : ring_char R = 3) (x : R) (h : (35 : R) * x = 0) : x = 0 := begin
    ring_char3 at h,
  end-/

  lemma char_p_a_plus_p_eq_a {R : Type*} [semiring R] {p : ℕ} (hchar : ring_char R = p)
  (a : ℕ) : ((a+p) : R) = a :=
  begin
    exact_mod_cast (cong_char_is_eq_N hchar a (a+p) (by simp)).symm,
  end

  meta def repeat_n_times {T : Type*} : ℕ → (ℕ → T → tactic T) → T → tactic T
  | 0 func t := (do return t)
  | (n+1) func t := (do func n t >>= repeat_n_times n func)

  /--
  Experimental ring tactic for characteristic p for p an integer literal.
  FIXME: You must provide a `hchar : ring_char R = p` hypothesis.
  -/
  meta def tactic.interactive.ring_charp (loc : parse location) : tactic unit :=
  do
    hchar ← get_local `hchar,
    `(ring_char _ = %%pp) ← infer_type hchar | tactic.fail "hchar : ring_char R = p is expected",
    p ← pp.to_nat <|> tactic.fail "p must be an integer literal",
    step ← norm_num.get_step,
    (s, u) ← tactic.mk_simp_set ff [] [], -- FIXME: this includes all default simp lemmas into it
    s ← repeat_n_times p (λ n (ss : simp_lemmas), do
      char_p_a_plus_p_eq_a ← tactic.to_expr ``(char_p_a_plus_p_eq_a %%hchar %%n),
      (_, a2) ← infer_type char_p_a_plus_p_eq_a >>= norm_num.derive' step,
      ss ← tactic.mk_eq_mp a2 char_p_a_plus_p_eq_a >>= ss.add,
      return ss
    ) s,
    ring_char_tactic_internal s u loc

  example {R : Type*} [semiring R] (hchar : ring_char R = 5) : (123567 : R) = 51832 := begin
    ring_charp,
  end

end char_specific


-- Basics about complex analytic (holomorphic) functions

import analysis.analytic.basic
import analysis.analytic.composition
import analysis.analytic.linear
import analysis.calculus.fderiv_analytic
import analysis.calculus.formal_multilinear_series
import analysis.complex.cauchy_integral
import data.complex.basic
import data.finset.basic
import data.real.basic
import data.real.ennreal
import data.real.nnreal
import data.real.pi.bounds
import data.set.basic
import topology.basic

import analytic
import bounds
import multilinear
import simple
import tactics
import topology

open complex (abs exp I log)
open filter (at_top)
open metric (ball closed_ball sphere)
open linear_order (min)
open_locale real nnreal ennreal topological_space
noncomputable theory

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

-- A function is entire iff it's differentiable everywhere
lemma differentiable.entire {f : ℂ → E} : differentiable ℂ f ↔ entire ℂ f :=
  ⟨differentiable.analytic_at, λ e z, analytic_at.differentiable_at (e z)⟩

-- A function is analytic at z iff it's differentiable on a surrounding open set
lemma differentiable_iff_analytic {f : ℂ → E} {s : set ℂ}
    (o : is_open s) : differentiable_on ℂ f s ↔ analytic_on ℂ f s := begin
  constructor, {
    intros d z zs,
    have n : s ∈ nhds z := is_open.mem_nhds o zs,
    exact differentiable_on.analytic_at d n
  }, {
    exact analytic_on.differentiable_on
  }
end

-- Constants are entire
theorem entire.const (a : E) : entire ℂ (λ _ : ℂ, a) := differentiable.entire.mp (differentiable_const a)

-- z^n is entire
theorem entire.monomial (n : ℕ) : entire ℂ (λ z : ℂ, z^n) := begin
  rw ←differentiable.entire, apply differentiable.pow differentiable_id,
end

-- Products of analytic functions are analytic
theorem analytic.mul {f g : ℂ → ℂ} {s : set ℂ}
    (o : is_open s) (hf : analytic_on ℂ f s) (hg : analytic_on ℂ g s) : analytic_on ℂ (f * g) s := begin
  rw ←differentiable_iff_analytic o at hf hg ⊢,
  exact differentiable_on.mul hf hg,
  repeat { exact complete_of_proper },
end

-- Products of analytic functions are analytic, point version
theorem analytic_at.mul {f g : ℂ → ℂ} {z : ℂ}
    (hf : analytic_at ℂ f z) (hg : analytic_at ℂ g z) : analytic_at ℂ (λ z, f z * g z) z := begin
  rcases hf.ball with ⟨fr,frp,fb⟩,
  rcases hg.ball with ⟨gr,grp,gb⟩,
  have o : is_open (ball z (min fr gr)) := metric.is_open_ball,
  exact analytic.mul o
    (fb.mono (metric.ball_subset_ball (by bound)))
    (gb.mono (metric.ball_subset_ball (by bound)))
    z (metric.mem_ball_self (by bound)),
end

-- Finite products of analytic functions are analytic
theorem prod_analytic {f : ℕ → ℂ → ℂ} {s : set ℂ}
    (o : is_open s) (h : ∀ n, analytic_on ℂ (f n) s) (N : finset ℕ)
    : analytic_on ℂ (λ z, N.prod (λ n, f n z)) s := begin
  induction N using finset.induction with a B aB hB, {
    simp, intros z zs, exact entire.const 1 z
  }, {
    simp_rw finset.prod_insert aB,
    exact analytic.mul o (h a) hB
  }
end

-- exp is entire
theorem entire.exp : entire ℂ exp := begin
  rw ←differentiable.entire, simp
end

-- log is analytic at positive re
theorem log_analytic_re_pos {f : ℂ → ℂ} {c : ℂ}
    : analytic_at ℂ f c → (f c).re > 0 → analytic_at ℂ (λ z, log (f z)) c := begin
  intros fa cp, refine analytic_at.comp _ fa,
  have la : analytic_on ℂ log (ball (f c) (f c).re), {
    rw ←differentiable_iff_analytic metric.is_open_ball,
    apply differentiable_on.clog differentiable_on_id,
    intros z zs, apply or.inl, simp [complex.dist_eq] at ⊢ zs,
    flip_ineq,
    calc z.re = (f c).re - ((f c).re - z.re) : by abel
    ... = (f c).re - (f c - z).re : by rw ←complex.sub_re
    ... ≥ (f c).re - abs (f c - z) : by bound [complex.re_le_abs]
    ... = (f c).re - abs (-(z - f c)) : by ring_nf
    ... = (f c).re - abs (z - f c) : by rw complex.abs_neg
    ... > 0 : by bound,
    apply_instance,
  },
  exact la _ (metric.mem_ball_self cp),
end

-- log is analytic near 1
theorem log_analytic_near_one {f : ℂ → ℂ} {s : set ℂ}
    : is_open s → analytic_on ℂ f s → (∀ z, z ∈ s → abs (f z - 1) < 1)
    → analytic_on ℂ (λ z, log (f z)) s := begin
  intros o fa n,
  rw ←differentiable_iff_analytic o,
  refine differentiable_on.clog _ _,
  rw differentiable_iff_analytic o, assumption, exact complete_of_proper,
  intros z zs,
  exact near_one_avoids_negative_reals (n z zs),
  exact complete_of_proper
end

-- The principle branch of sqrt
def sqrt (z : ℂ) : ℂ := exp (log z / 2)


import data.nat.parity
import data.finset
import .path
import .graph_induction
import tactic

noncomputable theory
open_locale classical

open simple_graph
namespace simple_graph

universes u
variables {V : Type u} [fintype V] [inhabited V] {G : simple_graph V}
open finset

/-- number of times v is in an edge in path x y -/
-- should be number of times v is in an edge of p
def path.crossed (v : V) (p : G.path) : ℕ :=
p.edges.countp $ λ e, v ∈ e

variables (G)
def has_eulerian_path : Prop := ∃ p : G.path, p.is_Eulerian
variables {G}

lemma empty_has_eulerian_path  :
  (@empty V).has_eulerian_path :=
begin
  split, swap, { exact path.empty _ (arbitrary V) },
  split, { exact list.nodup_nil },
  intro e, exfalso, exact empty_edge e,
end
-- no edges contained in the nil path
lemma crossed_cons {s v : V} (e : G.E) (p : G.path) (w : V) (hp : p.head ∈ e) (hs : s ∈ e) (hsv):
(p.cons e hp hs hsv).crossed v = p.crossed v + if v = s ∨ v = p.head then 1 else 0 :=
begin
  dsimp [path.crossed, path.cons],
  split_ifs with h,
  { cases h; simp [h, hs, hp] },
  suffices : v ∉ e, { simp [this] },
  rw e.mem_iff hs, push_neg, split, tauto,
  contrapose! h, right,
  rw h, symmetry, rw e.eq_other_iff, tauto,
end
-- adding an edge adds 1 to crossed if the edge contains the vertex

-- lemma crossed_add_non_edge {x y z : V} (e : G.adj x y) (p : G.path y z) (w : V) :
-- (w ≠ x ∧ w ≠ y) → ( G.crossed w (e :: p) = G.crossed w p) :=
-- begin
--   intro h, delta crossed, congr, ext a,
--   split_ifs with haw, swap, { tauto },
--   split, { tidy },
--   intro hp, apply mem.tail _ _ _ hp,
-- end
-- -- adding an edge adds 0 to crossed if the edge does not contain the vertex

-- if x=y, all vertices have crossed = even, else all vertices except x and y have crossed = odd
lemma path_crossed (p : G.path) (z : V) :
nat.even (p.crossed z) ↔ p.is_cycle ∨ (z ≠ p.head ∧ z ≠ p.last)
:=
begin
  apply p.induction_on,
  { intro v, split, intro t, left, exact rfl, intro t,
  suffices : path.crossed z (path.empty G v) = 0, simp [this],
  exact rfl },
  intros, have vh : v = (p_1.cons e hs hv hsv).head, exact rfl,
  have p_1e : p_1.last = (p_1.cons e hs hv hsv).last, symmetry,
  apply path.cons_last,
  split,
  -- implies case
  { by_cases cyc : v = (p_1.cons e hs hv hsv).last, intro t, left, exact cyc,
    intro ev, right, have eq : z ≠ v ∧ z ≠ p_1.last,
    contrapose! ev, by_cases z = v,
    { have odd : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
      apply crossed_cons, exact v, rw if_pos at odd, rw odd, rw ← nat.succ_eq_add_one, rw nat.even_succ, push_neg, rw a,
      right, split, exact ne_of_eq_of_ne h hsv, rw h, exact ne_of_ne_of_eq cyc (eq.symm p_1e), left, exact h },
    have ev1 := ev h,
    have even : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
    apply crossed_cons, exact v,
    by_cases h1 : z = p_1.head,
    { rw if_pos at even, rw [even, ← nat.succ_eq_add_one, nat.even_succ], push_neg, rw a,
      left, rw h1 at ev1, exact ev1, right, exact h1 },
    { rw [if_neg, add_zero] at even, rw [even, a], push_neg,
      split, rw ev1 at h1, exact (ne.symm h1).elim, intro t, exact ev1,
    push_neg, split, exact h, exact h1 }, rw [vh, p_1e] at eq, exact eq },
  -- impliedby case
  { intro cond, cases cond with cyc neq,
    by_cases z = v ∨ z = p_1.head,
    { have odd : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
      apply crossed_cons, exact v, rw if_pos at odd, rw [odd, ← nat.succ_eq_add_one, nat.even_succ, a], push_neg,
      split, refine ne.elim _, rw path.is_cycle at cyc, rw [p_1e, ← cyc, ← vh], symmetry, exact hsv,
      intro zneq, cases h with y z,
      { rw [y, p_1e], exact cyc },
      { exfalso, exact zneq z },
      exact h, },
    { have even : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
      apply crossed_cons, exact v, rw [if_neg, add_zero] at even, rw [even, a],
      { right, push_neg at h, cases h with h1 h2, split, exact h2,
        rw path.is_cycle at cyc, rw [p_1e, ← cyc], rw vh at h1, exact h1,},
      exact h, },
    by_cases z = p_1.head,
    { have odd : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
      apply crossed_cons, exact v, rw if_pos at odd, rw [odd, ← nat.succ_eq_add_one, nat.even_succ, a], push_neg,
      { split, cases neq with h1 h2, rw [h, ← p_1e] at h2, exact h2, intro h1, exfalso, exact h1 h },
      right, exact h },
    { have even : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + if z = v ∨ z = p_1.head then 1 else 0,
      apply crossed_cons, exact v, rw [if_neg, add_zero] at even, rw [even, a],
      right, split, exact h, cases neq with h1 h2, rw ← p_1e at h2, exact h2,
      push_neg, cases neq with h1 h2, rw ← vh at h1, split, exact h1, exact h }
  }

  -- have c_1 : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + 1,
  -- sorry,
  -- have odd : ¬ (path.crossed z p_1).even, refine nat.even_succ.mp _,
  -- rw nat.succ_eq_add_one, rw ← c_1, exact ev, rw a at odd,
  -- pretty sure something here is wrong, most likely the condition needed to use
  -- crossed_cons

  -- have z_c : path.crossed z (p_1.cons e hs hv hsv) = path.crossed z p_1 + 1,
  -- induction p with d a s t has p hp,
  -- { suffices : G.crossed z (path.nil d) = 0, simp [this],
  --   erw finset.card_eq_zero,
  --   convert finset.filter_false _, swap, { apply_instance },
  --   ext, split_ifs,
  --   { have := no_edge_in_nil G h, simpa }, tauto },
  -- have has' := G.ne_of_edge has,
  -- split;
  -- { by_cases hz : z = a ∨ z = s,
  --   { rw [crossed_add_edge, nat.even_succ, hp], assumption',
  --     try { rintro ⟨rfl, h⟩, tauto },
  --     cases hz; { rw hz at *, tauto }},
  --   push_neg at hz,
  --   rw [crossed_add_non_edge, hp], assumption',
  --   rintro ⟨rfl, h⟩; tauto },
end

lemma degree_eq_crossed {p : G.path} (hp : p.is_Eulerian) (v : V):
G.degree v = p.crossed v :=
begin
  unfold degree, unfold path.crossed,
  cases hp with h_trail h_all,
  rw neighbor_finset_eq_filter,
  rw list.countp_eq_length_filter,

  sorry,
  -- intro h,
  -- induction p with d a s t has p hp,
  -- I think we need induction on the number of edges?
  -- I don't think induction is possible here because the inductive hypothesis give us zero info
  -- Maybe just expanding definitions?
  -- unfold degree crossed,
  -- refine congr_fun _, ext a, congr,
  -- ext, simp only [true_and, mem_filter, mem_univ, mem_neighbor_finset],
  -- rw [set.set_of_app_iff, edge_symm],
  -- split_ifs with h1, swap, { tauto },
  -- suffices : G.mem h1 p, { simpa [h1] },
  -- cases h with t m,
  -- tauto,
end
-- convert this, ext,
--       simp_rw [degree_eq_crossed hp, path_crossed],
--       simp [h]; tauto } },
--   refine G.induction_on _ _ _,
--   { intro, apply empty_has_eulerian_path },
--   clear G, intros G hG0,
--   by_cases (filter {v : V | ¬(G.degree v).even} univ).card = 0,
--   { rw h,
--     haveI := G.inhabited_of_ne_empty hG0, --simp at *,
--     have e := arbitrary G.E,
--     use G.erase e,
--     split, { exact G.erase_is_subgraph e },
--     split, { rw ← G.card_edges_erase e, linarith },
--     intros h_even x, clear x,
--     replace h_even := h_even _,
lemma has_eulerian_path_iff :
  G.has_eulerian_path ↔ card (filter {v : V | ¬ nat.even (G.degree v)} univ) ∈ ({0, 2} : finset ℕ) :=
begin
  split,
  { intro hep, cases hep with p hp,
    simp only [mem_insert, card_eq_zero, mem_singleton],
    by_cases p.is_cycle,
    { left, convert finset.filter_false _,
      { ext, rw [degree_eq_crossed hp, path_crossed], tauto },
      { apply_instance } },
    { right,
      have : finset.card {p.head, p.last} = 2, { rw [card_insert_of_not_mem, card_singleton], rwa mem_singleton },
      convert this, ext,
      suffices : ¬(G.degree a).even ↔ a = p.head ∨ a = p.last, convert this; { simp; refl },
      have deg_cross := degree_eq_crossed hp, rw [deg_cross, path_crossed], simp [h]; tauto,
    }},
    refine G.induction_on _ _ _,
    { intro, apply empty_has_eulerian_path },
    clear G, intros G hG0,
    by_cases (filter {v : V | ¬(G.degree v).even} univ).card = 0,
    { rw h,
      haveI := G.inhabited_of_ne_empty hG0,
      have e := arbitrary G.E,
      use G.erase e,
      split, { exact G.erase_is_subgraph e },
      split, { rw ← G.card_edges_erase e, linarith },
      intro x, have eep : (G.erase e).has_eulerian_path, apply x,
      { left, sorry },
      cases eep with p ed, sorry,
    },
    by_cases (filter {v : V | ¬(G.degree v).even} univ).card = 2,
    { sorry },
    use empty, split, exact empty_is_subgraph G,

    -- convert G.induction_on _ _ _, refl,

  -- { rintro ⟨x, y, p, hep⟩,
  --   have deg_cross := G.degree_eq_crossed p hep,
  --   simp at *,
  --   by_cases x = y,
  --   { left, convert finset.filter_false _,
  --     { ext, simp [deg_cross, path_crossed, h] },
  --     { apply_instance } },
  --   { right,
  --     have : finset.card {x, y} = 2, { rw [card_insert_of_not_mem, card_singleton], rwa mem_singleton },
  --     convert this, ext,
  --     suffices : ¬(G.degree a).even ↔ a = x ∨ a = y, convert this; { simp; refl },
  --     rw [deg_cross, path_crossed'], simp [h]; tauto,
  --   }},
  -- intro h, simp only [mem_insert, card_eq_zero, mem_singleton] at h,
  -- I think we need induction on the number of edges?
  split, rw empty_card_edges, have zero_neq : G.card_edges ≠ 0, contrapose! hG0,
  rw ← card_edges_eq_zero_iff, exact hG0, omega,
  intro x, intro y, exfalso, finish,
end
-- iff the number of vertices of odd degree is 0 or 2

def KonigsbergBridge : simple_graph (fin 4) :=
begin
  sorry,
end

theorem KonigsbergBridgesProblem : ¬ has_eulerian_path KonigsbergBridge :=
begin
  sorry,
end

end simple_graph


import data.nat.basic
import tactic

noncomputable theory

open nat

theorem prob (f : ℕ → ℕ) (hinc : ∀ m n : ℕ, m < n → f m < f n) (hff : ∀ n : ℕ, f (f n) = 3 * n)
: f 0 = 0
∧ (∀ k n : ℕ, n ≤ 3 ^ k → f (3 ^ k + n) = 2 * 3 ^ k + n)
∧ (∀ k n : ℕ, n ≤ 3 ^ k → f (2 * 3 ^ k + n) = 3 * (3 ^ k + n)) :=
begin
  have h1 : f 0 = 0 := by {
    by_contradiction,
    have := hinc 0 (f 0) (nat.pos_of_ne_zero h),
    rw hff 0 at this,
    simp at this,
    exact not_lt_zero (f 0) this,
  },
  split, { exact h1, },
  have h2 : ∀ n k : ℕ, f(n) + k ≤ f(n+k) := by {
    intros n k,
    induction k with k hk,
    { simp, },
    rw succ_eq_add_one,
    repeat {rw ← add_assoc},
    calc f n + k + 1 ≤ f (n + k) + 1 : add_le_add_right hk 1
    ... ≤ f (n + k + 1) : by {
      have : n + k < n + k + 1 := lt_add_one (n + k),
      have : f (n + k) < f (n + k + 1) := hinc (n + k) (n + k + 1) this,
      exact succ_le_iff.mpr this,
    },
  },
  have h3 : f 1 = 2 := by {
    have t1 := h2 0 1,
    rw h1 at t1,
    simp at t1,
    by_cases t2 : f 1 < 2, {
      exfalso,
      have t3 : f 1 = 1 := le_antisymm (lt_succ_iff.mp t2) t1,
      have t4 : f 1 = 3 := by { have := hff 1, rw t3 at this, simp at this, exact this, },
      linarith only [t3, t4],
    },
    by_cases t3 : 2 < f 1, {
      exfalso,
      have t4 : 3 ≤ f 1 := succ_le_iff.mpr t3,
      have t5 : f 1 < f 2 := hinc 1 2 one_lt_two,
      have t6 : f 2 < f (f 1) := hinc 2 (f 1) t3,
      rw hff 1 at t6,
      simp at t6,
      linarith only [t4, t5, t6],
    },
    linarith only [t2, t3],
  },
  have h4 : ∀ k : ℕ, f (3 ^ k) = 2 * 3 ^ k ∧ f (2 * 3 ^ k) = 3 * 3 ^ k := by {
    intro k,
    induction k with k hk, {
      simp,
      split, { exact h3, },
      have := hff 1,
      rw h3 at this,
      simpa,
    }, {
      rw pow_succ,
      have t1 : f (3 * 3 ^ k) = 2 * (3 * 3 ^ k) := by {
        have := hff (2 * 3 ^ k),
        rw hk.2 at this,
        rw this,
        ring,
      },
      have := hff (3 * 3 ^ k),
      rw t1 at this,
      exact ⟨ t1, this ⟩,
    },
  },
  have h5 : ∀ k n : ℕ, n ≤ 3 ^ k → f (3 ^ k + n) = 2 * 3 ^ k + n := by {
    intros k n hnk,
    cases h4 k with t1 t2,
    have t3 : 2 * 3 ^ k + n ≤ f (3 ^ k + n) := by { have := h2 (3 ^ k) n, rw t1 at this, exact this, },
    cases le.dest hnk with m hm,
    have t4 := calc f (3 ^ k + n) + m ≤ f (3 ^ k + n + m) : h2 (3 ^ k + n) m
    ... = f (2 * 3 ^ k) : by { congr, rw ← hm, ring, }
    ... = 3 * 3 ^ k : t2
    ... = 2 * 3 ^ k + 3 ^ k : by ring
    ... = 2 * 3 ^ k + n + m : by { rw ← hm, ring, },
    rw add_le_add_iff_right m at t4,
    linarith only [t3, t4],
  },
  split, { exact h5, },
  intros k n hnk,
  have := hff (3 ^ k + n),
  rw h5 k n hnk at this,
  exact this,
end


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Yury Kudryashov

! This file was ported from Lean 3 source module topology.paracompact
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.SubsetProperties
import Mathbin.Topology.Separation
import Mathbin.Data.Option.Basic

/-!
# Paracompact topological spaces

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

A topological space `X` is said to be paracompact if every open covering of `X` admits a locally
finite refinement.

The definition requires that each set of the new covering is a subset of one of the sets of the
initial covering. However, one can ensure that each open covering `s : ι → set X` admits a *precise*
locally finite refinement, i.e., an open covering `t : ι → set X` with the same index set such that
`∀ i, t i ⊆ s i`, see lemma `precise_refinement`. We also provide a convenience lemma
`precise_refinement_set` that deals with open coverings of a closed subset of `X` instead of the
whole space.

We also prove the following facts.

* Every compact space is paracompact, see instance `paracompact_of_compact`.

* A locally compact sigma compact Hausdorff space is paracompact, see instance
  `paracompact_of_locally_compact_sigma_compact`. Moreover, we can choose a locally finite
  refinement with sets in a given collection of filter bases of `𝓝 x, `x : X`, see
  `refinement_of_locally_compact_sigma_compact_of_nhds_basis`. For example, in a proper metric space
  every open covering `⋃ i, s i` admits a refinement `⋃ i, metric.ball (c i) (r i)`.

* Every paracompact Hausdorff space is normal. This statement is not an instance to avoid loops in
  the instance graph.

* Every `emetric_space` is a paracompact space, see instance `emetric_space.paracompact_space` in
  `topology/metric_space/emetric_paracompact`.

## TODO

Prove (some of) [Michael's theorems](https://ncatlab.org/nlab/show/Michael%27s+theorem).

## Tags

compact space, paracompact space, locally finite covering
-/

open Set Filter Function

open Filter Topology

universe u v

#print ParacompactSpace /-
/-- A topological space is called paracompact, if every open covering of this space admits a locally
finite refinement. We use the same universe for all types in the definition to avoid creating a
class like `paracompact_space.{u v}`. Due to lemma `precise_refinement` below, every open covering
`s : α → set X` indexed on `α : Type v` has a *precise* locally finite refinement, i.e., a locally
finite refinement `t : α → set X` indexed on the same type such that each `∀ i, t i ⊆ s i`. -/
class ParacompactSpace (X : Type v) [TopologicalSpace X] : Prop where
  locallyFinite_refinement :
    ∀ (α : Type v) (s : α → Set X) (ho : ∀ a, IsOpen (s a)) (hc : (⋃ a, s a) = univ),
      ∃ (β : Type v)(t : β → Set X)(ho : ∀ b, IsOpen (t b))(hc : (⋃ b, t b) = univ),
        LocallyFinite t ∧ ∀ b, ∃ a, t b ⊆ s a
#align paracompact_space ParacompactSpace
-/

variable {ι : Type u} {X : Type v} [TopologicalSpace X]

#print precise_refinement /-
/-- Any open cover of a paracompact space has a locally finite *precise* refinement, that is,
one indexed on the same type with each open set contained in the corresponding original one. -/
theorem precise_refinement [ParacompactSpace X] (u : ι → Set X) (uo : ∀ a, IsOpen (u a))
    (uc : (⋃ i, u i) = univ) :
    ∃ v : ι → Set X, (∀ a, IsOpen (v a)) ∧ (⋃ i, v i) = univ ∧ LocallyFinite v ∧ ∀ a, v a ⊆ u a :=
  by
  -- Apply definition to `range u`, then turn existence quantifiers into functions using `choose`
  have :=
    ParacompactSpace.locallyFinite_refinement (range u) coe
      (SetCoe.forall.2 <| forall_range_iff.2 uo) (by rwa [← sUnion_range, Subtype.range_coe])
  simp only [SetCoe.exists, Subtype.coe_mk, exists_range_iff', Union_eq_univ_iff, exists_prop] at
    this
  choose α t hto hXt htf ind hind; choose t_inv ht_inv using hXt; choose U hxU hU using htf
  -- Send each `i` to the union of `t a` over `a ∈ ind ⁻¹' {i}`
  refine' ⟨fun i => ⋃ (a : α) (ha : ind a = i), t a, _, _, _, _⟩
  · exact fun a => isOpen_unionᵢ fun a => isOpen_unionᵢ fun ha => hto a
  · simp only [eq_univ_iff_forall, mem_Union]
    exact fun x => ⟨ind (t_inv x), _, rfl, ht_inv _⟩
  · refine' fun x => ⟨U x, hxU x, ((hU x).image ind).Subset _⟩
    simp only [subset_def, mem_Union, mem_set_of_eq, Set.Nonempty, mem_inter_iff]
    rintro i ⟨y, ⟨a, rfl, hya⟩, hyU⟩
    exact mem_image_of_mem _ ⟨y, hya, hyU⟩
  · simp only [subset_def, mem_Union]
    rintro i x ⟨a, rfl, hxa⟩
    exact hind _ hxa
#align precise_refinement precise_refinement
-/

#print precise_refinement_set /-
/-- In a paracompact space, every open covering of a closed set admits a locally finite refinement
indexed by the same type. -/
theorem precise_refinement_set [ParacompactSpace X] {s : Set X} (hs : IsClosed s) (u : ι → Set X)
    (uo : ∀ i, IsOpen (u i)) (us : s ⊆ ⋃ i, u i) :
    ∃ v : ι → Set X, (∀ i, IsOpen (v i)) ∧ (s ⊆ ⋃ i, v i) ∧ LocallyFinite v ∧ ∀ i, v i ⊆ u i :=
  by
  rcases precise_refinement (Option.elim' (sᶜ) u) (Option.forall.2 ⟨isOpen_compl_iff.2 hs, uo⟩)
      _ with
    ⟨v, vo, vc, vf, vu⟩
  refine' ⟨v ∘ some, fun i => vo _, _, vf.comp_injective (Option.some_injective _), fun i => vu _⟩
  · simp only [Union_option, ← compl_subset_iff_union] at vc
    exact subset.trans (subset_compl_comm.1 <| vu Option.none) vc
  · simpa only [Union_option, Option.elim', ← compl_subset_iff_union, compl_compl]
#align precise_refinement_set precise_refinement_set
-/

#print paracompact_of_compact /-
-- See note [lower instance priority]
/-- A compact space is paracompact. -/
instance (priority := 100) paracompact_of_compact [CompactSpace X] : ParacompactSpace X :=
  by
  -- the proof is trivial: we choose a finite subcover using compactness, and use it
  refine' ⟨fun ι s ho hu => _⟩
  rcases is_compact_univ.elim_finite_subcover _ ho hu.ge with ⟨T, hT⟩
  have := hT; simp only [subset_def, mem_Union] at this
  choose i hiT hi using fun x => this x (mem_univ x)
  refine'
    ⟨(T : Set ι), fun t => s t, fun t => ho _, _, locallyFinite_of_finite _, fun t =>
      ⟨t, subset.rfl⟩⟩
  simpa only [Union_coe_set, ← univ_subset_iff]
#align paracompact_of_compact paracompact_of_compact
-/

#print refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set /-
/-- Let `X` be a locally compact sigma compact Hausdorff topological space, let `s` be a closed set
in `X`. Suppose that for each `x ∈ s` the sets `B x : ι x → set X` with the predicate
`p x : ι x → Prop` form a basis of the filter `𝓝 x`. Then there exists a locally finite covering
`λ i, B (c i) (r i)` of `s` such that all “centers” `c i` belong to `s` and each `r i` satisfies
`p (c i)`.

The notation is inspired by the case `B x r = metric.ball x r` but the theorem applies to
`nhds_basis_opens` as well. If the covering must be subordinate to some open covering of `s`, then
the user should use a basis obtained by `filter.has_basis.restrict_subset` or a similar lemma, see
the proof of `paracompact_of_locally_compact_sigma_compact` for an example.

The formalization is based on two [ncatlab](https://ncatlab.org/) proofs:
* [locally compact and sigma compact spaces are paracompact](https://ncatlab.org/nlab/show/locally+compact+and+sigma-compact+spaces+are+paracompact);
* [open cover of smooth manifold admits locally finite refinement by closed balls](https://ncatlab.org/nlab/show/partition+of+unity#ExistenceOnSmoothManifolds).

See also `refinement_of_locally_compact_sigma_compact_of_nhds_basis` for a version of this lemma
dealing with a covering of the whole space.

In most cases (namely, if `B c r ∪ B c r'` is again a set of the form `B c r''`) it is possible
to choose `α = X`. This fact is not yet formalized in `mathlib`. -/
theorem refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] {ι : X → Type u} {p : ∀ x, ι x → Prop} {B : ∀ x, ι x → Set X}
    {s : Set X} (hs : IsClosed s) (hB : ∀ x ∈ s, (𝓝 x).HasBasis (p x) (B x)) :
    ∃ (α : Type v)(c : α → X)(r : ∀ a, ι (c a)),
      (∀ a, c a ∈ s ∧ p (c a) (r a)) ∧
        (s ⊆ ⋃ a, B (c a) (r a)) ∧ LocallyFinite fun a => B (c a) (r a) :=
  by
  classical
    -- For technical reasons we prepend two empty sets to the sequence `compact_exhaustion.choice X`
    set K' : CompactExhaustion X := CompactExhaustion.choice X
    set K : CompactExhaustion X := K'.shiftr.shiftr
    set Kdiff := fun n => K (n + 1) \ interior (K n)
    -- Now we restate some properties of `compact_exhaustion` for `K`/`Kdiff`
    have hKcov : ∀ x, x ∈ Kdiff (K'.find x + 1) :=
      by
      intro x
      simpa only [K'.find_shiftr] using
        diff_subset_diff_right interior_subset (K'.shiftr.mem_diff_shiftr_find x)
    have Kdiffc : ∀ n, IsCompact (Kdiff n ∩ s) := fun n =>
      ((K.is_compact _).diffₓ isOpen_interior).inter_right hs
    -- Next we choose a finite covering `B (c n i) (r n i)` of each
    -- `Kdiff (n + 1) ∩ s` such that `B (c n i) (r n i) ∩ s` is disjoint with `K n`
    have : ∀ (n) (x : Kdiff (n + 1) ∩ s), K nᶜ ∈ 𝓝 (x : X) := fun n x =>
      IsOpen.mem_nhds (K.is_closed n).isOpen_compl fun hx' =>
        x.2.1.2 <| K.subset_interior_succ _ hx'
    haveI : ∀ (n) (x : Kdiff n ∩ s), Nonempty (ι x) := fun n x => (hB x x.2.2).Nonempty
    choose! r hrp hr using fun n (x : Kdiff (n + 1) ∩ s) => (hB x x.2.2).mem_iff.1 (this n x)
    have hxr : ∀ (n x) (hx : x ∈ Kdiff (n + 1) ∩ s), B x (r n ⟨x, hx⟩) ∈ 𝓝 x := fun n x hx =>
      (hB x hx.2).mem_of_mem (hrp _ ⟨x, hx⟩)
    choose T hT using fun n => (Kdiffc (n + 1)).elim_nhds_subcover' _ (hxr n)
    set T' : ∀ n, Set ↥(Kdiff (n + 1) ∩ s) := fun n => T n
    -- Finally, we take the union of all these coverings
    refine' ⟨Σn, T' n, fun a => a.2, fun a => r a.1 a.2, _, _, _⟩
    · rintro ⟨n, x, hx⟩
      exact ⟨x.2.2, hrp _ _⟩
    · refine' fun x hx => mem_Union.2 _
      rcases mem_Union₂.1 (hT _ ⟨hKcov x, hx⟩) with ⟨⟨c, hc⟩, hcT, hcx⟩
      exact ⟨⟨_, ⟨c, hc⟩, hcT⟩, hcx⟩
    · intro x
      refine'
        ⟨interior (K (K'.find x + 3)),
          IsOpen.mem_nhds isOpen_interior (K.subset_interior_succ _ (hKcov x).1), _⟩
      have : (⋃ k ≤ K'.find x + 2, range <| Sigma.mk k : Set (Σn, T' n)).Finite :=
        (finite_le_nat _).bunionᵢ fun k hk => finite_range _
      apply this.subset
      rintro ⟨k, c, hc⟩
      simp only [mem_Union, mem_set_of_eq, mem_image, Subtype.coe_mk]
      rintro ⟨x, hxB : x ∈ B c (r k c), hxK⟩
      refine' ⟨k, _, ⟨c, hc⟩, rfl⟩
      have := (mem_compl_iff _ _).1 (hr k c hxB)
      contrapose! this with hnk
      exact K.subset hnk (interior_subset hxK)
#align refinement_of_locally_compact_sigma_compact_of_nhds_basis_set refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set
-/

#print refinement_of_locallyCompact_sigmaCompact_of_nhds_basis /-
/-- Let `X` be a locally compact sigma compact Hausdorff topological space. Suppose that for each
`x` the sets `B x : ι x → set X` with the predicate `p x : ι x → Prop` form a basis of the filter
`𝓝 x`. Then there exists a locally finite covering `λ i, B (c i) (r i)` of `X` such that each `r i`
satisfies `p (c i)`

The notation is inspired by the case `B x r = metric.ball x r` but the theorem applies to
`nhds_basis_opens` as well. If the covering must be subordinate to some open covering of `s`, then
the user should use a basis obtained by `filter.has_basis.restrict_subset` or a similar lemma, see
the proof of `paracompact_of_locally_compact_sigma_compact` for an example.

The formalization is based on two [ncatlab](https://ncatlab.org/) proofs:
* [locally compact and sigma compact spaces are paracompact](https://ncatlab.org/nlab/show/locally+compact+and+sigma-compact+spaces+are+paracompact);
* [open cover of smooth manifold admits locally finite refinement by closed balls](https://ncatlab.org/nlab/show/partition+of+unity#ExistenceOnSmoothManifolds).

See also `refinement_of_locally_compact_sigma_compact_of_nhds_basis_set` for a version of this lemma
dealing with a covering of a closed set.

In most cases (namely, if `B c r ∪ B c r'` is again a set of the form `B c r''`) it is possible
to choose `α = X`. This fact is not yet formalized in `mathlib`. -/
theorem refinement_of_locallyCompact_sigmaCompact_of_nhds_basis [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] {ι : X → Type u} {p : ∀ x, ι x → Prop} {B : ∀ x, ι x → Set X}
    (hB : ∀ x, (𝓝 x).HasBasis (p x) (B x)) :
    ∃ (α : Type v)(c : α → X)(r : ∀ a, ι (c a)),
      (∀ a, p (c a) (r a)) ∧ (⋃ a, B (c a) (r a)) = univ ∧ LocallyFinite fun a => B (c a) (r a) :=
  let ⟨α, c, r, hp, hU, hfin⟩ :=
    refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set isClosed_univ fun x _ => hB x
  ⟨α, c, r, fun a => (hp a).2, univ_subset_iff.1 hU, hfin⟩
#align refinement_of_locally_compact_sigma_compact_of_nhds_basis refinement_of_locallyCompact_sigmaCompact_of_nhds_basis
-/

#print paracompact_of_locallyCompact_sigmaCompact /-
-- See note [lower instance priority]
/-- A locally compact sigma compact Hausdorff space is paracompact. See also
`refinement_of_locally_compact_sigma_compact_of_nhds_basis` for a more precise statement. -/
instance (priority := 100) paracompact_of_locallyCompact_sigmaCompact [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] : ParacompactSpace X :=
  by
  refine' ⟨fun α s ho hc => _⟩
  choose i hi using Union_eq_univ_iff.1 hc
  have : ∀ x : X, (𝓝 x).HasBasis (fun t : Set X => (x ∈ t ∧ IsOpen t) ∧ t ⊆ s (i x)) id :=
    fun x : X => (nhds_basis_opens x).restrict_subset (IsOpen.mem_nhds (ho (i x)) (hi x))
  rcases refinement_of_locallyCompact_sigmaCompact_of_nhds_basis this with ⟨β, c, t, hto, htc, htf⟩
  exact ⟨β, t, fun x => (hto x).1.2, htc, htf, fun b => ⟨i <| c b, (hto b).2⟩⟩
#align paracompact_of_locally_compact_sigma_compact paracompact_of_locallyCompact_sigmaCompact
-/

#print normal_of_paracompact_t2 /-
/- Dieudonné‘s theorem: a paracompact Hausdorff space is normal. Formalization is based on the proof
at [ncatlab](https://ncatlab.org/nlab/show/paracompact+Hausdorff+spaces+are+normal). -/
theorem normal_of_paracompact_t2 [T2Space X] [ParacompactSpace X] : NormalSpace X :=
  by
  -- First we show how to go from points to a set on one side.
  have :
    ∀ s t : Set X,
      IsClosed s →
        IsClosed t →
          (∀ x ∈ s, ∃ u v, IsOpen u ∧ IsOpen v ∧ x ∈ u ∧ t ⊆ v ∧ Disjoint u v) →
            ∃ u v, IsOpen u ∧ IsOpen v ∧ s ⊆ u ∧ t ⊆ v ∧ Disjoint u v :=
    by
    /- For each `x ∈ s` we choose open disjoint `u x ∋ x` and `v x ⊇ t`. The sets `u x` form an
        open covering of `s`. We choose a locally finite refinement `u' : s → set X`, then `⋃ i, u' i`
        and `(closure (⋃ i, u' i))ᶜ` are disjoint open neighborhoods of `s` and `t`. -/
    intro s t hs ht H
    choose u v hu hv hxu htv huv using SetCoe.forall'.1 H
    rcases precise_refinement_set hs u hu fun x hx => mem_Union.2 ⟨⟨x, hx⟩, hxu _⟩ with
      ⟨u', hu'o, hcov', hu'fin, hsub⟩
    refine'
      ⟨⋃ i, u' i, closure (⋃ i, u' i)ᶜ, isOpen_unionᵢ hu'o, is_closed_closure.is_open_compl, hcov',
        _, disjoint_compl_right.mono le_rfl (compl_le_compl subset_closure)⟩
    rw [hu'fin.closure_Union, compl_Union, subset_Inter_iff]
    refine' fun i x hxt hxu =>
      absurd (htv i hxt) (closure_minimal _ (isClosed_compl_iff.2 <| hv _) hxu)
    exact fun y hyu hyv => (huv i).le_bot ⟨hsub _ hyu, hyv⟩
  -- Now we apply the lemma twice: first to `s` and `t`, then to `t` and each point of `s`.
  refine' ⟨fun s t hs ht hst => this s t hs ht fun x hx => _⟩
  rcases this t {x} ht isClosed_singleton fun y hy => _ with ⟨v, u, hv, hu, htv, hxu, huv⟩
  · exact ⟨u, v, hu, hv, singleton_subset_iff.1 hxu, htv, huv.symm⟩
  · simp_rw [singleton_subset_iff]
    exact t2_separation (hst.symm.ne_of_mem hy hx)
#align normal_of_paracompact_t2 normal_of_paracompact_t2
-/


import Lean4Axiomatic.Integer.Impl.Difference.Addition

namespace Lean4Axiomatic.Integer.Impl.Difference

/-! ## Multiplication of formal differences -/

variable {ℕ : Type} [Natural ℕ]

/--
Multiplication of differences.

**Definition intuition**: Geometry might be the best way to understand this
definition. Let's interpret each difference as the sum of a _positive_ value
(on the left) and a _negative_ value (on the right). Visualize this as a line
segment divided into two subsegments, colored black and red, with lengths
proportional to the positive and negative parts of the difference,
respectively.

The multiplication of two differences is then represented by a rectangle, where
each difference gets a dimension. The rectangle is divided into four smaller
rectangles, one for each combination of subsegments. The four regions are
colored according to the rules for multiplication of signs: if both sides of a
region are the same color, the region is colored black; if they are different
colors, the region is colored red. The difference in area between the black and
red regions is the result of the multiplication.
-/
def mul : Difference ℕ → Difference ℕ → Difference ℕ
| a——b, c——d => (a * c + b * d)——(a * d + b * c)

instance mulOp : Mul (Difference ℕ) := {
  mul := mul
}

/--
Multiplication of natural number differences is commutative.

**Proof intuition**: Expand definitions to see that we need to show the
equivalence of two differences of natural number sums of products. The left and
right elements of the differences are directly equivalent via commutativity of
natural number addition and multiplication, so convert the differences into
ordered pairs and use commutativity element-wise.
-/
theorem mul_comm {a b : Difference ℕ} : a * b ≃ b * a := by
  revert a; intro (n——m); revert b; intro (k——j)
  show n——m * k——j ≃ k——j * n——m
  show (n * k + m * j)——(n * j + m * k) ≃ (k * n + j * m)——(k * m + j * n)
  show from_prod (n * k + m * j, n * j + m * k)
     ≃ from_prod (k * n + j * m, k * m + j * n)
  apply AA.subst₁
  show (n * k + m * j, n * j + m * k) ≃ (k * n + j * m, k * m + j * n)
  calc
    (n * k + m * j, n * j + m * k) ≃ _ := AA.substL (AA.substL AA.comm)
    (k * n + m * j, n * j + m * k) ≃ _ := AA.substL (AA.substR AA.comm)
    (k * n + j * m, n * j + m * k) ≃ _ := AA.substR (AA.substL AA.comm)
    (k * n + j * m, j * n + m * k) ≃ _ := AA.substR (AA.substR AA.comm)
    (k * n + j * m, j * n + k * m) ≃ _ := AA.substR AA.comm
    (k * n + j * m, k * m + j * n) ≃ _ := Rel.refl

instance mul_commutative : AA.Commutative (α := Difference ℕ) (· * ·) := {
  comm := mul_comm
}

/--
Multiplying the same difference on the right of two equivalent differences
preserves their equivalence.

**Proof intuition**: The property is already intuitively true; imagine
stretching two line segments of the same length by the same amount. So the
proof just expands all definitions into equalities of sums of products of
natural numbers, and performs algebra to obtain the desired result.
-/
theorem mul_substL {a₁ a₂ b : Difference ℕ} : a₁ ≃ a₂ → a₁ * b ≃ a₂ * b := by
  revert a₁; intro (n——m); revert a₂; intro (k——j); revert b; intro (p——q)
  intro (_ : n——m ≃ k——j)
  have h : n + j ≃ k + m := ‹n——m ≃ k——j›
  show n——m * p——q ≃ k——j * p——q
  show (n * p + m * q)——(n * q + m * p) ≃ (k * p + j * q)——(k * q + j * p)
  show (n * p + m * q) + (k * q + j * p) ≃ (k * p + j * q) + (n * q + m * p)
  calc
    (n * p + m * q) + (k * q + j * p) ≃ _ := Rel.symm expand_swap
    (n + j) * p     + (k + m) * q     ≃ _ := AA.substL (AA.substL h)
    (k + m) * p     + (k + m) * q     ≃ _ := AA.substR (AA.substL (Rel.symm h))
    (k + m) * p     + (n + j) * q     ≃ _ := expand_swap
    (k * p + j * q) + (n * q + m * p) ≃ _ := Rel.refl
where
  expand_swap
      {u v w x y z : ℕ}
      : (w + x) * u + (y + z) * v ≃ (w * u + z * v) + (y * v + x * u)
      := calc
    (w + x) * u     + (y + z) * v     ≃ _ := AA.substL AA.distribR
    (w * u + x * u) + (y + z) * v     ≃ _ := AA.substR AA.distribR
    (w * u + x * u) + (y * v + z * v) ≃ _ := AA.expr_xxfxxff_lr_swap_rr
    (w * u + z * v) + (y * v + x * u) ≃ _ := Rel.refl

def mul_substitutiveL
    : AA.SubstitutiveOn
      Hand.L (α := Difference ℕ) (· * ·) AA.tc (· ≃ ·) (· ≃ ·) := {
  subst₂ := λ (_ : True) => mul_substL
}

def mul_substitutive
    : AA.Substitutive₂ (α := Difference ℕ) (· * ·) AA.tc (· ≃ ·) (· ≃ ·) := {
  substitutiveL := mul_substitutiveL
  substitutiveR := AA.substR_from_substL_swap (rS := (· ≃ ·)) mul_substitutiveL
}

/--
Multiplication of natural number differences is associative.

**Intuition**: It's not really clear why the property is true, or if there's a
clear principle behind the proof; brute force definition expansion and algebra
get the job done anyway.
-/
theorem mul_assoc {a b c : Difference ℕ} : (a * b) * c ≃ a * (b * c) := by
  revert a; intro (q——p); revert b; intro (n——m); revert c; intro (k——j)
  show (q——p * n——m) * k——j ≃ q——p * (n——m * k——j)
  let qn_pm := q * n + p * m
  let qm_pn := q * m + p * n
  let nk_mj := n * k + m * j
  let nj_mk := n * j + m * k
  show qn_pm——qm_pn * k——j ≃ q——p * nk_mj——nj_mk
  show (qn_pm * k + qm_pn * j)——(qn_pm * j + qm_pn * k)
     ≃ (q * nk_mj + p * nj_mk)——(q * nj_mk + p * nk_mj)
  show from_prod (qn_pm * k + qm_pn * j, qn_pm * j + qm_pn * k)
     ≃ from_prod (q * nk_mj + p * nj_mk, q * nj_mk + p * nk_mj)
  apply AA.subst₁
  show (qn_pm * k + qm_pn * j, qn_pm * j + qm_pn * k)
     ≃ (q * nk_mj + p * nj_mk, q * nj_mk + p * nk_mj)
  apply Relation.Equivalence.Impl.Prod.eqv_defn.mpr
  show qn_pm * k + qm_pn * j ≃ q * nk_mj + p * nj_mk
     ∧ qn_pm * j + qm_pn * k ≃ q * nj_mk + p * nk_mj
  have redistribute (x y : ℕ)
      : (q * n + p * m) * x + (q * m + p * n) * y
      ≃  q * (n * x + m * y) + p * (n * y + m * x)
      := calc
    (q * n + p * m) * x + (q * m + p * n) * y
      ≃ _ := AA.substL AA.distribR
    (q * n) * x + (p * m) * x + (q * m + p * n) * y
      ≃ _ := AA.substR AA.distribR
    (q * n) * x + (p * m) * x + ((q * m) * y + (p * n) * y)
      ≃ _ := AA.expr_xxfxxff_lr_swap_rl
    (q * n) * x + (q * m) * y + ((p * m) * x + (p * n) * y)
      ≃ _ := AA.substR AA.comm
    (q * n) * x + (q * m) * y + ((p * n) * y + (p * m) * x)
      ≃ _ := AA.substL (AA.substL AA.assoc)
    q * (n * x) + (q * m) * y + ((p * n) * y + (p * m) * x)
      ≃ _ := AA.substL (AA.substR AA.assoc)
    q * (n * x) + q * (m * y) + ((p * n) * y + (p * m) * x)
      ≃ _ := AA.substR (AA.substL AA.assoc)
    q * (n * x) + q * (m * y) + (p * (n * y) + (p * m) * x)
      ≃ _ := AA.substR (AA.substR AA.assoc)
    q * (n * x) + q * (m * y) + (p * (n * y) + p * (m * x))
      ≃ _ := AA.substL (Rel.symm AA.distribL)
    q * (n * x + m * y) + (p * (n * y) + p * (m * x))
      ≃ _ := AA.substR (Rel.symm AA.distribL)
    q * (n * x + m * y) + p * (n * y + m * x)
      ≃ _ := Rel.refl
  apply And.intro
  · show qn_pm * k + qm_pn * j ≃ q * nk_mj + p * nj_mk
    exact redistribute k j
  · show qn_pm * j + qm_pn * k ≃ q * nj_mk + p * nk_mj
    exact redistribute j k

def mul_associative : AA.Associative (α := Difference ℕ) (· * ·) := {
  assoc := mul_assoc
}

/--
The natural number difference `1` is a left multiplicative identity element.

**Property intuition**: A sum of a single value produces that same value.

**Proof intuition**: Not sure there's any deep insight here, the proof is the
standard formula of (1) expand definitions and (2) algebra.
-/
theorem mul_identL {a : Difference ℕ} : 1 * a ≃ a := by
  revert a; intro (n——m)
  show 1——0 * n——m ≃ n——m
  show (1 * n + 0 * m)——(1 * m + 0 * n) ≃ n——m
  show from_prod (1 * n + 0 * m, 1 * m + 0 * n) ≃ from_prod (n, m)
  apply AA.subst₁
  show (1 * n + 0 * m, 1 * m + 0 * n) ≃ (n, m)
  calc
    (1 * n + 0 * m, 1 * m + 0 * n) ≃ _ := AA.substL (AA.substL AA.identL)
    (n + 0 * m, 1 * m + 0 * n)     ≃ _ := AA.substL (AA.substR AA.absorbL)
    (n + 0, 1 * m + 0 * n)         ≃ _ := AA.substR (AA.substL AA.identL)
    (n + 0, m + 0 * n)             ≃ _ := AA.substR (AA.substR AA.absorbL)
    (n + 0, m + 0)                 ≃ _ := AA.substL AA.identR
    (n, m + 0)                     ≃ _ := AA.substR AA.identR
    (n, m)                         ≃ _ := Rel.refl

def mul_identityL : AA.IdentityOn Hand.L (α := Difference ℕ) 1 (· * ·) := {
  ident := mul_identL
}

def mul_identity : AA.Identity (α := Difference ℕ) 1 (· * ·) := {
  identityL := mul_identityL
  identityR := AA.identityR_from_identityL mul_identityL
}

/--
Multiplication on the left distributes over addition.

**Property intuition**

If we think of natural number differences as 1-dimensional vectors representing
the distance and direction to get from their first component to their second
component, then addition of differences is just the sum of vectors (magnitudes
and directions combine and some cancellation may occur) and multiplication of
differences is scaling, with a change in direction if the signs are opposite.

With that interpretation, this property then says that adding (combining) two
differences and multiplying (scaling with direction) the result is the same as
multiplying each difference before adding them. Geometrically this seems
plausible.

**Proof intuition**

After all definitions are expanded, the resulting equivalence of differences
turns out to follow from the "pointwise" equivalence of their components. So
the proof can be split into two cases, each of which follows from the same
algebraic identity on natural numbers.
-/
theorem mul_distribL {a b c : Difference ℕ} : a * (b + c) ≃ a * b + a * c := by
  revert a; intro (q——p); revert b; intro (n——m); revert c; intro (k——j)
  show q——p * (n——m + k——j) ≃ q——p * n——m + q——p * k——j
  let n_k := n + k; let m_j := m + j
  let qn := q * n; let qm := q * m; let qk := q * k; let qj := q * j
  let pn := p * n; let pm := p * m; let pk := p * k; let pj := p * j
  show q——p * n_k——m_j ≃ (qn + pm)——(qm + pn) + (qk + pj)——(qj + pk)
  show (q * n_k + p * m_j)——(q * m_j + p * n_k)
     ≃ ((qn + pm) + (qk + pj))——((qm + pn) + (qj + pk))
  show from_prod (q * n_k + p * m_j, q * m_j + p * n_k)
     ≃ from_prod ((qn + pm) + (qk + pj), (qm + pn) + (qj + pk))
  apply AA.subst₁
  show (q * n_k + p * m_j, q * m_j + p * n_k)
     ≃ ((qn + pm) + (qk + pj), (qm + pn) + (qj + pk))
  apply Relation.Equivalence.Impl.Prod.eqv_defn.mpr
  show q * n_k + p * m_j ≃ (qn + pm) + (qk + pj)
     ∧ q * m_j + p * n_k ≃ (qm + pn) + (qj + pk)
  have distrib_swap (w x y z : ℕ)
      : q * (w + y) + p * (x + z) ≃ (q * w + p * x) + (q * y + p * z)
      := calc
    q * (w + y) + p * (x + z)         ≃ _ := AA.substL AA.distribL
    (q * w + q * y) + p * (x + z)     ≃ _ := AA.substR AA.distribL
    (q * w + q * y) + (p * x + p * z) ≃ _ := AA.expr_xxfxxff_lr_swap_rl
    (q * w + p * x) + (q * y + p * z) ≃ _ := Rel.refl
  apply And.intro
  · show q * n_k + p * m_j ≃ (qn + pm) + (qk + pj)
    exact distrib_swap n m k j
  · show q * m_j + p * n_k ≃ (qm + pn) + (qj + pk)
    exact distrib_swap m n j k

def mul_distributiveL
    : AA.DistributiveOn Hand.L (α := Difference ℕ) (· * ·) (· + ·)
    := {
  distrib := mul_distribL
}

def mul_distributive : AA.Distributive (α := Difference ℕ) (· * ·) (· + ·) := {
  distributiveL := mul_distributiveL
  distributiveR := AA.distributiveR_from_distributiveL mul_distributiveL
}

/--
Conversion from `ℕ` to `Difference ℕ` is compatible with multiplication.

**Proprty intuition**: One would hope this is true, otherwise we could not say
that the set of differences (integers) is a superset of the natural numbers.

**Proof intuition**: Expand definitions to see that we only need to prove
equivalence of differences element-wise. And then it's just a matter of
reducing terms to zero and removing them.
-/
theorem mul_compat_natural
    {n m : ℕ} : ↑(n * m) ≃ (↑n : Difference ℕ) * ↑m
    := by
  show (n * m)——0 ≃ (n * m + 0 * 0)——(n * 0 + 0 * m)
  show from_prod (n * m, 0) ≃ from_prod (n * m + 0 * 0, n * 0 + 0 * m)
  apply AA.subst₁
  show (n * m, 0) ≃ (n * m + 0 * 0, n * 0 + 0 * m)
  apply Rel.symm (α := ℕ × ℕ)
  show (n * m + 0 * 0, n * 0 + 0 * m) ≃ (n * m, 0)
  calc
    (n * m + 0 * 0, n * 0 + 0 * m) ≃ _ := AA.substL (AA.substR AA.absorbL)
    (n * m + 0, n * 0 + 0 * m)     ≃ _ := AA.substL Natural.add_zero
    (n * m, n * 0 + 0 * m)         ≃ _ := AA.substR (AA.substL AA.absorbR)
    (n * m, 0 + 0 * m)             ≃ _ := AA.substR Natural.zero_add
    (n * m, 0 * m)                 ≃ _ := AA.substR AA.absorbL
    (n * m, 0)                     ≃ _ := Rel.refl

def mul_compatible_from_natural
    : AA.Compatible₂ (α := ℕ) (β := Difference ℕ) (↑·) (· * ·) (· * ·)
    := {
  compat₂ := mul_compat_natural
}

instance multiplication : Multiplication (ℕ := ℕ) (Difference ℕ) := {
  mulOp := mulOp
  mul_commutative := mul_commutative
  mul_substitutive := mul_substitutive
  mul_associative := mul_associative
  mul_identity := mul_identity
  mul_distributive := mul_distributive
  mul_compatible_from_natural := mul_compatible_from_natural
}

end Lean4Axiomatic.Integer.Impl.Difference


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import algebra.hom.iterate
import data.list.cycle
import data.pnat.basic
import data.nat.prime
import dynamics.fixed_points.basic
import group_theory.group_action.group

/-!
# Periodic points

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

A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.

## Main definitions

* `is_periodic_pt f n x` : `x` is a periodic point of `f` of period `n`, i.e. `f^[n] x = x`.
  We do not require `n > 0` in the definition.
* `pts_of_period f n` : the set `{x | is_periodic_pt f n x}`. Note that `n` is not required to
  be the minimal period of `x`.
* `periodic_pts f` : the set of all periodic points of `f`.
* `minimal_period f x` : the minimal period of a point `x` under an endomorphism `f` or zero
  if `x` is not a periodic point of `f`.
* `orbit f x`: the cycle `[x, f x, f (f x), ...]` for a periodic point.

## Main statements

We provide “dot syntax”-style operations on terms of the form `h : is_periodic_pt f n x` including
arithmetic operations on `n` and `h.map (hg : semiconj_by g f f')`. We also prove that `f`
is bijective on each set `pts_of_period f n` and on `periodic_pts f`. Finally, we prove that `x`
is a periodic point of `f` of period `n` if and only if `minimal_period f x | n`.

## References

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

-/

open set

namespace function

variables {α : Type*} {β : Type*} {f fa : α → α} {fb : β → β} {x y : α} {m n : ℕ}

/-- A point `x` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.
Note that we do not require `0 < n` in this definition. Many theorems about periodic points
need this assumption. -/
def is_periodic_pt (f : α → α) (n : ℕ) (x : α) := is_fixed_pt (f^[n]) x

/-- A fixed point of `f` is a periodic point of `f` of any prescribed period. -/
lemma is_fixed_pt.is_periodic_pt (hf : is_fixed_pt f x) (n : ℕ) : is_periodic_pt f n x :=
hf.iterate n

/-- For the identity map, all points are periodic. -/
lemma is_periodic_id (n : ℕ) (x : α) : is_periodic_pt id n x := (is_fixed_pt_id x).is_periodic_pt n

/-- Any point is a periodic point of period `0`. -/
lemma is_periodic_pt_zero (f : α → α) (x : α) : is_periodic_pt f 0 x := is_fixed_pt_id x

namespace is_periodic_pt

instance [decidable_eq α] {f : α → α} {n : ℕ} {x : α} : decidable (is_periodic_pt f n x) :=
is_fixed_pt.decidable

protected lemma is_fixed_pt (hf : is_periodic_pt f n x) : is_fixed_pt (f^[n]) x := hf

protected lemma map (hx : is_periodic_pt fa n x) {g : α → β} (hg : semiconj g fa fb) :
  is_periodic_pt fb n (g x) :=
hx.map (hg.iterate_right n)

lemma apply_iterate (hx : is_periodic_pt f n x) (m : ℕ) : is_periodic_pt f n (f^[m] x) :=
hx.map $ commute.iterate_self f m

protected lemma apply (hx : is_periodic_pt f n x) : is_periodic_pt f n (f x) :=
hx.apply_iterate 1

protected lemma add (hn : is_periodic_pt f n x) (hm : is_periodic_pt f m x) :
  is_periodic_pt f (n + m) x :=
by { rw [is_periodic_pt, iterate_add], exact hn.comp hm }

lemma left_of_add (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f m x) :
  is_periodic_pt f n x :=
by { rw [is_periodic_pt, iterate_add] at hn, exact hn.left_of_comp hm }

lemma right_of_add (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f n x) :
  is_periodic_pt f m x :=
by { rw add_comm at hn, exact hn.left_of_add hm }

protected lemma sub (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) :
  is_periodic_pt f (m - n) x :=
begin
  cases le_total n m with h h,
  { refine left_of_add _ hn,
    rwa [tsub_add_cancel_of_le h] },
  { rw [tsub_eq_zero_iff_le.mpr h],
    apply is_periodic_pt_zero }
end

protected lemma mul_const (hm : is_periodic_pt f m x) (n : ℕ) : is_periodic_pt f (m * n) x :=
by simp only [is_periodic_pt, iterate_mul, hm.is_fixed_pt.iterate n]

protected lemma const_mul (hm : is_periodic_pt f m x) (n : ℕ) : is_periodic_pt f (n * m) x :=
by simp only [mul_comm n, hm.mul_const n]

lemma trans_dvd (hm : is_periodic_pt f m x) {n : ℕ} (hn : m ∣ n) : is_periodic_pt f n x :=
let ⟨k, hk⟩ := hn in hk.symm ▸ hm.mul_const k

protected lemma iterate (hf : is_periodic_pt f n x) (m : ℕ) : is_periodic_pt (f^[m]) n x :=
begin
  rw [is_periodic_pt, ← iterate_mul, mul_comm, iterate_mul],
  exact hf.is_fixed_pt.iterate m
end

lemma comp {g : α → α} (hco : commute f g) (hf : is_periodic_pt f n x) (hg : is_periodic_pt g n x) :
  is_periodic_pt (f ∘ g) n x :=
by { rw [is_periodic_pt, hco.comp_iterate], exact hf.comp hg }

lemma comp_lcm {g : α → α} (hco : commute f g) (hf : is_periodic_pt f m x)
  (hg : is_periodic_pt g n x) :
  is_periodic_pt (f ∘ g) (nat.lcm m n) x :=
(hf.trans_dvd $ nat.dvd_lcm_left _ _).comp hco (hg.trans_dvd $ nat.dvd_lcm_right _ _)

lemma left_of_comp {g : α → α} (hco : commute f g) (hfg : is_periodic_pt (f ∘ g) n x)
  (hg : is_periodic_pt g n x) : is_periodic_pt f n x :=
begin
  rw [is_periodic_pt, hco.comp_iterate] at hfg,
  exact hfg.left_of_comp hg
end

lemma iterate_mod_apply (h : is_periodic_pt f n x) (m : ℕ) :
  f^[m % n] x = (f^[m] x) :=
by conv_rhs { rw [← nat.mod_add_div m n, iterate_add_apply, (h.mul_const _).eq] }

protected lemma mod (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) :
  is_periodic_pt f (m % n) x :=
(hn.iterate_mod_apply m).trans hm

protected lemma gcd (hm : is_periodic_pt f m x) (hn : is_periodic_pt f n x) :
  is_periodic_pt f (m.gcd n) x :=
begin
  revert hm hn,
  refine nat.gcd.induction m n (λ n h0 hn, _) (λ m n hm ih hm hn, _),
  { rwa [nat.gcd_zero_left], },
  { rw [nat.gcd_rec],
    exact ih (hn.mod hm) hm }
end

/-- If `f` sends two periodic points `x` and `y` of the same positive period to the same point,
then `x = y`. For a similar statement about points of different periods see `eq_of_apply_eq`. -/
lemma eq_of_apply_eq_same (hx : is_periodic_pt f n x) (hy : is_periodic_pt f n y) (hn : 0 < n)
  (h : f x = f y) :
  x = y :=
by rw [← hx.eq, ← hy.eq, ← iterate_pred_comp_of_pos f hn, comp_app, h]

/-- If `f` sends two periodic points `x` and `y` of positive periods to the same point,
then `x = y`. -/
lemma eq_of_apply_eq (hx : is_periodic_pt f m x) (hy : is_periodic_pt f n y) (hm : 0 < m)
  (hn : 0 < n) (h : f x = f y) :
  x = y :=
(hx.mul_const n).eq_of_apply_eq_same (hy.const_mul m) (mul_pos hm hn) h

end is_periodic_pt

/-- The set of periodic points of a given (possibly non-minimal) period. -/
def pts_of_period (f : α → α) (n : ℕ) : set α := {x : α | is_periodic_pt f n x}

@[simp] lemma mem_pts_of_period : x ∈ pts_of_period f n ↔ is_periodic_pt f n x :=
iff.rfl

lemma semiconj.maps_to_pts_of_period {g : α → β} (h : semiconj g fa fb) (n : ℕ) :
  maps_to g (pts_of_period fa n) (pts_of_period fb n) :=
(h.iterate_right n).maps_to_fixed_pts

lemma bij_on_pts_of_period (f : α → α) {n : ℕ} (hn : 0 < n) :
  bij_on f (pts_of_period f n) (pts_of_period f n) :=
⟨(commute.refl f).maps_to_pts_of_period n,
  λ x hx y hy hxy, hx.eq_of_apply_eq_same hy hn hxy,
  λ x hx, ⟨f^[n.pred] x, hx.apply_iterate _,
    by rw [← comp_app f, comp_iterate_pred_of_pos f hn, hx.eq]⟩⟩

lemma directed_pts_of_period_pnat (f : α → α) : directed (⊆) (λ n : ℕ+, pts_of_period f n) :=
λ m n, ⟨m * n, λ x hx, hx.mul_const n, λ x hx, hx.const_mul m⟩

/-- The set of periodic points of a map `f : α → α`. -/
def periodic_pts (f : α → α) : set α := {x : α | ∃ n > 0, is_periodic_pt f n x}

lemma mk_mem_periodic_pts (hn : 0 < n) (hx : is_periodic_pt f n x) :
  x ∈ periodic_pts f :=
⟨n, hn, hx⟩

lemma mem_periodic_pts : x ∈ periodic_pts f ↔ ∃ n > 0, is_periodic_pt f n x := iff.rfl

lemma is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate (hx : x ∈ periodic_pts f)
  (hm : is_periodic_pt f m (f^[n] x)) : is_periodic_pt f m x :=
begin
  rcases hx with ⟨r, hr, hr'⟩,
  convert (hm.apply_iterate ((n / r + 1) * r - n)).eq,
  suffices : n ≤ (n / r + 1) * r,
  { rw [←iterate_add_apply, nat.sub_add_cancel this, iterate_mul, (hr'.iterate _).eq] },
  rw [add_mul, one_mul],
  exact (nat.lt_div_mul_add hr).le
end

variable (f)

lemma bUnion_pts_of_period : (⋃ n > 0, pts_of_period f n) = periodic_pts f :=
set.ext $ λ x, by simp [mem_periodic_pts]

lemma Union_pnat_pts_of_period : (⋃ n : ℕ+, pts_of_period f n) = periodic_pts f :=
supr_subtype.trans $ bUnion_pts_of_period f

lemma bij_on_periodic_pts : bij_on f (periodic_pts f) (periodic_pts f) :=
Union_pnat_pts_of_period f ▸
  bij_on_Union_of_directed (directed_pts_of_period_pnat f) (λ i, bij_on_pts_of_period f i.pos)

variable {f}

lemma semiconj.maps_to_periodic_pts {g : α → β} (h : semiconj g fa fb) :
  maps_to g (periodic_pts fa) (periodic_pts fb) :=
λ x ⟨n, hn, hx⟩, ⟨n, hn, hx.map h⟩

open_locale classical

noncomputable theory

/-- Minimal period of a point `x` under an endomorphism `f`. If `x` is not a periodic point of `f`,
then `minimal_period f x = 0`. -/
def minimal_period (f : α → α) (x : α) :=
if h : x ∈ periodic_pts f then nat.find h else 0

lemma is_periodic_pt_minimal_period (f : α → α) (x : α) : is_periodic_pt f (minimal_period f x) x :=
begin
  delta minimal_period,
  split_ifs with hx,
  { exact (nat.find_spec hx).snd },
  { exact is_periodic_pt_zero f x }
end

@[simp] lemma iterate_minimal_period : f^[minimal_period f x] x = x :=
is_periodic_pt_minimal_period f x

@[simp] lemma iterate_add_minimal_period_eq : f^[n + minimal_period f x] x = (f^[n] x) :=
by { rw iterate_add_apply, congr, exact is_periodic_pt_minimal_period f x }

@[simp] lemma iterate_mod_minimal_period_eq : f^[n % minimal_period f x] x = (f^[n] x) :=
(is_periodic_pt_minimal_period f x).iterate_mod_apply n

lemma minimal_period_pos_of_mem_periodic_pts (hx : x ∈ periodic_pts f) :
  0 < minimal_period f x :=
by simp only [minimal_period, dif_pos hx, (nat.find_spec hx).fst.lt]

lemma minimal_period_eq_zero_of_nmem_periodic_pts (hx : x ∉ periodic_pts f) :
  minimal_period f x = 0 :=
by simp only [minimal_period, dif_neg hx]

lemma is_periodic_pt.minimal_period_pos (hn : 0 < n) (hx : is_periodic_pt f n x) :
  0 < minimal_period f x :=
minimal_period_pos_of_mem_periodic_pts $ mk_mem_periodic_pts hn hx

lemma minimal_period_pos_iff_mem_periodic_pts :
  0 < minimal_period f x ↔ x ∈ periodic_pts f :=
⟨not_imp_not.1 $ λ h,
  by simp only [minimal_period, dif_neg h, lt_irrefl 0, not_false_iff],
  minimal_period_pos_of_mem_periodic_pts⟩

lemma minimal_period_eq_zero_iff_nmem_periodic_pts : minimal_period f x = 0 ↔ x ∉ periodic_pts f :=
by rw [←minimal_period_pos_iff_mem_periodic_pts, not_lt, nonpos_iff_eq_zero]

lemma is_periodic_pt.minimal_period_le (hn : 0 < n) (hx : is_periodic_pt f n x) :
  minimal_period f x ≤ n :=
begin
  rw [minimal_period, dif_pos (mk_mem_periodic_pts hn hx)],
  exact nat.find_min' (mk_mem_periodic_pts hn hx) ⟨hn, hx⟩
end

lemma minimal_period_apply_iterate (hx : x ∈ periodic_pts f) (n : ℕ) :
  minimal_period f (f^[n] x) = minimal_period f x :=
begin
  apply (is_periodic_pt.minimal_period_le (minimal_period_pos_of_mem_periodic_pts hx) _).antisymm
    ((is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate hx
      (is_periodic_pt_minimal_period f _)).minimal_period_le
    (minimal_period_pos_of_mem_periodic_pts _)),
  { exact (is_periodic_pt_minimal_period f x).apply_iterate n, },
  { rcases hx with ⟨m, hm, hx⟩,
    exact ⟨m, hm, hx.apply_iterate n⟩ }
end

lemma minimal_period_apply (hx : x ∈ periodic_pts f) :
  minimal_period f (f x) = minimal_period f x :=
minimal_period_apply_iterate hx 1

lemma le_of_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
  (hmn : f^[m] x = (f^[n] x)) : m ≤ n :=
begin
  by_contra' hmn',
  rw [←nat.add_sub_of_le hmn'.le, add_comm, iterate_add_apply] at hmn,
  exact ((is_periodic_pt.minimal_period_le (tsub_pos_of_lt hmn')
    (is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate
    (minimal_period_pos_iff_mem_periodic_pts.1 ((zero_le m).trans_lt hm)) hmn)).trans
    (nat.sub_le m n)).not_lt hm
end

lemma eq_of_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
  (hn : n < minimal_period f x) (hmn : f^[m] x = (f^[n] x)) : m = n :=
(le_of_lt_minimal_period_of_iterate_eq hm hmn).antisymm
  (le_of_lt_minimal_period_of_iterate_eq hn hmn.symm)

lemma eq_iff_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
  (hn : n < minimal_period f x) : f^[m] x = (f^[n] x) ↔ m = n :=
⟨eq_of_lt_minimal_period_of_iterate_eq hm hn, congr_arg _⟩

lemma minimal_period_id : minimal_period id x = 1 :=
((is_periodic_id _ _ ).minimal_period_le nat.one_pos).antisymm
  (nat.succ_le_of_lt ((is_periodic_id _ _ ).minimal_period_pos nat.one_pos))

lemma is_fixed_point_iff_minimal_period_eq_one : minimal_period f x = 1 ↔ is_fixed_pt f x :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw ← iterate_one f,
    refine function.is_periodic_pt.is_fixed_pt _,
    rw ← h,
    exact is_periodic_pt_minimal_period f x },
  { exact ((h.is_periodic_pt 1).minimal_period_le nat.one_pos).antisymm
      (nat.succ_le_of_lt ((h.is_periodic_pt 1).minimal_period_pos nat.one_pos)) }
end

lemma is_periodic_pt.eq_zero_of_lt_minimal_period (hx : is_periodic_pt f n x)
  (hn : n < minimal_period f x) : n = 0 :=
eq.symm $ (eq_or_lt_of_le $ n.zero_le).resolve_right $ λ hn0,
not_lt.2 (hx.minimal_period_le hn0) hn

lemma not_is_periodic_pt_of_pos_of_lt_minimal_period :
  ∀ {n : ℕ} (n0 : n ≠ 0) (hn : n < minimal_period f x), ¬ is_periodic_pt f n x
| 0 n0 _ := (n0 rfl).elim
| (n + 1) _ hn := λ hp, nat.succ_ne_zero _ (hp.eq_zero_of_lt_minimal_period hn)

lemma is_periodic_pt.minimal_period_dvd (hx : is_periodic_pt f n x) : minimal_period f x ∣ n :=
(eq_or_lt_of_le $ n.zero_le).elim (λ hn0, hn0 ▸ dvd_zero _) $ λ hn0,
nat.dvd_iff_mod_eq_zero.2 $
(hx.mod $ is_periodic_pt_minimal_period f x).eq_zero_of_lt_minimal_period $
nat.mod_lt _ $ hx.minimal_period_pos hn0

lemma is_periodic_pt_iff_minimal_period_dvd : is_periodic_pt f n x ↔ minimal_period f x ∣ n :=
⟨is_periodic_pt.minimal_period_dvd, λ h, (is_periodic_pt_minimal_period f x).trans_dvd h⟩

open nat

lemma minimal_period_eq_minimal_period_iff {g : β → β} {y : β} :
  minimal_period f x = minimal_period g y ↔ ∀ n, is_periodic_pt f n x ↔ is_periodic_pt g n y :=
by simp_rw [is_periodic_pt_iff_minimal_period_dvd, dvd_right_iff_eq]

lemma minimal_period_eq_prime {p : ℕ} [hp : fact p.prime] (hper : is_periodic_pt f p x)
  (hfix : ¬ is_fixed_pt f x) : minimal_period f x = p :=
(hp.out.eq_one_or_self_of_dvd _ (hper.minimal_period_dvd)).resolve_left
  (mt is_fixed_point_iff_minimal_period_eq_one.1 hfix)

lemma minimal_period_eq_prime_pow {p k : ℕ} [hp : fact p.prime] (hk : ¬ is_periodic_pt f (p ^ k) x)
(hk1 : is_periodic_pt f (p ^ (k + 1)) x) : minimal_period f x = p ^ (k + 1) :=
begin
  apply nat.eq_prime_pow_of_dvd_least_prime_pow hp.out;
  rwa ← is_periodic_pt_iff_minimal_period_dvd
end

lemma commute.minimal_period_of_comp_dvd_lcm {g : α → α} (h : function.commute f g) :
  minimal_period (f ∘ g) x ∣ nat.lcm (minimal_period f x) (minimal_period g x) :=
begin
  rw [← is_periodic_pt_iff_minimal_period_dvd],
  exact (is_periodic_pt_minimal_period f x).comp_lcm h (is_periodic_pt_minimal_period g x)
end

lemma commute.minimal_period_of_comp_dvd_mul {g : α → α} (h : function.commute f g) :
  minimal_period (f ∘ g) x ∣ (minimal_period f x) * (minimal_period g x) :=
dvd_trans h.minimal_period_of_comp_dvd_lcm (lcm_dvd_mul _ _)

lemma commute.minimal_period_of_comp_eq_mul_of_coprime {g : α → α} (h : function.commute f g)
  (hco : coprime (minimal_period f x) (minimal_period g x)) :
  minimal_period (f ∘ g) x = (minimal_period f x) * (minimal_period g x) :=
begin
  apply dvd_antisymm (h.minimal_period_of_comp_dvd_mul),
  suffices : ∀ {f g : α → α}, commute f g → coprime (minimal_period f x) (minimal_period g x) →
    minimal_period f x ∣ minimal_period (f ∘ g) x,
    from hco.mul_dvd_of_dvd_of_dvd (this h hco) (h.comp_eq.symm ▸ this h.symm hco.symm),
  clear hco h f g,
  intros f g h hco,
  refine hco.dvd_of_dvd_mul_left (is_periodic_pt.left_of_comp h _ _).minimal_period_dvd,
  { exact (is_periodic_pt_minimal_period _ _).const_mul _ },
  { exact (is_periodic_pt_minimal_period _ _).mul_const _ }
end

private lemma minimal_period_iterate_eq_div_gcd_aux (h : 0 < gcd (minimal_period f x) n) :
  minimal_period (f ^[n]) x = minimal_period f x / nat.gcd (minimal_period f x) n :=
begin
  apply nat.dvd_antisymm,
  { apply is_periodic_pt.minimal_period_dvd,
    rw [is_periodic_pt, is_fixed_pt, ← iterate_mul, ← nat.mul_div_assoc _ (gcd_dvd_left _ _),
        mul_comm, nat.mul_div_assoc _ (gcd_dvd_right _ _), mul_comm, iterate_mul],
    exact (is_periodic_pt_minimal_period f x).iterate _ },
  { apply coprime.dvd_of_dvd_mul_right (coprime_div_gcd_div_gcd h),
    apply dvd_of_mul_dvd_mul_right h,
    rw [nat.div_mul_cancel (gcd_dvd_left _ _), mul_assoc, nat.div_mul_cancel (gcd_dvd_right _ _),
        mul_comm],
    apply is_periodic_pt.minimal_period_dvd,
    rw [is_periodic_pt, is_fixed_pt, iterate_mul],
    exact is_periodic_pt_minimal_period _ _ }
end

lemma minimal_period_iterate_eq_div_gcd (h : n ≠ 0) :
  minimal_period (f ^[n]) x = minimal_period f x / nat.gcd (minimal_period f x) n :=
minimal_period_iterate_eq_div_gcd_aux $ gcd_pos_of_pos_right _ (nat.pos_of_ne_zero h)

lemma minimal_period_iterate_eq_div_gcd' (h : x ∈ periodic_pts f) :
  minimal_period (f ^[n]) x = minimal_period f x / nat.gcd (minimal_period f x) n :=
minimal_period_iterate_eq_div_gcd_aux $
  gcd_pos_of_pos_left n (minimal_period_pos_iff_mem_periodic_pts.mpr h)

/-- The orbit of a periodic point `x` of `f` is the cycle `[x, f x, f (f x), ...]`. Its length is
the minimal period of `x`.

If `x` is not a periodic point, then this is the empty (aka nil) cycle. -/
def periodic_orbit (f : α → α) (x : α) : cycle α :=
(list.range (minimal_period f x)).map (λ n, f^[n] x)

/-- The definition of a periodic orbit, in terms of `list.map`. -/
lemma periodic_orbit_def (f : α → α) (x : α) :
  periodic_orbit f x = (list.range (minimal_period f x)).map (λ n, f^[n] x) :=
rfl

/-- The definition of a periodic orbit, in terms of `cycle.map`. -/

@[simp] lemma periodic_orbit_length : (periodic_orbit f x).length = minimal_period f x :=
by rw [periodic_orbit, cycle.length_coe, list.length_map, list.length_range]

@[simp] lemma periodic_orbit_eq_nil_iff_not_periodic_pt :
  periodic_orbit f x = cycle.nil ↔ x ∉ periodic_pts f :=
by { simp [periodic_orbit], exact minimal_period_eq_zero_iff_nmem_periodic_pts }

lemma periodic_orbit_eq_nil_of_not_periodic_pt (h : x ∉ periodic_pts f) :
  periodic_orbit f x = cycle.nil :=
periodic_orbit_eq_nil_iff_not_periodic_pt.2 h

@[simp] lemma mem_periodic_orbit_iff (hx : x ∈ periodic_pts f) :
  y ∈ periodic_orbit f x ↔ ∃ n, f^[n] x = y :=
begin
  simp only [periodic_orbit, cycle.mem_coe_iff, list.mem_map, list.mem_range],
  use λ ⟨a, ha, ha'⟩, ⟨a, ha'⟩,
  rintro ⟨n, rfl⟩,
  use [n % minimal_period f x, mod_lt _ (minimal_period_pos_of_mem_periodic_pts hx)],
  rw iterate_mod_minimal_period_eq
end

@[simp] lemma iterate_mem_periodic_orbit (hx : x ∈ periodic_pts f) (n : ℕ) :
  f^[n] x ∈ periodic_orbit f x :=
(mem_periodic_orbit_iff hx).2 ⟨n, rfl⟩

@[simp] lemma self_mem_periodic_orbit (hx : x ∈ periodic_pts f) : x ∈ periodic_orbit f x :=
iterate_mem_periodic_orbit hx 0

lemma nodup_periodic_orbit : (periodic_orbit f x).nodup :=
begin
  rw [periodic_orbit, cycle.nodup_coe_iff, list.nodup_map_iff_inj_on (list.nodup_range _)],
  intros m hm n hn hmn,
  rw list.mem_range at hm hn,
  rwa eq_iff_lt_minimal_period_of_iterate_eq hm hn at hmn
end

lemma periodic_orbit_apply_iterate_eq (hx : x ∈ periodic_pts f) (n : ℕ) :
  periodic_orbit f (f^[n] x) = periodic_orbit f x :=
eq.symm $ cycle.coe_eq_coe.2 $ ⟨n, begin
  apply list.ext_le _ (λ m _ _, _),
  { simp [minimal_period_apply_iterate hx] },
  { rw list.nth_le_rotate _ n m,
    simp [iterate_add_apply] }
end⟩

lemma periodic_orbit_apply_eq (hx : x ∈ periodic_pts f) :
  periodic_orbit f (f x) = periodic_orbit f x :=
periodic_orbit_apply_iterate_eq hx 1

theorem periodic_orbit_chain (r : α → α → Prop) {f : α → α} {x : α} :
  (periodic_orbit f x).chain r ↔ ∀ n < minimal_period f x, r (f^[n] x) (f^[n+1] x) :=
begin
  by_cases hx : x ∈ periodic_pts f,
  { have hx' := minimal_period_pos_of_mem_periodic_pts hx,
    have hM := nat.sub_add_cancel (succ_le_iff.2 hx'),
    rw [periodic_orbit, ←cycle.map_coe, cycle.chain_map, ←hM, cycle.chain_range_succ],
    refine ⟨_, λ H, ⟨_, λ m hm, H _ (hm.trans (nat.lt_succ_self _))⟩⟩,
    { rintro ⟨hr, H⟩ n hn,
      cases eq_or_lt_of_le (lt_succ_iff.1 hn) with hM' hM',
      { rwa [hM', hM, iterate_minimal_period] },
      { exact H _ hM' } },
    { rw iterate_zero_apply,
      nth_rewrite 2 ←@iterate_minimal_period α f x,
      nth_rewrite 1 ←hM,
      exact H _ (nat.lt_succ_self _) } },
  { rw [periodic_orbit_eq_nil_of_not_periodic_pt hx,
      minimal_period_eq_zero_of_nmem_periodic_pts hx],
    simp }
end

theorem periodic_orbit_chain' (r : α → α → Prop) {f : α → α} {x : α} (hx : x ∈ periodic_pts f) :
  (periodic_orbit f x).chain r ↔ ∀ n, r (f^[n] x) (f^[n+1] x) :=
begin
  rw periodic_orbit_chain r,
  refine ⟨λ H n, _, λ H n _, H n⟩,
  rw [iterate_succ_apply, ←iterate_mod_minimal_period_eq],
  nth_rewrite 1 ←iterate_mod_minimal_period_eq,
  rw [←iterate_succ_apply, minimal_period_apply hx],
  exact H _ (mod_lt _ (minimal_period_pos_of_mem_periodic_pts hx))
end

end function

namespace mul_action

open function

variables {α β : Type*} [group α] [mul_action α β] {a : α} {b : β}

@[to_additive] lemma pow_smul_eq_iff_minimal_period_dvd {n : ℕ} :
  a ^ n • b = b ↔ function.minimal_period ((•) a) b ∣ n :=
by rw [←is_periodic_pt_iff_minimal_period_dvd, is_periodic_pt, is_fixed_pt, smul_iterate]

@[to_additive] lemma zpow_smul_eq_iff_minimal_period_dvd {n : ℤ} :
  a ^ n • b = b ↔ (function.minimal_period ((•) a) b : ℤ) ∣ n :=
begin
  cases n,
  { rw [int.of_nat_eq_coe, zpow_coe_nat, int.coe_nat_dvd, pow_smul_eq_iff_minimal_period_dvd] },
  { rw [int.neg_succ_of_nat_coe, zpow_neg, zpow_coe_nat, inv_smul_eq_iff, eq_comm,
        dvd_neg, int.coe_nat_dvd, pow_smul_eq_iff_minimal_period_dvd] },
end

variables (a b)

@[simp, to_additive] lemma pow_smul_mod_minimal_period (n : ℕ) :
  a ^ (n % function.minimal_period ((•) a) b) • b = a ^ n • b :=
by conv_rhs { rw [← nat.mod_add_div n (minimal_period ((•) a) b), pow_add, mul_smul,
    pow_smul_eq_iff_minimal_period_dvd.mpr (dvd_mul_right _ _)] }

@[simp, to_additive] lemma zpow_smul_mod_minimal_period (n : ℤ) :
  a ^ (n % (function.minimal_period ((•) a) b : ℤ)) • b = a ^ n • b :=
by conv_rhs { rw [← int.mod_add_div n (minimal_period ((•) a) b), zpow_add, mul_smul,
    zpow_smul_eq_iff_minimal_period_dvd.mpr (dvd_mul_right _ _)] }

end mul_action


import tactic

-- Definition: a Proposition is a type `P`, where `P : Prop`.

variables (P Q R : Prop)

-- In Lean, `P → Q` means `P ⇒ Q`

example : P → P :=
begin
  intro hP, -- let hP be the hypothesis that P is true
  exact hP, -- our goal is exactly our hypothesis
end

example : P → (Q → P) :=
begin
  intro hP, -- let hP be the hypothesis that P is true
  intro hQ,
  exact hP,
end

-- is → associative? i.e. Does (P → Q) → R equal P → (Q → R) ?
-- (A+B)+C = A+(B+C)
-- (A-B)-C ≠ A-(B-C)
-- (A-B)-C
-- 2^(1^3) -- this is the convention for powers

-- CONVENTION: P → Q → R with no brackets MEANS P → (Q → R)

example : P → Q → P :=
begin
  intro hP,
  intro hQ,
  exact hP,
end

/-- Modus Ponens : if P is true, and P → Q, then Q is true -/
theorem modus_ponens : P → (P → Q) → Q :=
begin
  intro hP,
  intro hPQ, -- hPQ is the hypothesis that P → Q
  apply hPQ, -- apply the hypothesis that P → Q
  exact hP,
end

-- If `a<b` and `b<c` then `a<c` -- that's called "transitivity of <"

-- theorem transitivity : (P → Q) → (Q → R) → (P → R) :=
-- begin
--   sorry
-- end

example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  intro hPQR,
  intro hPQ,
  intro hP,
  apply hPQR,
    assumption,
  apply hPQ,
  assumption,
end

-- in Lean, the definition of ¬ P is `P → false`
-- if P is true, ¬ P is false, and P → false is false
-- if P is false, then ¬ P is true, and P → false is true

example : P → ¬ (¬ P) :=
begin
  intro hP,
  change (¬ P → false),
  intro hnP,
  change P → false at hnP,
  apply hnP,
  assumption,
end

example : ¬ (¬ P) → P :=
begin
  finish,
end

example : P → ¬ (¬ P) :=
begin
  apply modus_ponens,
end

-- and

example : P ∧ Q → P :=
begin
  intro hPaQ,
  cases hPaQ with hP hQ,
  assumption,
end

theorem and.elim' : P ∧ Q → (P → Q → R) → R :=
begin
  intro hPaQ,
  intro hPQR,
  cases hPaQ with hP hQ,
  apply hPQR;
  assumption,
end

theorem and.intro' : P → Q → P ∧ Q :=
begin
  intro hP,
  intro hQ,
  split,
    assumption,
  assumption,
end


/- Lecture 4.1: Mathematics — Foundation -/

namespace lecture

/- Type universes -/

#check (Prop   : Type)
#check (Type   : Type 1)
#check (Type 1 : Type 2)
#check (Type 2 : Type 3)

-- declare universe names
universes u v

example : Prop   = Sort 0       := by refl
example : Type   = Sort 1       := by refl
example : Type   = Type 0       := by refl
example : Type u = Sort (u + 1) := by refl

#check (Type u : Type (u + 1))

-- `ulift α` is isomorphic to `α`
#check ulift.{v u}
#check @ulift.up.{u v}
#check @ulift.down.{u v}

#check plift.{1}
#check eq.{u}

/- `Prop` vs. `Type` -/

-- `Prop` is a subsingleton
example {p : Prop} {h₁ h₂ : p} : h₁ = h₂ := by refl

namespace hidden

class inhabited (α : Type _) :=
(default : α)

-- inductive nonempty (α : Sort u) : Prop
-- | intro (val : α) : nonempty

-- inductive inhabited (α : Sort u) : Sort (max 1 u)
-- | mk (default : α) : inhabited

instance Prop_inhabited : inhabited Prop :=
inhabited.mk true

instance bool_inhabited : inhabited bool :=
inhabited.mk tt

instance nat_inhabited : inhabited nat :=
inhabited.mk 0

instance unit_inhabited : inhabited unit :=
inhabited.mk ()

def default (α : Type) [s : inhabited α] : α :=
@inhabited.default α s

instance prod_inhabited
    {α β : Type} [inhabited α] [inhabited β] :
  inhabited (prod α β) :=
⟨(default α, default β)⟩

#check default (nat × bool)
#reduce default (nat × bool)

end hidden
/- Large elimination -/

#check @false.elim        -- in a contradictory context
#check @and.rec
#check @eq.rec            -- substitution in `Prop` and `Type`
#check @well_founded.rec  -- induction or well-founded recursion

/- The axiom of choice -/

#print classical.choice

#check classical.some
#check classical.some_spec
#check classical.em
#check classical.prop_decidable

/- Quotient types -/

set_option pp.beta true

-- `quot` for arbitrary relations
#print quot
#print quot.mk
#print quot.lift
#print quot.sound

-- `quotient` for equivalence relations
#print quotient
#print setoid
#check quotient.lift_on
#check quotient.lift_on₂
#check quotient.exact

#check (≈)

/- Integers as a quotient -/

/- Basic idea: `(p, n)` represents `p - n` -/

instance int.rel : setoid (ℕ × ℕ) :=
{ r     := λa b, a.1 + b.2 = b.1 + a.2,
  iseqv :=
  ⟨ (assume a, rfl),
    (assume a b eq, eq.symm),
    (assume a b c eq_ab eq_bc,
      have (a.1 + c.2) + b.2 = (c.1 + a.2) + b.2 :=
        calc (a.1 + c.2) + b.2 = (a.1 + b.2) + c.2 : by ac_refl
        ... = a.2 + (b.1 + c.2) : by rw [eq_ab]; ac_refl
        ... = (c.1 + a.2) + b.2 : by rw [eq_bc]; ac_refl,
      calc a.1 + c.2 = c.1 + a.2 : eq_of_add_eq_add_right this) ⟩ }

@[simp] lemma rel_iff (a b : ℕ × ℕ) : a ≈ b ↔ a.1 + b.2 = b.1 + a.2 :=
iff.rfl

def int : Type := quotient int.rel

def zero : int := ⟦(0, 0)⟧

example (n : ℕ) : zero = ⟦(n, n)⟧ :=
begin
  unfold zero,
  apply quotient.sound,
  rw [rel_iff],
  simp
end

def add (a b : int) : int :=
quotient.lift_on₂ a b (λa b, ⟦(a.1 + b.1, a.2 + b.2)⟧)
  begin
    intros a₁ b₁ a₂ b₂ ha hb,
    apply quotient.sound,
    simp only [rel_iff] at ha hb ⊢,
    calc  (a₁.1 + b₁.1) + (a₂.2 + b₂.2) =
          (a₁.1 + a₂.2) + (b₁.1 + b₂.2) : by ac_refl
    ... = (a₂.1 + a₁.2) + (b₂.1 + b₁.2) : by rw [ha, hb]
    ... = (a₂.1 + b₂.1) + (a₁.2 + b₁.2) : by ac_refl
  end

lemma add_mk (ap an bp bn : ℕ) : add ⟦(ap, an)⟧ ⟦(bp, bn)⟧ = ⟦(ap + bp, an + bn)⟧ :=
by refl

lemma add_zero (i : int) : add zero i = i :=
quotient.induction_on i
  begin
    intro p,
    cases p,
    simp [zero, add_mk]
  end

end lecture


import analysis.special_functions.trigonometric
import analysis.special_functions.integrals
import analysis.calculus.lhopital

open set real topological_space measure_theory
open_locale real topological_space big_operators ennreal

/-
# Analysis in Lean
-/

example : deriv (λ x : ℝ, x^2) 2 = 4 := by norm_num

example (x : ℝ) : deriv cos x = - sin x := by simp

example (x : ℝ) :
  deriv (λ x, 2 * cos (cos x + 3) + 3) x =
  2 * (sin (cos x + 3) * sin x) :=
by simp

example : ∫ x : ℝ in 0..2, x ^ 3 = 4 := by norm_num

example : ∫ x in 0..π, sin x / 2 = 1 := by norm_num

example (x : ℝ) : ∫ t in 0..x, 2 * cos t = 2 * sin x := by simp

/-
Definitions in calculus:
* Derivatives
* Iterated derivatives
* Analytic functions
* Integration

1-dimensional calculus:
* Fundamental theorem of calculus
* L'Hôpital's rule
* Intermediate value theorem

Results in multivariable calculus:
* Implicit function theorem
* Inverse function theorem
* Lagrange multipliers
* The mean value theorem (vector-valued on a convex set)

Various inequalities:
* AM-GM inequality
* Hölder's inequality
* Minkowski inequality
* Jensen's inequality
-/

/- ## Differentiation -/

/- We want to define the derivative in a general setting. -/
#check @deriv

/-
Let `E` and `F` be normed spaces over `𝕜`.
The Fréchet derivative of a map `f : E → F`
at a point `x : E` is the continuous linear map `A : E → F`
if `∥f y - f x - A (y - x)∥ / ∥ y - x ∥ ⟶ 0` as `y ⟶ x`.

In other words:
`f y = f x + A (y - x) + o (y - x)`.
-/
#check @has_fderiv_at

#check @has_fderiv_at_iff_tendsto

#check @has_fderiv_at.unique

/- We can also consider the derivative of `f` within a set `s` at the point `x`. -/
#check @has_fderiv_within_at

#check @has_fderiv_within_at_iff_tendsto

#check @unique_diff_within_at.eq

/- `fderiv 𝕜 f x` is *the* Fréchet derivative of `f` at `x`. -/
#check @fderiv

/- If `E = 𝕜`, then all these definitions simplify by applying the linear map to `(1 : 𝕜)`, and then the derivative is just an element in `F`. -/
#check @deriv

open filter
/- As an example, here are the statements of the mean value theorem and one version of l'Hôpital's rule for functions `ℝ → ℝ`
`Icc a b` is `[a, b]`
`Ico a b` is `[a, b)` -/
#check exists_has_deriv_at_eq_slope
#check @has_deriv_at.lhopital_zero_nhds

/-
Integrals are defined in terms of the *Bochner integral*,
which is a generalization of the *Lebesgue integral* for Banach spaces.
-/

#check measurable_space

/- A measure on a measurable space is a countably additive function into `ℝ≥0∞`/`[0,∞]` -/
#check measure_theory.measure

example {X : Type*} [measurable_space X] (μ : measure X) :
  μ ∅ = 0 := by simp
example {X : Type*} [measure_space X] :
  volume (∅ : set X) = 0 := by simp

/- We can define the Lebesgue integral for nonnegative functions. -/
#check @simple_func.lintegral
#check @lintegral

example {X : Type*} [measurable_space X] (μ : measure X)
  {f g : X → ℝ≥0∞} (hf : measurable f) (hg : measurable g) :
  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ  :=
lintegral_add hf hg

/- `f` is `μ`-integrable if `f` is measurable and `∫ x, ∥ f ∥ ∂μ < ∞` -/
#check @has_finite_integral
#check @integrable

/- The L¹ functions are the integrable functions modulo a.e.-equality. -/
#check measure.ae
#check @Lp

/- Now we can define the Bochner integral for simple L¹ functions. Since the simple L¹ functions are dense in all L¹ functions, we can continuously extend it. -/
#check @simple_func.integral
#check @L1.integral

variables {E : Type*} [normed_group E]
  [second_countable_topology E] [complete_space E]
  [normed_space ℝ E] [measurable_space E] [borel_space E] [second_countable_topology E]

example {X : Type*} [measurable_space X]
  (μ : measure X) (A : set X) (f : X → E) :
 ∫ x in A, f x ∂μ = ∫ x, f x ∂(μ.restrict A) :=
by refl

-- (μ.restrict A)(B) = μ (A ∩ B)

/- The interval integral `∫ x in a..b, f x ∂μ` is defined to be the integral on `(a,b]` if `a ≤ b`.
-/
#check @interval_integral.integral_of_le
#check @interval_integral.integral_symm

/- Here are parts 1 & 2 of the fundamental theorem of calculus. -/
#check @interval_integral.deriv_integral_right
#check @interval_integral.integral_eq_sub_of_has_deriv_at