/-
1. Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as you can now with tactic proofs, using also rw and simp as appropriate.
-/

import data.int.basic

namespace ch03_ex01
    variables p q r : Prop

    -- commutativity of ∧ and ∨
    example : p ∧ q ↔ q ∧ p :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hq,
        constructor,
        repeat { assumption },
        -- <-
        intro h,
        cases h with hp hq,
        constructor,
        repeat { assumption }
    end

    example : p ∨ q ↔ q ∨ p :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hq,
        right,
        exact hp,
        left,
        exact hq,
        -- <-
        intro h,
        cases h with hq hp,
        right,
        exact hq,
        left,
        exact hp
    end

    -- associativity of ∧ and ∨
    example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hpq hr,
        cases hpq with hp hq,
        constructor,
        exact hp,
        constructor,
        repeat { assumption },
        -- <-
        intro h,
        cases h with hp hqr,
        cases hqr with hq hr,
        constructor,
        constructor,
        repeat { assumption }
    end

    example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hpq hr,
        cases hpq with hp hq,
        apply or.inl,
        exact hp,
        apply or.inr,
        apply or.inl,
        exact hq,
        apply or.inr,
        apply or.inr,
        exact hr,
        -- <-
        intro h,
        cases h with hp hqr,
        apply or.inl,
        apply or.inl,
        exact hp,
        cases hqr with hq hr,
        apply or.inl,
        apply or.inr,
        exact hq,
        apply or.inr,
        exact hr
    end

    -- distributivity
    example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hqr,
        cases hqr with hq hr,
        left,
        constructor,
        repeat { assumption },
        right,
        constructor,
        repeat { assumption },
        -- <-
        intro h,
        cases h with hpq hpr,
        cases hpq with hp hq,
        constructor,
        exact hp,
        left,
        exact hq,
        constructor,
        cases hpr with hp hr,
        exact hp,
        cases hpr with hp hr,
        right,
        exact hr
    end

    example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hqr,
        apply and.intro,
        left,
        exact hp,
        left,
        exact hp,
        cases hqr with hq hr,
        apply and.intro,
        right,
        exact hq,
        right,
        exact hr,
        -- <-
        intro h,
        cases h with hpq hpr,
        cases hpq with hp hq,
        left,
        exact hp,
        cases hpr with hp hr,
        left,
        exact hp,
        right,
        apply and.intro,
        repeat { assumption }
    end

    -- other properties
    example : (p → (q → r)) ↔ (p ∧ q → r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        intro hpq,
        cases hpq with hp hq,
        exact (h hp) hq,
        -- <-
        intro h,
        intro hp,
        intro hq,
        have hpq : p ∧ q, from ⟨hp, hq⟩,
        exact h hpq
    end

    example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        apply and.intro,
        intro hp,
        have hpq : p ∨ q, from or.inl hp,
        exact h hpq,
        intro hq,
        have hpq : p ∨ q, from or.inr hq,
        exact h hpq,
        -- <-
        intro h,
        intro hpq,
        cases h with h1 h2,
        cases hpq with hp hq,
        exact (h1 hp),
        exact (h2 hq)
    end

    example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        apply and.intro,
        intro hp,
        have hpq : p ∨ q, from or.inl hp,
        exact h hpq,
        intro hq,
        have hpq : p ∨ q, from or.inr hq,
        exact h hpq,
        -- <-
        intro h,
        intro hpq,
        cases h with hnp hnq,
        cases hpq with hp hq,
        exact hnp hp,
        exact hnq hq
    end

    example : ¬p ∨ ¬q → ¬(p ∧ q) :=
    begin
        intro h,
        intro hpq,
        cases h with hnp hnq,
        cases hpq with hp hq,
        exact hnp hp,
        cases hpq with hp hq,
        exact hnq hq
    end

    example : ¬(p ∧ ¬p) :=
    begin
        intro h,
        cases h with hp hnp,
        exact hnp hp
    end

    example : p ∧ ¬q → ¬(p → q) :=
    begin
        intro h1,
        cases h1 with hp hnq,
        intro h2,
        have hq : q, from h2 hp,
        exact hnq hq
    end

    example : ¬p → (p → q) :=
    begin
        intro hnp,
        intro hp,
        contradiction
    end

    example : (¬p ∨ q) → (p → q) :=
    begin
        intro h,
        intro hp,
        cases h with hnp hq,
        contradiction,
        exact hq
    end

    example : p ∨ false ↔ p :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hfalse,
        exact hp,
        contradiction,
        -- <-
        intro hp,
        left,
        exact hp
    end

    example : p ∧ false ↔ false :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with hp hfalse,
        exact hfalse,
        -- <-
        intro h,
        contradiction
    end

    example : (p → q) → (¬q → ¬p) :=
    begin
        intro h,
        intro hnq,
        intro hp,
        exact hnq (h hp)
    end
end ch03_ex01

namespace ch03_ex02
    open classical

    variables p q r s : Prop

    example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
    begin
        intro h,
        cases (em p) with hp hnp,
        have hrs : r ∨ s, from h hp,
        cases hrs with hr hs,
        left,
        intro hp,
        exact hr,
        right,
        intro hp,
        exact hs,
        left,
        intro hp,
        contradiction
    end

    example : ¬(p ∧ q) → ¬p ∨ ¬q :=
    begin
        intro h,
        cases (em p) with hp hnp,
        right,
        intro hq,
        exact h ⟨hp, hq⟩,
        left,
        exact hnp
    end

    example : ¬(p → q) → p ∧ ¬q :=
    begin
        intro h,
        cases (em p) with hp hnp,
        cases (em q) with hq hnq,
        apply and.intro,
        exact hp,
        have hpimplq : p → q, from
            begin
                intro hp,
                exact hq
            end,
        contradiction,
        apply and.intro,
        exact hp,
        exact hnq,
        have hpimplq : p → q, from
            begin
                intro hp,
                contradiction
            end,
        contradiction
    end

    example : (p → q) → (¬p ∨ q) :=
    begin
        intro h,
        cases (em p) with hp hnp,
        right,
        exact h hp,
        left,
        exact hnp
    end

    example : (¬q → ¬p) → (p → q) :=
    begin
        intro h,
        intro hp,
        cases (em q) with hq hnq,
        exact hq,
        have hnp : ¬ p, from h hnq,
        contradiction
    end

    example : p ∨ ¬p :=
    begin
        exact (em p)
    end

    example : (((p → q) → p) → p) :=
    begin
        intro h1,
        cases (em p) with hp hnp,
        exact hp,
        have hpimplq : p → q, from
            begin
                intro hp,
                contradiction
            end,
        have hp : p, from h1 hpimplq,
        contradiction
    end
end ch03_ex02

namespace ch03_ex03
    variables p : Prop

    example : ¬(p ↔ ¬p) :=
    begin
        intro h,
        have hpimplnp : p → ¬p, from iff.elim_left h,
        have hnpimplp : ¬p → p, from iff.elim_right h,
        have hnp : ¬p, from
            assume hp : p,
            show false, from absurd hp (hpimplnp hp),
        have hp : p, from hnpimplp hnp,
        contradiction
    end
end ch03_ex03

namespace ch04_ex01
    variables (α : Type) (p q : α → Prop)

    example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        apply and.intro,
        intro xx,
        exact (h xx).left,
        intro xx,
        exact (h xx).right,
        -- <-
        intro h,
        intro xx,
        apply and.intro,
        exact h.left xx,
        exact h.right xx
    end

    example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
    begin
        intro h1,
        intro h2,
        intro xx,
        exact (h1 xx) (h2 xx)
    end

    example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
    begin
        intro h,
        intro xx,
        cases h with hl hr,
        left,
        exact hl xx,
        right,
        exact hr xx
    end
end ch04_ex01

namespace ch04_ex02
    open classical

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

    example : α → ((∀ x : α, r) ↔ r) :=
    begin
        intro halpha,
        apply iff.intro,
        -- ->
        intro h,
        exact h halpha,
        -- <-
        intro hr,
        intro halpha',
        exact hr
    end

    example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases (em r) with hr hnr,
        right,
        exact hr,
        left,
        intro xx,
        cases (h xx) with hpxx hr,
        exact hpxx,
        contradiction,
        -- <-
        intro h,
        intro xx,
        cases h with hl hr,
        left,
        exact hl xx,
        right,
        exact hr
    end

    example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        intro hr,
        intro xx,
        exact h xx hr,
        -- <-
        intro h,
        intro xx,
        intro hr,
        exact h hr xx
    end
end ch04_ex02

namespace ch04_ex03
    open classical

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

    example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
    begin
        cases (em (shaves barber barber)) with h1 h1',
        {
            have h2 : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
            have h3 : shaves barber barber → ¬ shaves barber barber, from iff.mp h2,
            have h4 : ¬ shaves barber barber, from h3 h1,
            contradiction
        },
        {
            have h2 : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
            have h3 : ¬ shaves barber barber → shaves barber barber, from iff.mpr h2,
            have h4 : shaves barber barber, from h3 h1',
            contradiction
        }
    end
end ch04_ex03

namespace ch04_ex04

end ch04_ex04

namespace ch04_ex05
    open classical

    variables (α : Type) (p q : α → Prop)
    variable a : α
    variable r : Prop

    example : (∃ x : α, r) → r :=
    begin
        intro h,
        cases h with xx hr,
        exact hr
    end

    include a
    example : r → (∃ x : α, r) :=
    begin
        intro hr,
        existsi a,
        exact hr
    end

    example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with xx h1,
        cases h1 with hpxx hr,
        apply and.intro,
        existsi xx,
        exact hpxx,
        exact hr,
        -- <-
        intro h,
        cases h with h1 hr,
        cases h1 with xx hpxx,
        existsi xx,
        apply and.intro,
        repeat { assumption }
    end

    example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        cases h with xx h1,
        cases h1 with hpxx hqxx,
        left,
        existsi xx,
        exact hpxx,
        right,
        existsi xx,
        exact hqxx,
        -- <-
        intro h,
        cases h with hl hr,
        cases hl with xx hpxx,
        existsi xx,
        left,
        exact hpxx,
        cases hr with xx hqxx,
        existsi xx,
        right,
        exact hqxx
    end

    example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
    begin
        apply iff.intro,
        -- ->
        intro h,
        intro h1,
        cases h1 with xx hnpxx,
        have hpxx : p xx, from h xx,
        contradiction,
        -- <-
        intro h,
        intro xx,
        exact by_contradiction
            begin
                intro h1,
                have h2 : ∃ (x : α), ¬ p x, from
                    begin
                        existsi xx,
                        exact h1
                    end,
                contradiction
            end
    end

    example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
    begin
        apply iff.intro,

        intro h,
        intro h1,
        cases h with xx hpxx,
        have hnpxx : ¬ p xx, from h1 xx,
        contradiction,

        intro h,
        exact by_contradiction
            begin
                intro h1,
                have h2 : ∀ x, ¬ p x, from
                    begin
                        intro xx,
                        intro h3,
                        have h4 : ∃ (x : α), p x, from
                            begin
                                existsi xx,
                                exact h3
                            end,
                        contradiction
                    end,
                contradiction
            end
    end

    example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
    begin
        apply iff.intro,

        intro h,
        intro xx,
        intro hpxx,
        have h1 : ∃ (x : α), p x, from
            begin
                existsi xx,
                exact hpxx
            end,
        contradiction,

        intro h,
        intro h1,
        cases h1 with xx hpxx,
        have hnpxx : ¬ p xx, from h xx,
        contradiction
    end

    example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
    begin
        apply iff.intro,

        intro h,
        exact by_contradiction
            begin
                intro h1,
                have h2 : ∀ x, p x, from
                assume x1 : α,
                by_contradiction
                (
                    assume h3 : ¬ p x1,
                    h1 (exists.intro x1 h3)
                ),
                contradiction
            end,

        intro h,
        cases h with xx hnpxx,
        intro h1,
        have hpxx : p xx, from h1 xx,
        contradiction
    end

    example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
    begin
        apply iff.intro,

        intro h,
        intro h1,
        cases h1 with xx hpxx,
        exact (h xx) hpxx,

        intro h,
        intro xx,
        intro hpxx,
        exact h (exists.intro xx hpxx)
    end

    example : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
    sorry

    example : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
    sorry
end ch04_ex05

namespace ch04_ex06
    variables (real : Type) [ordered_ring real]
    variables (log exp : real → real)
    variable  log_exp_eq : ∀ x, log (exp x) = x
    variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
    variable  exp_pos    : ∀ x, exp x > 0
    variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

    -- this ensures the assumptions are available in tactic proofs
    include log_exp_eq exp_log_eq exp_pos exp_add

    example (x y z : real) :
    exp (x + y + z) = exp x * exp y * exp z :=
    by rw [exp_add, exp_add]

    example (y : real) (h : y > 0)  : exp (log y) = y :=
    exp_log_eq h

    theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
    log (x * y) = log x + log y :=
    sorry
end ch04_ex06

namespace ch04_ex07
    #check sub_self

    example (x : ℤ) : x * 0 = 0 :=
    sorry
end ch04_ex07


/-
Copyright (c) 2021 Noam Atar. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Noam Atar
-/
import order.ideal
import order.pfilter

/-!
# Prime ideals

## Main definitions

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

- `order.ideal.prime_pair`: A pair of an `ideal` and a `pfilter` which form a partition of `P`.
  This is useful as giving the data of a prime ideal is the same as giving the data of a prime
  filter.
- `order.ideal.is_prime`: a predicate for prime ideals. Dual to the notion of a prime filter.
- `order.pfilter.is_prime`: a predicate for prime filters. Dual to the notion of a prime ideal.

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>

## Tags

ideal, prime

-/

open order.pfilter

namespace order

variables {P : Type*}

namespace ideal

/-- A pair of an `ideal` and a `pfilter` which form a partition of `P`.
-/
@[nolint has_inhabited_instance]
structure prime_pair (P : Type*) [preorder P] :=
(I            : ideal P)
(F            : pfilter P)
(is_compl_I_F : is_compl (I : set P) F)

namespace prime_pair

variables [preorder P] (IF : prime_pair P)

lemma compl_I_eq_F : (IF.I : set P)ᶜ = IF.F := IF.is_compl_I_F.compl_eq
lemma compl_F_eq_I : (IF.F : set P)ᶜ = IF.I := IF.is_compl_I_F.eq_compl.symm

lemma I_is_proper : is_proper IF.I :=
begin
  cases IF.F.nonempty,
  apply is_proper_of_not_mem (_ : w ∉ IF.I),
  rwa ← IF.compl_I_eq_F at h,
end

lemma disjoint : disjoint (IF.I : set P) IF.F := IF.is_compl_I_F.disjoint

lemma I_union_F : (IF.I : set P) ∪ IF.F = set.univ := IF.is_compl_I_F.sup_eq_top
lemma F_union_I : (IF.F : set P) ∪ IF.I = set.univ := IF.is_compl_I_F.symm.sup_eq_top

end prime_pair

/-- An ideal `I` is prime if its complement is a filter.
-/
@[mk_iff] class is_prime [preorder P] (I : ideal P) extends is_proper I : Prop :=
(compl_filter : is_pfilter (I : set P)ᶜ)

section preorder

variable [preorder P]

/-- Create an element of type `order.ideal.prime_pair` from an ideal satisfying the predicate
`order.ideal.is_prime`. -/
def is_prime.to_prime_pair {I : ideal P} (h : is_prime I) : prime_pair P :=
{ I            := I,
  F            := h.compl_filter.to_pfilter,
  is_compl_I_F := is_compl_compl }

lemma prime_pair.I_is_prime (IF : prime_pair P) : is_prime IF.I :=
{ compl_filter := by { rw IF.compl_I_eq_F, exact IF.F.is_pfilter },
  ..IF.I_is_proper }

end preorder

section semilattice_inf

variables [semilattice_inf P] {x y : P} {I : ideal P}

lemma is_prime.mem_or_mem (hI : is_prime I) {x y : P} : x ⊓ y ∈ I → x ∈ I ∨ y ∈ I :=
begin
  contrapose!,
  let F := hI.compl_filter.to_pfilter,
  show x ∈ F ∧ y ∈ F → x ⊓ y ∈ F,
  exact λ h, inf_mem _ _ h.1 h.2,
end

lemma is_prime.of_mem_or_mem [is_proper I] (hI : ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I) :
  is_prime I :=
begin
  rw is_prime_iff,
  use ‹_›,
  apply is_pfilter.of_def,
  { exact set.nonempty_compl.2 (I.is_proper_iff.1 ‹_›) },
  { intros x _ y _,
    refine ⟨x ⊓ y, _, inf_le_left, inf_le_right⟩,
    have := mt hI,
    tauto! },
  { exact @mem_compl_of_ge _ _ _ }
end

lemma is_prime_iff_mem_or_mem [is_proper I] : is_prime I ↔ ∀ {x y : P}, x ⊓ y ∈ I → x ∈ I ∨ y ∈ I :=
⟨is_prime.mem_or_mem, is_prime.of_mem_or_mem⟩

end semilattice_inf

section distrib_lattice

variables [distrib_lattice P] {I : ideal P}

@[priority 100]
instance is_maximal.is_prime [is_maximal I] : is_prime I :=
begin
  rw is_prime_iff_mem_or_mem,
  intros x y,
  contrapose!,
  rintro ⟨hx, hynI⟩ hxy,
  apply hynI,
  let J := I ⊔ principal x,
  have hJuniv : (J : set P) = set.univ :=
    is_maximal.maximal_proper (lt_sup_principal_of_not_mem ‹_›),
  have hyJ : y ∈ ↑J := set.eq_univ_iff_forall.mp hJuniv y,
  rw coe_sup_eq at hyJ,
  rcases hyJ with ⟨a, ha, b, hb, hy⟩,
  rw hy,
  apply sup_mem _ _ ha,
  refine I.mem_of_le (le_inf hb _) hxy,
  rw hy,
  exact le_sup_right
end

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_prime.mem_or_compl_mem (hI : is_prime I) : x ∈ I ∨ xᶜ ∈ I :=
begin
  apply hI.mem_or_mem,
  rw inf_compl_eq_bot,
  exact bot_mem,
end

lemma is_prime.mem_compl_of_not_mem (hI : is_prime I) (hxnI : x ∉ I) : xᶜ ∈ I :=
hI.mem_or_compl_mem.resolve_left hxnI

lemma is_prime_of_mem_or_compl_mem [is_proper I] (h : ∀ {x : P}, x ∈ I ∨ xᶜ ∈ I) : is_prime I :=
begin
  simp only [is_prime_iff_mem_or_mem, or_iff_not_imp_left],
  intros x y hxy hxI,
  have hxcI : xᶜ ∈ I := h.resolve_left hxI,
  have ass : (x ⊓ y) ⊔ (y ⊓ xᶜ) ∈ I := sup_mem _ _ hxy (mem_of_le I inf_le_right hxcI),
  rwa [inf_comm, sup_inf_inf_compl] at ass
end

@[priority 100]
instance is_prime.is_maximal [is_prime I] : is_maximal I :=
begin
  simp only [is_maximal_iff, set.eq_univ_iff_forall, is_prime.to_is_proper, true_and],
  intros J hIJ x,
  rcases set.exists_of_ssubset hIJ with ⟨y, hyJ, hyI⟩,
  suffices ass : (x ⊓ y) ⊔ (x ⊓ yᶜ) ∈ J,
  { rwa sup_inf_inf_compl at ass },
  exact sup_mem _ _ (J.mem_of_le inf_le_right hyJ)
    (hIJ.le (I.mem_of_le inf_le_right (is_prime.mem_compl_of_not_mem ‹_› hyI))),
end

end boolean_algebra

end ideal

namespace pfilter

variable [preorder P]

/-- A filter `F` is prime if its complement is an ideal.
-/
@[mk_iff] class is_prime (F : pfilter P) : Prop :=
(compl_ideal : is_ideal (F : set P)ᶜ)

/-- Create an element of type `order.ideal.prime_pair` from a filter satisfying the predicate
`order.pfilter.is_prime`. -/
def is_prime.to_prime_pair {F : pfilter P} (h : is_prime F) : ideal.prime_pair P :=
{ I            := h.compl_ideal.to_ideal,
  F            := F,
  is_compl_I_F := is_compl_compl.symm }

lemma _root_.order.ideal.prime_pair.F_is_prime (IF : ideal.prime_pair P) : is_prime IF.F :=
{ compl_ideal := by { rw IF.compl_F_eq_I, exact IF.I.is_ideal } }

end pfilter

end order


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

It is known that epimorphisms in the category of groups
are always surjective, and monomorphisms are always regular.
These facts are also useful for giving Lean-friendly proofs of
various facts that do not explicitly involve category theory.
The tidiest proof (which we learned from Todd Trimble via the
nLab) involves the construction that we formalize here.
It is the semidirect product for the evident action of a
group `G` on `(G → bool)`.  Here we treat `bool` as a group
under `bxor`, so it is morally `ℤ/2`, but `bool` is more
natural in the Lean context.
-/

import group_theory.subgroup.basic
import tactic.interactive tactic.squeeze tactic.suggest

namespace group_theory

variables (G : Type*) [group G]

/- Elements of the subgroup classifier are represented as
   `T g u` with `g : G` and `u : G → bool`.
-/
inductive subgroup_classifier
| T : G → (G → bool) → subgroup_classifier

namespace subgroup_classifier

instance : group (subgroup_classifier G) := {
  one := T 1 (λ _,ff),
  mul := λ ⟨g,u⟩ ⟨h,v⟩, T (g * h) (λ x, bxor (u (h * x)) (v x)),
  inv := λ ⟨g,u⟩, T g⁻¹ (λ x, u (g⁻¹ * x)),
  one_mul := λ ⟨g,u⟩,
  begin
    change T (1 * g) _ = T g u, rw [one_mul], congr' 1,
    funext x, exact ff_bxor _
  end,
  mul_one := λ ⟨g,u⟩,
  begin
    change T (g * 1) _ = T g u, rw [mul_one], congr' 1,
    funext x, rw [one_mul], exact bxor_ff _
  end,
  mul_assoc := λ ⟨g,u⟩ ⟨h,v⟩ ⟨k,w⟩,
  begin
    change T ((g * h) * k) _ = T (g * (h * k)) _, rw [mul_assoc], congr' 1,
    funext x, simp only [], rw [mul_assoc, bool.bxor_assoc]
  end,
  mul_left_inv := λ ⟨g,u⟩,
  begin
    change T (g⁻¹ * g) _ = T 1 _, rw[mul_left_inv], congr' 1,
    funext x, change bxor (u (g⁻¹ * (g * x))) (u x) = ff,
    rw [← mul_assoc, mul_left_inv, one_mul, bxor_self]
  end
}

def proj : (subgroup_classifier G) →* G := {
  to_fun := λ ⟨g,u⟩, g,
  map_one' := rfl,
  map_mul' := λ ⟨g,u⟩ ⟨h,v⟩, rfl
}

def inc : G →* (subgroup_classifier G) := {
  to_fun := λ g, T g (λ _, ff),
  map_one' := rfl,
  map_mul' := λ g h,
  begin
    change T (g * h) _ = T (g * h) _, congr' 1
  end
}

variable {G}

/- A decidable subset `S ⊆ G` can be represented by the
   boolean characteristic function `G → bool` or the
   corresponding predicate `G → Prop` together with a
   decidability instance.  We will make some constructions
   with the boolean version first and then translate to
   the propositional case.

   For any such `S` we define a subgroup `core S` of `G`.
   This is just the stabiliser of `S` with respect to the
   obvious action of `G` on subsets of `G`, although we
   choose not to formulate it that way.

   We also define a homomorphism `δ S` from `G` to
   `subgroup_classifier G` such that the equaliser of `δ S`
   and the trivial inclusion is just the core of `S`.
   This is the main ingredient in applications of this
   construction.
-/

def δ₀ (m : G → bool) : G →* (subgroup_classifier G) := {
  to_fun := λ g, T g (λ x, bxor (m (g * x)) (m x) ),
  map_one' :=
  begin
    change T (1 : G) _ = T (1 : G) _, congr' 1,
    funext x, rw [one_mul, bxor_self]
  end,
  map_mul' := λ g h,
  begin
    change T (g * h) _ = T (g * h) _, congr' 1,
    funext x, rw [mul_assoc],
    let a := m x, let b := m (h * x), let c := m (g * (h * x)),
    change bxor c a = bxor (bxor c b) (bxor b a),
    rw [bool.bxor_assoc, ← bool.bxor_assoc b, bxor_self b,
        bool.bxor_comm ff, bxor_ff]
  end
}

def core₀ (m : G → bool) : subgroup G := {
 carrier := { g | ∀ y, m (g * y) = m y },
 one_mem' := by { intro a, rw[one_mul] },
 mul_mem' := by { intros a b ha hb c, rw[mul_assoc,ha,hb] },
 inv_mem' := by { intros a ha b, rw [← ha (a⁻¹ * b), ← mul_assoc, mul_right_inv, one_mul]}
}

def δ (S : set G) [decidable_pred S] : G →* (subgroup_classifier G) :=
  δ₀ (λ x, to_bool (S x))

def core (S : set G) [decidable_pred S] : subgroup G :=
  core₀ (λ x, to_bool (S x))

lemma to_bool_eq_iff_iff {p q : Prop} [decidable p] [decidable q] :
  (to_bool p = to_bool q) ↔ (p ↔ q) :=
by { by_cases hp : p; by_cases hq : q; simp [hp, hq] }

lemma bxor_eq_ff_iff {a b : bool} : bxor a b = ff ↔ a = b :=
  by { cases a; cases b; simp only [bxor, eq_true_intro rfl] }

lemma mem_core_iff (g : G) (S : set G) [dS : decidable_pred S] :
  g ∈ core S ↔ (∀ y, g * y ∈ S ↔ y ∈ S) :=
begin
  change g ∈ core S ↔ (∀ y, S (g * y) ↔ S y),
  dsimp [core, core₀], split; intros h y,
  { rw [← to_bool_eq_iff_iff], exact h y },
  { rw [  to_bool_eq_iff_iff], exact h y }
end

lemma core_of_subgroup (H : subgroup G) [decidable_pred (H : set G)] :
  core (H : set G) = H :=
begin
  ext a, rw [mem_core_iff],
  split,
  { intro h, replace h := (h 1).mpr H.one_mem,
    rw [mul_one] at h, exact h },
  { intros h y, apply H.mul_mem_cancel_left h }
end

lemma core_from_δ (S : set G) [decidable_pred S] :
  core S = monoid_hom.eq_locus (δ S) (inc G) :=
begin
  ext a, rw [mem_core_iff],
  change _ ↔ (T a _) = (T a _),
  split,
  { intro h, congr' 1, funext y,
    rw [bxor_eq_ff_iff, to_bool_eq_iff_iff], exact h y },
  { intro h,
    have : ∀ {u v : G → bool}, T a u = T a v → u = v :=
      λ u v e, by { injection e },
    intro y,
    exact to_bool_eq_iff_iff.mp (bxor_eq_ff_iff.mp (congr_fun (this h) y)) }
end

end subgroup_classifier
end group_theory


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

import model_theory.finitely_generated
import model_theory.direct_limit
import model_theory.bundled

/-!
# Fraïssé Classes and Fraïssé Limits

This file pertains to the ages of countable first-order structures. The age of a structure is the
class of all finitely-generated structures that embed into it.

Of particular interest are Fraïssé classes, which are exactly the ages of countable
ultrahomogeneous structures. To each is associated a unique (up to nonunique isomorphism)
Fraïssé limit - the countable structure with that age.

## Main Definitions
* `first_order.language.age` is the class of finitely-generated structures that embed into a
particular structure.
* A class `K` has the `first_order.language.hereditary` when all finitely-generated
structures that embed into structures in `K` are also in `K`.
* A class `K` has the `first_order.language.joint_embedding` when for every `M`, `N` in
`K`, there is another structure in `K` into which both `M` and `N` embed.
* A class `K` has the `first_order.language.amalgamation` when for any pair of embeddings
of a structure `M` in `K` into other structures in `K`, those two structures can be embedded into a
fourth structure in `K` such that the resulting square of embeddings commutes.
* `first_order.language.is_fraisse` indicates that a class is nonempty, isomorphism-invariant,
essentially countable, and satisfies the hereditary, joint embedding, and amalgamation properties.
* `first_order.language.fraisse_limit` noncomputably constructs a Fraïssé limit for any Fraïssé
class.

## Main Results
* We show that the age of any structure is isomorphism-invariant and satisfies the hereditary and
joint-embedding properties.
* `first_order.language.age.countable_quotient` shows that the age of any countable structure is
essentially countable.
* `first_order.language.exists_cg_is_age_of` constructs a countably-generated structure with a
particular age.

## Implementation Notes
* Classes of structures are formalized with `set (bundled L.Structure)`.
* Some results pertain to countable limit structures, others to countably-generated limit
structures. In the case of a language with countably many function symbols, these are equivalent.

## References
- [W. Hodges, *A Shorter Model Theory*][Hodges97]
- [K. Tent, M. Ziegler, *A Course in Model Theory*][Tent_Ziegler]

## TODO
* Define ultrahomogeneous structures
* Show that any two Fraïssé limits of a Fraïssé class are isomorphic
* Show that any Fraïssé limit is ultrahomogeneous
* Show that the age of any ultrahomogeneous countable structure is Fraïssé

-/

universes u v w w'

open_locale first_order
open set category_theory

namespace first_order
namespace language
open Structure substructure

variables (L : language.{u v})

/-! ### The Age of a Structure and Fraïssé Classes-/

/-- The age of a structure `M` is the class of finitely-generated structures that embed into it. -/
def age (M : Type w) [L.Structure M] : set (bundled.{w} L.Structure) :=
{ N | Structure.fg L N ∧ nonempty (N ↪[L] M) }

variables {L} (K : set (bundled.{w} L.Structure))

/-- A class `K` has the hereditary property when all finitely-generated structures that embed into
  structures in `K` are also in `K`.  -/
def hereditary : Prop :=
∀ (M : bundled.{w} L.Structure), M ∈ K → L.age M ⊆ K

/-- A class `K` has the joint embedding property when for every `M`, `N` in `K`, there is another
  structure in `K` into which both `M` and `N` embed. -/
def joint_embedding : Prop :=
directed_on (λ M N : bundled.{w} L.Structure, nonempty (M ↪[L] N)) K

/-- A class `K` has the amalgamation property when for any pair of embeddings of a structure `M` in
  `K` into other structures in `K`, those two structures can be embedded into a fourth structure in
  `K` such that the resulting square of embeddings commutes. -/
def amalgamation : Prop :=
∀ (M N P : bundled.{w} L.Structure) (MN : M ↪[L] N) (MP : M ↪[L] P), M ∈ K → N ∈ K → P ∈ K →
  ∃ (Q : bundled.{w} L.Structure) (NQ : N ↪[L] Q) (PQ : P ↪[L] Q), Q ∈ K ∧ NQ.comp MN = PQ.comp MP

/-- A Fraïssé class is a nonempty, isomorphism-invariant, essentially countable class of structures
satisfying the hereditary, joint embedding, and amalgamation properties. -/
class is_fraisse : Prop :=
(is_nonempty : K.nonempty)
(fg : ∀ M : bundled.{w} L.Structure, M ∈ K → Structure.fg L M)
(is_equiv_invariant : ∀ (M N : bundled.{w} L.Structure), nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K))
(is_essentially_countable : (quotient.mk '' K).countable)
(hereditary : hereditary K)
(joint_embedding : joint_embedding K)
(amalgamation : amalgamation K)

variables {K} (L) (M : Type w) [L.Structure M]

lemma age.is_equiv_invariant (N P : bundled.{w} L.Structure) (h : nonempty (N ≃[L] P)) :
  N ∈ L.age M ↔ P ∈ L.age M :=
and_congr h.some.fg_iff
  ⟨nonempty.map (λ x, embedding.comp x h.some.symm.to_embedding),
  nonempty.map (λ x, embedding.comp x h.some.to_embedding)⟩

variables {L} {M} {N : Type w} [L.Structure N]

lemma embedding.age_subset_age (MN : M ↪[L] N) : L.age M ⊆ L.age N :=
λ _, and.imp_right (nonempty.map MN.comp)

lemma equiv.age_eq_age (MN : M ≃[L] N) : L.age M = L.age N :=
le_antisymm MN.to_embedding.age_subset_age MN.symm.to_embedding.age_subset_age

lemma Structure.fg.mem_age_of_equiv {M N : bundled L.Structure} (h : Structure.fg L M)
  (MN : nonempty (M ≃[L] N)) : N ∈ L.age M :=
⟨MN.some.fg_iff.1 h, ⟨MN.some.symm.to_embedding⟩⟩

lemma hereditary.is_equiv_invariant_of_fg (h : hereditary K)
  (fg : ∀ (M : bundled.{w} L.Structure), M ∈ K → Structure.fg L M)
  (M N : bundled.{w} L.Structure) (hn : nonempty (M ≃[L] N)) : M ∈ K ↔ N ∈ K :=
⟨λ MK, h M MK ((fg M MK).mem_age_of_equiv hn),
  λ NK, h N NK ((fg N NK).mem_age_of_equiv ⟨hn.some.symm⟩)⟩

variable (M)

lemma age.hereditary : hereditary (L.age M) :=
λ N hN P hP, hN.2.some.age_subset_age hP

lemma age.joint_embedding : joint_embedding (L.age M) :=
λ N hN P hP, ⟨bundled.of ↥(hN.2.some.to_hom.range ⊔ hP.2.some.to_hom.range),
  ⟨(fg_iff_Structure_fg _).1 ((hN.1.range hN.2.some.to_hom).sup (hP.1.range hP.2.some.to_hom)),
  ⟨subtype _⟩⟩,
  ⟨embedding.comp (inclusion le_sup_left) hN.2.some.equiv_range.to_embedding⟩,
  ⟨embedding.comp (inclusion le_sup_right) hP.2.some.equiv_range.to_embedding⟩⟩

/-- The age of a countable structure is essentially countable (has countably many isomorphism
classes). -/
lemma age.countable_quotient (h : (univ : set M).countable) :
  (quotient.mk '' (L.age M)).countable :=
begin
  refine eq.mp (congr rfl (set.ext _)) ((countable_set_of_finite_subset h).image
    (λ s, ⟦⟨closure L s, infer_instance⟩⟧)),
  rw forall_quotient_iff,
  intro N,
  simp only [subset_univ, and_true, mem_image, mem_set_of_eq, quotient.eq],
  split,
  { rintro ⟨s, hs1, hs2⟩,
    use bundled.of ↥(closure L s),
    exact ⟨⟨(fg_iff_Structure_fg _).1 (fg_closure hs1), ⟨subtype _⟩⟩, hs2⟩ },
  { rintro ⟨P, ⟨⟨s, hs⟩, ⟨PM⟩⟩, hP2⟩,
    refine ⟨PM '' s, set.finite.image PM s.finite_to_set, setoid.trans _ hP2⟩,
    rw [← embedding.coe_to_hom, closure_image PM.to_hom, hs, ← hom.range_eq_map],
    exact ⟨PM.equiv_range.symm⟩ }
end

/-- The age of a direct limit of structures is the union of the ages of the structures. -/
@[simp]

/-- Sufficient conditions for a class to be the age of a countably-generated structure. -/
theorem exists_cg_is_age_of (hn : K.nonempty)
  (h : ∀ (M N : bundled.{w} L.Structure), nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K))
  (hc : (quotient.mk '' K).countable)
  (fg : ∀ (M : bundled.{w} L.Structure), M ∈ K → Structure.fg L M)
  (hp : hereditary K)
  (jep : joint_embedding K) :
  ∃ (M : bundled.{w} L.Structure), Structure.cg L M ∧ L.age M = K :=
begin
  obtain ⟨F, hF⟩ := hc.exists_surjective (hn.image _),
  simp only [set.ext_iff, forall_quotient_iff, mem_image, mem_range, quotient.eq] at hF,
  simp_rw [quotient.eq_mk_iff_out] at hF,
  have hF' : ∀ n : ℕ, (F n).out ∈ K,
  { intro n,
    obtain ⟨P, hP1, hP2⟩ := (hF (F n).out).2 ⟨n, setoid.refl _⟩,
    exact (h _ _ hP2).1 hP1 },
  choose P hPK hP hFP using (λ (N : K) (n : ℕ), jep N N.2 (F (n + 1)).out (hF' _)),
  let G : ℕ → K := @nat.rec (λ _, K) (⟨(F 0).out, hF' 0⟩) (λ n N, ⟨P N n, hPK N n⟩),
  let f : Π (i j), i ≤ j → G i ↪[L] G j :=
    directed_system.nat_le_rec (λ n, (hP _ n).some),
  refine ⟨bundled.of (direct_limit (λ n, G n) f), direct_limit.cg _ (λ n, (fg _ (G n).2).cg),
    (age_direct_limit _ _).trans (subset_antisymm
      (Union_subset (λ n N hN, hp (G n) (G n).2 hN)) (λ N KN, _))⟩,
  obtain ⟨n, ⟨e⟩⟩ := (hF N).1 ⟨N, KN, setoid.refl _⟩,
  refine mem_Union_of_mem n ⟨fg _ KN, ⟨embedding.comp _ e.symm.to_embedding⟩⟩,
  cases n,
  { exact embedding.refl _ _ },
  { exact (hFP _ n).some }
end

variable (K)

/-- A Fraïssé limit of a Fraïssé class, constructed as a direct limit. -/
noncomputable def fraisse_limit [h : is_fraisse K] : bundled L.Structure :=
classical.some (exists_cg_is_age_of
  h.is_nonempty
  h.is_equiv_invariant
  h.is_essentially_countable
  h.fg h.hereditary h.joint_embedding)

instance cg_fraisse_limit [h : is_fraisse K] : Structure.cg L (fraisse_limit K) :=
(classical.some_spec (exists_cg_is_age_of h.is_nonempty h.is_equiv_invariant
  h.is_essentially_countable h.fg h.hereditary h.joint_embedding)).1

theorem age_fraisse_limit [h : is_fraisse K] : L.age (fraisse_limit K) = K :=
(classical.some_spec (exists_cg_is_age_of h.is_nonempty h.is_equiv_invariant
  h.is_essentially_countable h.fg h.hereditary h.joint_embedding)).2

end language
end first_order


/-
WR Scott's Group Theory in Lean

Preliminaries

pp 1 - 5
-/

namespace introduction
open nat

definition set' (A : Type) := A → Prop
notation x ∈ S := S x

-- a set is determined by its members; that is, is S and T are sets, then S = T
-- iff(*) s ∈ S iff s ∈ T
definition is_equiv {A : Type} (S T: set A) := ∀ (x : A), x ∈ S ↔ x ∈ T
infix ` = `:55 := is_equiv

-- the number of elements in a set will be called the order of S and denoted
-- by o(S)
constant order {A : Type} (S : set A) : ℕ
notation `o(`S`)` := order S

-- A set S is a singleton iff o(S) = 1, and an n-ton iff o(S) = n
constant is_singleton {A : Type} (S : set A) : Prop
constant is_nton {A : Type} (S : set A) (n : ℕ) : Prop
axiom singleton_is_o1 {A : Type} (S : set A) : is_singleton S ↔ o(S) == 1
axiom nton_is_on {A : Type} (S : set A) (n : ℕ) : is_nton S n ↔ o(S) == n

-- A set S is a subset of a set T, written S ⊂ T, iff(*) if x ∈ X → x ∈ T
definition subset {A : Type} (S : set A) (T : set A) : Prop :=
  ∀ (a : A), a ∈ S → a ∈ T
notation S ⊂ T := subset S T

-- ordered pairs (a, b) and (c, d)
class ord_pair (A B : Type) :=
  (fst : A)
  (snd : B)

-- two order pairs (a, b) and (c, d) are equal iff(*) a = c and b = d
definition ord_pair.equal {A : Type} {B : Type} (p q : ord_pair A B) : Prop :=
  p.fst == q.fst ∧ p.snd == q.snd

-- introduce this as everything uses it
variable {A : Type}

-- its inverse R⁻¹ = {(b, a) | (a, b) ∈ R}
definition inverse (R : set (ord_pair A A)) : set (ord_pair A A) :=
  {p | (⟨p.snd, p.fst⟩ : ord_pair A A) ∈ R}
postfix `⁻¹`:100 := inverse

definition symmetric (R : set (ord_pair A A)) : Prop :=
  R = R⁻¹

-- Dom(R) = {a | ∃ b with (a, b) ∈ R}
definition domain (R : set (ord_pair A A)) : set A :=
  {p.fst | ∀ (p : (ord_pair A A)), p ∈ R}
notation `Dom(`R`)` := domain R

-- Rng(R) = Dom(R⁻¹)
definition range (R : set (ord_pair A A)) : set A :=
  Dom(R⁻¹)
notation `Rng(`R`)` := range R

-- a relation is said to be from A into B iff Dom(R) = A and Rng(R) = B
definition from_into (R : set (ord_pair A A)) (S : set A) (T : set A) : Prop :=
  Dom(R) = S ∧ Rng(R) ⊂ T

-- a relation is said to be from A onto B iff B = Rng(B)
definition from_onto (R : set (ord_pair A A)) (S : set A) (T : set A) : Prop :=
  T = Rng(R)
notation R` from `S` into `T := from_into R S T
notation R` from `S` onto `T := from_onto R S T

-- if S ⊂ Dom(R), then the restriction of R to S is the set
definition restriction (R : set (ord_pair A A)) (S : set A) : set (ord_pair A A) :=
  {p | ∀ (p: ord_pair A A), p ∈ R ∧ p.fst ∈ S}
infix ` | `:55 := restriction

-- if R and R' are relations, then their product is a relation
definition product (R S : set (ord_pair A A)) : set (ord_pair A A) :=
  {p | ∃ (b : A), (⟨p.fst, b⟩ : ord_pair A A) ∈ R ∧ (⟨b, p.snd⟩: ord_pair A A) ∈ S}
infix ` * `:55 := product

-- a relation R is transitive if RR ⊂ R
definition transitive (R : set (ord_pair A A)) : Prop :=
  R * R ⊂ R

-- If R₁, R₂, and R₃ are relations, then R₁ * (R₂ * R₃) = (R₁ * R₂ * R₃)
theorem mul_assoc (R₁ R₂ R₃ : set (ord_pair A A)) : R₁ * (R₂ * R₃) = (R₁ * R₂ * R₃) :=
begin
  intro h,
  split,
  intro p,
  rw [product, product] at p,
  cases p with p₁ p₂,
  cases p₂ with p₁₁ p₁₂,
  cases p₁₂ with p₂₁ p₂₂,
  cases p₂₂ with p₃₁ p₃₂,
  rw [product, product],
  repeat {split},
  apply p₁₁,
  apply p₃₁,
  apply p₃₂,

  intro p,
  rw [product, product] at p,
  cases p with p₁ p₂,
  cases p₂ with p₁₁ p₁₂,
  cases p₁₁ with p₂₁ p₂₂,
  cases p₂₂ with p₃₁ p₃₂,
  rw [product, product],
  repeat {split},
  apply p₃₁,
  apply p₃₂,
  apply p₁₂,
end

-- the cartesian product of two sets R and S
definition cart_product (R S : set (A)) : set (ord_pair A A) :=
  {p | p.fst ∈ R ∧ p.snd ∈ S}
infix ` × `:55 := cart_product

-- a relation R is on S iff R ⊂ S × S
definition relation_on (R : set (ord_pair A A)) (S : set A) : Prop :=
  R ⊂ S × S

-- helper construction for reflexive
definition double (S : set A) : set (ord_pair A A) :=
 {p | p.fst == p.snd ∧ p.fst ∈ S}

-- A relation R on S is reflexive iff {(a, a) | a ∈ S} ⊂ R
definition reflexive (R : set (ord_pair A A)) (S : set A) : Prop :=
  double S ⊂ R

-- An equivalence relation on S is a relation on S which is reflexive, symmetric,
-- and transitive
definition equivalence (R : set (ord_pair A A)) (S : set A) : Prop :=
  reflexive R S ∧ symmetric R ∧ transitive R

-- create an equivalence relation construction
class EquivalenceRelation (A : Type) :=
  (equiv : set (ord_pair A A)) (S : set A)
  (reflexive : reflexive equiv S)
  (symmetric : symmetric equiv)
  (transitive : transitive equiv)

definition is_equiv_on (R : set (ord_pair A A)) (S : set A) : Prop :=
  reflexive R S ∧
  symmetric R ∧
  transitive R

-- If R is an equivalence relation on S, the a subset B of S is an equivalence class
-- with respect ro R ↔ ∃ a ∈ S such that B = {b | (a, b) ∈ R}
definition equivalence_class [R : EquivalenceRelation A] (S B : set A) :=
  B ⊂ S ↔ (∃ (a : A), a ∈ S ∧ {b | (⟨a, b⟩ : ord_pair A A) ∈ R.equiv} = B)

-- less general union defined earlier (for exercises)
definition union (S T : set A) : set A :=
  {a | a ∈ S ∨ a ∈ T}
infix ` ∪ `:100 := union

-- less general intersection defined earlier (for exercises)
definition intersection (S T : set A) : set A :=
  {a | a ∈ S ∧ a ∈ T}
infix ` ∩ `:100 := intersection

definition is_function (R : set (ord_pair A A)) : Prop :=
  ∃ (a b c: A), ((⟨a, b⟩ : ord_pair A A) ∈ R ∧ (⟨a, c⟩ : ord_pair A A) ∈ R) → (b == c)

class Function (A : Type) :=
  (relation : set (ord_pair A A))
  (func_cond : is_function relation)

-- can't I just overload the notation?
notation `fDom(`R`)` := domain R.relation
notation `fRng(`R`)` := range R.relation

-- ugh this is bad
definition Function.apply (R : Function A) (a : A) : A := sorry

definition Function.equiv (A : Type) [f : Function A] [g : Function A] : Prop :=
  fDom(f) = fDom(g) ∧ ∀ a, a ∈ fDom(f) ∧ f.apply a == g.apply a

definition invertible (f : Function A) : Prop :=
  is_function(f.relation⁻¹)

lemma simple_fun (f : Function A) : is_function (f.relation) :=
begin
  rw is_function,
  apply f.func_cond,
end

-- this is incomplete
theorem prod_function (f g : Function A) : is_function (f.relation * g.relation) :=
begin
  -- i get weird stuff later on
  --let (a, d) and (a, e) ∈ fg. Then ∃ b st (a, b) ∈ f and (b, d) ∈ g
  -- and ∃ c st (a, c) ∈ f and (c, e) ∈ g. Since f and g are functions,
  -- then b = c and d = e. so fg is a function.
  sorry,
end

-- I don't know how to get lean to do this for me
lemma simp_or_member {A : Type} (S T : set A) (q : A): q ∈ {x | x ∈ S ∨ x ∈ T} ↔ q ∈ S ∨ q ∈ T :=
begin
  split,
  repeat {
    intro h,
    apply h
  },
end

lemma simp_and_member {A : Type} (S T : set A) (q : A): q ∈ {x | x ∈ S ∧ x ∈ T} ↔ q ∈ S ∧ q ∈ T :=
begin
  split,
  repeat {
    intro h,
    apply h
  },
end

section exercise
-- Exercise 1.1.4
-- show that ∪ and ∩ are commutative and associative (as binary operations)
example : ∀ (S T : set A), S ∪ T = T ∪ S :=
begin
  intros s t,
  repeat {rw union},
  intro p,
  simp [or.comm],
end

-- intersection is commutative
example : ∀ (S T : set A), S ∩ T = T ∩ S :=
begin
  intros s t,
  repeat {rw intersection},
  intro p,
  simp [and.comm],
end

-- union is associative
example : ∀ (S T U: set A), S ∪ T ∪ U = S ∪ (T ∪ U) :=
begin
  intros s t u,
  intro q,
  split,
  intro p,
  repeat {rw union at p},
  repeat {rw union},
  simp [simp_or_member],
  simp [simp_or_member] at p,
  simp [or.assoc] at p,
  apply p,

  intro p,
  repeat {rw union at p},
  repeat {rw union},
  simp [simp_or_member],
  simp [simp_or_member] at p,
  simp [or.assoc],
  apply p,
end

-- intersection is associative
example : ∀ (S T U: set A), S ∩ T ∩ U = S ∩ (T ∩ U) :=
begin
  intros s t u,
  intro q,
  split,
  intro p,
  repeat {rw intersection at p},
  repeat {rw intersection},
  simp [simp_and_member],
  simp [simp_and_member] at p,
  simp [and.assoc] at p,
  apply p,

  intro p,
  repeat {rw intersection at p},
  repeat {rw intersection},
  simp [simp_and_member],
  simp [simp_and_member] at p,
  simp [and.assoc],
  apply p,
end

-- Exercise 1.1.5
-- If A and B are sets, then A = B ↔ A ⊂ B ∧ B ⊂ A
-- we don't actually know symmetry, but we can prove it
lemma equiv_symm {A : Type} (S T: set A) : S = T ↔ T = S :=
begin
  split,
  repeat {
    intros h,
    rw is_equiv,
    rw is_equiv at h,
    intro x,
    rw h,
  },
end

example (A' B' : set A): A' = B' ↔ A' ⊂ B' ∧ B' ⊂ A' :=
begin
  split,

  intros p,
  split,
  rw subset,
  intros q r,
  rw ← equiv_symm at p,
  rw p,
  apply r,

  rw subset,
  intros q r,
  rw p,
  apply r,

  intros p,
  rw is_equiv,
  intros q,
  split,

  cases p with pl pr,
  rw subset at pl,
  rw subset at pr,
  intros r,
  apply pl,
  apply r,

  cases p with pl pr,
  rw subset at pl,
  rw subset at pr,
  intros r,
  apply pr,
  apply r,
end
end exercise

-- Exercise 1.1.6
-- TODO

-- Exercise 1.1.7
example (R : set (ord_pair A A)) (S : set A) :
  symmetric R ∧ transitive R → is_equiv_on (R ∪ {p | p.fst == p.snd ∧ p.fst ∈ S}) S :=
begin
  intro h,
  rw is_equiv_on,
  split,
  sorry,
  sorry,
end

-- Exercise 1.1.14
example (R₁ R₂ : set (ord_pair A A)) : (R₁ * R₂)⁻¹ = ((R₂⁻¹) * (R₁⁻¹)) :=
begin
  intros h,
  split,
  intros q,
  rw [product] at q,
  cases q with p q,
  cases q with q r,
  rw [product, inverse, inverse],
  repeat {split},
  apply r,
  apply q,

  intros q,
  rw [product, inverse, inverse] at q,
  cases q with p q,
  cases q with q r,
  rw [product],
  repeat {split},
  apply r,
  apply q,
end

end introduction


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

import algebra.hom.equiv.type_tags
import algebra.module.equiv
import data.finsupp.defs
import group_theory.free_abelian_group
import group_theory.is_free_group
import linear_algebra.dimension

/-!
# Isomorphism between `free_abelian_group X` and `X →₀ ℤ`

In this file we construct the canonical isomorphism between `free_abelian_group X` and `X →₀ ℤ`.
We use this to transport the notion of `support` from `finsupp` to `free_abelian_group`.

## Main declarations

- `free_abelian_group.equiv_finsupp`: group isomorphism between `free_abelian_group X` and `X →₀ ℤ`
- `free_abelian_group.coeff`: the multiplicity of `x : X` in `a : free_abelian_group X`
- `free_abelian_group.support`: the finset of `x : X` that occur in `a : free_abelian_group X`

-/

noncomputable theory

open_locale big_operators

variables {X : Type*}

/-- The group homomorphism `free_abelian_group X →+ (X →₀ ℤ)`. -/
def free_abelian_group.to_finsupp : free_abelian_group X →+ (X →₀ ℤ) :=
free_abelian_group.lift $ λ x, finsupp.single x (1 : ℤ)

/-- The group homomorphism `(X →₀ ℤ) →+ free_abelian_group X`. -/
def finsupp.to_free_abelian_group : (X →₀ ℤ) →+ free_abelian_group X :=
finsupp.lift_add_hom $ λ x, (smul_add_hom ℤ (free_abelian_group X)).flip (free_abelian_group.of x)

open finsupp free_abelian_group

@[simp] lemma finsupp.to_free_abelian_group_comp_single_add_hom (x : X) :
  finsupp.to_free_abelian_group.comp (finsupp.single_add_hom x) =
    (smul_add_hom ℤ (free_abelian_group X)).flip (of x) :=
begin
  ext,
  simp only [add_monoid_hom.coe_comp, finsupp.single_add_hom_apply, function.comp_app,
    one_smul, to_free_abelian_group, finsupp.lift_add_hom_apply_single]
end

@[simp] lemma free_abelian_group.to_finsupp_comp_to_free_abelian_group :
  to_finsupp.comp to_free_abelian_group = add_monoid_hom.id (X →₀ ℤ) :=
begin
  ext x y, simp only [add_monoid_hom.id_comp],
  rw [add_monoid_hom.comp_assoc, finsupp.to_free_abelian_group_comp_single_add_hom],
  simp only [to_finsupp, add_monoid_hom.coe_comp, finsupp.single_add_hom_apply,
    function.comp_app, one_smul, lift.of, add_monoid_hom.flip_apply,
    smul_add_hom_apply, add_monoid_hom.id_apply],
end

@[simp] lemma finsupp.to_free_abelian_group_comp_to_finsupp :
  to_free_abelian_group.comp to_finsupp = add_monoid_hom.id (free_abelian_group X) :=
begin
  ext,
  rw [to_free_abelian_group, to_finsupp, add_monoid_hom.comp_apply, lift.of,
    lift_add_hom_apply_single, add_monoid_hom.flip_apply, smul_add_hom_apply, one_smul,
    add_monoid_hom.id_apply],
end

@[simp] lemma finsupp.to_free_abelian_group_to_finsupp {X} (x : free_abelian_group X) :
  x.to_finsupp.to_free_abelian_group = x :=
by rw [← add_monoid_hom.comp_apply, finsupp.to_free_abelian_group_comp_to_finsupp,
  add_monoid_hom.id_apply]

namespace free_abelian_group
open finsupp

variable {X}

@[simp]

@[simp] lemma to_finsupp_to_free_abelian_group (f : X →₀ ℤ) :
  f.to_free_abelian_group.to_finsupp = f :=
by rw [← add_monoid_hom.comp_apply, to_finsupp_comp_to_free_abelian_group, add_monoid_hom.id_apply]

variable (X)

/-- The additive equivalence between `free_abelian_group X` and `(X →₀ ℤ)`. -/
@[simps]
def equiv_finsupp : free_abelian_group X ≃+ (X →₀ ℤ) :=
{ to_fun := to_finsupp,
  inv_fun := to_free_abelian_group,
  left_inv := to_free_abelian_group_to_finsupp,
  right_inv := to_finsupp_to_free_abelian_group,
  map_add' := to_finsupp.map_add }

/-- `A` is a basis of the ℤ-module `free_abelian_group A`. -/
noncomputable def basis (α : Type*) :
  basis α ℤ (free_abelian_group α) :=
⟨(free_abelian_group.equiv_finsupp α).to_int_linear_equiv ⟩

/-- Isomorphic free ablian groups (as modules) have equivalent bases. -/
def equiv.of_free_abelian_group_linear_equiv {α β : Type*}
  (e : free_abelian_group α ≃ₗ[ℤ] free_abelian_group β) :
  α ≃ β :=
let t : _root_.basis α ℤ (free_abelian_group β) := (free_abelian_group.basis α).map e
  in t.index_equiv $ free_abelian_group.basis _

/-- Isomorphic free abelian groups (as additive groups) have equivalent bases. -/
def equiv.of_free_abelian_group_equiv {α β : Type*}
  (e : free_abelian_group α ≃+ free_abelian_group β) :
  α ≃ β :=
equiv.of_free_abelian_group_linear_equiv e.to_int_linear_equiv

/-- Isomorphic free groups have equivalent bases. -/
def equiv.of_free_group_equiv {α β : Type*}
  (e : free_group α ≃* free_group β) :
  α ≃ β :=
equiv.of_free_abelian_group_equiv e.abelianization_congr.to_additive

open is_free_group
/-- Isomorphic free groups have equivalent bases (`is_free_group` variant`). -/
def equiv.of_is_free_group_equiv {G H : Type*}
  [group G] [group H] [is_free_group G] [is_free_group H]
  (e : G ≃* H) :
  generators G ≃ generators H :=
equiv.of_free_group_equiv $
  mul_equiv.trans ((to_free_group G).symm) $
  mul_equiv.trans e $
  to_free_group H

variable {X}

/-- `coeff x` is the additive group homomorphism `free_abelian_group X →+ ℤ`
that sends `a` to the multiplicity of `x : X` in `a`. -/
def coeff (x : X) : free_abelian_group X →+ ℤ :=
(finsupp.apply_add_hom x).comp to_finsupp

/-- `support a` for `a : free_abelian_group X` is the finite set of `x : X`
that occur in the formal sum `a`. -/
def support (a : free_abelian_group X) : finset X :=
a.to_finsupp.support

lemma mem_support_iff (x : X) (a : free_abelian_group X) :
  x ∈ a.support ↔ coeff x a ≠ 0 :=
by { rw [support, finsupp.mem_support_iff], exact iff.rfl }

lemma not_mem_support_iff (x : X) (a : free_abelian_group X) :
  x ∉ a.support ↔ coeff x a = 0 :=
by { rw [support, finsupp.not_mem_support_iff], exact iff.rfl }

@[simp] lemma support_zero : support (0 : free_abelian_group X) = ∅ :=
by simp only [support, finsupp.support_zero, add_monoid_hom.map_zero]

@[simp] lemma support_of (x : X) : support (of x) = {x} :=
by simp only [support, to_finsupp_of, finsupp.support_single_ne_zero _ one_ne_zero]

@[simp] lemma support_neg (a : free_abelian_group X) : support (-a) = support a :=
by simp only [support, add_monoid_hom.map_neg, finsupp.support_neg]

@[simp] lemma support_zsmul (k : ℤ) (h : k ≠ 0) (a : free_abelian_group X) :
  support (k • a) = support a :=
begin
  ext x,
  simp only [mem_support_iff, add_monoid_hom.map_zsmul],
  simp only [h, zsmul_int_int, false_or, ne.def, mul_eq_zero]
end

@[simp] lemma support_nsmul (k : ℕ) (h : k ≠ 0) (a : free_abelian_group X) :
  support (k • a) = support a :=
by { apply support_zsmul k _ a, exact_mod_cast h }

open_locale classical

lemma support_add (a b : free_abelian_group X) : (support (a + b)) ⊆ a.support ∪ b.support :=
begin
  simp only [support, add_monoid_hom.map_add],
  apply finsupp.support_add
end

end free_abelian_group


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.box_integral.partition.additive
import measure_theory.measure.lebesgue

/-!
# Box-additive functions defined by measures

In this file we prove a few simple facts about rectangular boxes, partitions, and measures:

- given a box `I : box ι`, its coercion to `set (ι → ℝ)` and `I.Icc` are measurable sets;
- if `μ` is a locally finite measure, then `(I : set (ι → ℝ))` and `I.Icc` have finite measure;
- if `μ` is a locally finite measure, then `λ J, (μ J).to_real` is a box additive function.

For the last statement, we both prove it as a proposition and define a bundled
`box_integral.box_additive` function.

### Tags

rectangular box, measure
-/

open set
noncomputable theory
open_locale ennreal big_operators classical box_integral

variables {ι : Type*}

namespace box_integral

open measure_theory

namespace box

lemma measure_Icc_lt_top (I : box ι) (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] :
  μ I.Icc < ∞ :=
show μ (Icc I.lower I.upper) < ∞, from I.is_compact_Icc.measure_lt_top

lemma measure_coe_lt_top (I : box ι) (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] :
  μ I < ∞ :=
(measure_mono $ coe_subset_Icc).trans_lt (I.measure_Icc_lt_top μ)

variables [fintype ι] (I : box ι)

lemma measurable_set_coe : measurable_set (I : set (ι → ℝ)) :=
begin
  rw [coe_eq_pi],
  haveI := fintype.encodable ι,
  exact measurable_set.univ_pi (λ i, measurable_set_Ioc)
end

lemma measurable_set_Icc : measurable_set I.Icc := measurable_set_Icc

lemma measurable_set_Ioo : measurable_set I.Ioo :=
(measurable_set_pi (finite.of_fintype _).countable).2 $ or.inl $ λ i hi, measurable_set_Ioo

lemma coe_ae_eq_Icc : (I : set (ι → ℝ)) =ᵐ[volume] I.Icc :=
by { rw coe_eq_pi, exact measure.univ_pi_Ioc_ae_eq_Icc }

lemma Ioo_ae_eq_Icc : I.Ioo =ᵐ[volume] I.Icc :=
measure.univ_pi_Ioo_ae_eq_Icc

end box

lemma prepartition.measure_Union_to_real [fintype ι] {I : box ι} (π : prepartition I)
  (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] :
  (μ π.Union).to_real = ∑ J in π.boxes, (μ J).to_real :=
begin
  erw [← ennreal.to_real_sum, π.Union_def, measure_bUnion_finset π.pairwise_disjoint],
  exacts [λ J hJ, J.measurable_set_coe, λ J hJ, (J.measure_coe_lt_top μ).ne]
end

end box_integral

open box_integral box_integral.box

variables [fintype ι]

namespace measure_theory

namespace measure

/-- If `μ` is a locally finite measure on `ℝⁿ`, then `λ J, (μ J).to_real` is a box-additive
function. -/
@[simps] def to_box_additive (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] :
  ι →ᵇᵃ[⊤] ℝ :=
{ to_fun := λ J, (μ J).to_real,
  sum_partition_boxes' := λ J hJ π hπ, by rw [← π.measure_Union_to_real, hπ.Union_eq] }

end measure

end measure_theory

namespace box_integral

open measure_theory

namespace box

@[simp] lemma volume_apply (I : box ι) :
  (volume : measure (ι → ℝ)).to_box_additive I = ∏ i, (I.upper i - I.lower i) :=
by rw [measure.to_box_additive_apply, coe_eq_pi, real.volume_pi_Ioc_to_real I.lower_le_upper]

lemma volume_face_mul {n} (i : fin (n + 1)) (I : box (fin (n + 1))) :
  (∏ j, ((I.face i).upper j - (I.face i).lower j)) * (I.upper i - I.lower i) =
    ∏ j, (I.upper j - I.lower j) :=
by simp only [face_lower, face_upper, (∘), fin.prod_univ_succ_above _ i, mul_comm]

end box

namespace box_additive_map

/-- Box-additive map sending each box `I` to the continuous linear endomorphism
`x ↦ (volume I).to_real • x`. -/
protected def volume {E : Type*} [normed_group E] [normed_space ℝ E] :
  ι →ᵇᵃ (E →L[ℝ] E) :=
(volume : measure (ι → ℝ)).to_box_additive.to_smul

lemma volume_apply {E : Type*} [normed_group E] [normed_space ℝ E] (I : box ι) (x : E) :
  box_additive_map.volume I x = (∏ j, (I.upper j - I.lower j)) • x :=
congr_arg2 (•) I.volume_apply rfl

end box_additive_map

end box_integral


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_214
  (a : ℝ)
  (f : ℝ → ℝ)
  (h₀ : ∀ x, f x = a * (x - 2)^2 + 3)
  (h₁ : f 4 = 4) :
  f 6 = 7 :=
begin
  revert h₁,
  simp [h₀],
  intro,
  nlinarith,
end


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Michael Stoll
-/
import number_theory.legendre_symbol.quadratic_char

/-!
# Legendre symbol and quadratic reciprocity.

This file contains results about quadratic residues modulo a prime number.

We define the Legendre symbol $\Bigl(\frac{a}{p}\Bigr)$ as `legendre_sym p a`.
Note the order of arguments! The advantage of this form is that then `legendre_sym p`
is a multiplicative map.

The Legendre symbol is used to define the Jacobi symbol, `jacobi_sym a b`, for integers `a`
and (odd) natural numbers `b`, which extends the Legendre symbol.

## Main results

We prove the law of quadratic reciprocity, see `legendre_sym.quadratic_reciprocity` and
`legendre_sym.quadratic_reciprocity'`, as well as the
interpretations in terms of existence of square roots depending on the congruence mod 4,
`zmod.exists_sq_eq_prime_iff_of_mod_four_eq_one`, and
`zmod.exists_sq_eq_prime_iff_of_mod_four_eq_three`.

We also prove the supplementary laws that give conditions for when `-1` or `2`
(or `-2`) is a square modulo a prime `p`:
`legendre_sym.at_neg_one` and `zmod.exists_sq_eq_neg_one_iff` for `-1`,
`legendre_sym.at_two` and `zmod.exists_sq_eq_two_iff` for `2`,
`legendre_sym.at_neg_two` and `zmod.exists_sq_eq_neg_two_iff` for `-2`.

## Implementation notes

The proofs use results for quadratic characters on arbitrary finite fields
from `number_theory.legendre_symbol.quadratic_char`, which in turn are based on
properties of quadratic Gauss sums as provided by `number_theory.legendre_symbol.gauss_sum`.

## Tags

quadratic residue, quadratic nonresidue, Legendre symbol, quadratic reciprocity
-/

open nat

section euler

namespace zmod

variables (p : ℕ) [fact p.prime]

/-- Euler's Criterion: A unit `x` of `zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion_units (x : (zmod p)ˣ) : (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ x ^ (p / 2) = 1 :=
begin
  by_cases hc : p = 2,
  { substI hc,
    simp only [eq_iff_true_of_subsingleton, exists_const], },
  { have h₀ := finite_field.unit_is_square_iff (by rwa ring_char_zmod_n) x,
    have hs : (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ is_square(x) :=
    by { rw is_square_iff_exists_sq x,
         simp_rw eq_comm, },
    rw hs,
    rwa card p at h₀, },
end

/-- Euler's Criterion: a nonzero `a : zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion {a : zmod p} (ha : a ≠ 0) : is_square (a : zmod p) ↔ a ^ (p / 2) = 1 :=
begin
  apply (iff_congr _ (by simp [units.ext_iff])).mp (euler_criterion_units p (units.mk0 a ha)),
  simp only [units.ext_iff, sq, units.coe_mk0, units.coe_mul],
  split, { rintro ⟨y, hy⟩, exact ⟨y, hy.symm⟩ },
  { rintro ⟨y, rfl⟩,
    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
    refine ⟨units.mk0 y hy, _⟩, simp, }
end

/-- If `a : zmod p` is nonzero, then `a^(p/2)` is either `1` or `-1`. -/
lemma pow_div_two_eq_neg_one_or_one {a : zmod p} (ha : a ≠ 0) :
  a ^ (p / 2) = 1 ∨ a ^ (p / 2) = -1 :=
begin
  cases prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, revert a ha, dec_trivial },
  rw [← mul_self_eq_one_iff, ← pow_add, ← two_mul, two_mul_odd_div_two hp_odd],
  exact pow_card_sub_one_eq_one ha
end

end zmod

end euler

section legendre

/-!
### Definition of the Legendre symbol and basic properties
-/

open zmod

variables (p : ℕ) [fact p.prime]

/-- The Legendre symbol of `a : ℤ` and a prime `p`, `legendre_sym p a`,
is an integer defined as

* `0` if `a` is `0` modulo `p`;
* `1` if `a` is a nonzero square modulo `p`
* `-1` otherwise.

Note the order of the arguments! The advantage of the order chosen here is
that `legendre_sym p` is a multiplicative function `ℤ → ℤ`.
-/
def legendre_sym (a : ℤ) : ℤ := quadratic_char (zmod p) a

namespace legendre_sym

/-- We have the congruence `legendre_sym p a ≡ a ^ (p / 2) mod p`. -/
lemma eq_pow (a : ℤ) : (legendre_sym p a : zmod p) = a ^ (p / 2) :=
begin
  cases eq_or_ne (ring_char (zmod p)) 2 with hc hc,
  { by_cases ha : (a : zmod p) = 0,
    { rw [legendre_sym, ha, quadratic_char_zero,
          zero_pow (nat.div_pos (fact.out p.prime).two_le (succ_pos 1))],
      norm_cast, },
    { have := (ring_char_zmod_n p).symm.trans hc, -- p = 2
      substI p,
      rw [legendre_sym, quadratic_char_eq_one_of_char_two hc ha],
      revert ha,
      generalize : (a : zmod 2) = b, revert b, dec_trivial } },
  { convert quadratic_char_eq_pow_of_char_ne_two' hc (a : zmod p),
    exact (card p).symm },
end

/-- If `p ∤ a`, then `legendre_sym p a` is `1` or `-1`. -/
lemma eq_one_or_neg_one {a : ℤ} (ha : (a : zmod p) ≠ 0) :
  legendre_sym p a = 1 ∨ legendre_sym p a = -1 :=
quadratic_char_dichotomy ha

lemma eq_neg_one_iff_not_one {a : ℤ} (ha : (a : zmod p) ≠ 0) :
  legendre_sym p a = -1 ↔ ¬ legendre_sym p a = 1 :=
quadratic_char_eq_neg_one_iff_not_one ha

/-- The Legendre symbol of `p` and `a` is zero iff `p ∣ a`. -/
lemma eq_zero_iff (a : ℤ) : legendre_sym p a = 0 ↔ (a : zmod p) = 0 :=
quadratic_char_eq_zero_iff

@[simp] lemma at_zero : legendre_sym p 0 = 0 :=
by rw [legendre_sym, int.cast_zero, mul_char.map_zero]

@[simp] lemma at_one : legendre_sym p 1 = 1 :=
by rw [legendre_sym, int.cast_one, mul_char.map_one]

/-- The Legendre symbol is multiplicative in `a` for `p` fixed. -/
protected
lemma mul (a b : ℤ) : legendre_sym p (a * b) = legendre_sym p a * legendre_sym p b :=
by simp only [legendre_sym, int.cast_mul, map_mul]

/-- The Legendre symbol is a homomorphism of monoids with zero. -/
@[simps] def hom : ℤ →*₀ ℤ :=
{ to_fun := legendre_sym p,
  map_zero' := at_zero p,
  map_one' := at_one p,
  map_mul' := legendre_sym.mul p }

/-- The square of the symbol is 1 if `p ∤ a`. -/
theorem sq_one {a : ℤ} (ha : (a : zmod p) ≠ 0) : (legendre_sym p a) ^ 2 = 1 :=
quadratic_char_sq_one ha

/-- The Legendre symbol of `a^2` at `p` is 1 if `p ∤ a`. -/
theorem sq_one' {a : ℤ} (ha : (a : zmod p) ≠ 0) : legendre_sym p (a ^ 2) = 1 :=
by exact_mod_cast quadratic_char_sq_one' ha

/-- The Legendre symbol depends only on `a` mod `p`. -/
protected
theorem mod (a : ℤ) : legendre_sym p a = legendre_sym p (a % p) :=
by simp only [legendre_sym, int_cast_mod]

/-- When `p ∤ a`, then `legendre_sym p a = 1` iff `a` is a square mod `p`. -/
lemma eq_one_iff {a : ℤ} (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym p a = 1 ↔ is_square (a : zmod p) :=
quadratic_char_one_iff_is_square ha0

lemma eq_one_iff' {a : ℕ} (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym p a = 1 ↔ is_square (a : zmod p) :=
by {rw eq_one_iff, norm_cast, exact_mod_cast ha0}

/-- `legendre_sym p a = -1` iff `a` is a nonsquare mod `p`. -/
lemma eq_neg_one_iff {a : ℤ} : legendre_sym p a = -1 ↔ ¬ is_square (a : zmod p) :=
quadratic_char_neg_one_iff_not_is_square

lemma eq_neg_one_iff' {a : ℕ} : legendre_sym p a = -1 ↔ ¬ is_square (a : zmod p) :=
by {rw eq_neg_one_iff, norm_cast}

/-- The number of square roots of `a` modulo `p` is determined by the Legendre symbol. -/
lemma card_sqrts (hp : p ≠ 2) (a : ℤ) :
  ↑{x : zmod p | x^2 = a}.to_finset.card = legendre_sym p a + 1 :=
quadratic_char_card_sqrts ((ring_char_zmod_n p).substr hp) a

end legendre_sym

end legendre

section values

/-!
### The value of the Legendre symbol at `-1`

See `jacobi_sym.at_neg_one` for the corresponding statement for the Jacobi symbol.
-/

variables {p : ℕ} [fact p.prime]

open zmod

/-- `legendre_sym p (-1)` is given by `χ₄ p`. -/
lemma legendre_sym.at_neg_one (hp : p ≠ 2) : legendre_sym p (-1) = χ₄ p :=
by simp only [legendre_sym, card p, quadratic_char_neg_one ((ring_char_zmod_n p).substr hp),
              int.cast_neg, int.cast_one]

namespace zmod

/-- `-1` is a square in `zmod p` iff `p` is not congruent to `3` mod `4`. -/
lemma exists_sq_eq_neg_one_iff : is_square (-1 : zmod p) ↔ p % 4 ≠ 3 :=
by rw [finite_field.is_square_neg_one_iff, card p]

lemma mod_four_ne_three_of_sq_eq_neg_one {y : zmod p} (hy : y ^ 2 = -1) : p % 4 ≠ 3 :=
exists_sq_eq_neg_one_iff.1 ⟨y, hy ▸ pow_two y⟩

/-- If two nonzero squares are negatives of each other in `zmod p`, then `p % 4 ≠ 3`. -/
lemma mod_four_ne_three_of_sq_eq_neg_sq' {x y : zmod p} (hy : y ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
  p % 4 ≠ 3 :=
@mod_four_ne_three_of_sq_eq_neg_one p _ (x / y) begin
  apply_fun (λ z, z / y ^ 2) at hxy,
  rwa [neg_div, ←div_pow, ←div_pow, div_self hy, one_pow] at hxy
end

lemma mod_four_ne_three_of_sq_eq_neg_sq {x y : zmod p} (hx : x ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
  p % 4 ≠ 3 :=
mod_four_ne_three_of_sq_eq_neg_sq' hx (neg_eq_iff_eq_neg.mpr hxy).symm

end zmod

/-!
### The value of the Legendre symbol at `2` and `-2`

See `jacobi_sym.at_two` and `jacobi_sym.at_neg_two` for the corresponding statements
for the Jacobi symbol.
-/

namespace legendre_sym

variables (hp : p ≠ 2)
include hp

/-- `legendre_sym p 2` is given by `χ₈ p`. -/
lemma at_two : legendre_sym p 2 = χ₈ p :=
by simp only [legendre_sym, card p, quadratic_char_two ((ring_char_zmod_n p).substr hp),
              int.cast_bit0, int.cast_one]

/-- `legendre_sym p (-2)` is given by `χ₈' p`. -/
lemma at_neg_two : legendre_sym p (-2) = χ₈' p :=
by simp only [legendre_sym, card p, quadratic_char_neg_two ((ring_char_zmod_n p).substr hp),
              int.cast_bit0, int.cast_one, int.cast_neg]

end legendre_sym

namespace zmod

variables (hp : p ≠ 2)
include hp

/-- `2` is a square modulo an odd prime `p` iff `p` is congruent to `1` or `7` mod `8`. -/
lemma exists_sq_eq_two_iff : is_square (2 : zmod p) ↔ p % 8 = 1 ∨ p % 8 = 7 :=
begin
  rw [finite_field.is_square_two_iff, card p],
  have h₁ := prime.mod_two_eq_one_iff_ne_two.mpr hp,
  rw [← mod_mod_of_dvd p (by norm_num : 2 ∣ 8)] at h₁,
  have h₂ := mod_lt p (by norm_num : 0 < 8),
  revert h₂ h₁,
  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
  dec_trivial!,
end

/-- `-2` is a square modulo an odd prime `p` iff `p` is congruent to `1` or `3` mod `8`. -/
lemma exists_sq_eq_neg_two_iff : is_square (-2 : zmod p) ↔ p % 8 = 1 ∨ p % 8 = 3 :=
begin
  rw [finite_field.is_square_neg_two_iff, card p],
  have h₁ := prime.mod_two_eq_one_iff_ne_two.mpr hp,
  rw [← mod_mod_of_dvd p (by norm_num : 2 ∣ 8)] at h₁,
  have h₂ := mod_lt p (by norm_num : 0 < 8),
  revert h₂ h₁,
  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
  dec_trivial!,
end

end zmod

end values

section reciprocity

/-!
### The Law of Quadratic Reciprocity

See `jacobi_sym.quadratic_reciprocity` and variants for a version of Quadratic Reciprocity
for the Jacobi symbol.
-/

variables {p q : ℕ} [fact p.prime] [fact q.prime]

namespace legendre_sym

open zmod

/-- The Law of Quadratic Reciprocity: if `p` and `q` are distinct odd primes, then
`(q / p) * (p / q) = (-1)^((p-1)(q-1)/4)`. -/

/-- The Law of Quadratic Reciprocity: if `p` and `q` are odd primes, then
`(q / p) = (-1)^((p-1)(q-1)/4) * (p / q)`. -/
theorem quadratic_reciprocity' (hp : p ≠ 2) (hq : q ≠ 2) :
  legendre_sym q p = (-1) ^ ((p / 2) * (q / 2)) * legendre_sym p q :=
begin
  cases eq_or_ne p q with h h,
  { substI p,
    rw [(eq_zero_iff q q).mpr (by exact_mod_cast nat_cast_self q), mul_zero] },
  { have qr := congr_arg (* legendre_sym p q) (quadratic_reciprocity hp hq h),
    have : ((q : ℤ) : zmod p) ≠ 0 := by exact_mod_cast prime_ne_zero p q h,
    simpa only [mul_assoc, ← pow_two, sq_one p this, mul_one] using qr }
end

/-- The Law of Quadratic Reciprocity: if `p` and `q` are odd primes and `p % 4 = 1`,
then `(q / p) = (p / q)`. -/
theorem quadratic_reciprocity_one_mod_four (hp : p % 4 = 1) (hq : q ≠ 2) :
  legendre_sym q p = legendre_sym p q :=
by rw [quadratic_reciprocity' (prime.mod_two_eq_one_iff_ne_two.mp
                                             (odd_of_mod_four_eq_one hp)) hq,
       pow_mul, neg_one_pow_div_two_of_one_mod_four hp, one_pow, one_mul]

/-- The Law of Quadratic Reciprocity: if `p` and `q` are primes that are both congruent
to `3` mod `4`, then `(q / p) = -(p / q)`. -/
theorem quadratic_reciprocity_three_mod_four (hp : p % 4 = 3) (hq : q % 4 = 3):
  legendre_sym q p = -legendre_sym p q :=
let nop := @neg_one_pow_div_two_of_three_mod_four in begin
  rw [quadratic_reciprocity', pow_mul, nop hp, nop hq, neg_one_mul];
  rwa [← prime.mod_two_eq_one_iff_ne_two, odd_of_mod_four_eq_three],
end

end legendre_sym

namespace zmod

open legendre_sym

/-- If `p` and `q` are odd primes and `p % 4 = 1`, then `q` is a square mod `p` iff
`p` is a square mod `q`. -/
lemma exists_sq_eq_prime_iff_of_mod_four_eq_one (hp1 : p % 4 = 1) (hq1 : q ≠ 2) :
  is_square (q : zmod p) ↔ is_square (p : zmod q) :=
begin
  cases eq_or_ne p q with h h,
  { substI p },
  { rw [← eq_one_iff' p (prime_ne_zero p q h), ← eq_one_iff' q (prime_ne_zero q p h.symm),
        quadratic_reciprocity_one_mod_four hp1 hq1], }
end

/-- If `p` and `q` are distinct primes that are both congruent to `3` mod `4`, then `q` is
a square mod `p` iff `p` is a nonsquare mod `q`. -/
lemma exists_sq_eq_prime_iff_of_mod_four_eq_three (hp3 : p % 4 = 3) (hq3 : q % 4 = 3)
  (hpq : p ≠ q) :
  is_square (q : zmod p) ↔ ¬ is_square (p : zmod q) :=
by rw [← eq_one_iff' p (prime_ne_zero p q hpq), ← eq_neg_one_iff' q,
       quadratic_reciprocity_three_mod_four hp3 hq3, neg_inj]

end zmod

end reciprocity


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

! This file was ported from Lean 3 source module number_theory.zeta_values
! leanprover-community/mathlib commit 8cce17e5783303db93df6810de9d85dd0f9e402a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.BernoulliPolynomials
import Mathbin.Analysis.SpecialFunctions.Integrals
import Mathbin.MeasureTheory.Integral.IntervalIntegral
import Mathbin.Analysis.Fourier.AddCircle
import Mathbin.Analysis.PSeries

/-!
# Critical values of the Riemann zeta function

In this file we prove formulae for the critical values of `ζ(s)`, and more generally of Hurwitz
zeta functions, in terms of Bernoulli polynomials.

## Main results:

* `has_sum_zeta_nat`: the final formula for zeta values,
  $$\zeta(2k) = \frac{(-1)^{(k + 1)} 2 ^ {2k - 1} \pi^{2k} B_{2 k}}{(2 k)!}.$$
* `has_sum_zeta_two` and `has_sum_zeta_four`: special cases given explicitly.
* `has_sum_one_div_nat_pow_mul_cos`: a formula for the sum `∑ (n : ℕ), cos (2 π i n x) / n ^ k` as
  an explicit multiple of `Bₖ(x)`, for any `x ∈ [0, 1]` and `k ≥ 2` even.
* `has_sum_one_div_nat_pow_mul_sin`: a formula for the sum `∑ (n : ℕ), sin (2 π i n x) / n ^ k` as
  an explicit multiple of `Bₖ(x)`, for any `x ∈ [0, 1]` and `k ≥ 3` odd.
-/

noncomputable section

open Nat Real Interval

open Complex MeasureTheory Set intervalIntegral

-- mathport name: expr𝕌
local notation "𝕌" => UnitAddCircle

attribute [local instance] Real.fact_zero_lt_one

section BernoulliFunProps

/-! Simple properties of the Bernoulli polynomial, as a function `ℝ → ℝ`. -/

/-- The function `x ↦ Bₖ(x) : ℝ → ℝ`. -/
def bernoulliFun (k : ℕ) (x : ℝ) : ℝ :=
  (Polynomial.map (algebraMap ℚ ℝ) (Polynomial.bernoulli k)).eval x
#align bernoulli_fun bernoulliFun

theorem bernoulliFun_eval_zero (k : ℕ) : bernoulliFun k 0 = bernoulli k := by
  rw [bernoulliFun, Polynomial.eval_zero_map, Polynomial.bernoulli_eval_zero, eq_ratCast]
#align bernoulli_fun_eval_zero bernoulliFun_eval_zero

theorem bernoulliFun_endpoints_eq_of_ne_one {k : ℕ} (hk : k ≠ 1) :
    bernoulliFun k 1 = bernoulliFun k 0 := by
  rw [bernoulliFun_eval_zero, bernoulliFun, Polynomial.eval_one_map, Polynomial.bernoulli_eval_one,
    bernoulli_eq_bernoulli'_of_ne_one hk, eq_ratCast]
#align bernoulli_fun_endpoints_eq_of_ne_one bernoulliFun_endpoints_eq_of_ne_one

theorem bernoulliFun_eval_one (k : ℕ) : bernoulliFun k 1 = bernoulliFun k 0 + ite (k = 1) 1 0 :=
  by
  rw [bernoulliFun, bernoulliFun_eval_zero, Polynomial.eval_one_map, Polynomial.bernoulli_eval_one]
  split_ifs
  · rw [h, bernoulli_one, bernoulli'_one, eq_ratCast]
    push_cast
    ring
  · rw [bernoulli_eq_bernoulli'_of_ne_one h, add_zero, eq_ratCast]
#align bernoulli_fun_eval_one bernoulliFun_eval_one

theorem hasDerivAt_bernoulliFun (k : ℕ) (x : ℝ) :
    HasDerivAt (bernoulliFun k) (k * bernoulliFun (k - 1) x) x :=
  by
  convert((Polynomial.bernoulli k).map <| algebraMap ℚ ℝ).HasDerivAt x using 1
  simp only [bernoulliFun, Polynomial.derivative_map, Polynomial.derivative_bernoulli k,
    Polynomial.map_mul, Polynomial.map_nat_cast, Polynomial.eval_mul, Polynomial.eval_nat_cast]
#align has_deriv_at_bernoulli_fun hasDerivAt_bernoulliFun

theorem antideriv_bernoulliFun (k : ℕ) (x : ℝ) :
    HasDerivAt (fun x => bernoulliFun (k + 1) x / (k + 1)) (bernoulliFun k x) x :=
  by
  convert(hasDerivAt_bernoulliFun (k + 1) x).div_const _
  field_simp [Nat.cast_add_one_ne_zero k]
  ring
#align antideriv_bernoulli_fun antideriv_bernoulliFun

theorem integral_bernoulliFun_eq_zero {k : ℕ} (hk : k ≠ 0) :
    (∫ x : ℝ in 0 ..1, bernoulliFun k x) = 0 :=
  by
  rw [integral_eq_sub_of_has_deriv_at (fun x hx => antideriv_bernoulliFun k x)
      ((Polynomial.continuous _).IntervalIntegrable _ _)]
  dsimp only
  rw [bernoulliFun_eval_one]
  split_ifs
  · exfalso
    exact hk (nat.succ_inj'.mp h); · simp
#align integral_bernoulli_fun_eq_zero integral_bernoulliFun_eq_zero

end BernoulliFunProps

section BernoulliFourierCoeffs

/-! Compute the Fourier coefficients of the Bernoulli functions via integration by parts. -/

/-- The `n`-th Fourier coefficient of the `k`-th Bernoulli function on the interval `[0, 1]`. -/
def bernoulliFourierCoeff (k : ℕ) (n : ℤ) : ℂ :=
  fourierCoeffOn zero_lt_one (fun x => bernoulliFun k x) n
#align bernoulli_fourier_coeff bernoulliFourierCoeff

/-- Recurrence relation (in `k`) for the `n`-th Fourier coefficient of `Bₖ`. -/
theorem bernoulliFourierCoeff_recurrence (k : ℕ) {n : ℤ} (hn : n ≠ 0) :
    bernoulliFourierCoeff k n =
      1 / (-2 * π * I * n) * (ite (k = 1) 1 0 - k * bernoulliFourierCoeff (k - 1) n) :=
  by
  unfold bernoulliFourierCoeff
  rw [fourierCoeffOn_of_hasDerivAt zero_lt_one hn
      (fun x hx => (hasDerivAt_bernoulliFun k x).of_real_comp)
      ((continuous_of_real.comp <|
            continuous_const.mul <| Polynomial.continuous _).IntervalIntegrable
        _ _)]
  dsimp only
  simp_rw [of_real_one, of_real_zero, sub_zero, one_mul]
  rw [QuotientAddGroup.mk_zero, fourier_eval_zero, one_mul, ← of_real_sub, bernoulliFun_eval_one,
    add_sub_cancel']
  congr 2
  · split_ifs
    all_goals simp only [of_real_one, of_real_zero, one_mul]
  · simp_rw [of_real_mul, of_real_nat_cast, fourierCoeffOn.const_mul]
#align bernoulli_fourier_coeff_recurrence bernoulliFourierCoeff_recurrence

/-- The Fourier coefficients of `B₀(x) = 1`. -/
theorem bernoulli_zero_fourier_coeff {n : ℤ} (hn : n ≠ 0) : bernoulliFourierCoeff 0 n = 0 := by
  simpa using bernoulliFourierCoeff_recurrence 0 hn
#align bernoulli_zero_fourier_coeff bernoulli_zero_fourier_coeff

/-- The `0`-th Fourier coefficient of `Bₖ(x)`. -/
theorem bernoulliFourierCoeff_zero {k : ℕ} (hk : k ≠ 0) : bernoulliFourierCoeff k 0 = 0 := by
  simp_rw [bernoulliFourierCoeff, fourierCoeffOn_eq_integral, neg_zero, fourier_zero, sub_zero,
    div_one, one_smul, intervalIntegral.integral_of_real, integral_bernoulliFun_eq_zero hk,
    of_real_zero]
#align bernoulli_fourier_coeff_zero bernoulliFourierCoeff_zero

theorem bernoulliFourierCoeff_eq {k : ℕ} (hk : k ≠ 0) (n : ℤ) :
    bernoulliFourierCoeff k n = -k ! / (2 * π * I * n) ^ k :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  ·
    rw [bernoulliFourierCoeff_zero hk, Int.cast_zero, MulZeroClass.mul_zero, zero_pow' _ hk,
      div_zero]
  refine' Nat.le_induction _ (fun k hk h'k => _) k (nat.one_le_iff_ne_zero.mpr hk)
  · rw [bernoulliFourierCoeff_recurrence 1 hn]
    simp only [Nat.cast_one, tsub_self, neg_mul, one_mul, eq_self_iff_true, if_true,
      Nat.factorial_one, pow_one, inv_I, mul_neg]
    rw [bernoulli_zero_fourier_coeff hn, sub_zero, mul_one, div_neg, neg_div]
  · rw [bernoulliFourierCoeff_recurrence (k + 1) hn, Nat.add_sub_cancel k 1]
    split_ifs
    · exfalso
      exact (ne_of_gt (nat.lt_succ_iff.mpr hk)) h
    · rw [h'k, Nat.factorial_succ, zero_sub, Nat.cast_mul, pow_add, pow_one, neg_div, mul_neg,
        mul_neg, mul_neg, neg_neg, neg_mul, neg_mul, neg_mul, div_neg]
      field_simp [int.cast_ne_zero.mpr hn, I_ne_zero]
      ring_nf
#align bernoulli_fourier_coeff_eq bernoulliFourierCoeff_eq

end BernoulliFourierCoeffs

section BernoulliPeriodized

/-! In this section we use the above evaluations of the Fourier coefficients of Bernoulli
polynomials, together with the theorem `has_pointwise_sum_fourier_series_of_summable` from Fourier
theory, to obtain an explicit formula for `∑ (n:ℤ), 1 / n ^ k * fourier n x`. -/

/-- The Bernoulli polynomial, extended from `[0, 1)` to the unit circle. -/
def periodizedBernoulli (k : ℕ) : 𝕌 → ℝ :=
  AddCircle.liftIco 1 0 (bernoulliFun k)
#align periodized_bernoulli periodizedBernoulli

theorem periodizedBernoulli.continuous {k : ℕ} (hk : k ≠ 1) : Continuous (periodizedBernoulli k) :=
  AddCircle.liftIco_zero_continuous
    (by exact_mod_cast (bernoulliFun_endpoints_eq_of_ne_one hk).symm)
    (Polynomial.continuous _).ContinuousOn
#align periodized_bernoulli.continuous periodizedBernoulli.continuous

theorem fourierCoeff_bernoulli_eq {k : ℕ} (hk : k ≠ 0) (n : ℤ) :
    fourierCoeff (coe ∘ periodizedBernoulli k : 𝕌 → ℂ) n = -k ! / (2 * π * I * n) ^ k :=
  by
  have : (coe ∘ periodizedBernoulli k : 𝕌 → ℂ) = AddCircle.liftIco 1 0 (coe ∘ bernoulliFun k) :=
    by
    ext1 x
    rfl
  rw [this, fourierCoeff_liftIco_eq]
  simpa only [zero_add] using bernoulliFourierCoeff_eq hk n
#align fourier_coeff_bernoulli_eq fourierCoeff_bernoulli_eq

theorem summable_bernoulli_fourier {k : ℕ} (hk : 2 ≤ k) :
    Summable (fun n => -k ! / (2 * π * I * n) ^ k : ℤ → ℂ) :=
  by
  have : ∀ n : ℤ, -(k ! : ℂ) / (2 * π * I * n) ^ k = -k ! / (2 * π * I) ^ k * (1 / n ^ k) :=
    by
    intro n
    rw [mul_one_div, div_div, ← mul_pow]
  simp_rw [this]
  apply Summable.mul_left
  rw [← summable_norm_iff]
  have : (fun x : ℤ => ‖1 / (x : ℂ) ^ k‖) = fun x : ℤ => |1 / (x : ℝ) ^ k| :=
    by
    ext1 x
    rw [norm_eq_abs, ← Complex.abs_ofReal]
    congr 1
    norm_cast
  simp_rw [this]
  rw [summable_abs_iff]
  exact real.summable_one_div_int_pow.mpr (one_lt_two.trans_le hk)
#align summable_bernoulli_fourier summable_bernoulli_fourier

theorem hasSum_one_div_pow_mul_fourier_mul_bernoulliFun {k : ℕ} (hk : 2 ≤ k) {x : ℝ}
    (hx : x ∈ Icc (0 : ℝ) 1) :
    HasSum (fun n : ℤ => 1 / (n : ℂ) ^ k * fourier n (x : 𝕌))
      (-(2 * π * I) ^ k / k ! * bernoulliFun k x) :=
  by
  -- first show it suffices to prove result for `Ico 0 1`
  suffices ∀ {y : ℝ}, y ∈ Ico (0 : ℝ) 1 → HasSum _ _
    by
    rw [← Ico_insert_right (zero_le_one' ℝ), mem_insert_iff, or_comm] at hx
    rcases hx with (hx | rfl)
    · exact this hx
    · convert this (left_mem_Ico.mpr zero_lt_one) using 1
      · rw [AddCircle.coe_period, QuotientAddGroup.mk_zero]
      · rw [bernoulliFun_endpoints_eq_of_ne_one (by linarith : k ≠ 1)]
  intro y hy
  let B : C(𝕌, ℂ) :=
    ContinuousMap.mk (coe ∘ periodizedBernoulli k)
      (continuous_of_real.comp (periodizedBernoulli.continuous (by linarith)))
  have step1 : ∀ n : ℤ, fourierCoeff B n = -k ! / (2 * π * I * n) ^ k :=
    by
    rw [ContinuousMap.coe_mk]
    exact fourierCoeff_bernoulli_eq (by linarith : k ≠ 0)
  have step2 :=
    has_pointwise_sum_fourier_series_of_summable
      ((summable_bernoulli_fourier hk).congr fun n => (step1 n).symm) y
  simp_rw [step1] at step2
  convert step2.mul_left (-(2 * ↑π * I) ^ k / (k ! : ℂ)) using 2
  ext1 n
  rw [smul_eq_mul, ← mul_assoc, mul_div, mul_neg, div_mul_cancel, neg_neg, mul_pow _ ↑n, ← div_div,
    div_self]
  · rw [Ne.def, pow_eq_zero_iff', not_and_or]
    exact Or.inl two_pi_I_ne_zero
  · exact nat.cast_ne_zero.mpr (Nat.factorial_ne_zero _)
  ·
    rw [ContinuousMap.coe_mk, Function.comp_apply, of_real_inj, periodizedBernoulli,
      AddCircle.liftIco_coe_apply (by rwa [zero_add])]
#align has_sum_one_div_pow_mul_fourier_mul_bernoulli_fun hasSum_one_div_pow_mul_fourier_mul_bernoulliFun

end BernoulliPeriodized

section Cleanup

-- This section is just reformulating the results in a nicer form.
theorem hasSum_one_div_nat_pow_mul_fourier {k : ℕ} (hk : 2 ≤ k) {x : ℝ} (hx : x ∈ Icc (0 : ℝ) 1) :
    HasSum (fun n : ℕ => 1 / (n : ℂ) ^ k * (fourier n (x : 𝕌) + (-1) ^ k * fourier (-n) (x : 𝕌)))
      (-(2 * π * I) ^ k / k ! * bernoulliFun k x) :=
  by
  convert(hasSum_one_div_pow_mul_fourier_mul_bernoulliFun hk hx).sum_nat_of_sum_int
  · ext1 n
    rw [Int.cast_neg, mul_add, ← mul_assoc]
    conv_rhs => rw [neg_eq_neg_one_mul, mul_pow, ← div_div]
    congr 2
    rw [div_mul_eq_mul_div₀, one_mul]
    congr 1
    rw [eq_div_iff, ← mul_pow, ← neg_eq_neg_one_mul, neg_neg, one_pow]
    apply pow_ne_zero
    rw [neg_ne_zero]
    exact one_ne_zero
  · rw [Int.cast_zero, zero_pow (by linarith : 0 < k), div_zero, MulZeroClass.zero_mul, add_zero]
#align has_sum_one_div_nat_pow_mul_fourier hasSum_one_div_nat_pow_mul_fourier

theorem hasSum_one_div_nat_pow_mul_cos {k : ℕ} (hk : k ≠ 0) {x : ℝ} (hx : x ∈ Icc (0 : ℝ) 1) :
    HasSum (fun n : ℕ => 1 / (n : ℝ) ^ (2 * k) * Real.cos (2 * π * n * x))
      ((-1) ^ (k + 1) * (2 * π) ^ (2 * k) / 2 / (2 * k)! *
        (Polynomial.map (algebraMap ℚ ℝ) (Polynomial.bernoulli (2 * k))).eval x) :=
  by
  have :
    HasSum (fun n : ℕ => 1 / (n : ℂ) ^ (2 * k) * (fourier n (x : 𝕌) + fourier (-n) (x : 𝕌)))
      ((-1) ^ (k + 1) * (2 * π) ^ (2 * k) / (2 * k)! * bernoulliFun (2 * k) x) :=
    by
    convert hasSum_one_div_nat_pow_mul_fourier
        (by linarith [nat.one_le_iff_ne_zero.mpr hk] : 2 ≤ 2 * k) hx
    · ext1 n
      rw [pow_mul (-1 : ℂ), neg_one_sq, one_pow, one_mul]
    · rw [pow_add, pow_one]
      conv_rhs =>
        rw [mul_pow]
        congr
        congr
        skip
        rw [pow_mul, I_sq]
      ring
  convert((has_sum_iff _ _).mp (this.div_const 2)).1
  · ext1 n
    convert(of_real_re _).symm
    rw [of_real_mul]
    rw [← mul_div]
    congr
    · rw [of_real_div, of_real_one, of_real_pow]
      rfl
    · rw [of_real_cos, of_real_mul, fourier_coe_apply, fourier_coe_apply, cos, of_real_one, div_one,
        div_one, of_real_mul, of_real_mul, of_real_bit0, of_real_one, Int.cast_neg, Int.cast_ofNat,
        of_real_nat_cast]
      congr 3
      · ring
      · ring
  · convert(of_real_re _).symm
    rw [of_real_mul, of_real_div, of_real_div, of_real_mul, of_real_pow, of_real_pow, of_real_neg,
      of_real_nat_cast, of_real_mul, of_real_bit0, of_real_one]
    ring
#align has_sum_one_div_nat_pow_mul_cos hasSum_one_div_nat_pow_mul_cos

theorem hasSum_one_div_nat_pow_mul_sin {k : ℕ} (hk : k ≠ 0) {x : ℝ} (hx : x ∈ Icc (0 : ℝ) 1) :
    HasSum (fun n : ℕ => 1 / (n : ℝ) ^ (2 * k + 1) * Real.sin (2 * π * n * x))
      ((-1) ^ (k + 1) * (2 * π) ^ (2 * k + 1) / 2 / (2 * k + 1)! *
        (Polynomial.map (algebraMap ℚ ℝ) (Polynomial.bernoulli (2 * k + 1))).eval x) :=
  by
  have :
    HasSum (fun n : ℕ => 1 / (n : ℂ) ^ (2 * k + 1) * (fourier n (x : 𝕌) - fourier (-n) (x : 𝕌)))
      ((-1) ^ (k + 1) * I * (2 * π) ^ (2 * k + 1) / (2 * k + 1)! * bernoulliFun (2 * k + 1) x) :=
    by
    convert hasSum_one_div_nat_pow_mul_fourier
        (by linarith [nat.one_le_iff_ne_zero.mpr hk] : 2 ≤ 2 * k + 1) hx
    · ext1 n
      rw [pow_add (-1 : ℂ), pow_mul (-1 : ℂ), neg_one_sq, one_pow, one_mul, pow_one, ←
        neg_eq_neg_one_mul, ← sub_eq_add_neg]
    · rw [pow_add, pow_one]
      conv_rhs =>
        rw [mul_pow]
        congr
        congr
        skip
        rw [pow_add, pow_one, pow_mul, I_sq]
      ring
  convert((has_sum_iff _ _).mp (this.div_const (2 * I))).1
  · ext1 n
    convert(of_real_re _).symm
    rw [of_real_mul]
    rw [← mul_div]
    congr
    · rw [of_real_div, of_real_one, of_real_pow]
      rfl
    · rw [of_real_sin, of_real_mul, fourier_coe_apply, fourier_coe_apply, sin, of_real_one, div_one,
        div_one, of_real_mul, of_real_mul, of_real_bit0, of_real_one, Int.cast_neg, Int.cast_ofNat,
        of_real_nat_cast, ← div_div, div_I, div_mul_eq_mul_div₀, ← neg_div, ← neg_mul, neg_sub]
      congr 4
      · ring
      · ring
  · convert(of_real_re _).symm
    rw [of_real_mul, of_real_div, of_real_div, of_real_mul, of_real_pow, of_real_pow, of_real_neg,
      of_real_nat_cast, of_real_mul, of_real_bit0, of_real_one, ← div_div, div_I,
      div_mul_eq_mul_div₀]
    have : ∀ α β γ δ : ℂ, α * I * β / γ * δ * I = I ^ 2 * α * β / γ * δ :=
      by
      intros
      ring
    rw [this, I_sq]
    ring
#align has_sum_one_div_nat_pow_mul_sin hasSum_one_div_nat_pow_mul_sin

theorem hasSum_zeta_nat {k : ℕ} (hk : k ≠ 0) :
    HasSum (fun n : ℕ => 1 / (n : ℝ) ^ (2 * k))
      ((-1) ^ (k + 1) * 2 ^ (2 * k - 1) * π ^ (2 * k) * bernoulli (2 * k) / (2 * k)!) :=
  by
  convert hasSum_one_div_nat_pow_mul_cos hk (left_mem_Icc.mpr zero_le_one)
  · ext1 n
    rw [MulZeroClass.mul_zero, Real.cos_zero, mul_one]
  rw [Polynomial.eval_zero_map, Polynomial.bernoulli_eval_zero, eq_ratCast]
  have : (2 : ℝ) ^ (2 * k - 1) = (2 : ℝ) ^ (2 * k) / 2 :=
    by
    rw [eq_div_iff (two_ne_zero' ℝ)]
    conv_lhs =>
      congr
      skip
      rw [← pow_one (2 : ℝ)]
    rw [← pow_add, Nat.sub_add_cancel]
    linarith [nat.one_le_iff_ne_zero.mpr hk]
  rw [this, mul_pow]
  ring
#align has_sum_zeta_nat hasSum_zeta_nat

end Cleanup

section Examples

theorem hasSum_zeta_two : HasSum (fun n : ℕ => 1 / (n : ℝ) ^ 2) (π ^ 2 / 6) :=
  by
  convert hasSum_zeta_nat one_ne_zero using 1; rw [mul_one]
  rw [bernoulli_eq_bernoulli'_of_ne_one (by decide : 2 ≠ 1), bernoulli'_two]
  norm_num; field_simp; ring
#align has_sum_zeta_two hasSum_zeta_two

theorem hasSum_zeta_four : HasSum (fun n : ℕ => 1 / (n : ℝ) ^ 4) (π ^ 4 / 90) :=
  by
  convert hasSum_zeta_nat two_ne_zero using 1; norm_num
  rw [bernoulli_eq_bernoulli'_of_ne_one, bernoulli'_four]
  norm_num; field_simp; ring; decide
#align has_sum_zeta_four hasSum_zeta_four

theorem Polynomial.bernoulli_three_eval_one_quarter :
    (Polynomial.bernoulli 3).eval (1 / 4) = 3 / 64 :=
  by
  simp_rw [Polynomial.bernoulli, Finset.sum_range_succ, Polynomial.eval_add,
    Polynomial.eval_monomial]
  rw [Finset.sum_range_zero, Polynomial.eval_zero, zero_add, bernoulli_one]
  rw [bernoulli_eq_bernoulli'_of_ne_one zero_ne_one, bernoulli'_zero,
    bernoulli_eq_bernoulli'_of_ne_one (by decide : 2 ≠ 1), bernoulli'_two,
    bernoulli_eq_bernoulli'_of_ne_one (by decide : 3 ≠ 1), bernoulli'_three]
  norm_num
#align polynomial.bernoulli_three_eval_one_quarter Polynomial.bernoulli_three_eval_one_quarter

/-- Explicit formula for `L(χ, 3)`, where `χ` is the unique nontrivial Dirichlet character modulo 4.
-/
theorem hasSum_L_function_mod_four_eval_three :
    HasSum (fun n : ℕ => 1 / (n : ℝ) ^ 3 * Real.sin (π * n / 2)) (π ^ 3 / 32) :=
  by
  convert hasSum_one_div_nat_pow_mul_sin one_ne_zero (_ : 1 / 4 ∈ Icc (0 : ℝ) 1)
  · ext1 n
    norm_num
    left
    congr 1
    ring
  · have : (1 / 4 : ℝ) = (algebraMap ℚ ℝ) (1 / 4 : ℚ) := by norm_num
    rw [this, mul_pow, Polynomial.eval_map, Polynomial.eval₂_at_apply, (by decide : 2 * 1 + 1 = 3),
      Polynomial.bernoulli_three_eval_one_quarter]
    norm_num
    field_simp
    ring
  · rw [mem_Icc]
    constructor
    linarith
    linarith
#align has_sum_L_function_mod_four_eval_three hasSum_L_function_mod_four_eval_three

end Examples