/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module number_theory.zsqrtd.gaussian_int
! leanprover-community/mathlib commit 2af0836443b4cfb5feda0df0051acdb398304931
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Zsqrtd.Basic
import Mathbin.Data.Complex.Basic
import Mathbin.RingTheory.PrincipalIdealDomain
import Mathbin.NumberTheory.LegendreSymbol.QuadraticReciprocity

/-!
# Gaussian integers

The Gaussian integers are complex integer, complex numbers whose real and imaginary parts are both
integers.

## Main definitions

The Euclidean domain structure on `ℤ[i]` is defined in this file.

The homomorphism `to_complex` into the complex numbers is also defined in this file.

## Main statements

`prime_iff_mod_four_eq_three_of_nat_prime`
A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`

## Notations

This file uses the local notation `ℤ[i]` for `gaussian_int`

## Implementation notes

Gaussian integers are implemented using the more general definition `zsqrtd`, the type of integers
adjoined a square root of `d`, in this case `-1`. The definition is reducible, so that properties
and definitions about `zsqrtd` can easily be used.
-/

open Zsqrtd Complex

open ComplexConjugate

/-- The Gaussian integers, defined as `ℤ√(-1)`. -/
@[reducible]
def GaussianInt : Type :=
  Zsqrtd (-1)
#align gaussian_int GaussianInt

-- mathport name: «exprℤ[i]»
local notation "ℤ[i]" => GaussianInt

namespace GaussianInt

instance : Repr ℤ[i] :=
  ⟨fun x => "⟨" ++ repr x.re ++ ", " ++ repr x.im ++ "⟩"⟩

instance : CommRing ℤ[i] :=
  Zsqrtd.commRing

section

attribute [-instance] Complex.field

-- Avoid making things noncomputable unnecessarily.
/-- The embedding of the Gaussian integers into the complex numbers, as a ring homomorphism. -/
def toComplex : ℤ[i] →+* ℂ :=
  Zsqrtd.lift ⟨I, by simp⟩
#align gaussian_int.to_complex GaussianInt.toComplex

end

instance : Coe ℤ[i] ℂ :=
  ⟨toComplex⟩

theorem to_complex_def (x : ℤ[i]) : (x : ℂ) = x.re + x.im * I :=
  rfl
#align gaussian_int.to_complex_def GaussianInt.to_complex_def

theorem to_complex_def' (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ) = x + y * I := by simp [to_complex_def]
#align gaussian_int.to_complex_def' GaussianInt.to_complex_def'

theorem to_complex_def₂ (x : ℤ[i]) : (x : ℂ) = ⟨x.re, x.im⟩ := by
  apply Complex.ext <;> simp [to_complex_def]
#align gaussian_int.to_complex_def₂ GaussianInt.to_complex_def₂

@[simp]
theorem to_real_re (x : ℤ[i]) : ((x.re : ℤ) : ℝ) = (x : ℂ).re := by simp [to_complex_def]
#align gaussian_int.to_real_re GaussianInt.to_real_re

@[simp]
theorem to_real_im (x : ℤ[i]) : ((x.im : ℤ) : ℝ) = (x : ℂ).im := by simp [to_complex_def]
#align gaussian_int.to_real_im GaussianInt.to_real_im

@[simp]
theorem to_complex_re (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).re = x := by simp [to_complex_def]
#align gaussian_int.to_complex_re GaussianInt.to_complex_re

@[simp]
theorem to_complex_im (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).im = y := by simp [to_complex_def]
#align gaussian_int.to_complex_im GaussianInt.to_complex_im

@[simp]
theorem to_complex_add (x y : ℤ[i]) : ((x + y : ℤ[i]) : ℂ) = x + y :=
  toComplex.map_add _ _
#align gaussian_int.to_complex_add GaussianInt.to_complex_add

@[simp]
theorem to_complex_mul (x y : ℤ[i]) : ((x * y : ℤ[i]) : ℂ) = x * y :=
  toComplex.map_mul _ _
#align gaussian_int.to_complex_mul GaussianInt.to_complex_mul

@[simp]
theorem to_complex_one : ((1 : ℤ[i]) : ℂ) = 1 :=
  toComplex.map_one
#align gaussian_int.to_complex_one GaussianInt.to_complex_one

@[simp]
theorem to_complex_zero : ((0 : ℤ[i]) : ℂ) = 0 :=
  toComplex.map_zero
#align gaussian_int.to_complex_zero GaussianInt.to_complex_zero

@[simp]
theorem to_complex_neg (x : ℤ[i]) : ((-x : ℤ[i]) : ℂ) = -x :=
  toComplex.map_neg _
#align gaussian_int.to_complex_neg GaussianInt.to_complex_neg

@[simp]
theorem to_complex_sub (x y : ℤ[i]) : ((x - y : ℤ[i]) : ℂ) = x - y :=
  toComplex.map_sub _ _
#align gaussian_int.to_complex_sub GaussianInt.to_complex_sub

@[simp]
theorem to_complex_star (x : ℤ[i]) : ((star x : ℤ[i]) : ℂ) = conj (x : ℂ) :=
  by
  rw [to_complex_def₂, to_complex_def₂]
  exact congr_arg₂ _ rfl (Int.cast_neg _)
#align gaussian_int.to_complex_star GaussianInt.to_complex_star

@[simp]
theorem to_complex_inj {x y : ℤ[i]} : (x : ℂ) = y ↔ x = y := by
  cases x <;> cases y <;> simp [to_complex_def₂]
#align gaussian_int.to_complex_inj GaussianInt.to_complex_inj

@[simp]
theorem to_complex_eq_zero {x : ℤ[i]} : (x : ℂ) = 0 ↔ x = 0 := by
  rw [← to_complex_zero, to_complex_inj]
#align gaussian_int.to_complex_eq_zero GaussianInt.to_complex_eq_zero

@[simp]
theorem nat_cast_real_norm (x : ℤ[i]) : (x.norm : ℝ) = (x : ℂ).normSq := by
  rw [Zsqrtd.norm, norm_sq] <;> simp
#align gaussian_int.nat_cast_real_norm GaussianInt.nat_cast_real_norm

@[simp]
theorem nat_cast_complex_norm (x : ℤ[i]) : (x.norm : ℂ) = (x : ℂ).normSq := by
  cases x <;> rw [Zsqrtd.norm, norm_sq] <;> simp
#align gaussian_int.nat_cast_complex_norm GaussianInt.nat_cast_complex_norm

theorem norm_nonneg (x : ℤ[i]) : 0 ≤ norm x :=
  norm_nonneg (by norm_num) _
#align gaussian_int.norm_nonneg GaussianInt.norm_nonneg

@[simp]
theorem norm_eq_zero {x : ℤ[i]} : norm x = 0 ↔ x = 0 := by rw [← @Int.cast_inj ℝ _ _ _] <;> simp
#align gaussian_int.norm_eq_zero GaussianInt.norm_eq_zero

theorem norm_pos {x : ℤ[i]} : 0 < norm x ↔ x ≠ 0 := by
  rw [lt_iff_le_and_ne, Ne.def, eq_comm, norm_eq_zero] <;> simp [norm_nonneg]
#align gaussian_int.norm_pos GaussianInt.norm_pos

theorem abs_coe_nat_norm (x : ℤ[i]) : (x.norm.natAbs : ℤ) = x.norm :=
  Int.natAbs_of_nonneg (norm_nonneg _)
#align gaussian_int.abs_coe_nat_norm GaussianInt.abs_coe_nat_norm

@[simp]
theorem nat_cast_natAbs_norm {α : Type _} [Ring α] (x : ℤ[i]) : (x.norm.natAbs : α) = x.norm := by
  rw [← Int.cast_ofNat, abs_coe_nat_norm]
#align gaussian_int.nat_cast_nat_abs_norm GaussianInt.nat_cast_natAbs_norm

theorem natAbs_norm_eq (x : ℤ[i]) :
    x.norm.natAbs = x.re.natAbs * x.re.natAbs + x.im.natAbs * x.im.natAbs :=
  Int.ofNat.inj <| by simp; simp [Zsqrtd.norm]
#align gaussian_int.nat_abs_norm_eq GaussianInt.natAbs_norm_eq

instance : Div ℤ[i] :=
  ⟨fun x y =>
    let n := (norm y : ℚ)⁻¹
    let c := star y
    ⟨round ((x * c).re * n : ℚ), round ((x * c).im * n : ℚ)⟩⟩

theorem div_def (x y : ℤ[i]) :
    x / y = ⟨round ((x * star y).re / norm y : ℚ), round ((x * star y).im / norm y : ℚ)⟩ :=
  show Zsqrtd.mk _ _ = _ by simp [div_eq_mul_inv]
#align gaussian_int.div_def GaussianInt.div_def

theorem to_complex_div_re (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).re = round (x / y : ℂ).re := by
  rw [div_def, ← @Rat.round_cast ℝ _ _] <;>
    simp [-Rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]
#align gaussian_int.to_complex_div_re GaussianInt.to_complex_div_re

theorem to_complex_div_im (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).im = round (x / y : ℂ).im := by
  rw [div_def, ← @Rat.round_cast ℝ _ _, ← @Rat.round_cast ℝ _ _] <;>
    simp [-Rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]
#align gaussian_int.to_complex_div_im GaussianInt.to_complex_div_im

theorem normSq_le_normSq_of_re_le_of_im_le {x y : ℂ} (hre : |x.re| ≤ |y.re|)
    (him : |x.im| ≤ |y.im|) : x.normSq ≤ y.normSq := by
  rw [norm_sq_apply, norm_sq_apply, ← _root_.abs_mul_self, _root_.abs_mul, ←
      _root_.abs_mul_self y.re, _root_.abs_mul y.re, ← _root_.abs_mul_self x.im,
      _root_.abs_mul x.im, ← _root_.abs_mul_self y.im, _root_.abs_mul y.im] <;>
    exact
      add_le_add (mul_self_le_mul_self (abs_nonneg _) hre) (mul_self_le_mul_self (abs_nonneg _) him)
#align gaussian_int.norm_sq_le_norm_sq_of_re_le_of_im_le GaussianInt.normSq_le_normSq_of_re_le_of_im_le

theorem normSq_div_sub_div_lt_one (x y : ℤ[i]) : ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).normSq < 1 :=
  calc
    ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).normSq =
        ((x / y : ℂ).re - ((x / y : ℤ[i]) : ℂ).re + ((x / y : ℂ).im - ((x / y : ℤ[i]) : ℂ).im) * I :
            ℂ).normSq :=
      congr_arg _ <| by apply Complex.ext <;> simp
    _ ≤ (1 / 2 + 1 / 2 * I).normSq :=
      (have : |(2⁻¹ : ℝ)| = 2⁻¹ := abs_of_nonneg (by norm_num)
      normSq_le_normSq_of_re_le_of_im_le
        (by
          rw [to_complex_div_re] <;> simp [norm_sq, this] <;>
            simpa using abs_sub_round (x / y : ℂ).re)
        (by
          rw [to_complex_div_im] <;> simp [norm_sq, this] <;>
            simpa using abs_sub_round (x / y : ℂ).im))
    _ < 1 := by simp [norm_sq] <;> norm_num

#align gaussian_int.norm_sq_div_sub_div_lt_one GaussianInt.normSq_div_sub_div_lt_one

instance : Mod ℤ[i] :=
  ⟨fun x y => x - y * (x / y)⟩

theorem mod_def (x y : ℤ[i]) : x % y = x - y * (x / y) :=
  rfl
#align gaussian_int.mod_def GaussianInt.mod_def

theorem norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
  have : (y : ℂ) ≠ 0 := by rwa [Ne.def, ← to_complex_zero, to_complex_inj]
  (@Int.cast_lt ℝ _ _ _ _).1 <|
    calc
      ↑(Zsqrtd.norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).normSq := by simp [mod_def]
      _ = (y : ℂ).normSq * (x / y - (x / y : ℤ[i]) : ℂ).normSq := by
        rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
      _ < (y : ℂ).normSq * 1 :=
        (mul_lt_mul_of_pos_left (normSq_div_sub_div_lt_one _ _) (normSq_pos.2 this))
      _ = Zsqrtd.norm y := by simp

#align gaussian_int.norm_mod_lt GaussianInt.norm_mod_lt

theorem natAbs_norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
    (x % y).norm.natAbs < y.norm.natAbs :=
  Int.ofNat_lt.1 (by simp [-Int.ofNat_lt, norm_mod_lt x hy])
#align gaussian_int.nat_abs_norm_mod_lt GaussianInt.natAbs_norm_mod_lt

theorem norm_le_norm_mul_left (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
    (norm x).natAbs ≤ (norm (x * y)).natAbs := by
  rw [Zsqrtd.norm_mul, Int.natAbs_mul] <;>
    exact
      le_mul_of_one_le_right (Nat.zero_le _)
        (Int.ofNat_le.1 (by rw [abs_coe_nat_norm] <;> exact Int.add_one_le_of_lt (norm_pos.2 hy)))
#align gaussian_int.norm_le_norm_mul_left GaussianInt.norm_le_norm_mul_left

instance : Nontrivial ℤ[i] :=
  ⟨⟨0, 1, by decide⟩⟩

instance : EuclideanDomain ℤ[i] :=
  { GaussianInt.commRing,
    GaussianInt.nontrivial with
    Quotient := (· / ·)
    remainder := (· % ·)
    quotient_zero := by
      simp [div_def]
      rfl
    quotient_mul_add_remainder_eq := fun _ _ => by simp [mod_def]
    R := _
    r_wellFounded := measure_wf (Int.natAbs ∘ norm)
    remainder_lt := natAbs_norm_mod_lt
    mul_left_not_lt := fun a b hb0 => not_lt_of_ge <| norm_le_norm_mul_left a hb0 }

open PrincipalIdealRing

theorem mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : Fact p.Prime]
    (hpi : Prime (p : ℤ[i])) : p % 4 = 3 :=
  hp.1.eq_two_or_odd.elim
    (fun hp2 =>
      absurd hpi
        (mt irreducible_iff_prime.2 fun ⟨hu, h⟩ =>
          by
          have := h ⟨1, 1⟩ ⟨1, -1⟩ (hp2.symm ▸ rfl)
          rw [← norm_eq_one_iff, ← norm_eq_one_iff] at this
          exact absurd this (by decide)))
    fun hp1 =>
    by_contradiction fun hp3 : p % 4 ≠ 3 =>
      by
      have hp41 : p % 4 = 1 :=
        by
        rw [← Nat.mod_mul_left_mod p 2 2, show 2 * 2 = 4 from rfl] at hp1
        have := Nat.mod_lt p (show 0 < 4 by decide)
        revert this hp3 hp1
        generalize p % 4 = m; decide!
      let ⟨k, hk⟩ := ZMod.exists_sq_eq_neg_one_iff.2 <| by rw [hp41] <;> exact by decide
      obtain ⟨k, k_lt_p, rfl⟩ : ∃ (k' : ℕ)(h : k' < p), (k' : ZMod p) = k := by
        refine' ⟨k.val, k.val_lt, ZMod.nat_cast_zmod_val k⟩
      have hpk : p ∣ k ^ 2 + 1 := by
        rw [pow_two, ← CharP.cast_eq_zero_iff (ZMod p) p, Nat.cast_add, Nat.cast_mul, Nat.cast_one,
          ← hk, add_left_neg]
      have hkmul : (k ^ 2 + 1 : ℤ[i]) = ⟨k, 1⟩ * ⟨k, -1⟩ := by simp [sq, Zsqrtd.ext]
      have hpne1 : p ≠ 1 := ne_of_gt hp.1.one_lt
      have hkltp : 1 + k * k < p * p :=
        calc
          1 + k * k ≤ k + k * k :=
            add_le_add_right
              (Nat.pos_of_ne_zero fun hk0 => by clear_aux_decl <;> simp_all [pow_succ']) _
          _ = k * (k + 1) := by simp [add_comm, mul_add]
          _ < p * p := mul_lt_mul k_lt_p k_lt_p (Nat.succ_pos _) (Nat.zero_le _)

      have hpk₁ : ¬(p : ℤ[i]) ∣ ⟨k, -1⟩ := fun ⟨x, hx⟩ =>
        lt_irrefl (p * x : ℤ[i]).norm.natAbs <|
          calc
            (norm (p * x : ℤ[i])).natAbs = (Zsqrtd.norm ⟨k, -1⟩).natAbs := by rw [hx]
            _ < (norm (p : ℤ[i])).natAbs := by simpa [add_comm, Zsqrtd.norm] using hkltp
            _ ≤ (norm (p * x : ℤ[i])).natAbs :=
              norm_le_norm_mul_left _ fun hx0 =>
                show (-1 : ℤ) ≠ 0 by decide <| by simpa [hx0] using congr_arg Zsqrtd.im hx

      have hpk₂ : ¬(p : ℤ[i]) ∣ ⟨k, 1⟩ := fun ⟨x, hx⟩ =>
        lt_irrefl (p * x : ℤ[i]).norm.natAbs <|
          calc
            (norm (p * x : ℤ[i])).natAbs = (Zsqrtd.norm ⟨k, 1⟩).natAbs := by rw [hx]
            _ < (norm (p : ℤ[i])).natAbs := by simpa [add_comm, Zsqrtd.norm] using hkltp
            _ ≤ (norm (p * x : ℤ[i])).natAbs :=
              norm_le_norm_mul_left _ fun hx0 =>
                show (1 : ℤ) ≠ 0 by decide <| by simpa [hx0] using congr_arg Zsqrtd.im hx

      have hpu : ¬IsUnit (p : ℤ[i]) :=
        mt norm_eq_one_iff.2
          (by
            rw [norm_nat_cast, Int.natAbs_mul, Nat.mul_eq_one_iff] <;>
              exact fun h => (ne_of_lt hp.1.one_lt).symm h.1)
      obtain ⟨y, hy⟩ := hpk
      have := hpi.2.2 ⟨k, 1⟩ ⟨k, -1⟩ ⟨y, by rw [← hkmul, ← Nat.cast_mul p, ← hy] <;> simp⟩
      clear_aux_decl
      tauto
#align gaussian_int.mod_four_eq_three_of_nat_prime_of_prime GaussianInt.mod_four_eq_three_of_nat_prime_of_prime

theorem sq_add_sq_of_nat_prime_of_not_irreducible (p : ℕ) [hp : Fact p.Prime]
    (hpi : ¬Irreducible (p : ℤ[i])) : ∃ a b, a ^ 2 + b ^ 2 = p :=
  have hpu : ¬IsUnit (p : ℤ[i]) :=
    mt norm_eq_one_iff.2 <| by
      rw [norm_nat_cast, Int.natAbs_mul, Nat.mul_eq_one_iff] <;>
        exact fun h => (ne_of_lt hp.1.one_lt).symm h.1
  have hab : ∃ a b, (p : ℤ[i]) = a * b ∧ ¬IsUnit a ∧ ¬IsUnit b := by
    simpa [irreducible_iff, hpu, not_forall, not_or] using hpi
  let ⟨a, b, hpab, hau, hbu⟩ := hab
  have hnap : (norm a).natAbs = p :=
    ((hp.1.mul_eq_prime_sq_iff (mt norm_eq_one_iff.1 hau) (mt norm_eq_one_iff.1 hbu)).1 <| by
        rw [← Int.coe_nat_inj', Int.coe_nat_pow, sq, ← @norm_nat_cast (-1), hpab] <;> simp).1
  ⟨a.re.natAbs, a.im.natAbs, by simpa [nat_abs_norm_eq, sq] using hnap⟩
#align gaussian_int.sq_add_sq_of_nat_prime_of_not_irreducible GaussianInt.sq_add_sq_of_nat_prime_of_not_irreducible

theorem prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : Fact p.Prime] (hp3 : p % 4 = 3) :
    Prime (p : ℤ[i]) :=
  irreducible_iff_prime.1 <|
    by_contradiction fun hpi =>
      let ⟨a, b, hab⟩ := sq_add_sq_of_nat_prime_of_not_irreducible p hpi
      have : ∀ a b : ZMod 4, a ^ 2 + b ^ 2 ≠ p := by
        erw [← ZMod.nat_cast_mod p 4, hp3] <;> exact by decide
      this a b (hab ▸ by simp)
#align gaussian_int.prime_of_nat_prime_of_mod_four_eq_three GaussianInt.prime_of_nat_prime_of_mod_four_eq_three

/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
theorem prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : Fact p.Prime] :
    Prime (p : ℤ[i]) ↔ p % 4 = 3 :=
  ⟨mod_four_eq_three_of_nat_prime_of_prime p, prime_of_nat_prime_of_mod_four_eq_three p⟩
#align gaussian_int.prime_iff_mod_four_eq_three_of_nat_prime GaussianInt.prime_iff_mod_four_eq_three_of_nat_prime

end GaussianInt


/-
Copyright (c) 2022 Cuma Kökmen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Cuma Kökmen, Yury Kudryashov

! This file was ported from Lean 3 source module measure_theory.integral.torus_integral
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.CircleIntegral

/-!
# Integral over a torus in `ℂⁿ`

In this file we define the integral of a function `f : ℂⁿ → E` over a torus
`{z : ℂⁿ | ∀ i, z i ∈ metric.sphere (c i) (R i)}`. In order to do this, we define
`torus_map (c : ℂⁿ) (R θ : ℝⁿ)` to be the point in `ℂⁿ` given by $z_k=c_k+R_ke^{θ_ki}$,
where $i$ is the imaginary unit, then define `torus_integral f c R` as the integral over
the cube $[0, (λ _, 2π)] = \{θ\|∀ k, 0 ≤ θ_k ≤ 2π\}$ of the Jacobian of the
`torus_map` multiplied by `f (torus_map c R θ)`.

We also define a predicate saying that `f ∘ torus_map c R` is integrable on the cube
`[0, (λ _, 2\pi)]`.

## Main definitions

* `torus_map c R`: the generalized multidimensional exponential map from `ℝⁿ` to `ℂⁿ` that sends
  $θ=(θ_0,…,θ_{n-1})$ to $z=(z_0,…,z_{n-1})$, where $z_k= c_k + R_ke^{θ_k i}$;

* `torus_integrable f c R`: a function `f : ℂⁿ → E` is integrable over the generalized torus
  with center `c : ℂⁿ` and radius `R : ℝⁿ` if `f ∘ torus_map c R` is integrable on the
  closed cube `Icc (0 : ℝⁿ) (λ _, 2 * π)`;

* `torus_integral f c R`: the integral of a function `f : ℂⁿ → E` over a torus with
  center `c ∈ ℂⁿ` and radius `R ∈ ℝⁿ` defined as
  $\iiint_{[0, 2 * π]} (∏_{k = 1}^{n} i R_k e^{θ_k * i}) • f (c + Re^{θ_k i})\,dθ_0…dθ_{k-1}$.

## Main statements

* `torus_integral_dim0`, `torus_integral_dim1`, `torus_integral_succ`: formulas for `torus_integral`
  in cases of dimension `0`, `1`, and `n + 1`.

## Notations

- `ℝ⁰`, `ℝ¹`, `ℝⁿ`, `ℝⁿ⁺¹`: local notation for `fin 0 → ℝ`, `fin 1 → ℝ`, `fin n → ℝ`, and
  `fin (n + 1) → ℝ`, respectively;
- `ℂ⁰`, `ℂ¹`, `ℂⁿ`, `ℂⁿ⁺¹`: local notation for `fin 0 → ℂ`, `fin 1 → ℂ`, `fin n → ℂ`, and
  `fin (n + 1) → ℂ`, respectively;
- `∯ z in T(c, R), f z`: notation for `torus_integral f c R`;
- `∮ z in C(c, R), f z`: notation for `circle_integral f c R`, defined elsewhere;
- `∏ k, f k`: notation for `finset.prod`, defined elsewhere;
- `π`: notation for `real.pi`, defined elsewhere.

## Tags

integral, torus
-/

variable {n : ℕ}

variable {E : Type _} [NormedAddCommGroup E]

noncomputable section

open Complex Set MeasureTheory Function Filter TopologicalSpace

open Real BigOperators

-- mathport name: «exprℝ⁰»
local notation "ℝ⁰" => Fin 0 → ℝ

-- mathport name: «exprℂ⁰»
local notation "ℂ⁰" => Fin 0 → ℂ

-- mathport name: «exprℝ¹»
local notation "ℝ¹" => Fin 1 → ℝ

-- mathport name: «exprℂ¹»
local notation "ℂ¹" => Fin 1 → ℂ

-- mathport name: «exprℝⁿ»
local notation "ℝⁿ" => Fin n → ℝ

-- mathport name: «exprℂⁿ»
local notation "ℂⁿ" => Fin n → ℂ

-- mathport name: «exprℝⁿ⁺¹»
local notation "ℝⁿ⁺¹" => Fin (n + 1) → ℝ

-- mathport name: «exprℂⁿ⁺¹»
local notation "ℂⁿ⁺¹" => Fin (n + 1) → ℂ

/-!
### `torus_map`, a generalization of a torus
-/

/-- The n dimensional exponential map $θ_i ↦ c + R e^{θ_i*I}, θ ∈ ℝⁿ$ representing
a torus in `ℂⁿ` with center `c ∈ ℂⁿ` and generalized radius `R ∈ ℝⁿ`, so we can adjust
it to every n axis. -/
def torusMap (c : ℂⁿ) (R : ℝⁿ) : ℝⁿ → ℂⁿ := fun θ i => c i + R i * exp (θ i * I)
#align torus_map torusMap

theorem torusMap_sub_center (c : ℂⁿ) (R : ℝⁿ) (θ : ℝⁿ) : torusMap c R θ - c = torusMap 0 R θ :=
  by
  ext1 i
  simp [torusMap]
#align torus_map_sub_center torusMap_sub_center

theorem torusMap_eq_center_iff {c : ℂⁿ} {R : ℝⁿ} {θ : ℝⁿ} : torusMap c R θ = c ↔ R = 0 := by
  simp [funext_iff, torusMap, exp_ne_zero]
#align torus_map_eq_center_iff torusMap_eq_center_iff

@[simp]
theorem torusMap_zero_radius (c : ℂⁿ) : torusMap c 0 = const ℝⁿ c :=
  by
  ext1
  rw [torusMap_eq_center_iff.2 rfl]
#align torus_map_zero_radius torusMap_zero_radius

/-!
### Integrability of a function on a generalized torus
-/

/-- A function `f : ℂⁿ → E` is integrable on the generalized torus if the function
`f ∘ torus_map c R θ` is integrable on `Icc (0 : ℝⁿ) (λ _, 2 * π)`-/
def TorusIntegrable (f : ℂⁿ → E) (c : ℂⁿ) (R : ℝⁿ) : Prop :=
  IntegrableOn (fun θ : ℝⁿ => f (torusMap c R θ)) (Icc (0 : ℝⁿ) fun _ => 2 * π) volume
#align torus_integrable TorusIntegrable

namespace TorusIntegrable

variable {f g : ℂⁿ → E} {c : ℂⁿ} {R : ℝⁿ}

/-- Constant functions are torus integrable -/
theorem torusIntegrable_const (a : E) (c : ℂⁿ) (R : ℝⁿ) : TorusIntegrable (fun _ => a) c R := by
  simp [TorusIntegrable, measure_Icc_lt_top]
#align torus_integrable.torus_integrable_const TorusIntegrable.torusIntegrable_const

/-- If `f` is torus integrable then `-f` is torus integrable. -/
protected theorem neg (hf : TorusIntegrable f c R) : TorusIntegrable (-f) c R :=
  hf.neg
#align torus_integrable.neg TorusIntegrable.neg

/-- If `f` and `g` are two torus integrable functions, then so is `f + g`. -/
protected theorem add (hf : TorusIntegrable f c R) (hg : TorusIntegrable g c R) :
    TorusIntegrable (f + g) c R :=
  hf.add hg
#align torus_integrable.add TorusIntegrable.add

/-- If `f` and `g` are two torus integrable functions, then so is `f - g`. -/
protected theorem sub (hf : TorusIntegrable f c R) (hg : TorusIntegrable g c R) :
    TorusIntegrable (f - g) c R :=
  hf.sub hg
#align torus_integrable.sub TorusIntegrable.sub

theorem torusIntegrable_zero_radius {f : ℂⁿ → E} {c : ℂⁿ} : TorusIntegrable f c 0 :=
  by
  rw [TorusIntegrable, torusMap_zero_radius]
  apply torus_integrable_const (f c) c 0
#align torus_integrable.torus_integrable_zero_radius TorusIntegrable.torusIntegrable_zero_radius

/-- The function given in the definition of `torus_integral` is integrable. -/
theorem functionIntegrable [NormedSpace ℂ E] (hf : TorusIntegrable f c R) :
    IntegrableOn (fun θ : ℝⁿ => (∏ i, R i * exp (θ i * I) * I : ℂ) • f (torusMap c R θ))
      (Icc (0 : ℝⁿ) fun _ => 2 * π) volume :=
  by
  refine' (hf.norm.const_mul (∏ i, |R i|)).mono' _ _
  · refine' (Continuous.aeStronglyMeasurable _).smul hf.1
    exact
      continuous_finset_prod Finset.univ fun i hi =>
        (continuous_const.mul
              ((continuous_of_real.comp (continuous_apply i)).mul continuous_const).cexp).mul
          continuous_const
  simp [norm_smul, map_prod]
#align torus_integrable.function_integrable TorusIntegrable.functionIntegrable

end TorusIntegrable

variable [NormedSpace ℂ E] [CompleteSpace E] {f g : ℂⁿ → E} {c : ℂⁿ} {R : ℝⁿ}

/-- The definition of the integral over a generalized torus with center `c ∈ ℂⁿ` and radius `R ∈ ℝⁿ`
as the `•`-product of the derivative of `torus_map` and `f (torus_map c R θ)`-/
def torusIntegral (f : ℂⁿ → E) (c : ℂⁿ) (R : ℝⁿ) :=
  ∫ θ : ℝⁿ in Icc (0 : ℝⁿ) fun _ => 2 * π, (∏ i, R i * exp (θ i * I) * I : ℂ) • f (torusMap c R θ)
#align torus_integral torusIntegral

-- mathport name: «expr∯ inT( , ), »
notation3"∯ "(...)" in ""T("c", "R")"", "r:(scoped f => torusIntegral f c R) => r

theorem torusIntegral_radius_zero (hn : n ≠ 0) (f : ℂⁿ → E) (c : ℂⁿ) : (∯ x in T(c, 0), f x) = 0 :=
  by
  simp only [torusIntegral, Pi.zero_apply, of_real_zero, MulZeroClass.mul_zero,
    MulZeroClass.zero_mul, Fin.prod_const, zero_pow' n hn, zero_smul, integral_zero]
#align torus_integral_radius_zero torusIntegral_radius_zero

theorem torusIntegral_neg (f : ℂⁿ → E) (c : ℂⁿ) (R : ℝⁿ) :
    (∯ x in T(c, R), -f x) = -∯ x in T(c, R), f x := by simp [torusIntegral, integral_neg]
#align torus_integral_neg torusIntegral_neg

theorem torusIntegral_add (hf : TorusIntegrable f c R) (hg : TorusIntegrable g c R) :
    (∯ x in T(c, R), f x + g x) = (∯ x in T(c, R), f x) + ∯ x in T(c, R), g x := by
  simpa only [torusIntegral, smul_add, Pi.add_apply] using
    integral_add hf.function_integrable hg.function_integrable
#align torus_integral_add torusIntegral_add

theorem torusIntegral_sub (hf : TorusIntegrable f c R) (hg : TorusIntegrable g c R) :
    (∯ x in T(c, R), f x - g x) = (∯ x in T(c, R), f x) - ∯ x in T(c, R), g x := by
  simpa only [sub_eq_add_neg, ← torusIntegral_neg] using torusIntegral_add hf hg.neg
#align torus_integral_sub torusIntegral_sub

theorem torusIntegral_smul {𝕜 : Type _} [IsROrC 𝕜] [NormedSpace 𝕜 E] [SMulCommClass 𝕜 ℂ E] (a : 𝕜)
    (f : ℂⁿ → E) (c : ℂⁿ) (R : ℝⁿ) : (∯ x in T(c, R), a • f x) = a • ∯ x in T(c, R), f x := by
  simp only [torusIntegral, integral_smul, ← smul_comm a]
#align torus_integral_smul torusIntegral_smul

theorem torusIntegral_const_mul (a : ℂ) (f : ℂⁿ → ℂ) (c : ℂⁿ) (R : ℝⁿ) :
    (∯ x in T(c, R), a * f x) = a * ∯ x in T(c, R), f x :=
  torusIntegral_smul a f c R
#align torus_integral_const_mul torusIntegral_const_mul

/-- If for all `θ : ℝⁿ`, `‖f (torus_map c R θ)‖` is less than or equal to a constant `C : ℝ`, then
`‖∯ x in T(c, R), f x‖` is less than or equal to `(2 * π)^n * (∏ i, |R i|) * C`-/
theorem norm_torusIntegral_le_of_norm_le_const {C : ℝ} (hf : ∀ θ, ‖f (torusMap c R θ)‖ ≤ C) :
    ‖∯ x in T(c, R), f x‖ ≤ ((2 * π) ^ (n : ℕ) * ∏ i, |R i|) * C :=
  calc
    ‖∯ x in T(c, R), f x‖ ≤ (∏ i, |R i|) * C * (volume (Icc (0 : ℝⁿ) fun _ => 2 * π)).toReal :=
      norm_set_integral_le_of_norm_le_const' measure_Icc_lt_top measurableSet_Icc fun θ hθ =>
        calc
          ‖(∏ i : Fin n, R i * exp (θ i * I) * I : ℂ) • f (torusMap c R θ)‖ =
              (∏ i : Fin n, |R i|) * ‖f (torusMap c R θ)‖ :=
            by simp [norm_smul]
          _ ≤ (∏ i : Fin n, |R i|) * C :=
            mul_le_mul_of_nonneg_left (hf _) (Finset.prod_nonneg fun _ _ => abs_nonneg _)

    _ = ((2 * π) ^ (n : ℕ) * ∏ i, |R i|) * C := by
      simp only [Pi.zero_def, Real.volume_Icc_pi_toReal fun _ => real.two_pi_pos.le, sub_zero,
        Fin.prod_const, mul_assoc, mul_comm ((2 * π) ^ (n : ℕ))]

#align norm_torus_integral_le_of_norm_le_const norm_torusIntegral_le_of_norm_le_const

@[simp]
theorem torusIntegral_dim0 (f : ℂ⁰ → E) (c : ℂ⁰) (R : ℝ⁰) : (∯ x in T(c, R), f x) = f c := by
  simp only [torusIntegral, Fin.prod_univ_zero, one_smul,
    Subsingleton.elim (fun i : Fin 0 => 2 * π) 0, Icc_self, measure.restrict_singleton, volume_pi,
    integral_smul_measure, integral_dirac, measure.pi_of_empty _ 0,
    measure.dirac_apply_of_mem (mem_singleton _), Subsingleton.elim (torusMap c R 0) c]
#align torus_integral_dim0 torusIntegral_dim0

/-- In dimension one, `torus_integral` is the same as `circle_integral`
(up to the natural equivalence between `ℂ` and `fin 1 → ℂ`). -/
theorem torusIntegral_dim1 (f : ℂ¹ → E) (c : ℂ¹) (R : ℝ¹) :
    (∯ x in T(c, R), f x) = ∮ z in C(c 0, R 0), f fun _ => z :=
  by
  have : ((fun (x : ℝ) (b : Fin 1) => x) ⁻¹' Icc 0 fun _ => 2 * π) = Icc 0 (2 * π) :=
    (OrderIso.funUnique (Fin 1) ℝ).symm.preimage_Icc _ _
  simp only [torusIntegral, circleIntegral, intervalIntegral.integral_of_le real.two_pi_pos.le,
    measure.restrict_congr_set Ioc_ae_eq_Icc, deriv_circleMap, Fin.prod_univ_one, ←
    ((volume_preserving_fun_unique (Fin 1) ℝ).symm _).set_integral_preimage_emb
      (MeasurableEquiv.measurableEmbedding _),
    this, MeasurableEquiv.funUnique_symm_apply]
  simp only [torusMap, circleMap, zero_add]
  rcongr
#align torus_integral_dim1 torusIntegral_dim1

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Recurrent formula for `torus_integral`, see also `torus_integral_succ`. -/
theorem torusIntegral_succAbove {f : ℂⁿ⁺¹ → E} {c : ℂⁿ⁺¹} {R : ℝⁿ⁺¹} (hf : TorusIntegrable f c R)
    (i : Fin (n + 1)) :
    (∯ x in T(c, R), f x) =
      ∮ x in C(c i, R i), ∯ y in T(c ∘ i.succAbove, R ∘ i.succAbove), f (i.insertNth x y) :=
  by
  set e : ℝ × ℝⁿ ≃ᵐ ℝⁿ⁺¹ := (MeasurableEquiv.piFinSuccAboveEquiv (fun _ => ℝ) i).symm
  have hem : measure_preserving e :=
    (volume_preserving_pi_fin_succ_above_equiv (fun j : Fin (n + 1) => ℝ) i).symm _
  have heπ : (e ⁻¹' Icc 0 fun _ => 2 * π) = Icc 0 (2 * π) ×ˢ Icc (0 : ℝⁿ) fun _ => 2 * π :=
    ((OrderIso.piFinSuccAboveIso (fun _ => ℝ) i).symm.preimage_Icc _ _).trans (Icc_prod_eq _ _)
  rw [torusIntegral, ← hem.map_eq, set_integral_map_equiv, heπ, measure.volume_eq_prod,
    set_integral_prod, circleIntegral_def_Icc]
  · refine' set_integral_congr measurableSet_Icc fun θ hθ => _
    simp only [torusIntegral, ← integral_smul, deriv_circleMap, i.prod_univ_succ_above _, smul_smul,
      torusMap, circleMap_zero]
    refine' set_integral_congr measurableSet_Icc fun Θ hΘ => _
    simp only [MeasurableEquiv.piFinSuccAboveEquiv_symm_apply, i.insert_nth_apply_same,
      i.insert_nth_apply_succ_above, (· ∘ ·)]
    congr 2
    simp only [funext_iff, i.forall_iff_succ_above, circleMap, Fin.insertNth_apply_same,
      eq_self_iff_true, Fin.insertNth_apply_succAbove, imp_true_iff, and_self_iff]
  · have := hf.function_integrable
    rwa [← hem.integrable_on_comp_preimage e.measurable_embedding, heπ] at this
#align torus_integral_succ_above torusIntegral_succAbove

/-- Recurrent formula for `torus_integral`, see also `torus_integral_succ_above`. -/
theorem torusIntegral_succ {f : ℂⁿ⁺¹ → E} {c : ℂⁿ⁺¹} {R : ℝⁿ⁺¹} (hf : TorusIntegrable f c R) :
    (∯ x in T(c, R), f x) =
      ∮ x in C(c 0, R 0), ∯ y in T(c ∘ Fin.succ, R ∘ Fin.succ), f (Fin.cons x y) :=
  by simpa using torusIntegral_succAbove hf 0
#align torus_integral_succ torusIntegral_succ


/-
Copyright (c) 2021 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey

! This file was ported from Lean 3 source module data.nat.periodic
! leanprover-community/mathlib commit 1ead22342e1a078bd44744ace999f85756555d35
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Periodic
import Mathbin.Data.Nat.Count
import Mathbin.Data.Nat.Interval

/-!
# Periodic Functions on ℕ

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

This file identifies a few functions on `ℕ` which are periodic, and also proves a lemma about
periodic predicates which helps determine their cardinality when filtering intervals over them.
-/

namespace Nat

open Nat Function

#print Nat.periodic_gcd /-
theorem periodic_gcd (a : ℕ) : Periodic (gcd a) a := by
  simp only [forall_const, gcd_add_self_right, eq_self_iff_true, periodic]
#align nat.periodic_gcd Nat.periodic_gcd
-/

#print Nat.periodic_coprime /-
theorem periodic_coprime (a : ℕ) : Periodic (coprime a) a := by
  simp only [coprime_add_self_right, forall_const, iff_self_iff, eq_iff_iff, periodic]
#align nat.periodic_coprime Nat.periodic_coprime
-/

#print Nat.periodic_mod /-
theorem periodic_mod (a : ℕ) : Periodic (fun n => n % a) a := by
  simp only [forall_const, eq_self_iff_true, add_mod_right, periodic]
#align nat.periodic_mod Nat.periodic_mod
-/

#print Nat.Function.Periodic.map_mod_nat /-
theorem Nat.Function.Periodic.map_mod_nat {α : Type _} {f : ℕ → α} {a : ℕ} (hf : Periodic f a) :
    ∀ n, f (n % a) = f n := fun n => by
  conv_rhs => rw [← Nat.mod_add_div n a, mul_comm, ← Nat.nsmul_eq_mul, hf.nsmul]
#align function.periodic.map_mod_nat Nat.Function.Periodic.map_mod_nat
-/

section Multiset

open Multiset

/- warning: nat.filter_multiset_Ico_card_eq_of_periodic -> Nat.filter_multiset_Ico_card_eq_of_periodic is a dubious translation:
lean 3 declaration is
  forall (n : Nat) (a : Nat) (p : Nat -> Prop) [_inst_1 : DecidablePred.{1} Nat p], (Function.Periodic.{0, 0} Nat Prop Nat.hasAdd p a) -> (Eq.{1} Nat (coeFn.{1, 1} (AddMonoidHom.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.orderedCancelAddCommMonoid.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (fun (_x : AddMonoidHom.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.orderedCancelAddCommMonoid.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) => (Multiset.{0} Nat) -> Nat) (AddMonoidHom.hasCoeToFun.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.orderedCancelAddCommMonoid.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.card.{0} Nat) (Multiset.filter.{0} Nat p (fun (a : Nat) => _inst_1 a) (Multiset.Ico.{0} Nat (PartialOrder.toPreorder.{0} Nat (OrderedCancelAddCommMonoid.toPartialOrder.{0} Nat (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{0} Nat Nat.strictOrderedSemiring))) Nat.locallyFiniteOrder n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) n a)))) (Nat.count p (fun (a : Nat) => _inst_1 a) a))
but is expected to have type
  forall (n : Nat) (a : Nat) (p : Nat -> Prop) [_inst_1 : DecidablePred.{1} Nat p], (Function.Periodic.{0, 0} Nat Prop instAddNat p a) -> (Eq.{1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{0} Nat) => Nat) (Multiset.filter.{0} Nat p (fun (a : Nat) => _inst_1 a) (Multiset.Ico.{0} Nat (PartialOrder.toPreorder.{0} Nat (StrictOrderedSemiring.toPartialOrder.{0} Nat Nat.strictOrderedSemiring)) instLocallyFiniteOrderNatToPreorderToPartialOrderStrictOrderedSemiring n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n a)))) (FunLike.coe.{1, 1, 1} (AddMonoidHom.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{0} Nat) (fun (_x : Multiset.{0} Nat) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : Multiset.{0} Nat) => Nat) _x) (AddHomClass.toFunLike.{0, 0, 0} (AddMonoidHom.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{0} Nat) Nat (AddZeroClass.toAdd.{0} (Multiset.{0} Nat) (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat))))))) (AddZeroClass.toAdd.{0} Nat (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (AddMonoidHomClass.toAddHomClass.{0, 0, 0} (AddMonoidHom.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)) (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid) (AddMonoidHom.addMonoidHomClass.{0, 0} (Multiset.{0} Nat) Nat (AddMonoid.toAddZeroClass.{0} (Multiset.{0} Nat) (AddRightCancelMonoid.toAddMonoid.{0} (Multiset.{0} Nat) (AddCancelMonoid.toAddRightCancelMonoid.{0} (Multiset.{0} Nat) (AddCancelCommMonoid.toAddCancelMonoid.{0} (Multiset.{0} Nat) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{0} (Multiset.{0} Nat) (Multiset.instOrderedCancelAddCommMonoidMultiset.{0} Nat)))))) (AddMonoid.toAddZeroClass.{0} Nat Nat.addMonoid)))) (Multiset.card.{0} Nat) (Multiset.filter.{0} Nat p (fun (a : Nat) => _inst_1 a) (Multiset.Ico.{0} Nat (PartialOrder.toPreorder.{0} Nat (StrictOrderedSemiring.toPartialOrder.{0} Nat Nat.strictOrderedSemiring)) instLocallyFiniteOrderNatToPreorderToPartialOrderStrictOrderedSemiring n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) n a)))) (Nat.count p (fun (a : Nat) => _inst_1 a) a))
Case conversion may be inaccurate. Consider using '#align nat.filter_multiset_Ico_card_eq_of_periodic Nat.filter_multiset_Ico_card_eq_of_periodicₓ'. -/
/-- An interval of length `a` filtered over a periodic predicate of period `a` has cardinality
equal to the number naturals below `a` for which `p a` is true. -/
theorem filter_multiset_Ico_card_eq_of_periodic (n a : ℕ) (p : ℕ → Prop) [DecidablePred p]
    (pp : Periodic p a) : (filter p (Ico n (n + a))).card = a.count p :=
  by
  rw [count_eq_card_filter_range, Finset.card, Finset.filter_val, Finset.range_val, ←
    multiset_Ico_map_mod n, ← map_count_true_eq_filter_card, ← map_count_true_eq_filter_card,
    map_map, Function.comp]
  simp only [pp.map_mod_nat]
#align nat.filter_multiset_Ico_card_eq_of_periodic Nat.filter_multiset_Ico_card_eq_of_periodic

end Multiset

section Finset

open Finset

#print Nat.filter_Ico_card_eq_of_periodic /-
/-- An interval of length `a` filtered over a periodic predicate of period `a` has cardinality
equal to the number naturals below `a` for which `p a` is true. -/
theorem filter_Ico_card_eq_of_periodic (n a : ℕ) (p : ℕ → Prop) [DecidablePred p]
    (pp : Periodic p a) : ((Ico n (n + a)).filterₓ p).card = a.count p :=
  filter_multiset_Ico_card_eq_of_periodic n a p pp
#align nat.filter_Ico_card_eq_of_periodic Nat.filter_Ico_card_eq_of_periodic
-/

end Finset

end Nat


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/

import algebra.is_prime_pow
import set_theory.cardinal.ordinal

/-!
# Cardinal Divisibility

We show basic results about divisibility in the cardinal numbers. This relation can be characterised
in the following simple way: if `a` and `b` are both less than `ℵ₀`, then `a ∣ b` iff they are
divisible as natural numbers. If `b` is greater than `ℵ₀`, then `a ∣ b` iff `a ≤ b`. This
furthermore shows that all infinite cardinals are prime; recall that `a * b = max a b` if
`ℵ₀ ≤ a * b`; therefore `a ∣ b * c = a ∣ max b c` and therefore clearly either `a ∣ b` or `a ∣ c`.
Note furthermore that no infinite cardinal is irreducible
(`cardinal.not_irreducible_of_aleph_0_le`), showing that the cardinal numbers do not form a
`comm_cancel_monoid_with_zero`.

## Main results

* `cardinal.prime_of_aleph_0_le`: a `cardinal` is prime if it is infinite.
* `cardinal.is_prime_iff`: a `cardinal` is prime iff it is infinite or a prime natural number.
* `cardinal.is_prime_pow_iff`: a `cardinal` is a prime power iff it is infinite or a natural number
  which is itself a prime power.

-/

namespace cardinal

open_locale cardinal

universe u
variables {a b : cardinal.{u}} {n m : ℕ}

@[simp] lemma is_unit_iff : is_unit a ↔ a = 1 :=
begin
  refine ⟨λ h, _, by { rintro rfl, exact is_unit_one }⟩,
  rcases eq_or_ne a 0 with rfl | ha,
  { exact (not_is_unit_zero h).elim },
  rw is_unit_iff_forall_dvd at h,
  cases h 1 with t ht,
  rw [eq_comm, mul_eq_one_iff'] at ht,
  { exact ht.1 },
  all_goals { rwa one_le_iff_ne_zero },
  { rintro rfl,
    rw mul_zero at ht,
    exact zero_ne_one ht }
end

instance : unique cardinal.{u}ˣ :=
{ default := 1,
  uniq := λ a, units.coe_eq_one.mp $ is_unit_iff.mp a.is_unit }

theorem le_of_dvd : ∀ {a b : cardinal}, b ≠ 0 → a ∣ b → a ≤ b
| a _ b0 ⟨b, rfl⟩ := by simpa only [mul_one] using mul_le_mul_left'
  (one_le_iff_ne_zero.2 (λ h : b = 0, by simpa only [h, mul_zero] using b0)) a

lemma dvd_of_le_of_aleph_0_le (ha : a ≠ 0) (h : a ≤ b) (hb : ℵ₀ ≤ b) : a ∣ b :=
⟨b, (mul_eq_right hb h ha).symm⟩

@[simp]

lemma not_irreducible_of_aleph_0_le (ha : ℵ₀ ≤ a) : ¬irreducible a :=
begin
  rw [irreducible_iff, not_and_distrib],
  refine or.inr (λ h, _),
  simpa [mul_aleph_0_eq ha, is_unit_iff, (one_lt_aleph_0.trans_le ha).ne', one_lt_aleph_0.ne']
    using h a ℵ₀
end

@[simp, norm_cast] lemma nat_coe_dvd_iff : (n : cardinal) ∣ m ↔ n ∣ m :=
begin
  refine ⟨_, λ ⟨h, ht⟩, ⟨h, by exact_mod_cast ht⟩⟩,
  rintro ⟨k, hk⟩,
  have : ↑m < ℵ₀ := nat_lt_aleph_0 m,
  rw [hk, mul_lt_aleph_0_iff] at this,
  rcases this with h | h | ⟨-, hk'⟩,
  iterate 2 { simp only [h, mul_zero,  zero_mul, nat.cast_eq_zero] at hk, simp [hk] },
  lift k to ℕ using hk',
  exact ⟨k, by exact_mod_cast hk⟩
end

@[simp] lemma nat_is_prime_iff : prime (n : cardinal) ↔ n.prime :=
begin
  simp only [prime, nat.prime_iff],
  refine and_congr (by simp) (and_congr _ ⟨λ h b c hbc, _, λ h b c hbc, _⟩),
  { simp only [is_unit_iff, nat.is_unit_iff],
    exact_mod_cast iff.rfl },
  { exact_mod_cast h b c (by exact_mod_cast hbc) },
  cases lt_or_le (b * c) ℵ₀ with h' h',
  { rcases mul_lt_aleph_0_iff.mp h' with rfl | rfl | ⟨hb, hc⟩,
    { simp },
    { simp },
    lift b to ℕ using hb,
    lift c to ℕ using hc,
    exact_mod_cast h b c (by exact_mod_cast hbc) },
  rcases aleph_0_le_mul_iff.mp h' with ⟨hb, hc, hℵ₀⟩,
  have hn : (n : cardinal) ≠ 0,
  { intro h,
    rw [h, zero_dvd_iff, mul_eq_zero] at hbc,
    cases hbc; contradiction },
  wlog hℵ₀ : ℵ₀ ≤ b := hℵ₀ using [b c],
  exact or.inl (dvd_of_le_of_aleph_0_le hn ((nat_lt_aleph_0 n).le.trans hℵ₀) hℵ₀),
end

lemma is_prime_iff {a : cardinal} : prime a ↔ ℵ₀ ≤ a ∨ ∃ p : ℕ, a = p ∧ p.prime :=
begin
  cases le_or_lt ℵ₀ a with h h,
  { simp [h] },
  lift a to ℕ using id h,
  simp [not_le.mpr h]
end

lemma is_prime_pow_iff {a : cardinal} :
  is_prime_pow a ↔ ℵ₀ ≤ a ∨ ∃ n : ℕ, a = n ∧ is_prime_pow n :=
begin
  by_cases h : ℵ₀ ≤ a,
  { simp [h, (prime_of_aleph_0_le h).is_prime_pow] },
  lift a to ℕ using not_le.mp h,
  simp only [h, nat.cast_inj, exists_eq_left', false_or, is_prime_pow_nat_iff],
  rw is_prime_pow_def,
  refine ⟨_, λ ⟨p, k, hp, hk, h⟩, ⟨p, k, nat_is_prime_iff.2 hp, by exact_mod_cast and.intro hk h⟩⟩,
  rintro ⟨p, k, hp, hk, hpk⟩,
  have key : _ ≤ p ^ k :=
    power_le_power_left hp.ne_zero (show (1 : cardinal) ≤ k, by exact_mod_cast hk),
  rw [power_one, hpk] at key,
  lift p to ℕ using key.trans_lt (nat_lt_aleph_0 a),
  exact ⟨p, k, nat_is_prime_iff.mp hp, hk, by exact_mod_cast hpk⟩
end

end cardinal


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

Bases of topologies. Countability axioms.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.continuous_on
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

namespace topological_space

/- countability axioms

For our applications we are interested that there exists a countable basis, but we do not need the
concrete basis itself. This allows us to declare these type classes as `Prop` to use them as mixins.
-/

/-- A topological basis is one that satisfies the necessary conditions so that
  it suffices to take unions of the basis sets to get a topology (without taking
  finite intersections as well). -/
def is_topological_basis {α : Type u} [t : topological_space α] (s : set (set α)) :=
  (∀ (t₁ : set α) (H : t₁ ∈ s) (t₂ : set α) (H : t₂ ∈ s) (x : α) (H : x ∈ t₁ ∩ t₂),
      ∃ (t₃ : set α), ∃ (H : t₃ ∈ s), x ∈ t₃ ∧ t₃ ⊆ t₁ ∩ t₂) ∧
    ⋃₀s = set.univ ∧ t = generate_from s

theorem is_topological_basis_of_subbasis {α : Type u} [t : topological_space α] {s : set (set α)} (hs : t = generate_from s) : is_topological_basis
  ((fun (f : set (set α)) => ⋂₀f) '' set_of fun (f : set (set α)) => set.finite f ∧ f ⊆ s ∧ set.nonempty (⋂₀f)) := sorry

theorem is_topological_basis_of_open_of_nhds {α : Type u} [t : topological_space α] {s : set (set α)} (h_open : ∀ (u : set α), u ∈ s → is_open u) (h_nhds : ∀ (a : α) (u : set α), a ∈ u → is_open u → ∃ (v : set α), ∃ (H : v ∈ s), a ∈ v ∧ v ⊆ u) : is_topological_basis s := sorry

theorem mem_nhds_of_is_topological_basis {α : Type u} [t : topological_space α] {a : α} {s : set α} {b : set (set α)} (hb : is_topological_basis b) : s ∈ nhds a ↔ ∃ (t : set α), ∃ (H : t ∈ b), a ∈ t ∧ t ⊆ s := sorry

theorem is_topological_basis.nhds_has_basis {α : Type u} [t : topological_space α] {b : set (set α)} (hb : is_topological_basis b) {a : α} : filter.has_basis (nhds a) (fun (t : set α) => t ∈ b ∧ a ∈ t) fun (t : set α) => t := sorry

theorem is_open_of_is_topological_basis {α : Type u} [t : topological_space α] {s : set α} {b : set (set α)} (hb : is_topological_basis b) (hs : s ∈ b) : is_open s := sorry

theorem mem_basis_subset_of_mem_open {α : Type u} [t : topological_space α] {b : set (set α)} (hb : is_topological_basis b) {a : α} {u : set α} (au : a ∈ u) (ou : is_open u) : ∃ (v : set α), ∃ (H : v ∈ b), a ∈ v ∧ v ⊆ u :=
  iff.mp (mem_nhds_of_is_topological_basis hb) (mem_nhds_sets ou au)

theorem sUnion_basis_of_is_open {α : Type u} [t : topological_space α] {B : set (set α)} (hB : is_topological_basis B) {u : set α} (ou : is_open u) : ∃ (S : set (set α)), ∃ (H : S ⊆ B), u = ⋃₀S := sorry

theorem Union_basis_of_is_open {α : Type u} [t : topological_space α] {B : set (set α)} (hB : is_topological_basis B) {u : set α} (ou : is_open u) : ∃ (β : Type u), ∃ (f : β → set α), (u = set.Union fun (i : β) => f i) ∧ ∀ (i : β), f i ∈ B := sorry

/-- A separable space is one with a countable dense subset, available through
`topological_space.exists_countable_dense`. If `α` is also known to be nonempty, then
`topological_space.dense_seq` provides a sequence `ℕ → α` with dense range, see
`topological_space.dense_range_dense_seq`.

If `α` is a uniform space with countably generated uniformity filter (e.g., an `emetric_space`),
then this condition is equivalent to `topological_space.second_countable_topology α`. In this case
the latter should be used as a typeclass argument in theorems because Lean can automatically deduce
`separable_space` from `second_countable_topology` but it can't deduce `second_countable_topology`
and `emetric_space`. -/
class separable_space (α : Type u) [t : topological_space α]
where
  exists_countable_dense : ∃ (s : set α), set.countable s ∧ dense s

theorem exists_countable_dense (α : Type u) [t : topological_space α] [separable_space α] : ∃ (s : set α), set.countable s ∧ dense s :=
  separable_space.exists_countable_dense

/-- A nonempty separable space admits a sequence with dense range. Instead of running `cases` on the
conclusion of this lemma, you might want to use `topological_space.dense_seq` and
`topological_space.dense_range_dense_seq`.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
theorem exists_dense_seq (α : Type u) [t : topological_space α] [separable_space α] [Nonempty α] : ∃ (u : ℕ → α), dense_range u := sorry

/-- A sequence dense in a non-empty separable topological space.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
def dense_seq (α : Type u) [t : topological_space α] [separable_space α] [Nonempty α] : ℕ → α :=
  classical.some (exists_dense_seq α)

/-- The sequence `dense_seq α` has dense range. -/
@[simp] theorem dense_range_dense_seq (α : Type u) [t : topological_space α] [separable_space α] [Nonempty α] : dense_range (dense_seq α) :=
  classical.some_spec (exists_dense_seq α)

end topological_space

/-- If `α` is a separable space and `f : α → β` is a continuous map with dense range, then `β` is
a separable space as well. E.g., the completion of a separable uniform space is separable. -/
protected theorem dense_range.separable_space {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space.separable_space α] [topological_space β] {f : α → β} (h : dense_range f) (h' : continuous f) : topological_space.separable_space β := sorry

namespace topological_space

/-- A first-countable space is one in which every point has a
  countable neighborhood basis. -/
class first_countable_topology (α : Type u) [t : topological_space α]
where
  nhds_generated_countable : ∀ (a : α), filter.is_countably_generated (nhds a)

namespace first_countable_topology

theorem tendsto_subseq {α : Type u} [t : topological_space α] [first_countable_topology α] {u : ℕ → α} {x : α} (hx : map_cluster_pt x filter.at_top u) : ∃ (ψ : ℕ → ℕ), strict_mono ψ ∧ filter.tendsto (u ∘ ψ) filter.at_top (nhds x) :=
  filter.is_countably_generated.subseq_tendsto (nhds_generated_countable x) hx

end first_countable_topology

theorem is_countably_generated_nhds {α : Type u} [t : topological_space α] [first_countable_topology α] (x : α) : filter.is_countably_generated (nhds x) :=
  first_countable_topology.nhds_generated_countable x

theorem is_countably_generated_nhds_within {α : Type u} [t : topological_space α] [first_countable_topology α] (x : α) (s : set α) : filter.is_countably_generated (nhds_within x s) :=
  filter.is_countably_generated.inf_principal (is_countably_generated_nhds x) s

/-- A second-countable space is one with a countable basis. -/
class second_countable_topology (α : Type u) [t : topological_space α]
where
  is_open_generated_countable : ∃ (b : set (set α)), set.countable b ∧ t = generate_from b

protected instance second_countable_topology.to_first_countable_topology (α : Type u) [t : topological_space α] [second_countable_topology α] : first_countable_topology α :=
  sorry

theorem second_countable_topology_induced (α : Type u) (β : Type u_1) [t : topological_space β] [second_countable_topology β] (f : α → β) : second_countable_topology α := sorry

protected instance subtype.second_countable_topology (α : Type u) [t : topological_space α] (s : set α) [second_countable_topology α] : second_countable_topology ↥s :=
  second_countable_topology_induced (↥s) α coe

theorem is_open_generated_countable_inter (α : Type u) [t : topological_space α] [second_countable_topology α] : ∃ (b : set (set α)), set.countable b ∧ ¬∅ ∈ b ∧ is_topological_basis b := sorry

/- TODO: more fine grained instances for first_countable_topology, separable_space, t2_space, ... -/

protected instance prod.second_countable_topology (α : Type u) [t : topological_space α] {β : Type u_1} [topological_space β] [second_countable_topology α] [second_countable_topology β] : second_countable_topology (α × β) :=
  second_countable_topology.mk sorry

protected instance second_countable_topology_fintype {ι : Type u_1} {π : ι → Type u_2} [fintype ι] [t : (a : ι) → topological_space (π a)] [sc : ∀ (a : ι), second_countable_topology (π a)] : second_countable_topology ((a : ι) → π a) :=
  (fun (this : ∀ (i : ι), ∃ (b : set (set (π i))), set.countable b ∧ ¬∅ ∈ b ∧ is_topological_basis b) => sorry)
    fun (a : ι) => is_open_generated_countable_inter (π a)

protected instance second_countable_topology.to_separable_space (α : Type u) [t : topological_space α] [second_countable_topology α] : separable_space α := sorry

theorem is_open_Union_countable {α : Type u} [t : topological_space α] [second_countable_topology α] {ι : Type u_1} (s : ι → set α) (H : ∀ (i : ι), is_open (s i)) : ∃ (T : set ι),
  set.countable T ∧ (set.Union fun (i : ι) => set.Union fun (H : i ∈ T) => s i) = set.Union fun (i : ι) => s i := sorry

theorem is_open_sUnion_countable {α : Type u} [t : topological_space α] [second_countable_topology α] (S : set (set α)) (H : ∀ (s : set α), s ∈ S → is_open s) : ∃ (T : set (set α)), set.countable T ∧ T ⊆ S ∧ ⋃₀T = ⋃₀S := sorry

/-- In a topological space with second countable topology, if `f` is a function that sends each
point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
`x ∈ s`, cover the whole space. -/
theorem countable_cover_nhds {α : Type u} [t : topological_space α] [second_countable_topology α] {f : α → set α} (hf : ∀ (x : α), f x ∈ nhds x) : ∃ (s : set α), set.countable s ∧ (set.Union fun (x : α) => set.Union fun (H : x ∈ s) => f x) = set.univ := sorry


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

! This file was ported from Lean 3 source module category_theory.monoidal.discrete
! leanprover-community/mathlib commit 8a0e71287eb4c80e87f72e8c174835f360a6ddd9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Group
import Mathlib.CategoryTheory.DiscreteCategory
import Mathlib.CategoryTheory.Monoidal.NaturalTransformation

/-!
# Monoids as discrete monoidal categories

The discrete category on a monoid is a monoidal category.
Multiplicative morphisms induced monoidal functors.
-/

universe u

open CategoryTheory

open CategoryTheory.Discrete

variable (M : Type u) [Monoid M]

namespace CategoryTheory

@[to_additive (attr := simps tensorObj_as) Discrete.addMonoidal]
instance Discrete.monoidal : MonoidalCategory (Discrete M)
    where
  tensorUnit' := Discrete.mk 1
  tensorObj X Y := Discrete.mk (X.as * Y.as)
  tensorHom f g := eqToHom (by dsimp; rw [eq_of_hom f, eq_of_hom g])
  leftUnitor X := Discrete.eqToIso (one_mul X.as)
  rightUnitor X := Discrete.eqToIso (mul_one X.as)
  associator X Y Z := Discrete.eqToIso (mul_assoc _ _ _)
#align category_theory.discrete.monoidal CategoryTheory.Discrete.monoidal
#align category_theory.discrete.add_monoidal CategoryTheory.Discrete.addMonoidal

@[to_additive (attr := simp) Discrete.addMonoidal_tensorUnit_as]
lemma Discrete.monoidal_tensorUnit_as :
  (𝟙_ (Discrete M)).as = 1 := rfl

variable {M} {N : Type u} [Monoid N]

/-- A multiplicative morphism between monoids gives a monoidal functor between the corresponding
discrete monoidal categories.
-/
@[to_additive (attr := simps) Discrete.addMonoidalFunctor]
def Discrete.monoidalFunctor (F : M →* N) : MonoidalFunctor (Discrete M) (Discrete N)
    where
  obj X := Discrete.mk (F X.as)
  map f := Discrete.eqToHom (F.congr_arg (eq_of_hom f))
  ε := Discrete.eqToHom F.map_one.symm
  μ X Y := Discrete.eqToHom (F.map_mul X.as Y.as).symm
#align category_theory.discrete.monoidal_functor CategoryTheory.Discrete.monoidalFunctor
#align category_theory.discrete.add_monoidal_functor CategoryTheory.Discrete.addMonoidalFunctor

/-- An additive morphism between add_monoids gives a
monoidal functor between the corresponding discrete monoidal categories. -/
add_decl_doc Discrete.addMonoidalFunctor

variable {K : Type u} [Monoid K]

/-- The monoidal natural isomorphism corresponding to composing two multiplicative morphisms.
-/
@[to_additive Discrete.addMonoidalFunctorComp
      "The monoidal natural isomorphism corresponding to\ncomposing two additive morphisms."]
def Discrete.monoidalFunctorComp (F : M →* N) (G : N →* K) :
    Discrete.monoidalFunctor F ⊗⋙ Discrete.monoidalFunctor G ≅ Discrete.monoidalFunctor (G.comp F)
    where
  hom := { app := fun X => 𝟙 _ }
  inv := { app := fun X => 𝟙 _ }
#align category_theory.discrete.monoidal_functor_comp CategoryTheory.Discrete.monoidalFunctorComp
#align category_theory.discrete.add_monoidal_functor_comp CategoryTheory.Discrete.addMonoidalFunctorComp

end CategoryTheory


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhangir Azerbayev, Adam Topaz, Eric Wieser
-/

import linear_algebra.clifford_algebra.basic
import linear_algebra.alternating

/-!
# Exterior Algebras

We construct the exterior algebra of a module `M` over a commutative semiring `R`.

## Notation

The exterior algebra of the `R`-module `M` is denoted as `exterior_algebra R M`.
It is endowed with the structure of an `R`-algebra.

Given a linear morphism `f : M → A` from a module `M` to another `R`-algebra `A`, such that
`cond : ∀ m : M, f m * f m = 0`, there is a (unique) lift of `f` to an `R`-algebra morphism,
which is denoted `exterior_algebra.lift R f cond`.

The canonical linear map `M → exterior_algebra R M` is denoted `exterior_algebra.ι R`.

## Theorems

The main theorems proved ensure that `exterior_algebra R M` satisfies the universal property
of the exterior algebra.
1. `ι_comp_lift` is  fact that the composition of `ι R` with `lift R f cond` agrees with `f`.
2. `lift_unique` ensures the uniqueness of `lift R f cond` with respect to 1.

## Definitions

* `ι_multi` is the `alternating_map` corresponding to the wedge product of `ι R m` terms.

## Implementation details

The exterior algebra of `M` is constructed as simply `clifford_algebra (0 : quadratic_form R M)`,
as this avoids us having to duplicate API.
-/

universes u1 u2 u3

variables (R : Type u1) [comm_ring R]
variables (M : Type u2) [add_comm_group M] [module R M]

/--
The exterior algebra of an `R`-module `M`.
-/
@[reducible]
def exterior_algebra := clifford_algebra (0 : quadratic_form R M)

namespace exterior_algebra

variables {M}

/--
The canonical linear map `M →ₗ[R] exterior_algebra R M`.
-/
@[reducible] def ι : M →ₗ[R] exterior_algebra R M := by exact clifford_algebra.ι _

variables {R}

/-- As well as being linear, `ι m` squares to zero -/
@[simp]
theorem ι_sq_zero (m : M) : (ι R m) * (ι R m) = 0 :=
(clifford_algebra.ι_sq_scalar _ m).trans $ map_zero _

variables {A : Type*} [semiring A] [algebra R A]

@[simp]
theorem comp_ι_sq_zero (g : exterior_algebra R M →ₐ[R] A)
  (m : M) : g (ι R m) * g (ι R m) = 0 :=
by rw [←alg_hom.map_mul, ι_sq_zero, alg_hom.map_zero]

variables (R)

/--
Given a linear map `f : M →ₗ[R] A` into an `R`-algebra `A`, which satisfies the condition:
`cond : ∀ m : M, f m * f m = 0`, this is the canonical lift of `f` to a morphism of `R`-algebras
from `exterior_algebra R M` to `A`.
-/
@[simps symm_apply]
def lift : {f : M →ₗ[R] A // ∀ m, f m * f m = 0} ≃ (exterior_algebra R M →ₐ[R] A) :=
equiv.trans (equiv.subtype_equiv (equiv.refl _) $ by simp) $ clifford_algebra.lift _

@[simp]
theorem ι_comp_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) :
  (lift R ⟨f, cond⟩).to_linear_map.comp (ι R) = f :=
clifford_algebra.ι_comp_lift f _

@[simp]
theorem lift_ι_apply (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) (x) :
  lift R ⟨f, cond⟩ (ι R x) = f x :=
clifford_algebra.lift_ι_apply f _ x

@[simp]
theorem lift_unique (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0)
  (g : exterior_algebra R M →ₐ[R] A) : g.to_linear_map.comp (ι R) = f ↔ g = lift R ⟨f, cond⟩ :=
clifford_algebra.lift_unique f _ _

variables {R M}

@[simp]
theorem lift_comp_ι (g : exterior_algebra R M →ₐ[R] A) :
  lift R ⟨g.to_linear_map.comp (ι R), comp_ι_sq_zero _⟩ = g :=
clifford_algebra.lift_comp_ι g

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext {f g : exterior_algebra R M →ₐ[R] A}
  (h : f.to_linear_map.comp (ι R) = g.to_linear_map.comp (ι R)) : f = g :=
clifford_algebra.hom_ext h

/-- If `C` holds for the `algebra_map` of `r : R` into `exterior_algebra R M`, the `ι` of `x : M`,
and is preserved under addition and muliplication, then it holds for all of `exterior_algebra R M`.
-/
@[elab_as_eliminator]
lemma induction {C : exterior_algebra R M → Prop}
  (h_grade0 : ∀ r, C (algebra_map R (exterior_algebra R M) r))
  (h_grade1 : ∀ x, C (ι R x))
  (h_mul : ∀ a b, C a → C b → C (a * b))
  (h_add : ∀ a b, C a → C b → C (a + b))
  (a : exterior_algebra R M) :
  C a :=
clifford_algebra.induction h_grade0 h_grade1 h_mul h_add a

/-- The left-inverse of `algebra_map`. -/
def algebra_map_inv : exterior_algebra R M →ₐ[R] R :=
exterior_algebra.lift R ⟨(0 : M →ₗ[R] R), λ m, by simp⟩

variables (M)

lemma algebra_map_left_inverse :
  function.left_inverse algebra_map_inv (algebra_map R $ exterior_algebra R M) :=
λ x, by simp [algebra_map_inv]

@[simp] lemma algebra_map_inj (x y : R) :
  algebra_map R (exterior_algebra R M) x = algebra_map R (exterior_algebra R M) y ↔ x = y :=
(algebra_map_left_inverse M).injective.eq_iff

@[simp] lemma algebra_map_eq_zero_iff (x : R) :
  algebra_map R (exterior_algebra R M) x = 0 ↔ x = 0 :=
map_eq_zero_iff (algebra_map _ _) (algebra_map_left_inverse _).injective

@[simp] lemma algebra_map_eq_one_iff (x : R) : algebra_map R (exterior_algebra R M) x = 1 ↔ x = 1 :=
map_eq_one_iff (algebra_map _ _) (algebra_map_left_inverse _).injective

lemma is_unit_algebra_map (r : R) : is_unit (algebra_map R (exterior_algebra R M) r) ↔ is_unit r :=
is_unit_map_of_left_inverse _ (algebra_map_left_inverse M)

/-- Invertibility in the exterior algebra is the same as invertibility of the base ring. -/
@[simps]
def invertible_algebra_map_equiv (r : R) :
  invertible (algebra_map R (exterior_algebra R M) r) ≃ invertible r :=
invertible_equiv_of_left_inverse _ _ _ (algebra_map_left_inverse M)

variables {M}

/-- The canonical map from `exterior_algebra R M` into `triv_sq_zero_ext R M` that sends
`exterior_algebra.ι` to `triv_sq_zero_ext.inr`. -/
def to_triv_sq_zero_ext [module Rᵐᵒᵖ M] [is_central_scalar R M] :
  exterior_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
lift R ⟨triv_sq_zero_ext.inr_hom R M, λ m, triv_sq_zero_ext.inr_mul_inr R m m⟩

@[simp] lemma to_triv_sq_zero_ext_ι [module Rᵐᵒᵖ M] [is_central_scalar R M] (x : M) :
  to_triv_sq_zero_ext (ι R x) = triv_sq_zero_ext.inr x :=
lift_ι_apply _ _ _ _

/-- The left-inverse of `ι`.

As an implementation detail, we implement this using `triv_sq_zero_ext` which has a suitable
algebra structure. -/
def ι_inv : exterior_algebra R M →ₗ[R] M :=
begin
  letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
  haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
  exact (triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map
end

lemma ι_left_inverse : function.left_inverse ι_inv (ι R : M → exterior_algebra R M) :=
λ x, by simp [ι_inv]

variables (R)

@[simp] lemma ι_inj (x y : M) : ι R x = ι R y ↔ x = y :=
ι_left_inverse.injective.eq_iff

variables {R}

@[simp] lemma ι_eq_zero_iff (x : M) : ι R x = 0 ↔ x = 0 :=
by rw [←ι_inj R x 0, linear_map.map_zero]

@[simp] lemma ι_eq_algebra_map_iff (x : M) (r : R) : ι R x = algebra_map R _ r ↔ x = 0 ∧ r = 0 :=
begin
  refine ⟨λ h, _, _⟩,
  { letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
    haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
    have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from to_triv_sq_zero_ext_ι _,
    rw [h, alg_hom.commutes] at hf0,
    have : r = 0 ∧ 0 = x := prod.ext_iff.1 hf0,
    exact this.symm.imp_left eq.symm, },
  { rintro ⟨rfl, rfl⟩,
    rw [linear_map.map_zero, ring_hom.map_zero] }
end

@[simp] lemma ι_ne_one [nontrivial R] (x : M) : ι R x ≠ 1 :=
begin
  rw [←(algebra_map R (exterior_algebra R M)).map_one, ne.def, ι_eq_algebra_map_iff],
  exact one_ne_zero ∘ and.right,
end

/-- The generators of the exterior algebra are disjoint from its scalars. -/
lemma ι_range_disjoint_one :
  disjoint (linear_map.range (ι R : M →ₗ[R] exterior_algebra R M))
    (1 : submodule R (exterior_algebra R M)) :=
begin
  rw submodule.disjoint_def,
  rintros _ ⟨x, hx⟩ ⟨r, (rfl : algebra_map _ _ _ = _)⟩,
  rw ι_eq_algebra_map_iff x at hx,
  rw [hx.2, ring_hom.map_zero]
end

@[simp]
lemma ι_add_mul_swap (x y : M) : ι R x * ι R y + ι R y * ι R x = 0 :=
calc _ = ι R (x + y) * ι R (x + y) : by simp [mul_add, add_mul]
   ... = _ : ι_sq_zero _

lemma ι_mul_prod_list {n : ℕ} (f : fin n → M) (i : fin n) :
  (ι R $ f i) * (list.of_fn $ λ i, ι R $ f i).prod = 0 :=
begin
  induction n with n hn,
  { exact i.elim0, },
  { rw [list.of_fn_succ, list.prod_cons, ←mul_assoc],
    by_cases h : i = 0,
    { rw [h, ι_sq_zero, zero_mul], },
    { replace hn := congr_arg ((*) $ ι R $ f 0) (hn (λ i, f $ fin.succ i) (i.pred h)),
      simp only at hn,
      rw [fin.succ_pred, ←mul_assoc, mul_zero] at hn,
      refine (eq_zero_iff_eq_zero_of_add_eq_zero _).mp hn,
      rw [← add_mul, ι_add_mul_swap, zero_mul], } }
end

variables (R)
/-- The product of `n` terms of the form `ι R m` is an alternating map.

This is a special case of `multilinear_map.mk_pi_algebra_fin`, and the exterior algebra version of
`tensor_algebra.tprod`. -/
def ι_multi (n : ℕ) : alternating_map R M (exterior_algebra R M) (fin n) :=
let F := (multilinear_map.mk_pi_algebra_fin R n (exterior_algebra R M)).comp_linear_map (λ i, ι R)
in
{ map_eq_zero_of_eq' := λ f x y hfxy hxy, begin
    rw [multilinear_map.comp_linear_map_apply, multilinear_map.mk_pi_algebra_fin_apply],
    clear F,
    wlog h : x < y,
    { exact this n f y x hfxy.symm hxy.symm (hxy.lt_or_lt.resolve_left h), },
    clear hxy,
    induction n with n hn,
    { exact x.elim0, },
    { rw [list.of_fn_succ, list.prod_cons],
      by_cases hx : x = 0,
      -- one of the repeated terms is on the left
      { rw hx at hfxy h,
        rw [hfxy, ←fin.succ_pred y (ne_of_lt h).symm],
        exact ι_mul_prod_list (f ∘ fin.succ) _, },
      -- ignore the left-most term and induct on the remaining ones, decrementing indices
      { convert mul_zero _,
        refine hn (λ i, f $ fin.succ i)
          (x.pred hx) (y.pred (ne_of_lt $ lt_of_le_of_lt x.zero_le h).symm) _
          (fin.pred_lt_pred_iff.mpr h),
        simp only [fin.succ_pred],
        exact hfxy, } }
  end,
  to_fun := F, ..F}
variables {R}

lemma ι_multi_apply {n : ℕ} (v : fin n → M) :
  ι_multi R n v = (list.of_fn $ λ i, ι R (v i)).prod := rfl

@[simp] lemma ι_multi_zero_apply (v : fin 0 → M) : ι_multi R 0 v = 1 := rfl

@[simp] lemma ι_multi_succ_apply {n : ℕ} (v : fin n.succ → M) :
  ι_multi R _ v = ι R (v 0) * ι_multi R _ (matrix.vec_tail v):=
(congr_arg list.prod (list.of_fn_succ _)).trans list.prod_cons

lemma ι_multi_succ_curry_left {n : ℕ} (m : M) :
  (ι_multi R n.succ).curry_left m =
    (linear_map.mul_left R (ι R m)).comp_alternating_map (ι_multi R n) :=
alternating_map.ext $ λ v, (ι_multi_succ_apply _).trans $ begin
  simp_rw matrix.tail_cons,
  refl,
end

end exterior_algebra

namespace tensor_algebra

variables {R M}

/-- The canonical image of the `tensor_algebra` in the `exterior_algebra`, which maps
`tensor_algebra.ι R x` to `exterior_algebra.ι R x`. -/
def to_exterior : tensor_algebra R M →ₐ[R] exterior_algebra R M :=
tensor_algebra.lift R (exterior_algebra.ι R : M →ₗ[R] exterior_algebra R M)

@[simp] lemma to_exterior_ι (m : M) : (tensor_algebra.ι R m).to_exterior = exterior_algebra.ι R m :=
by simp [to_exterior]

end tensor_algebra