/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import algebraic_geometry.projective_spectrum.structure_sheaf
import algebraic_geometry.Spec
import ring_theory.graded_algebra.radical

/-!
# Proj as a scheme

This file is to prove that `Proj` is a scheme.

## Notation

* `Proj`      : `Proj` as a locally ringed space
* `Proj.T`    : the underlying topological space of `Proj`
* `Proj| U`   : `Proj` restricted to some open set `U`
* `Proj.T| U` : the underlying topological space of `Proj` restricted to open set `U`
* `pbo f`     : basic open set at `f` in `Proj`
* `Spec`      : `Spec` as a locally ringed space
* `Spec.T`    : the underlying topological space of `Spec`
* `sbo g`     : basic open set at `g` in `Spec`
* `A⁰_x`      : the degree zero part of localized ring `Aₓ`

## Implementation

In `src/algebraic_geometry/projective_spectrum/structure_sheaf.lean`, we have given `Proj` a
structure sheaf so that `Proj` is a locally ringed space. In this file we will prove that `Proj`
equipped with this structure sheaf is a scheme. We achieve this by using an affine cover by basic
open sets in `Proj`, more specifically:

1. We prove that `Proj` can be covered by basic open sets at homogeneous element of positive degree.
2. We prove that for any homogeneous element `f : A` of positive degree `m`, `Proj.T | (pbo f)` is
    homeomorphic to `Spec.T A⁰_f`:
  - forward direction `to_Spec`:
    for any `x : pbo f`, i.e. a relevant homogeneous prime ideal `x`, send it to
    `A⁰_f ∩ span {g / 1 | g ∈ x}` (see `Proj_iso_Spec_Top_component.to_Spec.carrier`). This ideal is
    prime, the proof is in `Proj_iso_Spec_Top_component.to_Spec.to_fun`. The fact that this function
    is continuous is found in `Proj_iso_Spec_Top_component.to_Spec`
  - backward direction `from_Spec`:
    for any `q : Spec A⁰_f`, we send it to `{a | ∀ i, aᵢᵐ/fⁱ ∈ q}`; we need this to be a
    homogeneous prime ideal that is relevant.
    * This is in fact an ideal, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal`;
    * This ideal is also homogeneous, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.homogeneous`;
    * This ideal is relevant, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.relevant`;
    * This ideal is prime, the proof can be found in
      `Proj_iso_Spec_Top_component.from_Spec.carrier.prime`.
    Hence we have a well defined function `Spec.T A⁰_f → Proj.T | (pbo f)`, this function is called
    `Proj_iso_Spec_Top_component.from_Spec.to_fun`. But to prove the continuity of this function,
    we need to prove `from_Spec ∘ to_Spec` and `to_Spec ∘ from_Spec` are both identities (TBC).

## Main Definitions and Statements

* `degree_zero_part`: the degree zero part of the localized ring `Aₓ` where `x` is a homogeneous
  element of degree `n` is the subring of elements of the form `a/f^m` where `a` has degree `mn`.

For a homogeneous element `f` of degree `n`
* `Proj_iso_Spec_Top_component.to_Spec`: `forward f` is the
  continuous map between `Proj.T| pbo f` and `Spec.T A⁰_f`
* `Proj_iso_Spec_Top_component.to_Spec.preimage_eq`: for any `a: A`, if `a/f^m` has degree zero,
  then the preimage of `sbo a/f^m` under `to_Spec f` is `pbo f ∩ pbo a`.

* [Robin Hartshorne, *Algebraic Geometry*][Har77]: Chapter II.2 Proposition 2.5
-/

noncomputable theory

namespace algebraic_geometry

open_locale direct_sum big_operators pointwise big_operators
open direct_sum set_like.graded_monoid localization finset (hiding mk_zero)

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

variables (𝒜 : ℕ → submodule R A)
variables [graded_algebra 𝒜]

open Top topological_space
open category_theory opposite
open projective_spectrum.structure_sheaf

local notation `Proj` := Proj.to_LocallyRingedSpace 𝒜
-- `Proj` as a locally ringed space
local notation `Proj.T` := Proj .1.1.1
-- the underlying topological space of `Proj`
local notation `Proj| ` U := Proj .restrict (opens.open_embedding (U : opens Proj.T))
-- `Proj` restrict to some open set
local notation `Proj.T| ` U :=
  (Proj .restrict (opens.open_embedding (U : opens Proj.T))).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Proj` restricted to some open set
local notation `pbo ` x := projective_spectrum.basic_open 𝒜 x
-- basic open sets in `Proj`
local notation `sbo ` f := prime_spectrum.basic_open f
-- basic open sets in `Spec`
local notation `Spec ` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring)
-- `Spec` as a locally ringed space
local notation `Spec.T ` ring :=
  (Spec.LocallyRingedSpace_obj (CommRing.of ring)).to_SheafedSpace.to_PresheafedSpace.1
-- the underlying topological space of `Spec`
local notation `A⁰_ ` f := homogeneous_localization.away 𝒜 f

namespace Proj_iso_Spec_Top_component

/-
This section is to construct the homeomorphism between `Proj` restricted at basic open set at
a homogeneous element `x` and `Spec A⁰ₓ` where `A⁰ₓ` is the degree zero part of the localized
ring `Aₓ`.
-/

namespace to_Spec

open ideal

-- This section is to construct the forward direction :
-- So for any `x` in `Proj| (pbo f)`, we need some point in `Spec A⁰_f`, i.e. a prime ideal,
-- and we need this correspondence to be continuous in their Zariski topology.

variables {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : Proj| (pbo f))

/--For any `x` in `Proj| (pbo f)`, the corresponding ideal in `Spec A⁰_f`. This fact that this ideal
is prime is proven in `Top_component.forward.to_fun`-/
def carrier : ideal (A⁰_ f) :=
ideal.comap (algebra_map (A⁰_ f) (away f))
  (ideal.span $ algebra_map A (away f) '' x.val.as_homogeneous_ideal)

lemma mem_carrier_iff (z : A⁰_ f) :
  z ∈ carrier 𝒜 x ↔
  z.val ∈ ideal.span (algebra_map A (away f) '' x.1.as_homogeneous_ideal) :=
iff.rfl

lemma mem_carrier.clear_denominator' [decidable_eq (away f)]
  {z : localization.away f}
  (hz : z ∈ span ((algebra_map A (away f)) '' x.val.as_homogeneous_ideal)) :
  ∃ (c : algebra_map A (away f) '' x.1.as_homogeneous_ideal →₀ away f)
    (N : ℕ) (acd : Π y ∈ c.support.image c, A),
    f ^ N • z = algebra_map A (away f)
      (∑ i in c.support.attach, acd (c i) (finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) :=
begin
  rw [←submodule_span_eq, finsupp.span_eq_range_total, linear_map.mem_range] at hz,
  rcases hz with ⟨c, eq1⟩,
  rw [finsupp.total_apply, finsupp.sum] at eq1,
  obtain ⟨⟨_, N, rfl⟩, hN⟩ := is_localization.exist_integer_multiples_of_finset (submonoid.powers f)
    (c.support.image c),
  choose acd hacd using hN,

  refine ⟨c, N, acd, _⟩,
  rw [← eq1, smul_sum, map_sum, ← sum_attach],
  congr' 1,
  ext i,
  rw [_root_.map_mul, hacd, (classical.some_spec i.1.2).2, smul_eq_mul, smul_mul_assoc],
  refl
end

lemma mem_carrier.clear_denominator [decidable_eq (away f)]
  {z : A⁰_ f} (hz : z ∈ carrier 𝒜 x) :
  ∃ (c : algebra_map A (away f) '' x.1.as_homogeneous_ideal →₀ away f)
    (N : ℕ) (acd : Π y ∈ c.support.image c, A),
    f ^ N • z.val = algebra_map A (away f)
      (∑ i in c.support.attach, acd (c i) (finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) :=
mem_carrier.clear_denominator' x $ (mem_carrier_iff 𝒜 x z).mpr hz

lemma disjoint :
  (disjoint (x.1.as_homogeneous_ideal.to_ideal : set A) (submonoid.powers f : set A)) :=
begin
  by_contra rid,
  rw [set.not_disjoint_iff] at rid,
  choose g hg using rid,
  obtain ⟨hg1, ⟨k, rfl⟩⟩ := hg,
  by_cases k_ineq : 0 < k,
  { erw x.1.is_prime.pow_mem_iff_mem _ k_ineq at hg1,
    exact x.2 hg1 },
  { erw [show k = 0, by linarith, pow_zero, ←ideal.eq_top_iff_one] at hg1,
    apply x.1.is_prime.1,
    exact hg1 },
end

lemma carrier_ne_top :
  carrier 𝒜 x ≠ ⊤ :=
begin
  have eq_top := disjoint x,
  classical,
  contrapose! eq_top,
  obtain ⟨c, N, acd, eq1⟩ := mem_carrier.clear_denominator _ x ((ideal.eq_top_iff_one _).mp eq_top),
  rw [algebra.smul_def, homogeneous_localization.one_val, mul_one] at eq1,
  change localization.mk (f ^ N) 1 = mk (∑ _, _) 1 at eq1,
  simp only [mk_eq_mk', is_localization.eq] at eq1,
  rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩,
  erw [one_mul, one_mul] at eq1,
  change f^_ * f^_ = f^_ * _ at eq1,
  rw set.not_disjoint_iff_nonempty_inter,
  refine ⟨f^M * f^N, eq1.symm ▸ mul_mem_left _ _
    (sum_mem _ (λ i hi, mul_mem_left _ _ _)), ⟨M + N, by rw pow_add⟩⟩,
  generalize_proofs h₁ h₂,
  exact (classical.some_spec h₂).1,
end

variable (f)
/--The function between the basic open set `D(f)` in `Proj` to the corresponding basic open set in
`Spec A⁰_f`. This is bundled into a continuous map in `Top_component.forward`.
-/
def to_fun (x : Proj.T| (pbo f)) : (Spec.T (A⁰_ f)) :=
⟨carrier 𝒜 x, carrier_ne_top x, λ x1 x2 hx12, begin
  classical, simp only [mem_carrier_iff] at hx12 ⊢,
  let J := span (⇑(algebra_map A (away f)) '' x.val.as_homogeneous_ideal),
  suffices h : ∀ (x y : localization.away f), x * y ∈ J → x ∈ J ∨ y ∈ J,
  { rw [homogeneous_localization.mul_val] at hx12, exact h x1.val x2.val hx12, },
  clear' x1 x2 hx12, intros x1 x2 hx12,
  induction x1 using localization.induction_on with data_x1,
  induction x2 using localization.induction_on with data_x2,
  rcases ⟨data_x1, data_x2⟩ with ⟨⟨a1, _, ⟨n1, rfl⟩⟩, ⟨a2, _, ⟨n2, rfl⟩⟩⟩,
  rcases mem_carrier.clear_denominator' x hx12 with ⟨c, N, acd, eq1⟩,
  simp only [algebra.smul_def] at eq1,
  change localization.mk (f ^ N) 1 * (mk _ _ * mk _ _) = mk (∑ _, _) _ at eq1,
  simp only [localization.mk_mul, one_mul] at eq1,
  simp only [mk_eq_mk', is_localization.eq] at eq1,
  rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩,
  rw [submonoid.coe_one, one_mul] at eq1,
  change f^_ * (_ * _) = f^_ * (f^_ * f^_ * _) at eq1,
  rcases x.1.is_prime.mem_or_mem (show a1 * a2 * f ^ N * f ^ M ∈ _, from _) with h1|rid2,
  rcases x.1.is_prime.mem_or_mem h1 with h1|rid1,
  rcases x.1.is_prime.mem_or_mem h1 with h1|h2,
  { left, simp only [show (mk a1 ⟨f ^ n1, _⟩ : away f) = mk a1 1 * mk 1 ⟨f^n1, ⟨n1, rfl⟩⟩,
      by rw [localization.mk_mul, mul_one, one_mul]],
    exact ideal.mul_mem_right _ _ (ideal.subset_span ⟨_, h1, rfl⟩), },
  { right, simp only [show (mk a2 ⟨f ^ n2, _⟩ : away f) = mk a2 1 * mk 1 ⟨f^n2, ⟨n2, rfl⟩⟩,
      by rw [localization.mk_mul, mul_one, one_mul]],
    exact ideal.mul_mem_right _ _ (ideal.subset_span ⟨_, h2, rfl⟩), },
  { exact false.elim (x.2 (x.1.is_prime.mem_of_pow_mem N rid1)), },
  { exact false.elim (x.2 (x.1.is_prime.mem_of_pow_mem M rid2)), },
  { rw [←mul_comm (f^M), ←mul_comm (f^N), eq1],
    refine mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ (λ i hi, mul_mem_left _ _ _))),
    generalize_proofs h₁ h₂, exact (classical.some_spec h₂).1 },
end⟩

/-
The preimage of basic open set `D(a/f^n)` in `Spec A⁰_f` under the forward map from `Proj A` to
`Spec A⁰_f` is the basic open set `D(a) ∩ D(f)` in  `Proj A`. This lemma is used to prove that the
forward map is continuous.
-/
lemma preimage_eq (a b : A) (k : ℕ) (a_mem : a ∈ 𝒜 k) (b_mem1 : b ∈ 𝒜 k)
  (b_mem2 : b ∈ submonoid.powers f) : to_fun 𝒜 f ⁻¹'
    ((@prime_spectrum.basic_open (A⁰_ f) _
      (quotient.mk' ⟨k, ⟨a, a_mem⟩, ⟨b, b_mem1⟩, b_mem2⟩)) :
        set (prime_spectrum (homogeneous_localization.away 𝒜 f)))
  = {x | x.1 ∈ (pbo f) ⊓ (pbo a)} :=
begin
  classical,
  ext1 y, split; intros hy,
  { refine ⟨y.2, _⟩,
    rw [set.mem_preimage, set_like.mem_coe, prime_spectrum.mem_basic_open] at hy,
    rw projective_spectrum.mem_coe_basic_open,
    intro a_mem_y,
    apply hy,
    rw [to_fun, mem_carrier_iff, homogeneous_localization.val_mk', subtype.coe_mk],
    dsimp, rcases b_mem2 with ⟨k, hk⟩,
    simp only [show (mk a ⟨b, ⟨k, hk⟩⟩ : away f) = mk 1 ⟨f^k, ⟨_, rfl⟩⟩ * mk a 1,
      by { rw [mk_mul, one_mul, mul_one], congr, rw hk }],
    exact ideal.mul_mem_left _ _ (ideal.subset_span ⟨_, a_mem_y, rfl⟩), },
  { change y.1 ∈ _ at hy,
    rcases hy with ⟨hy1, hy2⟩,
    rw projective_spectrum.mem_coe_basic_open at hy1 hy2,
    rw [set.mem_preimage, to_fun, set_like.mem_coe, prime_spectrum.mem_basic_open],
    intro rid, dsimp at rid,
    rcases mem_carrier.clear_denominator 𝒜 _ rid with ⟨c, N, acd, eq1⟩,
    rw [algebra.smul_def] at eq1,
    change localization.mk (f^N) 1 * mk _ _ = mk (∑ _, _) _ at eq1,
    rw [mk_mul, one_mul, mk_eq_mk', is_localization.eq] at eq1,
    rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩,
    rw [submonoid.coe_one, one_mul] at eq1,
    simp only [subtype.coe_mk] at eq1,

    rcases y.1.is_prime.mem_or_mem (show a * f ^ N * f ^ M ∈ _, from _) with H1 | H3,
    rcases y.1.is_prime.mem_or_mem H1 with H1 | H2,
    { exact hy2 H1, },
    { exact y.2 (y.1.is_prime.mem_of_pow_mem N H2), },
    { exact y.2 (y.1.is_prime.mem_of_pow_mem M H3), },
    { rw [mul_comm _ (f^N), mul_comm _ (f^M), eq1],
      refine mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ (λ i hi, mul_mem_left _ _ _))),
      generalize_proofs h₁ h₂, exact (classical.some_spec h₂).1, }, },
end

end to_Spec

section

variable {𝒜}

/--The continuous function between the basic open set `D(f)` in `Proj` to the corresponding basic
open set in `Spec A⁰_f`.
-/
def to_Spec {f : A} : (Proj.T| (pbo f)) ⟶ (Spec.T (A⁰_ f)) :=
{ to_fun := to_Spec.to_fun 𝒜 f,
  continuous_to_fun := begin
    apply is_topological_basis.continuous (prime_spectrum.is_topological_basis_basic_opens),
    rintros _ ⟨⟨k, ⟨a, ha⟩, ⟨b, hb1⟩, ⟨k', hb2⟩⟩, rfl⟩, dsimp,
    erw to_Spec.preimage_eq f a b k ha hb1 ⟨k', hb2⟩,
    refine is_open_induced_iff.mpr ⟨(pbo f).1 ⊓ (pbo a).1, is_open.inter (pbo f).2 (pbo a).2, _⟩,
    ext z, split; intros hz; simpa [set.mem_preimage],
  end }

end

namespace from_Spec

open graded_algebra set_like finset (hiding mk_zero)
open _root_.homogeneous_localization

variables {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m)

private meta def mem_tac : tactic unit :=
let b : tactic unit :=
  `[exact pow_mem_graded _ (submodule.coe_mem _) <|> exact nat_cast_mem_graded _ _ <|>
    exact pow_mem_graded _ f_deg] in
b <|> `[by repeat { all_goals { apply graded_monoid.mul_mem } }; b]

include f_deg
/--The function from `Spec A⁰_f` to `Proj|D(f)` is defined by `q ↦ {a | aᵢᵐ/fⁱ ∈ q}`, i.e. sending
`q` a prime ideal in `A⁰_f` to the homogeneous prime relevant ideal containing only and all the
elements `a : A` such that for every `i`, the degree 0 element formed by dividing the `m`-th power
of the `i`-th projection of `a` by the `i`-th power of the degree-`m` homogeneous element `f`,
lies in `q`.

The set `{a | aᵢᵐ/fⁱ ∈ q}`
* is an ideal, as proved in `carrier.as_ideal`;
* is homogeneous, as proved in `carrier.as_homogeneous_ideal`;
* is prime, as proved in `carrier.as_ideal.prime`;
* is relevant, as proved in `carrier.relevant`.
-/
def carrier (q : Spec.T (A⁰_ f)) : set A :=
{a | ∀ i, (quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩,
  ⟨f^i, by rw mul_comm; mem_tac⟩, ⟨_, rfl⟩⟩ : A⁰_ f) ∈ q.1}

lemma mem_carrier_iff (q : Spec.T (A⁰_ f)) (a : A) :
  a ∈ carrier f_deg q ↔
  ∀ i, (quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩, ⟨f^i, by rw mul_comm; mem_tac⟩, ⟨_, rfl⟩⟩
    : A⁰_ f) ∈ q.1 :=
iff.rfl

lemma mem_carrier_iff' (q : Spec.T (A⁰_ f)) (a : A) :
  a ∈ carrier f_deg q ↔
  ∀ i, (localization.mk (proj 𝒜 i a ^ m) ⟨f^i, ⟨i, rfl⟩⟩ : localization.away f) ∈
    (algebra_map (homogeneous_localization.away 𝒜 f) (localization.away f)) '' q.1.1 :=
(mem_carrier_iff f_deg q a).trans begin
  split; intros h i; specialize h i,
  { rw set.mem_image, refine ⟨_, h, rfl⟩, },
  { rw set.mem_image at h, rcases h with ⟨x, h, hx⟩,
    convert h, rw [ext_iff_val, val_mk'], dsimp only [subtype.coe_mk], rw ←hx, refl, },
end

lemma carrier.add_mem (q : Spec.T (A⁰_ f)) {a b : A} (ha : a ∈ carrier f_deg q)
  (hb : b ∈ carrier f_deg q) :
  a + b ∈ carrier f_deg q :=
begin
  refine λ i, (q.2.mem_or_mem _).elim id id,
  change (quotient.mk' ⟨_, _, _, _⟩ : A⁰_ f) ∈ q.1, dsimp only [subtype.coe_mk],
  simp_rw [←pow_add, map_add, add_pow, mul_comm, ← nsmul_eq_mul],
  let g : ℕ → A⁰_ f := λ j, (m + m).choose j • if h2 : m + m < j then 0 else if h1 : j ≤ m
    then quotient.mk' ⟨m * i, ⟨proj 𝒜 i a^j * proj 𝒜 i b ^ (m - j), _⟩,
      ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩ *
      quotient.mk' ⟨m * i, ⟨proj 𝒜 i b ^ m, by mem_tac⟩, ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩
    else quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩,
      ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩ * quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ (j - m) *
        proj 𝒜 i b ^ (m + m - j), _⟩, ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩,
  rotate,
  { rw (_ : m*i = _), mem_tac, rw [← add_smul, nat.add_sub_of_le h1], refl },
  { rw (_ : m*i = _), mem_tac, rw ←add_smul, congr, zify [le_of_not_lt h2, le_of_not_le h1], abel },
  convert_to ∑ i in range (m + m + 1), g i ∈ q.1, swap,
  { refine q.1.sum_mem (λ j hj, nsmul_mem _ _), split_ifs,
    exacts [q.1.zero_mem, q.1.mul_mem_left _ (hb i), q.1.mul_mem_right _ (ha i)] },
  rw [ext_iff_val, val_mk'],
  change _ = (algebra_map (homogeneous_localization.away 𝒜 f) (localization.away f)) _,
  dsimp only [subtype.coe_mk], rw [map_sum, mk_sum],
  apply finset.sum_congr rfl (λ j hj, _),
  change _ = homogeneous_localization.val _,
  rw [homogeneous_localization.smul_val],
  split_ifs with h2 h1,
  { exact ((finset.mem_range.1 hj).not_le h2).elim },
  all_goals { simp only [mul_val, zero_val, val_mk', subtype.coe_mk, mk_mul, ←smul_mk], congr' 2 },
  { rw [mul_assoc, ←pow_add, add_comm (m-j), nat.add_sub_assoc h1] }, { simp_rw [pow_add], refl },
  { rw [← mul_assoc, ←pow_add, nat.add_sub_of_le (le_of_not_le h1)] }, { simp_rw [pow_add], refl },
end

variables (hm : 0 < m) (q : Spec.T (A⁰_ f))
include hm

lemma carrier.zero_mem : (0 : A) ∈ carrier f_deg q := λ i, begin
  convert submodule.zero_mem q.1 using 1,
  rw [ext_iff_val, val_mk', zero_val], simp_rw [map_zero, zero_pow hm],
  convert localization.mk_zero _ using 1,
end

/--
For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as an ideal.
-/
def carrier.as_ideal : ideal A :=
{ carrier := carrier f_deg q,
  zero_mem' := carrier.zero_mem f_deg hm q,
  add_mem' := λ a b, carrier.add_mem f_deg q,
  smul_mem' := carrier.smul_mem f_deg hm q }

lemma carrier.as_ideal.homogeneous : (carrier.as_ideal f_deg hm q).is_homogeneous 𝒜 :=
λ i a ha j, (em (i = j)).elim
  (λ h, h ▸ by simpa only [proj_apply, decompose_coe, of_eq_same] using ha _)
  (λ h, begin
    simp only [proj_apply, decompose_of_mem_ne 𝒜 (submodule.coe_mem (decompose 𝒜 a i)) h,
      zero_pow hm], convert carrier.zero_mem f_deg hm q j, rw [map_zero, zero_pow hm],
  end)

/--
For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as a homogeneous ideal.
-/
def carrier.as_homogeneous_ideal : homogeneous_ideal 𝒜 :=
⟨carrier.as_ideal f_deg hm q, carrier.as_ideal.homogeneous f_deg hm q⟩

lemma carrier.denom_not_mem : f ∉ carrier.as_ideal f_deg hm q :=
λ rid, q.is_prime.ne_top $ (ideal.eq_top_iff_one _).mpr
begin
  convert rid m,
  simpa only [ext_iff_val, one_val, proj_apply, decompose_of_mem_same _ f_deg, val_mk'] using
    (mk_self (⟨_, m, rfl⟩ : submonoid.powers f)).symm,
end

lemma carrier.relevant :
  ¬homogeneous_ideal.irrelevant 𝒜 ≤ carrier.as_homogeneous_ideal f_deg hm q :=
λ rid, carrier.denom_not_mem f_deg hm q $ rid $ direct_sum.decompose_of_mem_ne 𝒜 f_deg hm.ne'

lemma carrier.as_ideal.ne_top : (carrier.as_ideal f_deg hm q) ≠ ⊤ :=
λ rid, carrier.denom_not_mem f_deg hm q (rid.symm ▸ submodule.mem_top)

lemma carrier.as_ideal.prime : (carrier.as_ideal f_deg hm q).is_prime :=
(carrier.as_ideal.homogeneous f_deg hm q).is_prime_of_homogeneous_mem_or_mem
  (carrier.as_ideal.ne_top f_deg hm q) $ λ x y ⟨nx, hnx⟩ ⟨ny, hny⟩ hxy,
show (∀ i, _ ∈ _) ∨ ∀ i, _ ∈ _, begin
  rw [← and_forall_ne nx, and_iff_left, ← and_forall_ne ny, and_iff_left],
  { apply q.2.mem_or_mem, convert hxy (nx + ny) using 1,
    simp_rw [proj_apply, decompose_of_mem_same 𝒜 hnx, decompose_of_mem_same 𝒜 hny,
      decompose_of_mem_same 𝒜 (mul_mem hnx hny), mul_pow, pow_add],
    simpa only [ext_iff_val, val_mk', mul_val, mk_mul], },
  all_goals { intros n hn, convert q.1.zero_mem using 1,
    rw [ext_iff_val, val_mk', zero_val], simp_rw [proj_apply, subtype.coe_mk],
    convert mk_zero _, rw [decompose_of_mem_ne 𝒜 _ hn.symm, zero_pow hm],
    { exact hnx <|> exact hny } },
end

variable (f_deg)
/--
The function `Spec A⁰_f → Proj|D(f)` by sending `q` to `{a | aᵢᵐ/fⁱ ∈ q}`.
-/
def to_fun : (Spec.T (A⁰_ f)) → (Proj.T| (pbo f)) :=
λ q, ⟨⟨carrier.as_homogeneous_ideal f_deg hm q, carrier.as_ideal.prime f_deg hm q,
  carrier.relevant f_deg hm q⟩,
  (projective_spectrum.mem_basic_open _ f _).mp $ carrier.denom_not_mem f_deg hm q⟩

end from_Spec

end Proj_iso_Spec_Top_component

end algebraic_geometry


import data.nat.prime
import algebra.order_functions

open nat

-- local attribute [trans] dvd_trans

-- Definition
def exactly_divides (p : ℕ) (r : ℕ) (n : ℕ) := p^r ∣ n ∧ ¬(p^(succ r) ∣ n)

notation p`^`r `∣∣`:50 n:50 := exactly_divides p r n

section
variable {p : ℕ}

-- Equivalent definitions
lemma exactly_divides' {r : ℕ} {n : ℕ} : p^r ∣∣ n ↔ (∀ i, p^i ∣ n ↔ i ≤ r) :=
begin
  apply iff.intro,
  { intros prn i, apply iff.intro,
    { intro pin,
      apply (le_or_gt _ _).resolve_right, intro i_gt_r,
      exact absurd (dvd_trans (nat.pow_dvd_pow p i_gt_r) pin) prn.right },
    { intro i_le_r,
      exact dvd.trans (pow_dvd_pow p i_le_r) (and.left prn) }
    },
  { intro h, split,
    { exact (h r).mpr (refl r) },
    { exact mt (h (succ r)).mp (not_succ_le_self r) }
  }
end

lemma exactly_divides'' {r : ℕ} {n : ℕ} (p_pos : p > 0) :
  p^r ∣∣ n ↔ ∃ k, n = p^r * k ∧ ¬(p ∣ k) :=
begin
  apply iff.intro,
  { intro prn,
    existsi n / (p^r), split,
    { exact (nat.mul_div_cancel' prn.left).symm },
    { intro d,
      have :=
      calc p^(succ r) = p^r * p            : rfl
           ...        ∣ p^r * (n / (p^r))  : mul_dvd_mul_left (p^r) d
           ...        = n                  : nat.mul_div_cancel' prn.left,
      have := prn.right, contradiction
    }
  },
  { intro h, rcases h with ⟨k, h1, h2⟩, split,
    { exact ⟨k,h1⟩ },
    { intro d,
      rw h1 at d,
      have : p ∣ k := dvd_of_mul_dvd_mul_left (pos_pow_of_pos r p_pos) d,
      contradiction
    }
  }
end

-- Uniqueness
lemma exactly_divides_unique {r s : ℕ} {n : ℕ} : p^r ∣∣ n → p^s ∣∣ n → r = s :=
λ prn psn,
have ri : ∀ i, p^i ∣ n ↔ i ≤ r := exactly_divides'.mp prn,
have si : ∀ i, p^i ∣ n ↔ i ≤ s := exactly_divides'.mp psn,
have this : ∀ i, i ≤ r ↔ i ≤ s := λ i, (ri i).symm.trans (si i),
le_antisymm ((this r).mp (le_refl r)) ((this s).mpr (le_refl s))

-- Recursion relations
lemma exactly_divides_zero {n : ℕ} (p_pos : p > 0) : ¬(p ∣ n) ↔ p^0 ∣∣ n :=
begin
  rw exactly_divides'' p_pos,
  apply iff.intro,
  { intro h, exact ⟨n, by simp, h⟩ },
  { intro h, rcases h with ⟨k, e, nd⟩, simp [e, nd] }
end

lemma exactly_divides_succ {r n : ℕ} (p_pos : p > 0) : p^r ∣∣ n ↔ p^(succ r) ∣∣ (p * n) :=
begin
  rw [exactly_divides'' p_pos, exactly_divides'' p_pos],
  apply iff.intro,
  {
    intro prn,
    rcases prn with ⟨k, h1, h2⟩,
    have h1' : p * n = p^(succ r) * k :=
    calc p * n = p * (p^r * k)  : by rw h1
         ...   = (p^r * p) * k  : by ac_refl,
    exact ⟨k, h1', h2⟩,
  },
  {
    intro psrpn,
    rcases psrpn with ⟨k, h1, h2⟩,
    have h1' : p * n = p * (p^r * k) :=
    calc p * n = p^(succ r) * k  : h1
         ...   = p * (p^r * k)   : by unfold pow nat.pow; ac_refl,
    exact ⟨k, eq_of_mul_eq_mul_left p_pos h1', h2⟩
  }
end

-- Multiplicative
lemma exactly_divides_one (hp : prime p) : p^0 ∣∣ 1 :=
(exactly_divides_zero (lt.trans dec_trivial hp.one_lt)).mp (prime.not_dvd_one hp)

lemma exactly_divides_mul {r s a b : ℕ} (hp : prime p) : p^r ∣∣ a → p^s ∣∣ b → p^(r+s) ∣∣ a*b :=
begin
  intros pra psb,
  rw exactly_divides'' (lt.trans dec_trivial hp.one_lt) at ⊢ pra psb,
  rcases pra with ⟨ka, ha1, ha2⟩,
  rcases psb with ⟨kb, hb1, hb2⟩,
  existsi ka * kb, split,
  { exact calc a * b = (p^r * ka) * (p^s * kb)  : by rw [ha1, hb1]
               ...   = (p^r * p^s) * (ka * kb)  : by ac_refl
               ...   = p^(r+s) * (ka * kb)      : by rw nat.pow_add },
  { exact prime.not_dvd_mul hp ha2 hb2 }
end

lemma exactly_divides_pow {r k a : ℕ} (hp : prime p) : p^r ∣∣ a → p^(k * r) ∣∣ a^k :=
mul_comm r k ▸
  λ pra, nat.rec_on k
           (exactly_divides_one hp)
           (λ k' ih, (exactly_divides_mul hp ih pra))

-- Gcd
lemma dvd_gcd_iff {a b k : ℕ} : k ∣ gcd a b ↔ k ∣ a ∧ k ∣ b :=
iff.intro (λ d, ⟨dvd_trans d (gcd_dvd a b).left,
                 dvd_trans d (gcd_dvd a b).right⟩)
          (λ p, and.elim p dvd_gcd)

lemma exactly_divides_gcd {r s a b : ℕ} : p^r ∣∣ a → p^s ∣∣ b → p^(min r s) ∣∣ gcd a b :=
begin
  intros pra psb,
  rw exactly_divides' at ⊢ pra psb,
  intro i,
  exact calc p^i ∣ gcd a b ↔ p^i ∣ a ∧ p^i ∣ b  : nat.dvd_gcd_iff
             ...           ↔ i ≤ r ∧ i ≤ s      : and_congr (pra i) (psb i)
             ...           ↔ i ≤ min r s        : le_min_iff.symm
end

end


import Lean4Axiomatic.AbstractAlgebra
import Lean4Axiomatic.Integer.Impl.Difference
import Lean4Axiomatic.Natural.Impl.Nat
import Lean4Axiomatic.Rational.Impl.Fraction

namespace AnalysisI.Ch4.Sec2

open Coe (coe)
open Lean4Axiomatic
open Lean4Axiomatic.Integer (Nonzero)
open Lean4Axiomatic.Logic (AP)
open Lean4Axiomatic.Natural (step)
open Lean4Axiomatic.Rational.Impl
open Lean4Axiomatic.Signed (Negative Positive sgn)

abbrev ℕ : Type := Nat
abbrev ℤ : Type := Integer.Impl.Difference ℕ

/- 4.2 The rationals -/

section formal_fractions

-- Definition 4.2.1.
-- A _rational number_ is an expression of the form `a//b`, where `a` and `b`
-- are integers and `b` is non-zero; `a//0` is not considered to be a rational
-- number. Two rational numbers are considered to be equal, `a//b ≃ c//d`, if
-- and only if `a * d ≃ c * b`. The set of all rational numbers is denoted `ℚ`.
abbrev ℚ : Type := Fraction ℤ

-- [Note: the implementation of rationals we're using requires denominators to
-- be _positive_, not just nonzero. Since this is a stronger requirement it
-- shouldn't impact the code here too much; we'll clarify with a note when it
-- does.]
example {a b : ℤ} [AP (Positive b)] : ℚ := a//b

example
    {a b c d : ℤ} [AP (Positive b)] [AP (Positive d)]
    : a//b ≃ c//d ↔ a * d ≃ c * b
    :=
  Iff.intro id id

-- [axiom and definition for rational equality]
example : ℚ → ℚ → Prop := Rational.eqv
example : ℚ → ℚ → Prop := Fraction.eqv

-- [helper function to generate `Nonzero` instances for integer literals]
def literal_nonzero {n : ℕ} : n ≄ 0 → Nonzero (n : ℤ) := by
  intro (_ : n ≄ 0)
  have : coe n ≄ coe 0 := AA.subst₁ (β := ℤ) ‹n ≄ 0›
  have : Nonzero (n : ℤ) := Integer.nonzero_iff_neqv_zero.mpr ‹coe n ≄ coe 0›
  exact this

-- [helper function to generate `Positive` instances for integer literals]
def literal_positive {n : ℕ} : n ≄ 0 → AP (Positive (n : ℤ)) := by
  intro (_ : n ≄ 0)
  have : Positive n := Signed.positive_defn.mpr ‹n ≄ 0›
  have : Positive (n : ℤ) := Integer.positive_intro_nat ‹Positive n› Rel.refl
  exact AP.mk this

-- [This is a default instance so that integer literals can be used without
-- type annotations. The priority is higher than both `Neg Int` and `OfNat Nat`
-- from the Prelude.]
@[default_instance mid+1]
abbrev integer_literal {n : Nat} := Integer.literal (ℤ := ℤ) (n := n)

-- [these instances are needed for literals to be denominators of fractions]
instance : Nonzero 5 := literal_nonzero Natural.step_neqv_zero
instance : AP (Positive 2) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 3) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 4) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 5) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 6) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 8) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 10) := literal_positive Natural.step_neqv_zero
instance : AP (Positive 20) := literal_positive Natural.step_neqv_zero

-- Thus for instance `3//4 ≃ 6//8 ≃ -3//-4`, but `3//4 ≄ 4//3`.
example : 3//4 ≃ 6//8 := by
  show 3 * 8 ≃ 6 * 4
  show 24 ≃ 24
  rfl

-- [Note: `-3//(-4)` is not a valid fraction in our definition; so we show a
-- slightly different equivalence.]
-- example : 6//8 ≃ (-3)//(-4) := by
example : (-6)//8 ≃ (-3)//4 := by
  show -6 * 4 ≃ -3 * 8
  show -24 ≃ -24
  rfl

example : 3//4 ≄ 4//3 := by
  intro (_ : 3//4 ≃ 4//3)
  show False
  have : 3 * 3 ≃ 4 * 4 := ‹3//4 ≃ 4//3›
  have : 9 ≃ 16 := this
  have : step 8 ≃ step 15 := this
  have : 8 ≃ 15 := AA.inject this
  have : step 7 ≃ step 14 := this
  have : 7 ≃ 14 := AA.inject this
  have : step 6 ≃ step 13 := this
  have : 6 ≃ 13 := AA.inject this
  have : step 5 ≃ step 12 := this
  have : 5 ≃ 12 := AA.inject this
  have : step 4 ≃ step 11 := this
  have : 4 ≃ 11 := AA.inject this
  have : step 3 ≃ step 10 := this
  have : 3 ≃ 10 := AA.inject this
  have : step 2 ≃ step 9 := this
  have : 2 ≃ 9 := AA.inject this
  have : step 1 ≃ step 8 := this
  have : 1 ≃ 8 := AA.inject this
  have : step 0 ≃ step 7 := this
  have : 0 ≃ 7 := AA.inject this
  have : 0 ≃ step 6 := this
  have : 0 ≄ step 6 := Rel.symm Natural.step_neqv_zero
  exact absurd ‹0 ≃ step 6› ‹0 ≄ step 6›

-- This is a valid definition of equality.
-- Exercise 4.2.1.
-- Show that the definition of equality for the rational numbers is reflexive,
-- symmetric, and transitive.
-- [axioms]
example {p : ℚ} : p ≃ p := Rational.eqv_refl
example {p q : ℚ} : p ≃ q → q ≃ p := Rational.eqv_symm
example {p q r : ℚ} : p ≃ q → q ≃ r → p ≃ r := Rational.eqv_trans

-- [fraction implementations]
example {p : ℚ} : p ≃ p := Fraction.eqv_refl
example {p q : ℚ} : p ≃ q → q ≃ p := Fraction.eqv_symm
example {p q r : ℚ} : p ≃ q → q ≃ r → p ≃ r := Fraction.eqv_trans

-- Definition 4.2.2.
-- If `a//b` and `c//d` are rational numbers, we define their sum
example
    {a b c d : ℤ} [AP (Positive b)] [AP (Positive d)]
    : (a//b) + (c//d) ≃ (a * d + b * c)//(b * d)
    :=
  rfl

-- [declaration and definition of addition]
example : ℚ → ℚ → ℚ := Rational.add
example : ℚ → ℚ → ℚ := Fraction.add

-- their product
example
    {a b c d : ℤ} [AP (Positive b)] [AP (Positive d)]
    : (a//b) * (c//d) ≃ (a * c)//(b * d)
    :=
  rfl

-- [declaration and definition of multiplication]
example : ℚ → ℚ → ℚ := Rational.mul
example : ℚ → ℚ → ℚ := Fraction.mul

-- and the negation
example {a b : ℤ} [AP (Positive b)] : -(a//b) ≃ (-a)//b := rfl

-- [declaration and definition of negation]
example : ℚ → ℚ := Rational.neg
example : ℚ → ℚ := Fraction.neg

-- Lemma 4.2.3. / Exercise 4.2.2.
-- The sum, product, and negation operations on rational numbers are
-- well-defined, in the sense that if one replaces `a//b` with another rational
-- number `a'//b'` which is equal to `a//b`, then the output of the above
-- operations remains unchanged, and similarly for `c//d`.
example
    {a a' b b' c d : ℤ} [AP (Positive b)] [AP (Positive b')] [AP (Positive d)]
    : a//b ≃ a'//b' → a//b + c//d ≃ a'//b' + c//d
    :=
  Fraction.add_substL

example
    {a b c c' d d' : ℤ} [AP (Positive b)] [AP (Positive d)] [AP (Positive d')]
    : c//d ≃ c'//d' → a//b + c//d ≃ a//b + c'//d'
    :=
  Fraction.add_substR

example
    {a a' b b' c d : ℤ} [AP (Positive b)] [AP (Positive b')] [AP (Positive d)]
    : a//b ≃ a'//b' → a//b * c//d ≃ a'//b' * c//d
    :=
  Fraction.mul_substL

example
    {a b c c' d d' : ℤ} [AP (Positive b)] [AP (Positive d)] [AP (Positive d')]
    : c//d ≃ c'//d' → a//b * c//d ≃ a//b * c'//d'
    :=
  Fraction.mul_substR

example
    {a a' b b' : ℤ} [AP (Positive b)] [AP (Positive b')]
    : a//b ≃ a'//b' → -(a//b) ≃ -(a'//b')
    :=
  Fraction.neg_subst

-- [axioms for all substitution properties]
example {p p' q : ℚ} : p ≃ p' → p + q ≃ p' + q := Rational.add_substL
example {p p' q : ℚ} : p ≃ p' → q + p ≃ q + p' := Rational.add_substR
example {p p' q : ℚ} : p ≃ p' → p * q ≃ p' * q := Rational.mul_substL
example {p p' q : ℚ} : p ≃ p' → q * p ≃ q * p' := Rational.mul_substR
example {p p' : ℚ} : p ≃ p' → -p ≃ -p' := Rational.neg_subst

-- We note that the rational numbers `a//1` behave in a manner identical to the
-- integers `a`:
example {a b : ℤ} : a//1 + b//1 ≃ (a + b)//1 :=
  Fraction.eqv_symm Fraction.add_compat_from_integer

example {a b : ℤ} : a//1 * b//1 ≃ (a * b)//1 :=
  Fraction.eqv_symm Fraction.mul_compat_from_integer

example {a : ℤ} : -(a//1) ≃ (-a)//1 :=
  Fraction.eqv_symm Fraction.neg_compat_from_integer

-- Also, `a//1` and `b//1` are only equal when `a` and `b` are equal.
example {a b : ℤ} : a ≃ b ↔ a//1 ≃ b//1 :=
  Iff.intro Fraction.from_integer_subst Fraction.from_integer_inject

-- Because of this, we will identify `a` with `a//1` for each integer `a`:
-- `a ≡ a//1`; the above identities then guarantee that the arithmetic of the
-- integers is consistent with the arithmetic of the rationals.
-- [Note: we can't make integers equal to rationals in Lean, but we can provide
-- a coercion from integers to rationals.]
example {a : ℤ} : (a : ℚ) ≃ a//1 := Rel.refl

-- [corresponding axioms for integer conversion]
example : ℤ → ℚ := Rational.from_integer
example : ℤ → ℚ := coe -- typeclass, backed by `from_integer`

example {a₁ a₂ : ℤ} : a₁ ≃ a₂ → (a₁ : ℚ) ≃ (a₂ : ℚ) :=
  Rational.from_integer_subst
example {a₁ a₂ : ℤ} : (a₁ : ℚ) ≃ (a₂ : ℚ) → a₁ ≃ a₂ :=
  Rational.from_integer_inject

example {a b : ℤ} : ((a + b : ℤ) : ℚ) ≃ (a : ℚ) + (b : ℚ) :=
  Rational.add_compat_from_integer
example {a b : ℤ} : ((a * b : ℤ) : ℚ) ≃ (a : ℚ) * (b : ℚ) :=
  Rational.mul_compat_from_integer
example {a : ℤ} : ((-a : ℤ) : ℚ) ≃ -(a : ℚ) := Rational.neg_compat_from_integer

-- Thus just as we embedded the natural numbers inside the integers, we embed
-- the integers inside the rational numbers. In particular, all natural numbers
-- are rational numbers, for instance `0` is equal to `0//1` and `1` is equal
-- to `1//1`.
example : 0 ≃ 0//1 := Rational.eqv_refl
example : 1 ≃ 1//1 := Rational.eqv_refl

-- Observe that a rational number `a//b` is equal to `0 ≃ 0//1` if and only if
-- `a * 1 ≃ b * 0`, i.e., if the numerator `a` is equal to `0`. Thus if `a` and
-- `b` are non-zero then so is `a//b`.
example {p : ℚ} : p ≃ 0 ↔ p.numerator ≃ 0 :=
  Fraction.eqv_zero_iff_numerator_eqv_zero

-- We now define a new operation on the rationals: reciprocal. If `x ≃ a//b` is
-- a non-zero rational (so that `a, b ≄ 0`) then we define the _reciprocal_
-- `x⁻¹` of `x` to be the rational number `x⁻¹ := b//a`.
-- [Note: this is one place where we must use a different definition due to our
-- stronger positive-denominator constraint. The denominator of the reciprocal
-- needs to be positive, but we only know that the numerator of the original
-- fraction is nonzero. Multiply it by `sgn` of itself to ensure that it is
-- positive, then multiply the numerator of the reciprocal by the same amount
-- so that the sign of the fraction doesn't change.]
example
    {a b : ℤ} [AP (Positive b)] [AP (a//b ≄ 0)]
    : have : Integer.Nonzero a := Fraction.nonzero_numerator (a//b)
      (a//b)⁻¹ ≃ (b * sgn a)//(a * sgn a)
    :=
  rfl

-- [declaration and definition of reciprocal]
example : (q : ℚ) → [AP (q ≄ 0)] → ℚ := Rational.reciprocal
example : (q : ℚ) → [AP (q ≄ 0)] → ℚ := Fraction.reciprocal

-- It is easy to check that this operation is consistent with our notion of
-- equality: if two rational numbers `a//b`, `a'//b'` are equal, then their
-- reciprocals are also equal.
example {p q : ℚ} [AP (p ≄ 0)] [AP (q ≄ 0)] : p ≃ q → p⁻¹ ≃ q⁻¹ :=
  Rational.recip_subst (p₁ := p)
example {p q : ℚ} [AP (p ≄ 0)] [AP (q ≄ 0)] : p ≃ q → p⁻¹ ≃ q⁻¹ :=
  Fraction.recip_subst

section prop_4_2_4

-- Exercise 4.2.3.
-- Proposition 4.2.4 (Laws of algebra for rationals).
-- Let `x`, `y`, `z` be rationals. Then the following laws of algebra hold:
variable {x y z : ℚ}

example : x + y ≃ y + x := Rational.add_comm
example : x + y ≃ y + x := Fraction.add_comm

example : (x + y) + z ≃ x + (y + z) := Rational.add_assoc
example : (x + y) + z ≃ x + (y + z) := Fraction.add_assoc

example : x + 0 ≃ x := Rational.add_identR
example : x + 0 ≃ x := Fraction.add_identR

example : 0 + x ≃ x := Rational.add_identL
example : 0 + x ≃ x := Fraction.add_identL

example : x + -x ≃ 0 := Rational.add_inverseR
example : x + -x ≃ 0 := Fraction.add_inverseR

example : -x + x ≃ 0 := Rational.add_inverseL
example : -x + x ≃ 0 := Fraction.add_inverseL

example : x * y ≃ y * x := Rational.mul_comm
example : x * y ≃ y * x := Fraction.mul_comm

example : (x * y) * z ≃ x * (y * z) := Rational.mul_assoc
example : (x * y) * z ≃ x * (y * z) := Fraction.mul_assoc

example : x * 1 ≃ x := Rational.mul_identR
example : x * 1 ≃ x := Fraction.mul_identR

example : 1 * x ≃ x := Rational.mul_identL
example : 1 * x ≃ x := Fraction.mul_identL

example : x * (y + z) ≃ x * y + x * z := Rational.mul_distribL
example : x * (y + z) ≃ x * y + x * z := Fraction.mul_distribL

example : (y + z) * x ≃ y * x + z * x := Rational.mul_distribR
example : (y + z) * x ≃ y * x + z * x := Fraction.mul_distribR

-- If `x` is non-zero, we also have
example [AP (x ≄ 0)] : x * x⁻¹ ≃ 1 := Rational.mul_inverseR
example [AP (x ≄ 0)] : x * x⁻¹ ≃ 1 := Fraction.mul_inverseR

example [AP (x ≄ 0)] : x⁻¹ * x ≃ 1 := Rational.mul_inverseL
example [AP (x ≄ 0)] : x⁻¹ * x ≃ 1 := Fraction.mul_inverseL

end prop_4_2_4

-- We can now define the _quotient_ `x / y` of two rational numbers `x` and
-- `y`, _provided that_ `y` is non-zero, by the formula
example {x y : ℚ} [AP (y ≄ 0)] : x / y ≃ x * y⁻¹ := Rational.div_mul_recip

-- [declaration and definition of division]
example : (x y : ℚ) → [AP (y ≄ 0)] → ℚ := Rational.div
example : (x y : ℚ) → [AP (y ≄ 0)] → ℚ := Fraction.div

-- [instance needed for example below]
instance : AP (5//6 ≄ 0) := by
  apply AP.mk
  intro (_ : 5//6 ≃ 0)
  show False
  have : 5//6 ≃ 0//1 := ‹5//6 ≃ 0›
  have : 5 * 1 ≃ 0 * 6 := this
  have : 5 ≃ 0 := this
  have : (5 : ℕ) ≃ (0 : ℕ) → (5 : ℤ) ≃ (0 : ℤ) := AA.subst₁ (f := coe)
  have : (5 : ℤ) ≄ (0 : ℤ) := mt this Natural.step_neqv_zero
  exact absurd ‹5 ≃ 0› ‹5 ≄ 0›

-- Thus, for instance
example : (3//4 : ℚ) / (5//6 : ℚ) ≃ 9//10 := calc
  (3//4 : ℚ) / (5//6 : ℚ) ≃ _ := Rational.div_mul_recip
  3//4 * (5//6)⁻¹         ≃ _ := Fraction.eqv_refl
  3//4 * 6//5             ≃ _ := Fraction.eqv_refl
  (3 * 6)//(4 * 5)        ≃ _ := Fraction.eqv_refl
  18//20                  ≃ _ := Fraction.eqv_refl
  ((2 * 9)//(2 * 10) : ℚ) ≃ _ := Fraction.cancelL
  9//10                   ≃ _ := Fraction.eqv_refl

-- Using this formula, it is easy to see that `a / b ≃ a//b` for every integer
-- `a` and every non-zero integer `b`.
example {a b : ℤ} [AP (Positive b)] : (a : ℚ) / (b : ℚ) ≃ a//b :=
  Fraction.div_eqv_fraction

-- Thus we can now discard the `//` notation, and use the more customary
-- `a / b` instead of `a//b`. [Note: we enforce that in this file by only
-- allowing the `//` notation in this first section; the remainder of this
-- document does not have access to it.]

-- In a similar spirit, we define subtraction on the rationals by the formula
example {x y : ℚ} : x - y ≃ x + (-y) := Rational.sub_add_neg

-- [declaration and definition of subtraction]
example : ℚ → ℚ → ℚ := Rational.sub
example : ℚ → ℚ → ℚ := Fraction.sub

end formal_fractions

variable {ℚ : Type} [Rational (ℤ := ℤ) ℚ]

-- Definition 4.2.6
-- A rational number `x` is said to be _positive_ iff we have `x ≃ a / b` for
-- some positive integers `a` and `b`.
inductive AltPositive (x : ℚ) : Prop :=
| intro
    (a b : ℤ)
    (a_pos : AP (Positive a))
    (b_pos : AP (Positive b))
    (eqv : x ≃ a / b)

def AltPositive.mk
    {a b : ℤ} {x : ℚ} [AP (Positive a)] [AP (Positive b)] (_ : x ≃ a / b)
    : AltPositive x
    :=
  AltPositive.intro a b ‹AP (Positive a)› ‹AP (Positive b)› ‹x ≃ a / b›

theorem alt_positive {x : ℚ} : Positive x ↔ AltPositive x := by
  apply Iff.intro
  case mp =>
    intro (_ : Positive x)
    show AltPositive x
    have (Rational.AsRatio.intro a b (_ : Integer.Nonzero b) x_eqv) :=
      Rational.as_ratio x
    have : x ≃ a / b := x_eqv

    have : Integer.Sqrt1 (sgn b) := Integer.sgn_nonzero.mp ‹Integer.Nonzero b›
    have : sgn a * sgn b ≃ 1 := calc
      sgn a * sgn b     ≃ _ := Rel.symm Rational.sgn_div_integers
      sgn ((a : ℚ) / b) ≃ _ := Rational.sgn_subst (Rel.symm ‹x ≃ a / b›)
      sgn x             ≃ _ := Rational.sgn_positive.mp ‹Positive x›
      1                 ≃ _ := Rel.refl
    have : sgn a ≃ sgn b := Integer.mul_sqrt1_eqv.mp this
    have : sgn b ≃ 1 ∨ sgn b ≃ -1 :=
      Integer.sqrt1_cases.mp ‹Integer.Sqrt1 (sgn b)›
    match this with
    | Or.inl (_ : sgn b ≃ 1) =>
      have : sgn a ≃ 1 := Rel.trans ‹sgn a ≃ sgn b› ‹sgn b ≃ 1›
      have : AP (Positive a) := AP.mk (Integer.sgn_positive.mpr ‹sgn a ≃ 1›)
      have : AP (Positive b) := AP.mk (Integer.sgn_positive.mpr ‹sgn b ≃ 1›)
      exact AltPositive.mk ‹x ≃ a / b›
    | Or.inr (_ : sgn b ≃ -1) =>
      have : sgn (-b) ≃ 1 := calc
        sgn (-b)   ≃ _ := Integer.sgn_compat_neg
        (-(sgn b)) ≃ _ := AA.subst₁ ‹sgn b ≃ -1›
        (-(-1))    ≃ _ := Integer.neg_involutive
        1          ≃ _ := Rel.refl
      have : sgn (-a) ≃ 1 := calc
        sgn (-a)   ≃ _ := Integer.sgn_compat_neg
        (-(sgn a)) ≃ _ := AA.subst₁ ‹sgn a ≃ sgn b›
        (-(sgn b)) ≃ _ := Rel.symm Integer.sgn_compat_neg
        sgn (-b)   ≃ _ := ‹sgn (-b) ≃ 1›
        1          ≃ _ := Rel.refl
      have : Positive (-a) := Integer.sgn_positive.mpr ‹sgn (-a) ≃ 1›
      have : Positive (-b) := Integer.sgn_positive.mpr ‹sgn (-b) ≃ 1›
      have : AP (Positive (-a)) := AP.mk ‹Positive (-a)›
      have : AP (Positive (-b)) := AP.mk ‹Positive (-b)›

      have neg_eqv {z : ℤ} : -(z : ℚ) ≃ ((-z : ℤ) : ℚ) :=
        Rational.eqv_symm Rational.neg_compat_from_integer
      have : x ≃ ((-a : ℤ) : ℚ) / ((-b : ℤ) : ℚ) := calc
        x                               ≃ _ := ‹x ≃ a / b›
        (a : ℚ) / b                     ≃ _ := Rel.symm Rational.div_neg_cancel
        (-(a : ℚ)) / (-(b : ℚ))         ≃ _ := Rational.div_substL neg_eqv
        ((-a : ℤ) : ℚ) / (-b : ℚ)       ≃ _ := Rational.div_substR neg_eqv
        ((-a : ℤ) : ℚ) / ((-b : ℤ) : ℚ) ≃ _ := Rational.eqv_refl
      exact AltPositive.mk this
  case mpr =>
    intro (_ : AltPositive x)
    show Positive x
    have (AltPositive.intro a b a_pos b_pos x_eqv) := ‹AltPositive x›
    have : AP (Positive a) := a_pos
    have : sgn a ≃ 1 := Integer.sgn_positive.mp this.ev
    have : AP (Positive b) := b_pos
    have : sgn b ≃ 1 := Integer.sgn_positive.mp this.ev
    have : x ≃ a / b := x_eqv

    have : sgn a ≃ sgn b := Rel.trans ‹sgn a ≃ 1› (Rel.symm ‹sgn b ≃ 1›)
    have : Integer.Nonzero b := Integer.nonzero_from_positive_inst
    have : Integer.Sqrt1 (sgn b) := Integer.sgn_nonzero.mp this
    have : sgn x ≃ 1 := calc
      sgn x                   ≃ _ := Rational.sgn_subst ‹x ≃ a / b›
      sgn ((a : ℚ) / (b : ℚ)) ≃ _ := Rational.sgn_div_integers
      sgn a * sgn b           ≃ _ := Integer.mul_sqrt1_eqv.mpr ‹sgn a ≃ sgn b›
      1                       ≃ _ := Rel.refl
    have : Positive x := Rational.sgn_positive.mpr this
    exact this

-- It is said to be _negative_ iff we have `x ≃ -y` for some positive rational
-- `y` (i.e., `x ≃ (-a)/b` for some positive integers `a` and `b`).
theorem negative_iff_neg_positive
    {x : ℚ} : Negative x ↔ ∃ (y : ℚ), Positive y ∧ x ≃ -y
    := by
  apply Iff.intro
  case mp =>
    intro (_ : Negative x)
    show ∃ (y : ℚ), Positive y ∧ x ≃ -y
    have : sgn x ≃ -1 := Rational.sgn_negative.mp ‹Negative x›
    have : sgn (-x) ≃ 1 := calc
      sgn (-x) ≃ _ := Rational.sgn_compat_neg
      (-sgn x) ≃ _ := AA.subst₁ ‹sgn x ≃ -1›
      (-(-1))  ≃ _ := Integer.neg_involutive
      1        ≃ _ := Rel.refl
    have : Positive (-x) := Rational.sgn_positive.mpr ‹sgn (-x) ≃ 1›
    have : x ≃ -(-x) := Rational.eqv_symm Rational.neg_involutive
    exact Exists.intro (-x) (And.intro ‹Positive (-x)› ‹x ≃ -(-x)›)
  case mpr =>
    intro (Exists.intro (y : ℚ) (And.intro (_ : Positive y) (_ : x ≃ -y)))
    show Negative x
    have : sgn y ≃ 1 := Rational.sgn_positive.mp ‹Positive y›
    have : sgn x ≃ -1 := calc
      sgn x      ≃ _ := Rational.sgn_subst ‹x ≃ -y›
      sgn (-y)   ≃ _ := Rational.sgn_compat_neg
      (-(sgn y)) ≃ _ := AA.subst₁ ‹sgn y ≃ 1›
      (-1)       ≃ _ := Rel.refl
    have : Negative x := Rational.sgn_negative.mpr this
    exact this

inductive AltNegative (x : ℚ) : Prop :=
| intro
    (a b : ℤ)
    (a_pos : AP (Positive a))
    (b_pos : AP (Positive b))
    (eqv : x ≃ (-a) / b)

def AltNegative.mk
    {a b : ℤ} {x : ℚ} [AP (Positive a)] [AP (Positive b)] (_ : x ≃ (-a) / b)
    : AltNegative x
    :=
  AltNegative.intro a b ‹AP (Positive a)› ‹AP (Positive b)› ‹x ≃ (-a) / b›

theorem alt_negative {x : ℚ} : Negative x ↔ AltNegative x := by
  apply Iff.intro
  case mp =>
    intro (_ : Negative x)
    show AltNegative x
    have (Exists.intro (y : ℚ) (And.intro (_ : Positive y) (_ : x ≃ -y))) :=
      negative_iff_neg_positive.mp ‹Negative x›
    have
      (AltPositive.intro
        (a : ℤ) (b : ℤ)
        (_ : AP (Positive a)) (_ : AP (Positive b)) y_eqv_a_over_b)
      := alt_positive.mp ‹Positive y›
    have : y ≃ a / b := y_eqv_a_over_b
    have : x ≃ (-a) / b := calc
      x                ≃ _ := ‹x ≃ -y›
      (-y)             ≃ _ := Rational.neg_subst ‹y ≃ a / b›
      (-((a : ℚ) / b)) ≃ _ := Rational.neg_scompatL_div
      (-a : ℚ) / b     ≃ _ := Rational.eqv_refl
    exact AltNegative.mk this
  case mpr =>
    intro (_ : AltNegative x)
    show Negative x
    have
      (AltNegative.intro
        (a : ℤ) (b : ℤ)
        (_ : AP (Positive a)) (_ : AP (Positive b)) x_eqv_neg_a_over_b)
      := ‹AltNegative x›
    have : x ≃ (-a) / b := x_eqv_neg_a_over_b
    have : AltPositive ((a : ℚ) / b) := AltPositive.mk Rational.eqv_refl
    have : Positive ((a : ℚ) / b) := alt_positive.mpr this
    have : x ≃ -((a : ℚ) / b) := calc
      x                ≃ _ := ‹x ≃ (-a) / b›
      (-a : ℚ) / b     ≃ _ := Rational.eqv_symm Rational.neg_scompatL_div
      (-((a : ℚ) / b)) ≃ _ := Rational.eqv_refl
    have : ∃ (y : ℚ), Positive y ∧ x ≃ -y :=
      Exists.intro ((a : ℚ) / b) (And.intro ‹Positive ((a : ℚ) / b)› this)
    have : Negative x := negative_iff_neg_positive.mpr this
    exact this

-- Thus for instance, every positive integer is a positive rational number, and
-- every negative integer is a negative rational number, so our new definition
-- is consistent with our old one.
example {a : ℤ} : Positive a → Positive (a : ℚ) := by
  intro (_ : Positive a)
  show Positive (a : ℚ)
  have : sgn a ≃ 1 := Integer.sgn_positive.mp ‹Positive a›
  have : sgn (a : ℚ) ≃ 1 := calc
    sgn (a : ℚ) ≃ _ := Rational.sgn_from_integer
    sgn a       ≃ _ := ‹sgn a ≃ 1›
    1           ≃ _ := Rel.refl
  have : Positive (a : ℚ) := Rational.sgn_positive.mpr this
  exact this

example {a : ℤ} : Negative a → Negative (a : ℚ) := by
  intro (_ : Negative a)
  show Negative (a : ℚ)
  have : sgn a ≃ -1 := Integer.sgn_negative.mp ‹Negative a›
  have : sgn (a : ℚ) ≃ -1 := calc
    sgn (a : ℚ) ≃ _ := Rational.sgn_from_integer
    sgn a       ≃ _ := ‹sgn a ≃ -1›
    (-1)        ≃ _ := Rel.refl
  have : Negative (a : ℚ) := Rational.sgn_negative.mpr this
  exact this

-- Exercise 4.2.4.
-- Lemma 4.2.7 (Trichotomy of rationals).
-- Let `x` be a rational number. Then exactly one of the following three
-- statements is true: (a) `x` is equal to `0`. (b) `x` is a positive rational
-- number. (c) `x` is a negative rational number.
example {x : ℚ} : AA.ExactlyOneOfThree (x ≃ 0) (Positive x) (Negative x) := by
  have : AA.OneOfThree (sgn x ≃ 0) (sgn x ≃ 1) (sgn x ≃ -1) :=
    Rational.sgn_trichotomy x
  have atLeastOne : AA.OneOfThree (x ≃ 0) (Positive x) (Negative x) :=
    this.map
      Rational.sgn_zero.mpr Rational.sgn_positive.mpr Rational.sgn_negative.mpr

  have : ¬AA.TwoOfThree (sgn x ≃ 0) (sgn x ≃ 1) (sgn x ≃ -1) :=
    Integer.signs_distinct
  have atMostOne : ¬AA.TwoOfThree (x ≃ 0) (Positive x) (Negative x) :=
    mt
      (AA.TwoOfThree.map
        Rational.sgn_zero.mp Rational.sgn_positive.mp Rational.sgn_negative.mp)
      this

  exact AA.ExactlyOneOfThree.mk atLeastOne atMostOne

-- Definition 4.2.8 (Ordering of the rationals).
-- [First, here are the axioms for the operators.]
example : ℚ → ℚ → Prop := Rational.lt -- [Less than.]
example : ℚ → ℚ → Prop := Rational.le -- [Less than or equivalent.]
-- [The "greater than" variants use `lt` and `le`, but with swapped arguments.]

-- [Here are the operator definitions.]
example : ℚ → ℚ → Prop := Rational.Impl.Generic.lt
example : ℚ → ℚ → Prop := Rational.Impl.Generic.le

-- Let `x` and `y` be rational numbers. We say that `x > y` iff `x - y` is a
-- positive rational number, and `x < y` iff `x - y` is a negative rational
-- number. We write `x ≥ y` iff either `x > y` or `x = y`, and similarly define
-- `x ≤ y`.
example {x y : ℚ} : x > y ↔ Positive (x - y) := by
  apply Iff.intro
  case mp =>
    intro (_ : x > y)
    show Positive (x - y)
    have : sgn (x - y) ≃ 1 := Rational.gt_sgn.mp ‹x > y›
    have : Positive (x - y) := Rational.sgn_positive.mpr this
    exact this
  case mpr =>
    intro (_ : Positive (x - y))
    show x > y
    have : sgn (x - y) ≃ 1 := Rational.sgn_positive.mp ‹Positive (x - y)›
    have : x > y := Rational.gt_sgn.mpr this
    exact this

example {x y : ℚ} : x < y ↔ Negative (x - y) := by
  apply Iff.intro
  case mp =>
    intro (_ : x < y)
    show Negative (x - y)
    have : sgn (x - y) ≃ -1 := Rational.lt_sgn.mp ‹x < y›
    have : Negative (x - y) := Rational.sgn_negative.mpr this
    exact this
  case mpr =>
    intro (_ : Negative (x - y))
    show x < y
    have : sgn (x - y) ≃ -1 := Rational.sgn_negative.mp ‹Negative (x - y)›
    have : x < y := Rational.lt_sgn.mpr this
    exact this

example {x y : ℚ} : x ≥ y ↔ x > y ∨ x ≃ y := Rational.ge_cases
example {x y : ℚ} : x ≤ y ↔ x < y ∨ x ≃ y := Rational.le_cases

-- Exercise 4.2.5.
-- Proposition 4.2.9 (Basic properties of order on the rationals).
-- Let `x`, `y`, `z` be rational numbers. Then the following properties hold.

-- (a) (Order trichotomy) Exactly one of the three statements `x ≃ y`, `x < y`,
-- or `x > y` is true.
example : ∀ (x y : ℚ), AA.ExactlyOneOfThree (x < y) (x ≃ y) (x > y) :=
  Rational.order_trichotomy

-- (b) (Order is anti-symmetric) One has `x < y` if and only if `y > x`.
-- [Note: This is trivial because `· > ·` is defined to be `· < ·` with swapped
-- arguments.]
example {x y : ℚ} : x < y ↔ y > x := Iff.intro id id

-- (c) (Order is transitive) If `x < y` and `y < z`, then `x < z`.
example {x y z : ℚ} : x < y → y < z → x < z := Rational.lt_trans

-- (d) (Addition preserves order) If `x < y`, then `x + z < y + z`.
example {x y z : ℚ} : x < y → x + z < y + z := by
  intro (_ : x < y)
  show x + z < y + z
  have : sgn (x - y) ≃ -1 := Rational.lt_sgn.mp ‹x < y›
  have : (x + z) - (y + z) ≃ x - y := Rational.sub_cancelR_add
  have : sgn ((x + z) - (y + z)) ≃ -1 := calc
    sgn ((x + z) - (y + z)) ≃ _ := Rational.sgn_subst this
    sgn (x - y)             ≃ _ := ‹sgn (x - y) ≃ -1›
    (-1)                    ≃ _ := Rel.refl
  have : x + z < y + z := Rational.lt_sgn.mpr this
  exact this

-- (e) (Positive multiplication preserves order) If `x < y` and `z` is
-- positive, then `x * z < y * z`.
example {x y z : ℚ} : x < y → Positive z → x * z < y * z := by
  intro (_ : x < y) (_ : Positive z)
  show x * z < y * z
  have : sgn (x - y) ≃ -1 := Rational.lt_sgn.mp ‹x < y›
  have : sgn z ≃ 1 := Rational.sgn_positive.mp ‹Positive z›
  have : x * z - y * z ≃ (x - y) * z := Rel.symm Rational.mul_distribR_sub
  have : sgn (x * z - y * z) ≃ -1 := calc
    sgn (x * z - y * z) ≃ _ := Rational.sgn_subst this
    sgn ((x - y) * z)   ≃ _ := Rational.sgn_compat_mul
    sgn (x - y) * sgn z ≃ _ := AA.substR ‹sgn z ≃ 1›
    sgn (x - y) * 1     ≃ _ := AA.identR
    sgn (x - y)         ≃ _ := ‹sgn (x - y) ≃ -1›
    (-1)                ≃ _ := Rel.refl
  have : x * z < y * z := Rational.lt_sgn.mpr this
  exact this

-- Exercise 4.2.6.
-- Show that if `x`, `y`, `z` are rational numbers such that `x < y` and `z` is
-- _negative_, then `x * z > y * z`.
example {x y z : ℚ} : x < y → Negative z → x * z > y * z := by
  intro (_ : x < y) (_ : Negative z)
  show x * z > y * z
  have : sgn (x - y) ≃ -1 := Rational.lt_sgn.mp ‹x < y›
  have : sgn z ≃ -1 := Rational.sgn_negative.mp ‹Negative z›
  have : x * z - y * z ≃ (x - y) * z := Rel.symm Rational.mul_distribR_sub
  have : sgn (x * z - y * z) ≃ 1 := calc
    sgn (x * z - y * z) ≃ _ := Rational.sgn_subst this
    sgn ((x - y) * z)   ≃ _ := Rational.sgn_compat_mul
    sgn (x - y) * sgn z ≃ _ := AA.substR ‹sgn z ≃ -1›
    sgn (x - y) * (-1)  ≃ _ := AA.substL ‹sgn (x - y) ≃ -1›
    (-1) * (-1)         ≃ _ := Integer.sqrt1_neg_one.elim
    1                   ≃ _ := Rel.refl
  have : x * z > y * z := Rational.gt_sgn.mpr this
  exact this

end AnalysisI.Ch4.Sec2


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson, Markus Himmel
-/
import data.nat.bitwise
import set_theory.game.birthday
import set_theory.game.impartial

/-!
# Nim and the Sprague-Grundy theorem

This file contains the definition for nim for any ordinal `O`. In the game of `nim O₁` both players
may move to `nim O₂` for any `O₂ < O₁`.
We also define a Grundy value for an impartial game `G` and prove the Sprague-Grundy theorem, that
`G` is equivalent to `nim (grundy_value G)`.
Finally, we compute the sum of finite Grundy numbers: if `G` and `H` have Grundy values `n` and `m`,
where `n` and `m` are natural numbers, then `G + H` has the Grundy value `n xor m`.

## Implementation details

The pen-and-paper definition of nim defines the possible moves of `nim O` to be `{O' | O' < O}`.
However, this definition does not work for us because it would make the type of nim
`ordinal.{u} → pgame.{u + 1}`, which would make it impossible for us to state the Sprague-Grundy
theorem, since that requires the type of `nim` to be `ordinal.{u} → pgame.{u}`. For this reason, we
instead use `O.out.α` for the possible moves, which makes proofs significantly more messy and
tedious, but avoids the universe bump.

The lemma `nim_def` is somewhat prone to produce "motive is not type correct" errors. If you run
into this problem, you may find the lemmas `exists_ordinal_move_left_eq` and `exists_move_left_eq`
useful.

-/
universes u

/-- `ordinal.out'` has the sole purpose of making `nim` computable. It performs the same job as
  `quotient.out` but is specific to ordinals. -/
def ordinal.out' (o : ordinal) : Well_order :=
⟨o.out.α, (<), o.out.wo⟩

/-- The definition of single-heap nim, which can be viewed as a pile of stones where each player can
  take a positive number of stones from it on their turn. -/
def nim : ordinal → pgame
| O₁ := let f := λ O₂, have hwf : ordinal.typein O₁.out'.r O₂ < O₁ := ordinal.typein_lt_self O₂,
          nim (ordinal.typein O₁.out'.r O₂) in ⟨O₁.out'.α, O₁.out'.α, f, f⟩
using_well_founded { dec_tac := tactic.assumption }

namespace pgame

local infix ` ⧏ `:50 := lf
local infix ` ≈ ` := equiv
local infix ` ∥ `:50 := fuzzy
local infix ` ≡r `:50 := relabelling

namespace nim

open ordinal

lemma nim_def (O : ordinal) : nim O = pgame.mk O.out.α O.out.α
  (λ O₂, nim (ordinal.typein (<) O₂))
  (λ O₂, nim (ordinal.typein (<) O₂)) :=
by { rw nim, refl }

instance : is_empty (nim 0).left_moves :=
by { rw nim_def, exact ordinal.is_empty_out_zero }

instance : is_empty (nim 0).right_moves :=
by { rw nim_def, exact ordinal.is_empty_out_zero }

noncomputable instance : unique (nim 1).left_moves :=
by { rw nim_def, exact ordinal.unique_out_one }

noncomputable instance : unique (nim 1).right_moves :=
by { rw nim_def, exact ordinal.unique_out_one }

/-- `nim 0` has exactly the same moves as `0`. -/
def nim_zero_relabelling : nim 0 ≡r 0 := relabelling.is_empty _

@[simp] theorem nim_zero_equiv : nim 0 ≈ 0 := equiv.is_empty _

/-- `nim 1` has exactly the same moves as `star`. -/
noncomputable def nim_one_relabelling : nim 1 ≡r star :=
begin
  rw nim_def,
  refine ⟨_, _, λ i, _, λ j, _⟩,
  any_goals { dsimp, apply equiv.equiv_of_unique },
  all_goals { simp, exact nim_zero_relabelling }
end

@[simp] theorem nim_one_equiv : nim 1 ≈ star := nim_one_relabelling.equiv

@[simp] lemma nim_birthday (O : ordinal) : (nim O).birthday = O :=
begin
  induction O using ordinal.induction with O IH,
  rw [nim_def, birthday_def],
  dsimp,
  rw max_eq_right le_rfl,
  convert lsub_typein O,
  exact funext (λ i, IH _ (typein_lt_self i))
end

lemma left_moves_nim (O : ordinal) : (nim O).left_moves = O.out.α :=
by { rw nim_def, refl }
lemma right_moves_nim (O : ordinal) : (nim O).right_moves = O.out.α :=
by { rw nim_def, refl }

lemma move_left_nim_heq (O : ordinal) : (nim O).move_left == λ i : O.out.α, nim (typein (<) i) :=
by { rw nim_def, refl }
lemma move_right_nim_heq (O : ordinal) : (nim O).move_right == λ i : O.out.α, nim (typein (<) i) :=
by { rw nim_def, refl }

/-- Turns an ordinal less than `O` into a left move for `nim O` and viceversa. -/
noncomputable def to_left_moves_nim {O : ordinal} : set.Iio O ≃ (nim O).left_moves :=
(enum_iso_out O).to_equiv.trans (equiv.cast (left_moves_nim O).symm)

/-- Turns an ordinal less than `O` into a right move for `nim O` and viceversa. -/
noncomputable def to_right_moves_nim {O : ordinal} : set.Iio O ≃ (nim O).right_moves :=
(enum_iso_out O).to_equiv.trans (equiv.cast (right_moves_nim O).symm)

@[simp]

@[simp] theorem to_right_moves_nim_symm_lt {O : ordinal} (i : (nim O).right_moves) :
  ↑(to_right_moves_nim.symm i) < O :=
(to_right_moves_nim.symm i).prop

@[simp] lemma move_left_nim' {O : ordinal.{u}} (i) :
  (nim O).move_left i = nim (to_left_moves_nim.symm i).val :=
(congr_heq (move_left_nim_heq O).symm (cast_heq _ i)).symm

lemma move_left_nim {O : ordinal} (i) :
  (nim O).move_left (to_left_moves_nim i) = nim i :=
by simp

@[simp] lemma move_right_nim' {O : ordinal} (i) :
  (nim O).move_right i = nim (to_right_moves_nim.symm i).val :=
(congr_heq (move_right_nim_heq O).symm (cast_heq _ i)).symm

lemma move_right_nim {O : ordinal} (i) :
  (nim O).move_right (to_right_moves_nim i) = nim i :=
by simp

@[simp] lemma neg_nim (O : ordinal) : -nim O = nim O :=
begin
  induction O using ordinal.induction with O IH,
  rw nim_def, dsimp; congr;
  funext i;
  exact IH _ (ordinal.typein_lt_self i)
end

instance nim_impartial (O : ordinal) : impartial (nim O) :=
begin
  induction O using ordinal.induction with O IH,
  rw [impartial_def, neg_nim],
  refine ⟨equiv_rfl, λ i, _, λ i, _⟩;
  simpa using IH _ (typein_lt_self _)
end

lemma exists_ordinal_move_left_eq {O : ordinal} (i) : ∃ O' < O, (nim O).move_left i = nim O' :=
⟨_, typein_lt_self _, move_left_nim' i⟩

lemma exists_move_left_eq {O O' : ordinal} (h : O' < O) : ∃ i, (nim O).move_left i = nim O' :=
⟨to_left_moves_nim ⟨O', h⟩, by simp⟩

lemma non_zero_first_wins {O : ordinal} (hO : O ≠ 0) : nim O ∥ 0 :=
begin
  rw [impartial.fuzzy_zero_iff_lf, nim_def, lf_zero_le],
  rw ←ordinal.pos_iff_ne_zero at hO,
  exact ⟨(ordinal.principal_seg_out hO).top, by simp⟩
end

@[simp] lemma add_equiv_zero_iff_eq (O₁ O₂ : ordinal) : nim O₁ + nim O₂ ≈ 0 ↔ O₁ = O₂ :=
begin
  split,
  { contrapose,
    intro h,
    rw [impartial.not_equiv_zero_iff],
    wlog h' : O₁ ≤ O₂ using [O₁ O₂, O₂ O₁],
    { exact le_total O₁ O₂ },
    { have h : O₁ < O₂ := lt_of_le_of_ne h' h,
      rw [impartial.fuzzy_zero_iff_gf, zero_lf_le, nim_def O₂],
      refine ⟨to_left_moves_add (sum.inr _), _⟩,
      { exact (ordinal.principal_seg_out h).top },
      { simpa using (impartial.add_self (nim O₁)).2 } },
    { exact (fuzzy_congr_left add_comm_equiv).1 (this (ne.symm h)) } },
  { rintro rfl,
    exact impartial.add_self (nim O₁) }
end

@[simp] lemma add_fuzzy_zero_iff_ne (O₁ O₂ : ordinal) : nim O₁ + nim O₂ ∥ 0 ↔ O₁ ≠ O₂ :=
by rw [iff_not_comm, impartial.not_fuzzy_zero_iff, add_equiv_zero_iff_eq]

@[simp] lemma equiv_iff_eq (O₁ O₂ : ordinal) : nim O₁ ≈ nim O₂ ↔ O₁ = O₂ :=
by rw [impartial.equiv_iff_add_equiv_zero, add_equiv_zero_iff_eq]

end nim

/-- The Grundy value of an impartial game, the ordinal which corresponds to the game of nim that the
 game is equivalent to -/
noncomputable def grundy_value : Π (G : pgame.{u}), ordinal.{u}
| G := ordinal.mex.{u u} (λ i, grundy_value (G.move_left i))
using_well_founded { dec_tac := pgame_wf_tac }

lemma grundy_value_def (G : pgame) :
  grundy_value G = ordinal.mex.{u u} (λ i, grundy_value (G.move_left i)) :=
by rw grundy_value

/-- The Sprague-Grundy theorem which states that every impartial game is equivalent to a game of
 nim, namely the game of nim corresponding to the games Grundy value -/
theorem equiv_nim_grundy_value : ∀ (G : pgame.{u}) [G.impartial], G ≈ nim (grundy_value G)
| G :=
begin
  introI hG,
  rw [impartial.equiv_iff_add_equiv_zero, ←impartial.forall_left_moves_fuzzy_iff_equiv_zero],
  intro i,
  apply left_moves_add_cases i,
  { intro i₁,
    rw add_move_left_inl,
    apply (fuzzy_congr_left (add_congr_left (equiv_nim_grundy_value (G.move_left i₁)).symm)).1,
    rw nim.add_fuzzy_zero_iff_ne,
    intro heq,
    rw [eq_comm, grundy_value_def G] at heq,
    have h := ordinal.ne_mex _,
    rw heq at h,
    exact (h i₁).irrefl },
  { intro i₂,
    rw [add_move_left_inr, ←impartial.exists_left_move_equiv_iff_fuzzy_zero],
    revert i₂,
    rw nim.nim_def,
    intro i₂,

    have h' : ∃ i : G.left_moves, (grundy_value (G.move_left i)) =
      ordinal.typein (quotient.out (grundy_value G)).r i₂,
    { revert i₂,
      rw grundy_value_def,
      intros i₂,
      have hnotin : _ ∉ _ := λ hin, (le_not_le_of_lt (ordinal.typein_lt_self i₂)).2 (cInf_le' hin),
      simpa using hnotin},

    cases h' with i hi,
    use to_left_moves_add (sum.inl i),
    rw [add_move_left_inl, move_left_mk],
    apply (add_congr_left (equiv_nim_grundy_value (G.move_left i))).trans,
    simpa only [hi] using impartial.add_self (nim (grundy_value (G.move_left i))) }
end
using_well_founded { dec_tac := pgame_wf_tac }

@[simp] lemma grundy_value_eq_iff_equiv_nim (G : pgame) [G.impartial] (O : ordinal) :
  grundy_value G = O ↔ G ≈ nim O :=
⟨by { rintro rfl, exact equiv_nim_grundy_value G },
  by { intro h, rw ←nim.equiv_iff_eq, exact (equiv_nim_grundy_value G).symm.trans h }⟩

lemma nim.grundy_value (O : ordinal.{u}) : grundy_value (nim O) = O :=
by simp

@[simp] lemma grundy_value_eq_iff_equiv (G H : pgame) [G.impartial] [H.impartial] :
  grundy_value G = grundy_value H ↔ G ≈ H :=
(grundy_value_eq_iff_equiv_nim _ _).trans (equiv_congr_left.1 (equiv_nim_grundy_value H) _).symm

@[simp] lemma grundy_value_zero : grundy_value 0 = 0 := by simp [nim.nim_zero_equiv.symm]

@[simp] lemma grundy_value_iff_equiv_zero (G : pgame) [G.impartial] : grundy_value G = 0 ↔ G ≈ 0 :=
by rw [←grundy_value_eq_iff_equiv, grundy_value_zero]

lemma grundy_value_star : grundy_value star = 1 := by simp [nim.nim_one_equiv.symm]

@[simp] lemma grundy_value_nim_add_nim (n m : ℕ) :
  grundy_value (nim.{u} n + nim.{u} m) = nat.lxor n m :=
begin
  induction n using nat.strong_induction_on with n hn generalizing m,
  induction m using nat.strong_induction_on with m hm,
  rw [grundy_value_def],

  -- We want to show that `n xor m` is the smallest unreachable Grundy value. We will do this in two
  -- steps:
  -- h₀: `n xor m` is not a reachable grundy number.
  -- h₁: every Grundy number strictly smaller than `n xor m` is reachable.

  have h₀ : ∀ i, grundy_value ((nim n + nim m).move_left i) ≠ (nat.lxor n m : ordinal),
  { -- To show that `n xor m` is unreachable, we show that every move produces a Grundy number
    -- different from `n xor m`.
    intro i,

    -- The move operates either on the left pile or on the right pile.
    apply left_moves_add_cases i,

    all_goals
    { -- One of the piles is reduced to `k` stones, with `k < n` or `k < m`.
      intro a,
      obtain ⟨ok, hk, hk'⟩ := nim.exists_ordinal_move_left_eq a,
      obtain ⟨k, rfl⟩ := ordinal.lt_omega.1 (lt_trans hk (ordinal.nat_lt_omega _)),
      replace hk := ordinal.nat_cast_lt.1 hk,

      -- Thus, the problem is reduced to computing the Grundy value of `nim n + nim k` or
      -- `nim k + nim m`, both of which can be dealt with using an inductive hypothesis.
      simp only [hk', add_move_left_inl, add_move_left_inr, id],
      rw hn _ hk <|> rw hm _ hk,

      -- But of course xor is injective, so if we change one of the arguments, we will not get the
      -- same value again.
      intro h,
      rw ordinal.nat_cast_inj at h,
      try { rw [nat.lxor_comm n k, nat.lxor_comm n m] at h },
      exact hk.ne (nat.lxor_left_inj h) } },

  have h₁ : ∀ (u : ordinal), u < nat.lxor n m →
    u ∈ set.range (λ i, grundy_value ((nim n + nim m).move_left i)),
  { -- Take any natural number `u` less than `n xor m`.
    intros ou hu,
    obtain ⟨u, rfl⟩ := ordinal.lt_omega.1 (lt_trans hu (ordinal.nat_lt_omega _)),
    replace hu := ordinal.nat_cast_lt.1 hu,

    -- Our goal is to produce a move that gives the Grundy value `u`.
    rw set.mem_range,

    -- By a lemma about xor, either `u xor m < n` or `u xor n < m`.
    have : nat.lxor u (nat.lxor n m) ≠ 0,
    { intro h, rw nat.lxor_eq_zero at h, linarith },
    rcases nat.lxor_trichotomy this with h|h|h,
    { linarith },

    -- Therefore, we can play the corresponding move, and by the inductive hypothesis the new state
    -- is `(u xor m) xor m = u` or `n xor (u xor n) = u` as required.
    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq (ordinal.nat_cast_lt.2 h),
      refine ⟨to_left_moves_add (sum.inl i), _⟩,
      simp only [hi, add_move_left_inl],
      rw [hn _ h, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] },
    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq (ordinal.nat_cast_lt.2 h),
      refine ⟨to_left_moves_add (sum.inr i), _⟩,
      simp only [hi, add_move_left_inr],
      rw [hm _ h, nat.lxor_comm, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] } },

  -- We are done!
  apply (ordinal.mex_le_of_ne.{u u} h₀).antisymm,
  contrapose! h₁,
  exact ⟨_, ⟨h₁, ordinal.mex_not_mem_range _⟩⟩,
end

lemma nim_add_nim_equiv {n m : ℕ} : nim n + nim m ≈ nim (nat.lxor n m) :=
by rw [←grundy_value_eq_iff_equiv_nim, grundy_value_nim_add_nim]

lemma grundy_value_add (G H : pgame) [G.impartial] [H.impartial] {n m : ℕ} (hG : grundy_value G = n)
  (hH : grundy_value H = m) : grundy_value (G + H) = nat.lxor n m :=
begin
  rw [←nim.grundy_value (nat.lxor n m), grundy_value_eq_iff_equiv],
  refine equiv.trans _ nim_add_nim_equiv,
  convert add_congr (equiv_nim_grundy_value G) (equiv_nim_grundy_value H);
  simp only [hG, hH]
end

end pgame


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

! This file was ported from Lean 3 source module dynamics.omega_limit
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Dynamics.Flow
import Mathlib.Tactic.Monotonicity

/-!
# ω-limits

For a function `ϕ : τ → α → β` where `β` is a topological space, we
define the ω-limit under `ϕ` of a set `s` in `α` with respect to
filter `f` on `τ`: an element `y : β` is in the ω-limit of `s` if the
forward images of `s` intersect arbitrarily small neighbourhoods of
`y` frequently "in the direction of `f`".

In practice `ϕ` is often a continuous monoid-act, but the definition
requires only that `ϕ` has a coercion to the appropriate function
type. In the case where `τ` is `ℕ` or `ℝ` and `f` is `atTop`, we
recover the usual definition of the ω-limit set as the set of all `y`
such that there exist sequences `(tₙ)`, `(xₙ)` such that `ϕ tₙ xₙ ⟶ y`
as `n ⟶ ∞`.

## Notations

The `omegaLimit` locale provides the localised notation `ω` for
`omegaLimit`, as well as `ω⁺` and `ω⁻` for `omegaLimit atTop` and
`omegaLimit atBot` respectively for when the acting monoid is
endowed with an order.
-/

open Set Function Filter

open Topology

/-!
### Definition and notation
-/

section omegaLimit

variable {τ : Type _} {α : Type _} {β : Type _} {ι : Type _}

/-- The ω-limit of a set `s` under `ϕ` with respect to a filter `f` is
    ⋂ u ∈ f, cl (ϕ u s). -/
def omegaLimit [TopologicalSpace β] (f : Filter τ) (ϕ : τ → α → β) (s : Set α) : Set β :=
  ⋂ u ∈ f, closure (image2 ϕ u s)
#align omega_limit omegaLimit

-- mathport name: omega_limit
scoped[omegaLimit] notation "ω" => omegaLimit

-- mathport name: omega_limit.atTop
scoped[omegaLimit] notation "ω⁺" => omegaLimit Filter.atTop

-- mathport name: omega_limit.atBot
scoped[omegaLimit] notation "ω⁻" => omegaLimit Filter.atBot

variable [TopologicalSpace β]

variable (f : Filter τ) (ϕ : τ → α → β) (s s₁ s₂ : Set α)

/-!
### Elementary properties
-/
open omegaLimit

theorem omegaLimit_def : ω f ϕ s = ⋂ u ∈ f, closure (image2 ϕ u s) := rfl
#align omega_limit_def omegaLimit_def

theorem omegaLimit_subset_of_tendsto {m : τ → τ} {f₁ f₂ : Filter τ} (hf : Tendsto m f₁ f₂) :
    ω f₁ (fun t x ↦ ϕ (m t) x) s ⊆ ω f₂ ϕ s := by
  refine' interᵢ₂_mono' fun u hu ↦ ⟨m ⁻¹' u, tendsto_def.mp hf _ hu, _⟩
  rw [← image2_image_left]
  exact closure_mono (image2_subset (image_preimage_subset _ _) Subset.rfl)
#align omega_limit_subset_of_tendsto omegaLimit_subset_of_tendsto

theorem omegaLimit_mono_left {f₁ f₂ : Filter τ} (hf : f₁ ≤ f₂) : ω f₁ ϕ s ⊆ ω f₂ ϕ s :=
  omegaLimit_subset_of_tendsto ϕ s (tendsto_id'.2 hf)
#align omega_limit_mono_left omegaLimit_mono_left

theorem omegaLimit_mono_right {s₁ s₂ : Set α} (hs : s₁ ⊆ s₂) : ω f ϕ s₁ ⊆ ω f ϕ s₂ :=
  interᵢ₂_mono fun _u _hu ↦ closure_mono (image2_subset Subset.rfl hs)
#align omega_limit_mono_right omegaLimit_mono_right

theorem isClosed_omegaLimit : IsClosed (ω f ϕ s) :=
  isClosed_interᵢ fun _u ↦ isClosed_interᵢ fun _hu ↦ isClosed_closure
#align is_closed_omega_limit isClosed_omegaLimit

theorem mapsTo_omega_limit' {α' β' : Type _} [TopologicalSpace β'] {f : Filter τ} {ϕ : τ → α → β}
    {ϕ' : τ → α' → β'} {ga : α → α'} {s' : Set α'} (hs : MapsTo ga s s') {gb : β → β'}
    (hg : ∀ᶠ t in f, EqOn (gb ∘ ϕ t) (ϕ' t ∘ ga) s) (hgc : Continuous gb) :
    MapsTo gb (ω f ϕ s) (ω f ϕ' s') := by
  simp only [omegaLimit_def, mem_interᵢ, MapsTo]
  intro y hy u hu
  refine' map_mem_closure hgc (hy _ (inter_mem hu hg)) (forall_image2_iff.2 fun t ht x hx ↦ _)
  calc
    gb (ϕ t x) = ϕ' t (ga x) := ht.2 hx
    _ ∈ image2 ϕ' u s' := mem_image2_of_mem ht.1 (hs hx)

#align maps_to_omega_limit' mapsTo_omega_limit'

theorem mapsTo_omegaLimit {α' β' : Type _} [TopologicalSpace β'] {f : Filter τ} {ϕ : τ → α → β}
    {ϕ' : τ → α' → β'} {ga : α → α'} {s' : Set α'} (hs : MapsTo ga s s') {gb : β → β'}
    (hg : ∀ t x, gb (ϕ t x) = ϕ' t (ga x)) (hgc : Continuous gb) :
    MapsTo gb (ω f ϕ s) (ω f ϕ' s') :=
  mapsTo_omega_limit' _ hs (eventually_of_forall fun t x _hx ↦ hg t x) hgc
#align maps_to_omega_limit mapsTo_omegaLimit

theorem omegaLimit_image_eq {α' : Type _} (ϕ : τ → α' → β) (f : Filter τ) (g : α → α') :
    ω f ϕ (g '' s) = ω f (fun t x ↦ ϕ t (g x)) s := by simp only [omegaLimit, image2_image_right]
#align omega_limit_image_eq omegaLimit_image_eq

theorem omegaLimit_preimage_subset {α' : Type _} (ϕ : τ → α' → β) (s : Set α') (f : Filter τ)
    (g : α → α') : ω f (fun t x ↦ ϕ t (g x)) (g ⁻¹' s) ⊆ ω f ϕ s :=
  mapsTo_omegaLimit _ (mapsTo_preimage _ _) (fun _t _x ↦ rfl) continuous_id
#align omega_limit_preimage_subset omegaLimit_preimage_subset

/-!
### Equivalent definitions of the omega limit

The next few lemmas are various versions of the property
characterising ω-limits:
-/

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    preimages of an arbitrary neighbourhood of `y` frequently
    (w.r.t. `f`) intersects of `s`. -/
theorem mem_omegaLimit_iff_frequently (y : β) :
    y ∈ ω f ϕ s ↔ ∀ n ∈ 𝓝 y, ∃ᶠ t in f, (s ∩ ϕ t ⁻¹' n).Nonempty := by
  simp_rw [frequently_iff, omegaLimit_def, mem_interᵢ, mem_closure_iff_nhds]
  constructor
  · intro h _ hn _ hu
    rcases h _ hu _ hn with ⟨_, _, _, _, ht, hx, hϕtx⟩
    exact ⟨_, ht, _, hx, by rwa [mem_preimage, hϕtx]⟩
  · intro h _ hu _ hn
    rcases h _ hn hu with ⟨_, ht, _, hx, hϕtx⟩
    exact ⟨_, hϕtx, _, _, ht, hx, rfl⟩
#align mem_omega_limit_iff_frequently mem_omegaLimit_iff_frequently

/-- An element `y` is in the ω-limit set of `s` w.r.t. `f` if the
    forward images of `s` frequently (w.r.t. `f`) intersect arbitrary
    neighbourhoods of `y`. -/
theorem mem_omegaLimit_iff_frequently₂ (y : β) :
    y ∈ ω f ϕ s ↔ ∀ n ∈ 𝓝 y, ∃ᶠ t in f, (ϕ t '' s ∩ n).Nonempty := by
  simp_rw [mem_omegaLimit_iff_frequently, image_inter_nonempty_iff]
#align mem_omega_limit_iff_frequently₂ mem_omegaLimit_iff_frequently₂

/-- An element `y` is in the ω-limit of `x` w.r.t. `f` if the forward
    images of `x` frequently (w.r.t. `f`) falls within an arbitrary
    neighbourhood of `y`. -/
theorem mem_omegaLimit_singleton_iff_map_cluster_point (x : α) (y : β) :
    y ∈ ω f ϕ {x} ↔ MapClusterPt y f fun t ↦ ϕ t x := by
  simp_rw [mem_omegaLimit_iff_frequently, mapClusterPt_iff, singleton_inter_nonempty, mem_preimage]
#align mem_omega_limit_singleton_iff_map_cluster_point mem_omegaLimit_singleton_iff_map_cluster_point

/-!
### Set operations and omega limits
-/

theorem omegaLimit_inter : ω f ϕ (s₁ ∩ s₂) ⊆ ω f ϕ s₁ ∩ ω f ϕ s₂ :=
  subset_inter (omegaLimit_mono_right _ _ (inter_subset_left _ _))
    (omegaLimit_mono_right _ _ (inter_subset_right _ _))
#align omega_limit_inter omegaLimit_inter

theorem omegaLimit_interᵢ (p : ι → Set α) : ω f ϕ (⋂ i, p i) ⊆ ⋂ i, ω f ϕ (p i) :=
  subset_interᵢ fun _i ↦ omegaLimit_mono_right _ _ (interᵢ_subset _ _)
#align omega_limit_Inter omegaLimit_interᵢ

theorem omegaLimit_union : ω f ϕ (s₁ ∪ s₂) = ω f ϕ s₁ ∪ ω f ϕ s₂ := by
  ext y; constructor
  · simp only [mem_union, mem_omegaLimit_iff_frequently, union_inter_distrib_right, union_nonempty,
      frequently_or_distrib]
    contrapose!
    simp only [not_frequently, not_nonempty_iff_eq_empty, ← subset_empty_iff]
    rintro ⟨⟨n₁, hn₁, h₁⟩, ⟨n₂, hn₂, h₂⟩⟩
    refine' ⟨n₁ ∩ n₂, inter_mem hn₁ hn₂, h₁.mono fun t ↦ _, h₂.mono fun t ↦ _⟩
    exacts[Subset.trans <| inter_subset_inter_right _ <| preimage_mono <| inter_subset_left _ _,
      Subset.trans <| inter_subset_inter_right _ <| preimage_mono <| inter_subset_right _ _]
  · rintro (hy | hy)
    exacts[omegaLimit_mono_right _ _ (subset_union_left _ _) hy,
      omegaLimit_mono_right _ _ (subset_union_right _ _) hy]
#align omega_limit_union omegaLimit_union

theorem omegaLimit_unionᵢ (p : ι → Set α) : (⋃ i, ω f ϕ (p i)) ⊆ ω f ϕ (⋃ i, p i) := by
  rw [unionᵢ_subset_iff]
  exact fun i ↦ omegaLimit_mono_right _ _ (subset_unionᵢ _ _)
#align omega_limit_Union omegaLimit_unionᵢ

/-!
Different expressions for omega limits, useful for rewrites. In
particular, one may restrict the intersection to sets in `f` which are
subsets of some set `v` also in `f`.
-/

theorem omegaLimit_eq_interᵢ : ω f ϕ s = ⋂ u : ↥f.sets, closure (image2 ϕ u s) :=
  binterᵢ_eq_interᵢ _ _
#align omega_limit_eq_Inter omegaLimit_eq_interᵢ

theorem omegaLimit_eq_bInter_inter {v : Set τ} (hv : v ∈ f) :
    ω f ϕ s = ⋂ u ∈ f, closure (image2 ϕ (u ∩ v) s) :=
  Subset.antisymm (interᵢ₂_mono' fun u hu ↦ ⟨u ∩ v, inter_mem hu hv, Subset.rfl⟩)
    (interᵢ₂_mono fun _u _hu ↦ closure_mono <| image2_subset (inter_subset_left _ _) Subset.rfl)
#align omega_limit_eq_bInter_inter omegaLimit_eq_bInter_inter

theorem omegaLimit_eq_interᵢ_inter {v : Set τ} (hv : v ∈ f) :
    ω f ϕ s = ⋂ u : ↥f.sets, closure (image2 ϕ (u ∩ v) s) := by
  rw [omegaLimit_eq_bInter_inter _ _ _ hv]
  apply binterᵢ_eq_interᵢ
#align omega_limit_eq_Inter_inter omegaLimit_eq_interᵢ_inter

theorem omegaLimit_subset_closure_fw_image {u : Set τ} (hu : u ∈ f) :
    ω f ϕ s ⊆ closure (image2 ϕ u s) := by
  rw [omegaLimit_eq_interᵢ]
  intro _ hx
  rw [mem_interᵢ] at hx
  exact hx ⟨u, hu⟩
#align omega_limit_subset_closure_fw_image omegaLimit_subset_closure_fw_image

/-!
### `ω-limits and compactness
-/

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset' {c : Set β}
    (hc₁ : IsCompact c) (hc₂ : ∃ v ∈ f, closure (image2 ϕ v s) ⊆ c) {n : Set β} (hn₁ : IsOpen n)
    (hn₂ : ω f ϕ s ⊆ n) : ∃ u ∈ f, closure (image2 ϕ u s) ⊆ n := by
  rcases hc₂ with ⟨v, hv₁, hv₂⟩
  let k := closure (image2 ϕ v s)
  have hk : IsCompact (k \ n) :=
    IsCompact.diff (isCompact_of_isClosed_subset hc₁ isClosed_closure hv₂) hn₁
  let j u := closure (image2 ϕ (u ∩ v) s)ᶜ
  have hj₁ : ∀ u ∈ f, IsOpen (j u) := fun _ _ ↦ isOpen_compl_iff.mpr isClosed_closure
  have hj₂ : k \ n ⊆ ⋃ u ∈ f, j u := by
    have : (⋃ u ∈ f, j u) = ⋃ u : (↥f.sets), j u := bunionᵢ_eq_unionᵢ _ _
    rw [this, diff_subset_comm, diff_unionᵢ]
    rw [omegaLimit_eq_interᵢ_inter _ _ _ hv₁] at hn₂
    simp_rw [diff_compl]
    rw [← inter_interᵢ]
    exact Subset.trans (inter_subset_right _ _) hn₂
  rcases hk.elim_finite_subcover_image hj₁ hj₂ with ⟨g, hg₁ : ∀ u ∈ g, u ∈ f, hg₂, hg₃⟩
  let w := (⋂ u ∈ g, u) ∩ v
  have hw₂ : w ∈ f := by simpa [*]
  have hw₃ : k \ n ⊆ closure (image2 ϕ w s)ᶜ := by
    apply Subset.trans hg₃
    simp only [unionᵢ_subset_iff, compl_subset_compl]
    intros u hu
    mono
    refine' interᵢ_subset_of_subset u (interᵢ_subset_of_subset hu _)
    all_goals exact Subset.rfl
  have hw₄ : kᶜ ⊆ closure (image2 ϕ w s)ᶜ := by
    simp only [compl_subset_compl]
    exact closure_mono (image2_subset (inter_subset_right _ _) Subset.rfl)
  have hnc : nᶜ ⊆ k \ n ∪ kᶜ := by rw [union_comm, ← inter_subset, diff_eq, inter_comm]
  have hw : closure (image2 ϕ w s) ⊆ n :=
    compl_subset_compl.mp (Subset.trans hnc (union_subset hw₃ hw₄))
  exact ⟨_, hw₂, hw⟩
#align eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset' eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset'

/-- A set is eventually carried into any open neighbourhood of its ω-limit:
if `c` is a compact set such that `closure {ϕ t x | t ∈ v, x ∈ s} ⊆ c` for some `v ∈ f`
and `n` is an open neighbourhood of `ω f ϕ s`, then for some `u ∈ f` we have
`closure {ϕ t x | t ∈ u, x ∈ s} ⊆ n`. -/
theorem eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset [T2Space β]
    {c : Set β} (hc₁ : IsCompact c) (hc₂ : ∀ᶠ t in f, MapsTo (ϕ t) s c) {n : Set β} (hn₁ : IsOpen n)
    (hn₂ : ω f ϕ s ⊆ n) : ∃ u ∈ f, closure (image2 ϕ u s) ⊆ n :=
  eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset' f ϕ _ hc₁
    ⟨_, hc₂, closure_minimal (image2_subset_iff.2 fun _t ↦ id) hc₁.isClosed⟩ hn₁ hn₂
#align eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset

theorem eventually_mapsTo_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset [T2Space β]
    {c : Set β} (hc₁ : IsCompact c) (hc₂ : ∀ᶠ t in f, MapsTo (ϕ t) s c) {n : Set β} (hn₁ : IsOpen n)
    (hn₂ : ω f ϕ s ⊆ n) : ∀ᶠ t in f, MapsTo (ϕ t) s n := by
  rcases eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset f ϕ s hc₁
      hc₂ hn₁ hn₂ with
    ⟨u, hu_mem, hu⟩
  refine' mem_of_superset hu_mem fun t ht x hx ↦ _
  exact hu (subset_closure <| mem_image2_of_mem ht hx)
#align eventually_maps_to_of_is_compact_absorbing_of_is_open_of_omega_limit_subset eventually_mapsTo_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset

theorem eventually_closure_subset_of_isOpen_of_omegaLimit_subset [CompactSpace β] {v : Set β}
    (hv₁ : IsOpen v) (hv₂ : ω f ϕ s ⊆ v) : ∃ u ∈ f, closure (image2 ϕ u s) ⊆ v :=
  eventually_closure_subset_of_isCompact_absorbing_of_isOpen_of_omegaLimit_subset' _ _ _
    isCompact_univ ⟨univ, univ_mem, subset_univ _⟩ hv₁ hv₂
#align eventually_closure_subset_of_is_open_of_omega_limit_subset eventually_closure_subset_of_isOpen_of_omegaLimit_subset

theorem eventually_mapsTo_of_isOpen_of_omegaLimit_subset [CompactSpace β] {v : Set β}
    (hv₁ : IsOpen v) (hv₂ : ω f ϕ s ⊆ v) : ∀ᶠ t in f, MapsTo (ϕ t) s v := by
  rcases eventually_closure_subset_of_isOpen_of_omegaLimit_subset f ϕ s hv₁ hv₂ with ⟨u, hu_mem, hu⟩
  refine' mem_of_superset hu_mem fun t ht x hx ↦ _
  exact hu (subset_closure <| mem_image2_of_mem ht hx)
#align eventually_maps_to_of_is_open_of_omega_limit_subset eventually_mapsTo_of_isOpen_of_omegaLimit_subset

/-- The ω-limit of a nonempty set w.r.t. a nontrivial filter is nonempty. -/
theorem nonempty_omegaLimit_of_isCompact_absorbing [NeBot f] {c : Set β} (hc₁ : IsCompact c)
    (hc₂ : ∃ v ∈ f, closure (image2 ϕ v s) ⊆ c) (hs : s.Nonempty) : (ω f ϕ s).Nonempty := by
  rcases hc₂ with ⟨v, hv₁, hv₂⟩
  rw [omegaLimit_eq_interᵢ_inter _ _ _ hv₁]
  apply IsCompact.nonempty_interᵢ_of_directed_nonempty_compact_closed
  · rintro ⟨u₁, hu₁⟩ ⟨u₂, hu₂⟩
    use ⟨u₁ ∩ u₂, inter_mem hu₁ hu₂⟩
    constructor
    all_goals exact closure_mono (image2_subset (inter_subset_inter_left _ (by simp)) Subset.rfl)
  · intro u
    have hn : (image2 ϕ (u ∩ v) s).Nonempty :=
      Nonempty.image2 (Filter.nonempty_of_mem (inter_mem u.prop hv₁)) hs
    exact hn.mono subset_closure
  · intro
    apply isCompact_of_isClosed_subset hc₁ isClosed_closure
    calc
      _ ⊆ closure (image2 ϕ v s) := closure_mono (image2_subset (inter_subset_right _ _) Subset.rfl)
      _ ⊆ c := hv₂

  · exact fun _ ↦ isClosed_closure
#align nonempty_omega_limit_of_is_compact_absorbing nonempty_omegaLimit_of_isCompact_absorbing

theorem nonempty_omegaLimit [CompactSpace β] [NeBot f] (hs : s.Nonempty) : (ω f ϕ s).Nonempty :=
  nonempty_omegaLimit_of_isCompact_absorbing _ _ _ isCompact_univ ⟨univ, univ_mem, subset_univ _⟩ hs
#align nonempty_omega_limit nonempty_omegaLimit

end omegaLimit

/-!
### ω-limits of Flows by a Monoid
-/

namespace Flow

variable {τ : Type _} [TopologicalSpace τ] [AddMonoid τ] [ContinuousAdd τ] {α : Type _}
  [TopologicalSpace α] (f : Filter τ) (ϕ : Flow τ α) (s : Set α)

open omegaLimit

theorem isInvariant_omegaLimit (hf : ∀ t, Tendsto ((· + ·) t) f f) : IsInvariant ϕ (ω f ϕ s) := by
  refine' fun t ↦ MapsTo.mono_right _ (omegaLimit_subset_of_tendsto ϕ s (hf t))
  exact
    mapsTo_omegaLimit _ (mapsTo_id _) (fun t' x ↦ (ϕ.map_add _ _ _).symm)
      (continuous_const.flow ϕ continuous_id)
#align flow.is_invariant_omega_limit Flow.isInvariant_omegaLimit

theorem omegaLimit_image_subset (t : τ) (ht : Tendsto (· + t) f f) : ω f ϕ (ϕ t '' s) ⊆ ω f ϕ s :=
  by
  simp only [omegaLimit_image_eq, ← map_add]
  exact omegaLimit_subset_of_tendsto ϕ s ht
#align flow.omega_limit_image_subset Flow.omegaLimit_image_subset

end Flow

/-!
### ω-limits of Flows by a Group
-/

namespace Flow

variable {τ : Type _} [TopologicalSpace τ] [AddCommGroup τ] [TopologicalAddGroup τ] {α : Type _}
  [TopologicalSpace α] (f : Filter τ) (ϕ : Flow τ α) (s : Set α)

open omegaLimit

/-- the ω-limit of a forward image of `s` is the same as the ω-limit of `s`. -/
@[simp]
theorem omegaLimit_image_eq (hf : ∀ t, Tendsto (· + t) f f) (t : τ) : ω f ϕ (ϕ t '' s) = ω f ϕ s :=
  Subset.antisymm (omegaLimit_image_subset _ _ _ _ (hf t)) <|
    calc
      ω f ϕ s = ω f ϕ (ϕ (-t) '' (ϕ t '' s)) := by simp [image_image, ← map_add]
      _ ⊆ ω f ϕ (ϕ t '' s) := omegaLimit_image_subset _ _ _ _ (hf _)

#align flow.omega_limit_image_eq Flow.omegaLimit_image_eq

theorem omegaLimit_omegaLimit (hf : ∀ t, Tendsto ((· + ·) t) f f) : ω f ϕ (ω f ϕ s) ⊆ ω f ϕ s := by
  simp only [subset_def, mem_omegaLimit_iff_frequently₂, frequently_iff]
  intro _ h
  rintro n hn u hu
  rcases mem_nhds_iff.mp hn with ⟨o, ho₁, ho₂, ho₃⟩
  rcases h o (IsOpen.mem_nhds ho₂ ho₃) hu with ⟨t, _ht₁, ht₂⟩
  have l₁ : (ω f ϕ s ∩ o).Nonempty :=
    ht₂.mono
      (inter_subset_inter_left _
        ((isInvariant_iff_image _ _).mp (isInvariant_omegaLimit _ _ _ hf) _))
  have l₂ : (closure (image2 ϕ u s) ∩ o).Nonempty :=
    l₁.mono fun b hb ↦ ⟨omegaLimit_subset_closure_fw_image _ _ _ hu hb.1, hb.2⟩
  have l₃ : (o ∩ image2 ϕ u s).Nonempty :=
    by
    rcases l₂ with ⟨b, hb₁, hb₂⟩
    exact mem_closure_iff_nhds.mp hb₁ o (IsOpen.mem_nhds ho₂ hb₂)
  rcases l₃ with ⟨ϕra, ho, ⟨_, _, hr, ha, hϕra⟩⟩
  exact ⟨_, hr, ϕra, ⟨_, ha, hϕra⟩, ho₁ ho⟩
#align flow.omega_limit_omega_limit Flow.omegaLimit_omegaLimit

end Flow


/-
Copyright (c) 2021 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 algebraic_topology.Moore_complex
! leanprover-community/mathlib commit 0bd2ea37bcba5769e14866170f251c9bc64e35d7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Homology.HomologicalComplex
import Mathbin.AlgebraicTopology.SimplicialObject
import Mathbin.CategoryTheory.Abelian.Basic

/-!
## Moore complex

We construct the normalized Moore complex, as a functor
`simplicial_object C ⥤ chain_complex C ℕ`,
for any abelian category `C`.

The `n`-th object is intersection of
the kernels of `X.δ i : X.obj n ⟶ X.obj (n-1)`, for `i = 1, ..., n`.

The differentials are induced from `X.δ 0`,
which maps each of these intersections of kernels to the next.

This functor is one direction of the Dold-Kan equivalence, which we're still working towards.

### References

* https://stacks.math.columbia.edu/tag/0194
* https://ncatlab.org/nlab/show/Moore+complex
-/

universe v u

noncomputable section

open CategoryTheory CategoryTheory.Limits

open Opposite

namespace AlgebraicTopology

variable {C : Type _} [Category C] [Abelian C]

attribute [local instance] abelian.has_pullbacks

/-! The definitions in this namespace are all auxiliary definitions for `normalized_Moore_complex`
and should usually only be accessed via that. -/

namespace NormalizedMooreComplex

open CategoryTheory.Subobject

variable (X : SimplicialObject C)

/-- The normalized Moore complex in degree `n`, as a subobject of `X n`.
-/
@[simp]
def objX : ∀ n : ℕ, Subobject (X.obj (op (SimplexCategory.mk n)))
  | 0 => ⊤
  | n + 1 => Finset.univ.inf fun k : Fin (n + 1) => kernelSubobject (X.δ k.succ)
#align algebraic_topology.normalized_Moore_complex.obj_X AlgebraicTopology.NormalizedMooreComplex.objX

/-- The differentials in the normalized Moore complex.
-/
@[simp]
def objD : ∀ n : ℕ, (objX X (n + 1) : C) ⟶ (objX X n : C)
  | 0 => Subobject.arrow _ ≫ X.δ (0 : Fin 2) ≫ inv (⊤ : Subobject _).arrow
  | n + 1 =>
    by
    -- The differential is `subobject.arrow _ ≫ X.δ (0 : fin (n+3))`,
    -- factored through the intersection of the kernels.
    refine' factor_thru _ (arrow _ ≫ X.δ (0 : Fin (n + 3))) _
    -- We now need to show that it factors!
    -- A morphism factors through an intersection of subobjects if it factors through each.
    refine' (finset_inf_factors _).mpr fun i m => _
    -- A morphism `f` factors through the kernel of `g` exactly if `f ≫ g = 0`.
    apply kernel_subobject_factors
    -- Use a simplicial identity
    dsimp [obj_X]
    erw [category.assoc, ← X.δ_comp_δ (Fin.zero_le i.succ), ← category.assoc]
    -- It's the first two factors which are zero.
    convert zero_comp
    -- We can rewrite the arrow out of the intersection of all the kernels as a composition
    -- of a morphism we don't care about with the arrow out of the kernel of `X.δ i.succ.succ`.
    rw [← factor_thru_arrow _ _ (finset_inf_arrow_factors Finset.univ _ i.succ (by simp))]
    -- It's the second two factors which are zero.
    rw [category.assoc]
    convert comp_zero
    exact kernel_subobject_arrow_comp _
#align algebraic_topology.normalized_Moore_complex.obj_d AlgebraicTopology.NormalizedMooreComplex.objD

theorem d_squared (n : ℕ) : objD X (n + 1) ≫ objD X n = 0 :=
  by
  -- It's a pity we need to do a case split here;
    -- after the first simp the proofs are almost identical
    cases n <;>
    dsimp
  · simp only [subobject.factor_thru_arrow_assoc]
    slice_lhs 2 3 => erw [← X.δ_comp_δ (Fin.zero_le (0 : Fin (0 + 2)))]
    rw [← factor_thru_arrow _ _ (finset_inf_arrow_factors Finset.univ _ (0 : Fin 2) (by simp))]
    slice_lhs 2 3 => rw [kernel_subobject_arrow_comp]
    simp
  · simp [factor_thru_right]
    slice_lhs 2 3 => erw [← X.δ_comp_δ (Fin.zero_le (0 : Fin (n.succ + 2)))]
    rw [←
      factor_thru_arrow _ _ (finset_inf_arrow_factors Finset.univ _ (0 : Fin (n + 3)) (by simp))]
    slice_lhs 2 3 => rw [kernel_subobject_arrow_comp]
    simp
#align algebraic_topology.normalized_Moore_complex.d_squared AlgebraicTopology.NormalizedMooreComplex.d_squared

/-- The normalized Moore complex functor, on objects.
-/
@[simps]
def obj (X : SimplicialObject C) : ChainComplex C ℕ :=
  ChainComplex.of (fun n => (objX X n : C))
    (-- the coercion here picks a representative of the subobject
      objD
      X)
    (d_squared X)
#align algebraic_topology.normalized_Moore_complex.obj AlgebraicTopology.NormalizedMooreComplex.obj

variable {X} {Y : SimplicialObject C} (f : X ⟶ Y)

/-- The normalized Moore complex functor, on morphisms.
-/
@[simps]
def map (f : X ⟶ Y) : obj X ⟶ obj Y :=
  ChainComplex.ofHom _ _ _ _ _ _
    (fun n => by
      refine' factor_thru _ (arrow _ ≫ f.app (op (SimplexCategory.mk n))) _
      cases n <;> dsimp
      · apply top_factors
      · refine' (finset_inf_factors _).mpr fun i m => _
        apply kernel_subobject_factors
        slice_lhs 2 3 => erw [← f.naturality]
        rw [← factor_thru_arrow _ _ (finset_inf_arrow_factors Finset.univ _ i (by simp))]
        slice_lhs 2 3 => erw [kernel_subobject_arrow_comp]
        simp)
    fun n => by
    cases n <;> dsimp
    · ext
      simp
    · ext
      simp
#align algebraic_topology.normalized_Moore_complex.map AlgebraicTopology.NormalizedMooreComplex.map

end NormalizedMooreComplex

open NormalizedMooreComplex

variable (C)

/-- The (normalized) Moore complex of a simplicial object `X` in an abelian category `C`.

The `n`-th object is intersection of
the kernels of `X.δ i : X.obj n ⟶ X.obj (n-1)`, for `i = 1, ..., n`.

The differentials are induced from `X.δ 0`,
which maps each of these intersections of kernels to the next.
-/
@[simps]
def normalizedMooreComplex : SimplicialObject C ⥤ ChainComplex C ℕ
    where
  obj := obj
  map X Y f := map f
  map_id' X := by
    ext n
    cases n <;>
      · dsimp
        simp
  map_comp' X Y Z f g := by
    ext n
    cases n <;> simp
#align algebraic_topology.normalized_Moore_complex AlgebraicTopology.normalizedMooreComplex

variable {C}

@[simp]
theorem normalizedMooreComplex_objD (X : SimplicialObject C) (n : ℕ) :
    ((normalizedMooreComplex C).obj X).d (n + 1) n = NormalizedMooreComplex.objD X n := by
  apply ChainComplex.of_d
#align algebraic_topology.normalized_Moore_complex_obj_d AlgebraicTopology.normalizedMooreComplex_objD

end AlgebraicTopology


import data.int.modeq

/-
For each of the following congruence equations, either find a solution x ∈ ℤ or show that no solution exists:
(a) 99x ≡ 18 mod 30.
(b) 91x ≡ 84 mod 143.
(c) x^2 ≡ 2 mod 5.
(d) x^2 + x + 1 ≡ 0 mod 5.
(e) x^2 + x + 1 ≡ 0 mod 7.
-/

-- For the following parts, either provide a solution and proof that the solution solves the congruence,
-- or negate the statement of the lemma with ¬ and prove that no solution exists.

lemma part_a : ∃x : ℤ, 99 * x ≡ 18 [ZMOD 30] :=
begin
  sorry
end

lemma part_b : ∃x : ℤ, 91 * x ≡ 84 [ZMOD 143] :=
begin
  sorry
end

lemma part_c : ∃x : ℤ, x^2 ≡ 2 [ZMOD 5] :=
begin
  sorry
end

lemma part_d : ∃x : ℤ, x^2 + x + 1 ≡ 0 [ZMOD 5] :=
begin
  sorry
end

lemma part_e : ∃x : ℤ, x^2 + x + 1 ≡ 0 [ZMOD 5] :=
begin
  sorry
end