/-
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.box.basic

/-!
# Partitions of rectangular boxes in `ℝⁿ`

In this file we define (pre)partitions of rectangular boxes in `ℝⁿ`.  A partition of a box `I` in
`ℝⁿ` (see `box_integral.prepartition` and `box_integral.prepartition.is_partition`) is a finite set
of pairwise disjoint boxes such that their union is exactly `I`. We use `boxes : finset (box ι)` to
store the set of boxes.

Many lemmas about box integrals deal with pairwise disjoint collections of subboxes, so we define a
structure `box_integral.prepartition (I : box_integral.box ι)` that stores a collection of boxes
such that

* each box `J ∈ boxes` is a subbox of `I`;
* the boxes are pairwise disjoint as sets in `ℝⁿ`.

Then we define a predicate `box_integral.prepartition.is_partition`; `π.is_partition` means that the
boxes of `π` actually cover the whole `I`. We also define some operations on prepartitions:

* `box_integral.partition.bUnion`: split each box of a partition into smaller boxes;
* `box_integral.partition.restrict`: restrict a partition to a smaller box.

We also define a `semilattice_inf` structure on `box_integral.partition I` for all
`I : box_integral.box ι`.

## Tags

rectangular box, partition
-/

open set finset function
open_locale classical nnreal big_operators
noncomputable theory

namespace box_integral

variables {ι : Type*}

/-- A prepartition of `I : box_integral.box ι` is a finite set of pairwise disjoint subboxes of
`I`. -/
structure prepartition (I : box ι) :=
(boxes : finset (box ι))
(le_of_mem' : ∀ J ∈ boxes, J ≤ I)
(pairwise_disjoint : set.pairwise ↑boxes (disjoint on (coe : box ι → set (ι → ℝ))))

namespace prepartition

variables {I J J₁ J₂ : box ι} (π : prepartition I) {π₁ π₂ : prepartition I} {x : ι → ℝ}

instance : has_mem (box ι) (prepartition I) := ⟨λ J π, J ∈ π.boxes⟩

@[simp] lemma mem_boxes : J ∈ π.boxes ↔ J ∈ π := iff.rfl
@[simp] lemma mem_mk {s h₁ h₂} : J ∈ (mk s h₁ h₂ : prepartition I) ↔ J ∈ s := iff.rfl

lemma disjoint_coe_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (h : J₁ ≠ J₂) :
  disjoint (J₁ : set (ι → ℝ)) J₂ :=
π.pairwise_disjoint J₁ h₁ J₂ h₂ h

lemma eq_of_mem_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hx₁ : x ∈ J₁) (hx₂ : x ∈ J₂) :
  J₁ = J₂ :=
by_contra $ λ H, π.disjoint_coe_of_mem h₁ h₂ H ⟨hx₁, hx₂⟩

lemma eq_of_le_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle₁ : J ≤ J₁) (hle₂ : J ≤ J₂) :
  J₁ = J₂ :=
π.eq_of_mem_of_mem h₁ h₂ (hle₁ J.upper_mem) (hle₂ J.upper_mem)

lemma eq_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle : J₁ ≤ J₂) : J₁ = J₂ :=
π.eq_of_le_of_le h₁ h₂ le_rfl hle

lemma le_of_mem (hJ : J ∈ π) : J ≤ I := π.le_of_mem' J hJ

lemma lower_le_lower (hJ : J ∈ π) : I.lower ≤ J.lower := box.antitone_lower (π.le_of_mem hJ)

lemma upper_le_upper (hJ : J ∈ π) : J.upper ≤ I.upper := box.monotone_upper (π.le_of_mem hJ)

lemma injective_boxes : function.injective (boxes : prepartition I → finset (box ι)) :=
by { rintro ⟨s₁, h₁, h₁'⟩ ⟨s₂, h₂, h₂'⟩ (rfl : s₁ = s₂), refl }

@[ext] lemma ext (h : ∀ J, J ∈ π₁ ↔ J ∈ π₂) : π₁ = π₂ := injective_boxes $ finset.ext h

/-- The singleton prepartition `{J}`, `J ≤ I`. -/
@[simps] def single (I J : box ι) (h : J ≤ I) : prepartition I :=
⟨{J}, by simpa, by simp⟩

@[simp] lemma mem_single {J'} (h : J ≤ I) : J' ∈ single I J h ↔ J' = J := mem_singleton

/-- We say that `π ≤ π'` if each box of `π` is a subbox of some box of `π'`. -/
instance : has_le (prepartition I) := ⟨λ π π', ∀ ⦃I⦄, I ∈ π → ∃ I' ∈ π', I ≤ I'⟩

instance : partial_order (prepartition I) :=
{ le := (≤),
  le_refl := λ π I hI, ⟨I, hI, le_rfl⟩,
  le_trans := λ π₁ π₂ π₃ h₁₂ h₂₃ I₁ hI₁,
    let ⟨I₂, hI₂, hI₁₂⟩ := h₁₂ hI₁, ⟨I₃, hI₃, hI₂₃⟩ := h₂₃ hI₂ in ⟨I₃, hI₃, hI₁₂.trans hI₂₃⟩,
  le_antisymm :=
    begin
      suffices : ∀ {π₁ π₂ : prepartition I}, π₁ ≤ π₂ → π₂ ≤ π₁ → π₁.boxes ⊆ π₂.boxes,
        from λ π₁ π₂ h₁ h₂, injective_boxes (subset.antisymm (this h₁ h₂) (this h₂ h₁)),
      intros π₁ π₂ h₁ h₂ J hJ,
      rcases h₁ hJ with ⟨J', hJ', hle⟩, rcases h₂ hJ' with ⟨J'', hJ'', hle'⟩,
      obtain rfl : J = J'', from π₁.eq_of_le hJ hJ'' (hle.trans hle'),
      obtain rfl : J' = J, from le_antisymm ‹_› ‹_›,
      assumption
    end }

instance : order_top (prepartition I) :=
{ top := single I I le_rfl,
  le_top := λ π J hJ, ⟨I, by simp, π.le_of_mem hJ⟩ }

instance : order_bot (prepartition I) :=
{ bot := ⟨∅, λ J hJ, false.elim hJ, λ J hJ, false.elim hJ⟩,
  bot_le := λ π J hJ, false.elim hJ }

instance : inhabited (prepartition I) := ⟨⊤⟩

lemma le_def : π₁ ≤ π₂ ↔ ∀ J ∈ π₁, ∃ J' ∈ π₂, J ≤ J' := iff.rfl

@[simp] lemma mem_top : J ∈ (⊤ : prepartition I) ↔ J = I := mem_singleton

@[simp] lemma top_boxes : (⊤ : prepartition I).boxes = {I} := rfl

@[simp] lemma not_mem_bot : J ∉ (⊥ : prepartition I) := id

@[simp] lemma bot_boxes : (⊥ : prepartition I).boxes = ∅ := rfl

/-- An auxiliary lemma used to prove that the same point can't belong to more than
`2 ^ fintype.card ι` closed boxes of a prepartition. -/
lemma inj_on_set_of_mem_Icc_set_of_lower_eq (x : ι → ℝ) :
  inj_on (λ J : box ι, {i | J.lower i = x i}) {J | J ∈ π ∧ x ∈ J.Icc} :=
begin
  rintros J₁ ⟨h₁, hx₁⟩ J₂ ⟨h₂, hx₂⟩ (H : {i | J₁.lower i = x i} = {i | J₂.lower i = x i}),
  suffices : ∀ i, (Ioc (J₁.lower i) (J₁.upper i) ∩ Ioc (J₂.lower i) (J₂.upper i)).nonempty,
  { choose y hy₁ hy₂,
    exact π.eq_of_mem_of_mem h₁ h₂ hy₁ hy₂ },
  intro i,
  simp only [set.ext_iff, mem_set_of_eq] at H,
  cases (hx₁.1 i).eq_or_lt with hi₁ hi₁,
  { have hi₂ : J₂.lower i = x i, from (H _).1 hi₁,
    have H₁ : x i < J₁.upper i, by simpa only [hi₁] using J₁.lower_lt_upper i,
    have H₂ : x i < J₂.upper i, by simpa only [hi₂] using J₂.lower_lt_upper i,
    rw [Ioc_inter_Ioc, hi₁, hi₂, sup_idem, set.nonempty_Ioc],
    exact lt_min H₁ H₂ },
  { have hi₂ : J₂.lower i < x i, from (hx₂.1 i).lt_of_ne (mt (H _).2 hi₁.ne),
    exact ⟨x i, ⟨hi₁, hx₁.2 i⟩, ⟨hi₂, hx₂.2 i⟩⟩ }
end

/-- The set of boxes of a prepartition that contain `x` in their closures has cardinality
at most `2 ^ fintype.card ι`. -/
lemma card_filter_mem_Icc_le [fintype ι] (x : ι → ℝ) :
  (π.boxes.filter (λ J : box ι, x ∈ J.Icc)).card ≤ 2 ^ fintype.card ι :=
begin
  rw [← fintype.card_set],
  refine finset.card_le_card_of_inj_on (λ J : box ι, {i | J.lower i = x i})
    (λ _ _, finset.mem_univ _) _,
  simpa only [finset.mem_filter] using π.inj_on_set_of_mem_Icc_set_of_lower_eq x
end

/-- Given a prepartition `π : box_integral.prepartition I`, `π.Union` is the part of `I` covered by
the boxes of `π`. -/
protected def Union : set (ι → ℝ) := ⋃ J ∈ π, ↑J

lemma Union_def : π.Union = ⋃ J ∈ π, ↑J := rfl

lemma Union_def' : π.Union = ⋃ J ∈ π.boxes, ↑J := rfl

@[simp] lemma mem_Union : x ∈ π.Union ↔ ∃ J ∈ π, x ∈ J := set.mem_bUnion_iff

@[simp] lemma Union_single (h : J ≤ I) : (single I J h).Union = J := by simp [Union_def]

@[simp] lemma Union_top : (⊤ : prepartition I).Union = I := by simp [prepartition.Union]

@[simp] lemma Union_eq_empty : π₁.Union = ∅ ↔ π₁ = ⊥ :=
by simp [← injective_boxes.eq_iff, finset.ext_iff, prepartition.Union, imp_false]

@[simp] lemma Union_bot : (⊥ : prepartition I).Union = ∅ := Union_eq_empty.2 rfl

lemma subset_Union (h : J ∈ π) : ↑J ⊆ π.Union := subset_bUnion_of_mem h

lemma Union_subset : π.Union ⊆ I := bUnion_subset π.le_of_mem'

@[mono] lemma Union_mono (h : π₁ ≤ π₂) : π₁.Union ⊆ π₂.Union :=
λ x hx, let ⟨J₁, hJ₁, hx⟩ := π₁.mem_Union.1 hx, ⟨J₂, hJ₂, hle⟩ := h hJ₁
  in π₂.mem_Union.2 ⟨J₂, hJ₂, hle hx⟩

lemma disjoint_boxes_of_disjoint_Union (h : disjoint π₁.Union π₂.Union) :
  disjoint π₁.boxes π₂.boxes :=
finset.disjoint_left.2 $ λ J h₁ h₂, h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂)
  ⟨J.upper_mem, J.upper_mem⟩

lemma le_iff_nonempty_imp_le_and_Union_subset : π₁ ≤ π₂ ↔
  (∀ (J ∈ π₁) (J' ∈ π₂), (J ∩ J' : set (ι → ℝ)).nonempty → J ≤ J') ∧ π₁.Union ⊆ π₂.Union :=
begin
  fsplit,
  { refine λ H, ⟨λ J hJ J' hJ' Hne, _, Union_mono H⟩,
    rcases H hJ with ⟨J'', hJ'', Hle⟩, rcases Hne with ⟨x, hx, hx'⟩,
    rwa π₂.eq_of_mem_of_mem hJ' hJ'' hx' (Hle hx) },
  { rintro ⟨H, HU⟩ J hJ, simp only [set.subset_def, mem_Union] at HU,
    rcases HU J.upper ⟨J, hJ, J.upper_mem⟩ with ⟨J₂, hJ₂, hx⟩,
    exact ⟨J₂, hJ₂, H _ hJ _ hJ₂ ⟨_, J.upper_mem, hx⟩⟩ }
end

lemma eq_of_boxes_subset_Union_superset (h₁ : π₁.boxes ⊆ π₂.boxes) (h₂ : π₂.Union ⊆ π₁.Union) :
  π₁ = π₂ :=
le_antisymm (λ J hJ, ⟨J, h₁ hJ, le_rfl⟩) $ le_iff_nonempty_imp_le_and_Union_subset.2
  ⟨λ J₁ hJ₁ J₂ hJ₂ Hne, (π₂.eq_of_mem_of_mem hJ₁ (h₁ hJ₂) Hne.some_spec.1 Hne.some_spec.2).le, h₂⟩

/-- Given a prepartition `π` of a box `I` and a collection of prepartitions `πi J` of all boxes
`J ∈ π`, returns the prepartition of `I` into the union of the boxes of all `πi J`.

Though we only use the values of `πi` on the boxes of `π`, we require `πi` to be a globally defined
function. -/
@[simps] def bUnion (πi : Π J : box ι, prepartition J) : prepartition I :=
{ boxes := π.boxes.bUnion $ λ J, (πi J).boxes,
  le_of_mem' := λ J hJ,
    begin
      simp only [finset.mem_bUnion, exists_prop, mem_boxes] at hJ,
      rcases hJ with ⟨J', hJ', hJ⟩,
      exact ((πi J').le_of_mem hJ).trans (π.le_of_mem hJ')
    end,
  pairwise_disjoint :=
    begin
      simp only [set.pairwise, finset.mem_coe, finset.mem_bUnion],
      rintro J₁' ⟨J₁, hJ₁, hJ₁'⟩ J₂' ⟨J₂, hJ₂, hJ₂'⟩ Hne x ⟨hx₁, hx₂⟩, apply Hne,
      obtain rfl : J₁ = J₂,
        from π.eq_of_mem_of_mem hJ₁ hJ₂ ((πi J₁).le_of_mem hJ₁' hx₁)
          ((πi J₂).le_of_mem hJ₂' hx₂),
      exact (πi J₁).eq_of_mem_of_mem hJ₁' hJ₂' hx₁ hx₂
    end }

variables {πi πi₁ πi₂ : Π J : box ι, prepartition J}

@[simp] lemma mem_bUnion : J ∈ π.bUnion πi ↔ ∃ J' ∈ π, J ∈ πi J' :=
by simp [bUnion]

lemma bUnion_le (πi : Π J, prepartition J) : π.bUnion πi ≤ π :=
λ J hJ, let ⟨J', hJ', hJ⟩ := π.mem_bUnion.1 hJ in ⟨J', hJ', (πi J').le_of_mem hJ⟩

@[simp] lemma bUnion_top : π.bUnion (λ _, ⊤) = π := by { ext, simp }

@[congr] lemma bUnion_congr (h : π₁ = π₂) (hi : ∀ J ∈ π₁, πi₁ J = πi₂ J) :
  π₁.bUnion πi₁ = π₂.bUnion πi₂ :=
by { subst π₂, ext J, simp [hi] { contextual := tt } }

lemma bUnion_congr_of_le (h : π₁ = π₂) (hi : ∀ J ≤ I, πi₁ J = πi₂ J) :
  π₁.bUnion πi₁ = π₂.bUnion πi₂ :=
bUnion_congr h $ λ J hJ, hi J (π₁.le_of_mem hJ)

@[simp] lemma Union_bUnion (πi : Π J : box ι, prepartition J) :
  (π.bUnion πi).Union = ⋃ J ∈ π, (πi J).Union :=
by simp [prepartition.Union]

@[simp] lemma sum_bUnion_boxes {M : Type*} [add_comm_monoid M] (π : prepartition I)
  (πi : Π J, prepartition J) (f : box ι → M) :
  ∑ J in π.boxes.bUnion (λ J, (πi J).boxes), f J = ∑ J in π.boxes, ∑ J' in (πi J).boxes, f J' :=
begin
  refine finset.sum_bUnion (λ J₁ h₁ J₂ h₂ hne, finset.disjoint_left.2 $ λ J' h₁' h₂', _),
  exact hne (π.eq_of_le_of_le h₁ h₂ ((πi J₁).le_of_mem h₁') ((πi J₂).le_of_mem h₂'))
end

/-- Given a box `J ∈ π.bUnion πi`, returns the box `J' ∈ π` such that `J ∈ πi J'`.
For `J ∉ π.bUnion πi`, returns `I`. -/
def bUnion_index (πi : Π J, prepartition J) (J : box ι) :
  box ι :=
if hJ : J ∈ π.bUnion πi then (π.mem_bUnion.1 hJ).some else I

lemma bUnion_index_mem (hJ : J ∈ π.bUnion πi) :
  π.bUnion_index πi J ∈ π :=
by { rw [bUnion_index, dif_pos hJ], exact (π.mem_bUnion.1 hJ).some_spec.fst }

lemma bUnion_index_le (πi : Π J, prepartition J) (J : box ι) : π.bUnion_index πi J ≤ I :=
begin
  by_cases hJ : J ∈ π.bUnion πi,
  { exact π.le_of_mem (π.bUnion_index_mem hJ) },
  { rw [bUnion_index, dif_neg hJ], exact le_rfl }
end

lemma mem_bUnion_index (hJ : J ∈ π.bUnion πi) : J ∈ πi (π.bUnion_index πi J) :=
by convert (π.mem_bUnion.1 hJ).some_spec.snd; exact dif_pos hJ

lemma le_bUnion_index (hJ : J ∈ π.bUnion πi) : J ≤ π.bUnion_index πi J :=
le_of_mem _ (π.mem_bUnion_index hJ)

/-- Uniqueness property of `box_integral.partition.bUnion_index`. -/
lemma bUnion_index_of_mem (hJ : J ∈ π) {J'} (hJ' : J' ∈ πi J) : π.bUnion_index πi J' = J :=
have J' ∈ π.bUnion πi, from π.mem_bUnion.2 ⟨J, hJ, hJ'⟩,
π.eq_of_le_of_le (π.bUnion_index_mem this) hJ (π.le_bUnion_index this) (le_of_mem _ hJ')

/-- Create a `box_integral.prepartition` from a collection of possibly empty boxes by filtering out
the empty one if it exists. -/
def of_with_bot (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint) :
  prepartition I :=
{ boxes := boxes.erase_none,
  le_of_mem' := λ J hJ,
    begin
      rw mem_erase_none at hJ,
      simpa only [with_bot.some_eq_coe, with_bot.coe_le_coe] using le_of_mem _ hJ
    end,
  pairwise_disjoint := λ J₁ h₁ J₂ h₂ hne,
    begin
      simp only [mem_coe, mem_erase_none] at h₁ h₂,
      exact box.disjoint_coe.1 (pairwise_disjoint _ h₁ _ h₂ (mt option.some_inj.1 hne))
    end }

@[simp] lemma mem_of_with_bot {boxes : finset (with_bot (box ι))} {h₁ h₂} :
  J ∈ (of_with_bot boxes h₁ h₂ : prepartition I) ↔ (J : with_bot (box ι)) ∈ boxes :=
mem_erase_none

@[simp] lemma Union_of_with_bot (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint) :
  (of_with_bot boxes le_of_mem pairwise_disjoint).Union = ⋃ J ∈ boxes, ↑J :=
begin
  suffices : (⋃ (J : box ι) (hJ : ↑J ∈ boxes), ↑J) = ⋃ J ∈ boxes, ↑J,
    by simpa [of_with_bot, prepartition.Union],
  simp only [← box.bUnion_coe_eq_coe, @Union_comm _ _ (box ι), @Union_comm _ _ (@eq _ _ _),
    Union_Union_eq_right]
end

lemma of_with_bot_le {boxes : finset (with_bot (box ι))}
  {le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ boxes, J ≠ ⊥ → ∃ J' ∈ π, J ≤ ↑J') :
  of_with_bot boxes le_of_mem pairwise_disjoint ≤ π :=
have ∀ (J : box ι), ↑J ∈ boxes → ∃ J' ∈ π, J ≤ J',
  from λ J hJ, by simpa only [with_bot.coe_le_coe] using H J hJ (with_bot.coe_ne_bot J),
by simpa [of_with_bot, le_def]

lemma le_of_with_bot {boxes : finset (with_bot (box ι))}
  {le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ π, ∃ J' ∈ boxes, ↑J ≤ J') :
  π ≤ of_with_bot boxes le_of_mem pairwise_disjoint :=
begin
  intros J hJ,
  rcases H J hJ with ⟨J', J'mem, hle⟩,
  lift J' to box ι using ne_bot_of_le_ne_bot (with_bot.coe_ne_bot _) hle,
  exact ⟨J', mem_of_with_bot.2 J'mem, with_bot.coe_le_coe.1 hle⟩
end

lemma of_with_bot_mono {boxes₁ : finset (with_bot (box ι))}
  {le_of_mem₁ : ∀ J ∈ boxes₁, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint₁ : set.pairwise (boxes₁ : set (with_bot (box ι))) disjoint}
  {boxes₂ : finset (with_bot (box ι))}
  {le_of_mem₂ : ∀ J ∈ boxes₂, (J : with_bot (box ι)) ≤ I}
  {pairwise_disjoint₂ : set.pairwise (boxes₂ : set (with_bot (box ι))) disjoint}
  (H : ∀ J ∈ boxes₁, J ≠ ⊥ → ∃ J' ∈ boxes₂, J ≤ J') :
  of_with_bot boxes₁ le_of_mem₁ pairwise_disjoint₁ ≤
    of_with_bot boxes₂ le_of_mem₂ pairwise_disjoint₂ :=
le_of_with_bot _ $ λ J hJ, H J (mem_of_with_bot.1 hJ) (with_bot.coe_ne_bot _)

lemma sum_of_with_bot {M : Type*} [add_comm_monoid M]
  (boxes : finset (with_bot (box ι)))
  (le_of_mem : ∀ J ∈ boxes, (J : with_bot (box ι)) ≤ I)
  (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint)
  (f : box ι → M) :
  ∑ J in (of_with_bot boxes le_of_mem pairwise_disjoint).boxes, f J =
    ∑ J in boxes, option.elim J 0 f :=
finset.sum_erase_none _ _

/-- Restrict a prepartition to a box. -/
def restrict (π : prepartition I) (J : box ι) :
  prepartition J :=
of_with_bot (π.boxes.image (λ J', J ⊓ J'))
  (λ J' hJ', by { rcases finset.mem_image.1 hJ' with ⟨J', -, rfl⟩, exact inf_le_left })
  begin
    simp only [set.pairwise, on_fun, finset.mem_coe, finset.mem_image],
    rintro _ ⟨J₁, h₁, rfl⟩ _ ⟨J₂, h₂, rfl⟩ Hne,
    have : J₁ ≠ J₂, by { rintro rfl, exact Hne rfl },
    exact ((box.disjoint_coe.2 $ π.disjoint_coe_of_mem h₁ h₂ this).inf_left' _).inf_right' _
  end

@[simp] lemma mem_restrict : J₁ ∈ π.restrict J ↔ ∃ (J' ∈ π), (J₁ : with_bot (box ι)) = J ⊓ J' :=
by simp [restrict, eq_comm]

lemma mem_restrict' : J₁ ∈ π.restrict J ↔ ∃ (J' ∈ π), (J₁ : set (ι → ℝ)) = J ∩ J' :=
by simp only [mem_restrict, ← box.with_bot_coe_inj, box.coe_inf, box.coe_coe]

@[mono] lemma restrict_mono {π₁ π₂ : prepartition I} (Hle : π₁ ≤ π₂) :
  π₁.restrict J ≤ π₂.restrict J :=
begin
  refine of_with_bot_mono (λ J₁ hJ₁ hne, _),
  rw finset.mem_image at hJ₁, rcases hJ₁ with ⟨J₁, hJ₁, rfl⟩,
  rcases Hle hJ₁ with ⟨J₂, hJ₂, hle⟩,
  exact ⟨_, finset.mem_image_of_mem _ hJ₂, inf_le_inf_left _ $ with_bot.coe_le_coe.2 hle⟩
end

lemma monotone_restrict : monotone (λ π : prepartition I, restrict π J) :=
λ π₁ π₂, restrict_mono

/-- Restricting to a larger box does not change the set of boxes. We cannot claim equality
of prepartitions because they have different types. -/
lemma restrict_boxes_of_le (π : prepartition I) (h : I ≤ J) :
  (π.restrict J).boxes = π.boxes :=
begin
  simp only [restrict, of_with_bot, erase_none_eq_bUnion],
  refine finset.image_bUnion.trans _,
  refine (finset.bUnion_congr rfl _).trans finset.bUnion_singleton_eq_self,
  intros J' hJ',
  rw [inf_of_le_right, ← with_bot.some_eq_coe, option.to_finset_some],
  exact with_bot.coe_le_coe.2 ((π.le_of_mem hJ').trans h)
end

@[simp] lemma restrict_self : π.restrict I = π :=
injective_boxes $ restrict_boxes_of_le π le_rfl

@[simp] lemma Union_restrict : (π.restrict J).Union = J ∩ π.Union :=
by simp [restrict, ← inter_Union, ← Union_def]

@[simp] lemma restrict_bUnion (πi : Π J, prepartition J) (hJ : J ∈ π) :
  (π.bUnion πi).restrict J = πi J :=
begin
  refine (eq_of_boxes_subset_Union_superset (λ J₁ h₁, _) _).symm,
  { refine (mem_restrict _).2 ⟨J₁, π.mem_bUnion.2 ⟨J, hJ, h₁⟩, (inf_of_le_right _).symm⟩,
    exact with_bot.coe_le_coe.2 (le_of_mem _ h₁) },
  { simp only [Union_restrict, Union_bUnion, set.subset_def, set.mem_inter_eq, set.mem_Union],
    rintro x ⟨hxJ, J₁, h₁, hx⟩,
    obtain rfl : J = J₁, from π.eq_of_mem_of_mem hJ h₁ hxJ (Union_subset _ hx),
    exact hx }
end

lemma bUnion_le_iff {πi : Π J, prepartition J} {π' : prepartition I} :
  π.bUnion πi ≤ π' ↔ ∀ J ∈ π, πi J ≤ π'.restrict J :=
begin
  fsplit; intros H J hJ,
  { rw ← π.restrict_bUnion πi hJ, exact restrict_mono H },
  { rw mem_bUnion at hJ, rcases hJ with ⟨J₁, h₁, hJ⟩,
    rcases H J₁ h₁ hJ with ⟨J₂, h₂, Hle⟩,
    rcases π'.mem_restrict.mp h₂ with ⟨J₃, h₃, H⟩,
    exact ⟨J₃, h₃, Hle.trans $ with_bot.coe_le_coe.1 $ H.trans_le inf_le_right⟩ }
end

lemma le_bUnion_iff {πi : Π J, prepartition J} {π' : prepartition I} :
  π' ≤ π.bUnion πi ↔ π' ≤ π ∧ ∀ J ∈ π, π'.restrict J ≤ πi J :=
begin
  refine ⟨λ H, ⟨H.trans (π.bUnion_le πi), λ J hJ, _⟩, _⟩,
  { rw ← π.restrict_bUnion πi hJ, exact restrict_mono H },
  { rintro ⟨H, Hi⟩ J' hJ',
    rcases H hJ' with ⟨J, hJ, hle⟩,
    have : J' ∈ π'.restrict J,
      from π'.mem_restrict.2 ⟨J', hJ', (inf_of_le_right $ with_bot.coe_le_coe.2 hle).symm⟩,
    rcases Hi J hJ this with ⟨Ji, hJi, hlei⟩,
    exact ⟨Ji, π.mem_bUnion.2 ⟨J, hJ, hJi⟩, hlei⟩ }
end

instance : has_inf (prepartition I) :=
⟨λ π₁ π₂, π₁.bUnion (λ J, π₂.restrict J)⟩

lemma inf_def (π₁ π₂ : prepartition I) :
  π₁ ⊓ π₂ = π₁.bUnion (λ J, π₂.restrict J) :=
rfl

@[simp] lemma mem_inf {π₁ π₂ : prepartition I} :
  J ∈ π₁ ⊓ π₂ ↔ ∃ (J₁ ∈ π₁) (J₂ ∈ π₂), (J : with_bot (box ι)) = J₁ ⊓ J₂ :=
by simp only [inf_def, mem_bUnion, mem_restrict]

@[simp] lemma Union_inf (π₁ π₂ : prepartition I) : (π₁ ⊓ π₂).Union = π₁.Union ∩ π₂.Union :=
by simp only [inf_def, Union_bUnion, Union_restrict, ← Union_inter, ← Union_def]

instance : semilattice_inf (prepartition I) :=
{ inf_le_left := λ π₁ π₂, π₁.bUnion_le _,
  inf_le_right := λ π₁ π₂, (bUnion_le_iff _).2 (λ J hJ, le_rfl),
  le_inf := λ π π₁ π₂ h₁ h₂, π₁.le_bUnion_iff.2 ⟨h₁, λ J hJ, restrict_mono h₂⟩,
  .. prepartition.has_inf,
  .. prepartition.partial_order }

/-- The prepartition with boxes `{J ∈ π | p J}`. -/
@[simps] def filter (π : prepartition I) (p : box ι → Prop) : prepartition I :=
{ boxes := π.boxes.filter p,
  le_of_mem' := λ J hJ, π.le_of_mem (mem_filter.1 hJ).1,
  pairwise_disjoint := λ J₁ h₁ J₂ h₂, π.disjoint_coe_of_mem (mem_filter.1 h₁).1
    (mem_filter.1 h₂).1 }

@[simp] lemma mem_filter {p : box ι → Prop} : J ∈ π.filter p ↔ J ∈ π ∧ p J := finset.mem_filter

lemma filter_le (π : prepartition I) (p : box ι → Prop) : π.filter p ≤ π :=
λ J hJ, let ⟨hπ, hp⟩ := π.mem_filter.1 hJ in ⟨J, hπ, le_rfl⟩

lemma filter_of_true {p : box ι → Prop} (hp : ∀ J ∈ π, p J) : π.filter p = π :=
by { ext J, simpa using hp J }

@[simp] lemma filter_true : π.filter (λ _, true) = π := π.filter_of_true (λ _ _, trivial)

@[simp] lemma Union_filter_not (π : prepartition I) (p : box ι → Prop) :
  (π.filter (λ J, ¬p J)).Union = π.Union \ (π.filter p).Union :=
begin
  simp only [prepartition.Union],
  convert (@set.bUnion_diff_bUnion_eq _ (box ι) π.boxes (π.filter p).boxes coe _).symm,
  { ext J x, simp { contextual := tt } },
  { convert π.pairwise_disjoint, simp }
end

lemma sum_fiberwise {α M} [add_comm_monoid M] (π : prepartition I) (f : box ι → α) (g : box ι → M) :
  ∑ y in π.boxes.image f, ∑ J in (π.filter (λ J, f J = y)).boxes, g J = ∑ J in π.boxes, g J :=
by convert sum_fiberwise_of_maps_to (λ _, finset.mem_image_of_mem f) g

/-- Union of two disjoint prepartitions. -/
@[simps] def disj_union (π₁ π₂ : prepartition I) (h : disjoint π₁.Union π₂.Union) :
  prepartition I :=
{ boxes := π₁.boxes ∪ π₂.boxes,
  le_of_mem' := λ J hJ, (finset.mem_union.1 hJ).elim π₁.le_of_mem π₂.le_of_mem,
  pairwise_disjoint :=
    suffices ∀ (J₁ ∈ π₁) (J₂ ∈ π₂), J₁ ≠ J₂ → disjoint (J₁ : set (ι → ℝ)) J₂,
      by simpa [pairwise_union_of_symmetric (symmetric_disjoint.comap _), pairwise_disjoint],
    λ J₁ h₁ J₂ h₂ _, h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂) }

@[simp] lemma mem_disj_union (H : disjoint π₁.Union π₂.Union) :
  J ∈ π₁.disj_union π₂ H ↔ J ∈ π₁ ∨ J ∈ π₂ :=
finset.mem_union

@[simp] lemma Union_disj_union (h : disjoint π₁.Union π₂.Union) :
  (π₁.disj_union π₂ h).Union = π₁.Union ∪ π₂.Union :=
by simp [disj_union, prepartition.Union, Union_or, Union_union_distrib]

@[simp] lemma sum_disj_union_boxes {M : Type*} [add_comm_monoid M]
  (h : disjoint π₁.Union π₂.Union) (f : box ι → M) :
  ∑ J in π₁.boxes ∪ π₂.boxes, f J = ∑ J in π₁.boxes, f J + ∑ J in π₂.boxes, f J :=
sum_union $ disjoint_boxes_of_disjoint_Union h

section distortion

variable [fintype ι]

/-- The distortion of a prepartition is the maximum of the distortions of the boxes of this
prepartition. -/
def distortion : ℝ≥0 := π.boxes.sup box.distortion

lemma distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion :=
le_sup h

lemma distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, box.distortion J ≤ c :=
sup_le_iff

lemma distortion_bUnion (π : prepartition I) (πi : Π J, prepartition J) :
  (π.bUnion πi).distortion = π.boxes.sup (λ J, (πi J).distortion) :=
sup_bUnion _ _

@[simp] lemma distortion_disj_union (h : disjoint π₁.Union π₂.Union) :
  (π₁.disj_union π₂ h).distortion = max π₁.distortion π₂.distortion :=
sup_union

lemma distortion_of_const {c} (h₁ : π.boxes.nonempty) (h₂ : ∀ J ∈ π, box.distortion J = c) :
  π.distortion = c :=
(sup_congr rfl h₂).trans (sup_const h₁ _)

@[simp] lemma distortion_top (I : box ι) : distortion (⊤ : prepartition I) = I.distortion :=
sup_singleton

@[simp] lemma distortion_bot (I : box ι) : distortion (⊥ : prepartition I) = 0 := sup_empty

end distortion

/-- A prepartition `π` of `I` is a partition if the boxes of `π` cover the whole `I`. -/
def is_partition (π : prepartition I) := ∀ x ∈ I, ∃ J ∈ π, x ∈ J

lemma is_partition_iff_Union_eq {π : prepartition I} : π.is_partition ↔ π.Union = I :=
by simp_rw [is_partition, set.subset.antisymm_iff, π.Union_subset, true_and, set.subset_def,
  mem_Union, box.mem_coe]

@[simp] lemma is_partition_single_iff (h : J ≤ I) : is_partition (single I J h) ↔ J = I :=
by simp [is_partition_iff_Union_eq]

lemma is_partition_top (I : box ι) : is_partition (⊤ : prepartition I) :=
λ x hx, ⟨I, mem_top.2 rfl, hx⟩

namespace is_partition

variables {π}

lemma Union_eq (h : π.is_partition) : π.Union = I := is_partition_iff_Union_eq.1 h

lemma Union_subset (h : π.is_partition) (π₁ : prepartition I) : π₁.Union ⊆ π.Union :=
h.Union_eq.symm ▸ π₁.Union_subset

protected lemma exists_unique (h : π.is_partition) (hx : x ∈ I) :
  ∃! J ∈ π, x ∈ J :=
begin
  rcases h x hx with ⟨J, h, hx⟩,
  exact exists_unique.intro2 J h hx (λ J' h' hx', π.eq_of_mem_of_mem h' h hx' hx),
end

lemma nonempty_boxes (h : π.is_partition) : π.boxes.nonempty :=
let ⟨J, hJ, _⟩ := h _ I.upper_mem in ⟨J, hJ⟩

lemma eq_of_boxes_subset (h₁ : π₁.is_partition) (h₂ : π₁.boxes ⊆ π₂.boxes) : π₁ = π₂ :=
eq_of_boxes_subset_Union_superset h₂ $ h₁.Union_subset _

lemma le_iff (h : π₂.is_partition) :
  π₁ ≤ π₂ ↔ ∀ (J ∈ π₁) (J' ∈ π₂), (J ∩ J' : set (ι → ℝ)).nonempty → J ≤ J' :=
le_iff_nonempty_imp_le_and_Union_subset.trans $ and_iff_left $ h.Union_subset _

protected lemma bUnion (h : is_partition π) (hi : ∀ J ∈ π, is_partition (πi J)) :
  is_partition (π.bUnion πi) :=
λ x hx, let ⟨J, hJ, hxi⟩ := h x hx, ⟨Ji, hJi, hx⟩ := hi J hJ x hxi in
⟨Ji, π.mem_bUnion.2 ⟨J, hJ, hJi⟩, hx⟩

protected lemma restrict (h : is_partition π) (hJ : J ≤ I) : is_partition (π.restrict J) :=
is_partition_iff_Union_eq.2 $ by simp [h.Union_eq, hJ]

protected lemma inf (h₁ : is_partition π₁) (h₂ : is_partition π₂) :
  is_partition (π₁ ⊓ π₂) :=
is_partition_iff_Union_eq.2 $ by simp [h₁.Union_eq, h₂.Union_eq]

end is_partition

lemma Union_bUnion_partition (h : ∀ J ∈ π, (πi J).is_partition) : (π.bUnion πi).Union = π.Union :=
(Union_bUnion _ _).trans $ Union_congr id surjective_id $ λ J, Union_congr id surjective_id $ λ hJ,
  (h J hJ).Union_eq

lemma is_partition_disj_union_of_eq_diff (h : π₂.Union = I \ π₁.Union) :
  is_partition (π₁.disj_union π₂ (h.symm ▸ disjoint_diff)) :=
is_partition_iff_Union_eq.2 $ (Union_disj_union _).trans $ by simp [h, π₁.Union_subset]

end prepartition

end box_integral


/-!
# Do a bunch of commutative algebra for this week
and graph theory next week

Or can ask questions instead

And gonna talk about universes too

Picard groups:

Input is a commutative ring R
Output is an abellian group Pic(R)

Know two construction
## Construction 1

Let X = set of all ideals of R
if I, J ▵ R are ideals,
then we can define I + J and I ⨯ J

I + J = {i+j | i ∈ I, j ∈ J}
I ⨯ J ≠ {i⨯j | i ∈ I, j ∈ J} as this might not be an ideal,
Define I ⨯ J be the ideal generated by {i⨯j | i ∈ I, j ∈ J}

### Note, this is a group without an inverse, called a monoid

1 ∈ X := R (unit ideal)
I ⨯ 1 = 1 ⨯ I = I
and
(IJ)K = I(JK)

#### Interlude

Let G a group.
Q1) What are the subobjects of G, i.e. injective group homs X → G?
    These are basically the subgroups of G
Q2) What are all the quotient objects of G, i.e. surjective group homs G → Y
    The 1st iso theorem Y ≅ G/ker(φ), so Y is determined by kerφ a normal subgroup
    Conversily if N (normal triangle) G
    G → G⧸N is a quotient

Monoids are "horrible"
  A = {0,1,2} under addition
  Define
  x+y = 2 if actual x+y ≥ 2

Similarly B = {0,1,2,3}

And there exists a monoid hom from B to A
Quotient not by subobjcets but equivalence relations!

-----------------------------------------
Warning cannot use a random equivalence relation,
as one one want G a monoid which has N : equivalence relation on G

G/N ~~equiv class~~ / quotient

Want multiplication to decend!

G   ⨯  G   →    G
|      |        |
↓      ↓        ↓
G⧸N ⨯  G⧸N - - → G⧸N

Ideals of R is a monoid

equiv I ~ J ↔ I ≅ J as an R-module (R-vector space)

≅ is weaker than equality (take 2 different 1d sub vector spaces, they span the same thing)

Q) Is "≅" a congruance relation?
Yes.

Conclusion X⧸≅ is a quotient monoid

If R ≠ {0} then is not a group!

n ⨯ n Matrix over the complex under X,
take units = GLₙ(ℂ) = invertible matrices
= group,  R⨯ (units of R)

#### End of interlude

Picard group of R = Unit group of (ideals of R)⧸(equivalences)

Define an

## Kevin defining Picard group via Idels in Lean

## Or not, talking about universes now

## Construction 2
Picard groups via R modules

Let R be a commutative ring
If V, W are R-modules, then there is a consecpt of being isomorphic
V ≅ᵣ W
Product on R modules its the tensor product

V ⊗ W another R module
not V ⨯ W, its usually bigger

Typicial element of this tensor product is

V₁ ⊗ W₁ + V₂ ⊗ W₂

Is ⊗ associative?
(I×J)×K = I×(J×K) equality of type ideal R

Is V⊗ᵣ(W⊗ᵣX) = (V⊗ᵣW)⊗ᵣX ?
is an equality of *types*

But V⊗ᵣ(W⊗ᵣX) ≅ (V⊗ᵣW)⊗ᵣX is true

Modules over R have some "quasi-multiplication"
  ⊗ exist but R ⊗ V ≠ V and R ⊗ V ≅ V

Let M =  all R=modules,

equiv relation on M ≅ Picard group

### Doing it in Lean in section13 again now

congr lemmas are a useful thing to know
linear_equiv probaly too

##### To get ⊗ notation
open_locale tensor_product

-/


opaque f (x : Nat) : Nat
@[simp] axiom fEq (x : Nat) : f x = x

theorem ex1 (x : Nat) : f (f x, x).fst = x := by simp

theorem ex2 (x : Nat) : f ((fun a => f (f a)) x) = x := by simp

opaque g (x : Nat) : Nat
@[simp] axiom gEq (x : Nat) : g x = match x with | 0 => 1 | x+1 => 2
@[simp] theorem add1 (x : Nat) : x + 1 = x.succ := rfl

theorem ex3 (x : Nat) : g (x + 1) = 2 := by simp

theorem ex4 (x : Nat) : (fun x => x + 1) = (fun x => x.succ) := by simp

@[simp] theorem comm (x y : Nat) : x + y = y + x := Nat.add_comm ..

theorem ex5 (x y : Nat) : (fun x y : Nat => x + 0 + y) = (fun x y : Nat => y + x + 0) := by simp


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

import algebraic_geometry.prime_spectrum.basic
import ring_theory.localization.as_subring

/-!
# Maximal spectrum of a commutative ring

The maximal spectrum of a commutative ring is the type of all maximal ideals.
It is naturally a subset of the prime spectrum endowed with the subspace topology.

## Main definitions

* `maximal_spectrum R`: The maximal spectrum of a commutative ring `R`,
  i.e., the set of all maximal ideals of `R`.

## Implementation notes

The Zariski topology on the maximal spectrum is defined as the subspace topology induced by the
natural inclusion into the prime spectrum to avoid API duplication for zero loci.
-/

noncomputable theory
open_locale classical

universes u v

variables (R : Type u) [comm_ring R]

/-- The maximal spectrum of a commutative ring `R` is the type of all maximal ideals of `R`. -/
@[ext] structure maximal_spectrum :=
(as_ideal : ideal R)
(is_maximal : as_ideal.is_maximal)

attribute [instance] maximal_spectrum.is_maximal

variable {R}

namespace maximal_spectrum

instance [nontrivial R] : nonempty $ maximal_spectrum R :=
let ⟨I, hI⟩ := ideal.exists_maximal R in ⟨⟨I, hI⟩⟩

/-- The natural inclusion from the maximal spectrum to the prime spectrum. -/
def to_prime_spectrum (x : maximal_spectrum R) : prime_spectrum R :=
⟨x.as_ideal, x.is_maximal.is_prime⟩

lemma to_prime_spectrum_injective : (@to_prime_spectrum R _).injective :=
λ ⟨_, _⟩ ⟨_, _⟩ h, by simpa only [mk.inj_eq] using (prime_spectrum.ext_iff _ _).mp h

open prime_spectrum set

lemma to_prime_spectrum_range :
  set.range (@to_prime_spectrum R _) = {x | is_closed ({x} : set $ prime_spectrum R)} :=
begin
  simp only [is_closed_singleton_iff_is_maximal],
  ext ⟨x, _⟩,
  exact ⟨λ ⟨y, hy⟩, hy ▸ y.is_maximal, λ hx, ⟨⟨x, hx⟩, rfl⟩⟩
end

/-- The Zariski topology on the maximal spectrum of a commutative ring is defined as the subspace
topology induced by the natural inclusion into the prime spectrum. -/
instance zariski_topology : topological_space $ maximal_spectrum R :=
prime_spectrum.zariski_topology.induced to_prime_spectrum

instance : t1_space $ maximal_spectrum R :=
⟨λ x, is_closed_induced_iff.mpr
  ⟨{to_prime_spectrum x}, (is_closed_singleton_iff_is_maximal _).mpr x.is_maximal,
    by simpa only [← image_singleton] using preimage_image_eq {x} to_prime_spectrum_injective⟩⟩

lemma to_prime_spectrum_continuous : continuous $ @to_prime_spectrum R _ := continuous_induced_dom

variables (R) [is_domain R] (K : Type v) [field K] [algebra R K] [is_fraction_ring R K]

/-- An integral domain is equal to the intersection of its localizations at all its maximal ideals
viewed as subalgebras of its field of fractions. -/
theorem infi_localization_eq_bot :
  (⨅ v : maximal_spectrum R,
    localization.subalgebra.of_field K _ v.as_ideal.prime_compl_le_non_zero_divisors) = ⊥ :=
begin
  ext x,
  rw [algebra.mem_bot, algebra.mem_infi],
  split,
  { apply imp_of_not_imp_not,
    intros hrange hlocal,
    let denom : ideal R := (submodule.span R {1} : submodule R K).colon (submodule.span R {x}),
    have hdenom : (1 : R) ∉ denom :=
    begin
      intro hdenom,
      rcases submodule.mem_span_singleton.mp
        (submodule.mem_colon.mp hdenom x $ submodule.mem_span_singleton_self x) with ⟨y, hy⟩,
      exact hrange ⟨y, by rw [← mul_one $ algebra_map R K y, ← algebra.smul_def, hy, one_smul]⟩
    end,
    rcases denom.exists_le_maximal (λ h, (h ▸ hdenom) submodule.mem_top) with ⟨max, hmax, hle⟩,
    rcases hlocal ⟨max, hmax⟩ with ⟨n, d, hd, rfl⟩,
    apply hd (hle $ submodule.mem_colon.mpr $ λ _ hy, _),
    rcases submodule.mem_span_singleton.mp hy with ⟨y, rfl⟩,
    exact submodule.mem_span_singleton.mpr
      ⟨y * n, by rw [algebra.smul_def, mul_one, map_mul, smul_comm, algebra.smul_def,
                     algebra.smul_def, mul_comm $ algebra_map R K d, inv_mul_cancel_right₀ $
                       (map_ne_zero_iff _ $ no_zero_smul_divisors.algebra_map_injective R K).mpr $
                       λ h, (h ▸ hd) max.zero_mem]⟩ },
  { rintro ⟨y, rfl⟩ ⟨v, hv⟩,
    exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩ }
end

end maximal_spectrum

namespace prime_spectrum

variables (R) [is_domain R] (K : Type v) [field K] [algebra R K] [is_fraction_ring R K]

/-- An integral domain is equal to the intersection of its localizations at all its prime ideals
viewed as subalgebras of its field of fractions. -/
theorem infi_localization_eq_bot :
  (⨅ v : prime_spectrum R,
    localization.subalgebra.of_field K _ $ v.as_ideal.prime_compl_le_non_zero_divisors) = ⊥ :=
begin
  ext x,
  rw [algebra.mem_infi],
  split,
  { rw [← maximal_spectrum.infi_localization_eq_bot, algebra.mem_infi],
    exact λ hx ⟨v, hv⟩, hx ⟨v, hv.is_prime⟩ },
  { rw [algebra.mem_bot],
    rintro ⟨y, rfl⟩ ⟨v, hv⟩,
    exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩ }
end

end prime_spectrum


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.algebra.group_completion

/-!
# Multiplicative action on the completion of a uniform space

In this file we define typeclasses `has_uniform_continuous_const_vadd` and
`has_uniform_continuous_const_smul` and prove that a multiplicative action on `X` with uniformly
continuous `(•) c` can be extended to a multiplicative action on `uniform_space.completion X`. We
also provide similar instances `distrib_mul_action`, `mul_action_with_zero`, and `module`.
-/

universes u v w x y z

noncomputable theory

variables (R : Type u) (M : Type v) (N : Type w) (X : Type x) (Y : Type y)
  [uniform_space X] [uniform_space Y]

/-- An additive action such that for all `c`, the map `λ x, c +ᵥ x` is uniformly continuous. -/
class has_uniform_continuous_const_vadd [uniform_space X] [has_vadd M X] : Prop :=
(uniform_continuous_const_vadd : ∀ (c : M), uniform_continuous ((+ᵥ) c : X → X))

/-- A multiplicative action such that for all `c`, the map `λ x, c • x` is uniformly continuous. -/
@[to_additive]
class has_uniform_continuous_const_smul [uniform_space X] [has_scalar M X] : Prop :=
(uniform_continuous_const_smul : ∀ (c : M), uniform_continuous ((•) c : X → X))

export has_uniform_continuous_const_vadd (uniform_continuous_const_vadd)
  has_uniform_continuous_const_smul (uniform_continuous_const_smul)

section has_scalar

variable [has_scalar M X]

@[priority 100, to_additive]
instance has_uniform_continuous_const_smul.to_has_continuous_const_smul
  [has_uniform_continuous_const_smul M X] : has_continuous_const_smul M X :=
⟨λ c, (uniform_continuous_const_smul c).continuous⟩

lemma uniform_continuous.const_smul [has_uniform_continuous_const_smul M X]
  {f : Y → X} (hf : uniform_continuous f) (c : M) :
  uniform_continuous (c • f) :=
(uniform_continuous_const_smul c).comp hf

/-- If a scalar is central, then its right action is uniform continuous when its left action is. -/
@[priority 100]
instance has_uniform_continuous_const_smul.op [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X]
  [has_uniform_continuous_const_smul M X] : has_uniform_continuous_const_smul Mᵐᵒᵖ X :=
⟨mul_opposite.rec $ λ c, begin
  change uniform_continuous (λ m, mul_opposite.op c • m),
  simp_rw op_smul_eq_smul,
  exact uniform_continuous_const_smul c,
end⟩

end has_scalar

@[to_additive] instance uniform_group.to_has_uniform_continuous_const_smul
  {G : Type u} [group G] [uniform_space G] [uniform_group G] :
  has_uniform_continuous_const_smul G G :=
⟨λ c, uniform_continuous_const.mul uniform_continuous_id⟩

namespace uniform_space

namespace completion

section has_scalar

variable [has_scalar M X]

@[to_additive has_vadd] instance : has_scalar M (completion X) :=
⟨λ c, completion.map ((•) c)⟩

@[to_additive] instance : has_uniform_continuous_const_smul M (completion X) :=
⟨λ c, uniform_continuous_map⟩

instance [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X] : is_central_scalar M (completion X) :=
⟨λ c a, congr_arg (λ f, completion.map f a) $ by exact funext (op_smul_eq_smul c)⟩

variables {M X} [has_uniform_continuous_const_smul M X]

@[simp, norm_cast, to_additive]

end has_scalar

@[to_additive] instance [monoid M] [mul_action M X] [has_uniform_continuous_const_smul M X] :
  mul_action M (completion X) :=
{ smul := (•),
  one_smul := ext' (continuous_const_smul _) continuous_id $ λ a, by rw [← coe_smul, one_smul],
  mul_smul := λ x y, ext' (continuous_const_smul _) ((continuous_const_smul _).const_smul _) $
    λ a, by simp only [← coe_smul, mul_smul] }

instance [monoid_with_zero M] [has_zero X] [mul_action_with_zero M X]
  [has_uniform_continuous_const_smul M X] :
  mul_action_with_zero M (completion X) :=
{ smul := (•),
  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, mul_action_with_zero.smul_zero r],
  zero_smul := ext' (continuous_const_smul _) continuous_const $ λ a,
    by rw [← coe_smul, zero_smul, coe_zero],
  .. completion.mul_action M X }

instance [monoid M] [add_group N] [distrib_mul_action M N] [uniform_space N]
  [uniform_add_group N] [has_uniform_continuous_const_smul M N] :
  distrib_mul_action M (completion N) :=
{ smul := (•),
  smul_add := λ r x y, induction_on₂ x y
    (is_closed_eq ((continuous_fst.add continuous_snd).const_smul _)
      ((continuous_fst.const_smul _).add (continuous_snd.const_smul _)))
    (λ a b, by simp only [← coe_add, ← coe_smul, smul_add]),
  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, smul_zero r],
  .. completion.mul_action M N }

instance [semiring R] [add_comm_group M] [module R M] [uniform_space M] [uniform_add_group M]
  [has_uniform_continuous_const_smul R M] : module R (completion M) :=
{ smul := (•),
  add_smul := λ a b, ext' (continuous_const_smul _)
    ((continuous_const_smul _).add (continuous_const_smul _)) $ λ x, by { norm_cast, rw add_smul },
  .. completion.distrib_mul_action R M, .. completion.mul_action_with_zero R M }

end completion

end uniform_space


import hilbert.wr.and_or
import hilbert.wr.proofs.or

namespace clfrags
    namespace hilbert
        namespace wr
            namespace and_or

                theorem c₁ {a b : Prop} (h₁ : a) (h₂ : b) : and a b :=
                    have h₃ : or (and a b) a, from or.d₁' h₁,
                    have h₄ : or (and a b) b, from or.d₁' h₂,
                    have h₅ : or (and a b) (and a b), from cd₁ h₃ h₄,
                    show and a b, from or.d₂ h₅

                theorem c₂ {a b : Prop} (h₁ : and a b) : a :=
                    have h₂ : or a (and a b), from or.d₁' h₁,
                    have h₃ : or a a, from cd₂ h₂,
                    show a, from or.d₂ h₃

                theorem c₃ {a b : Prop} (h₁ : and a b) : b :=
                    have h₂ : or b (and a b), from or.d₁' h₁,
                    have h₃ : or b b, from cd₃ h₂,
                    show b, from or.d₂ h₃

            end and_or
        end wr
    end hilbert
end clfrags


import data.finset

namespace finset

lemma diff_singleton_ssub {X : Type*} [decidable_eq X] {s : finset X} {x : X} (h : x ∈ s) : s \ {x} ⊂ s :=
finset.ssubset_iff.2 ⟨x, by simp,
  λ y hy, (mem_insert.1 hy).elim (λ hxy, hxy.symm ▸ h) (by simp {contextual := tt})⟩

-- open_locale classical

-- lemma ssub_of_diff {X : Type*} (S T : finset X)
--   (hST : S ∩ T = ∅) : S \ T ⊂ S :=
-- begin

-- end

end finset


import tactic
import linear_algebra.tensor_product
import algebra.category.Module.basic

-- Picard groups via the category `Module R` of R-modules.

universe u

variables (R : Type u) [comm_ring R]

variables (V : Type u) [add_comm_group V] [module R V]

example : Module R := Module.of R V

-- enable notation for tensor product
open_locale tensor_product

def Module.mul (M N : Module.{u u} R) : Module R :=
Module.of R (M ⊗[R] N)

variables (A B : Module.{u u} R)

instance : has_mul (Module.{u u} R) :=
{ mul := Module.mul R }

instance : has_one (Module.{u u} R) :=
{ one := Module.of R R }

open category_theory

def module.s : con (Module.{u u} R) :=
{ r := λ M N, nonempty (M ≅ N),
  iseqv := begin
    refine ⟨_, _, _⟩,
    { intro M,
      exact nonempty.intro (iso.refl M) },
    { intros M N hMN,
      exact nonempty.map iso.symm hMN },
    { rintros M N P ⟨hMN⟩ ⟨hNP⟩,
      exact nonempty.intro (hMN.trans hNP) },
  end,
  mul' := begin
    rintros A B C D ⟨hAB⟩ ⟨hCD⟩,
    replace hAB := iso.to_linear_equiv hAB,
    replace hCD := iso.to_linear_equiv hCD,
    let hABCD := tensor_product.congr hAB hCD,
    apply nonempty.intro,
    exact linear_equiv.to_Module_iso hABCD,
  end }

abbreviation Module.Picard_monoid := (module.s R).quotient

instance : has_mul (Module.Picard_monoid R) := infer_instance

instance : monoid (Module.Picard_monoid R) :=
{ mul := (*),
  mul_assoc := begin
    intros a b c,
    apply quotient.induction_on₃' a b c, clear a b c,
    intros M N P,
    apply quotient.sound',
    exact ⟨linear_equiv.to_Module_iso (tensor_product.assoc R ↥M ↥N ↥P)⟩,
  end,
  one := quotient.mk' 1,
  one_mul := begin
    intro a, apply quotient.induction_on' a, clear a,
    intro M,
    apply quotient.sound',
    apply nonempty.intro,
    suffices : M ≅ Module.of R M,
    { refine iso.trans _ this.symm,
      convert (tensor_product.lid R M).to_Module_iso },
    cases M,
    apply linear_equiv.to_Module_iso,
    convert (linear_equiv.refl R _),
  end,
  mul_one := begin
    intro a, apply quotient.induction_on' a, clear a,
    intro M,
    apply quotient.sound',
    apply nonempty.intro,
    suffices : M ≅ Module.of R M,
    { refine iso.trans _ this.symm,
      convert (tensor_product.rid R M).to_Module_iso },
    cases M,
    apply linear_equiv.to_Module_iso,
    convert (linear_equiv.refl R _),
  end,
}

abbreviation Module.Picard_group := units (Module.Picard_monoid R)

instance : group (Module.Picard_group R) := infer_instance

#check (Module.Picard_group R) -- Type (u + 1) because
-- the collection of all modules over a ring "isn't a set"


import analysis.inner_product_space.adjoint

variables {𝕜 E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E] [complete_space E]

open_locale big_operators matrix topological_space

namespace continuous_linear_map

lemma norm_map_of_unitary {U : (E →L[𝕜] E)} (hU : U ∈ unitary (E →L[𝕜] E)) (x : E) :
  ∥U x∥ = ∥x∥ :=
begin
  rw ← sq_eq_sq (norm_nonneg (U x)) (norm_nonneg x),
  rw [norm_sq_eq_inner, ← continuous_linear_map.adjoint_inner_left,
    ← continuous_linear_map.mul_apply],
  rw unitary.mem_iff at hU,
  rw [← continuous_linear_map.star_eq_adjoint, hU.1, continuous_linear_map.one_apply,
    inner_self_eq_norm_sq],
end

lemma op_norm_of_unitary [nontrivial E] {U : (E →L[𝕜] E)} (hU : U ∈ unitary (E →L[𝕜] E)) :
  ∥U∥ = 1 :=
begin
  have h_above : ∀ (x : E), ∥U x∥ ≤ 1 * ∥x∥,
  { intro x,
    rw norm_map_of_unitary hU,
    norm_num },
  have h_below : ∀ (N : ℝ), N ≥ 0 → (∀ (x : E), ∥U x∥ ≤ N * ∥x∥) → 1 ≤ N,
  { intros N hN_zero,
    contrapose,
    push_neg,
    intro hN_one,
    have hy_nonzero : ∃ (y : E), y ≠ 0 := exists_ne 0,
    cases hy_nonzero with y hy,
    use y,
    rw norm_map_of_unitary hU,
    have hy_pos : 0 < ∥y∥ := by {rw norm_pos_iff, exact hy},
    rw mul_lt_iff_lt_one_left hy_pos,
    exact hN_one },
  apply continuous_linear_map.op_norm_eq_of_bounds zero_le_one h_above h_below,
end

end continuous_linear_map


import category_theory.category.default

universes v u  -- The order in this declaration matters: v often needs to be explicitly specified while u often can be omitted

namespace category_theory

variables (C : Type u) [category.{v} C]

--rewrite this

/-
# Category world

## Level 7: Composition of monomorphisms

Now we show that the composition of two monomorphisms produces another monomorphism.-/

/- Lemma
If $$f : X ⟶ Y$$ and $$g : X ⟶ Y$$ are monomorphisms, then $$f ≫ g : X ⟶ Z$$ is a monomorphism.
-/
lemma epi_comp' {X Y Z : C} (f : X ⟶ Y) [epi f] (g : Y ⟶ Z) [epi g] : epi (f ≫ g) :=
begin
    split,
    intros Z h l hyp,
    rw ← cancel_epi g,
    rw ← cancel_epi f,
    rw ← category.assoc,
    rw ← category.assoc,
    exact hyp,
end

end category_theory


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) : α ∉ ℚ → ∃ S : set ℝ, (∀ x ∈ S, x ∈ Icc 0 1) ∧ (∀ x y ∈ S, x ≠ y) ∧ (∀ x y ∈ S, ∃ z ∈ S, |x - y| = z) :=
begin
  -- Let $\alpha$ be an irrational number.
  assume h1 : α ∉ ℚ,

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ≠ (j : ℝ) * α - ⌊(j : ℝ) * α⌋,
  from by auto [sub_floor, sub_floor],

  -- If this were not true, then
  -- $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h3 : ∀ i j : ℤ, i ≠ j → α ≠ ((⌊(i : ℝ) * α⌋ - ⌊(j : ℝ) * α⌋)/(i - j)),
  from by auto [sub_floor, sub_floor, sub_div],

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  let S := {(i : ℝ) * α - ⌊(i : ℝ) * α⌋ | i : ℤ},

  -- is an infinite subset of $\left[0,1\right]$.
  have h4 : ∀ i : ℤ, (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ∈ Icc 0 1,
  from by auto [sub_floor, sub_floor, sub_nonneg],
  have h5 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ≠ (j : ℝ) * α - ⌊(j : ℝ) * α⌋,
  from by auto [sub_floor, sub_floor],
  have h6 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j, from by auto [int.exists_ne],
  have h7 : ∀ i : ℤ, ∃ j : ℤ, (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ≠ (j : ℝ) * α - ⌊(j : ℝ) * α⌋,
  from by auto [h6, h5],
  have h8 : ∃ (i : ℤ), (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ≠ (i : ℝ) * α - ⌊(i : ℝ) * α⌋,
  from by auto [h7],
  have h9 : ∃ (i : ℤ), (i : ℝ) * α - ⌊(i : ℝ) * α⌋ ∈ S,
  from by auto [h8, set.mem_def],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h10 : ∃ x : ℝ, x ∈ Icc 0 1 ∧ ∀ ε > 0, ∃ y ∈ S, y ≠ x ∧ |y - x| < ε,
  from by auto [h9, set.bounded_iff, set.bounded_iff, set.compact_iff, set.compact_iff, set.compact_iff] using [compact_Icc],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h11 : ∀ ε > 0, ∃ x y ∈ S, x ≠ y ∧ |x - y| < ε,
  from by auto [h10, set.mem_def, set.mem_def, set.mem_def],

  -- Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h12 : ∀ x y ∈ S, ∃ z ∈ S, |x - y| = z,
  from by auto [h11],

  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h13 : ∀ y ε > 0, ∃ x ∈ S, |y - x| < ε,
  from by auto [h11],

  -- Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h14 : ∀ y ε > 0, ∃ N x ∈ S, N * x ≤ y ∧ y < (N + 1) * x ∧ |y - (N * x)| < ε,
  from by auto [h13, set.mem_def, set.mem_def, set.mem_def, set.mem_def, set.mem_def, set.mem_def, set.mem_def, set.mem_def, set.mem_def],

  -- QED
  show ∃ (S : set ℝ), (∀ (x : ℝ), x ∈ S → x ∈ Icc 0 1) ∧ (∀ (x y : ℝ), x ∈ S → y ∈ S → x ≠ y) ∧ (∀ (x y : ℝ), x ∈ S → y ∈ S → ∃ (z : ℝ), z ∈ S ∧ |x - y| = z),
  from by auto [h4, h5, h6, h7, h8, h9, h10, h11, h12, h13, h14, set.mem_def],
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
  ∀ (ε : ℝ) (hε : ε > 0), ∃ (n : ℤ) (h1 : 0 ≤ n) (h2 : n ≤ 1/ε), ∃ (m : ℤ), (n : ℝ) ≤ m * α ∧ m * α < (n + 1) :=
begin
  assume (ε : ℝ) (hε : ε > 0),
  let S := {n : ℤ | 0 ≤ n ∧ n ≤ 1/ε},
  have h1 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h2 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h3 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h4 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h5 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h6 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h7 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h8 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h9 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h10 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h11 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h12 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h13 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h14 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h15 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h16 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h17 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h18 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h19 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h20 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h21 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h22 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h23 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h24 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h25 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h26 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h27 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h28 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h29 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h30 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h31 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq],
  have h32 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ 1 / ε, from by auto [set.mem_set_of_eq],
  have h33 : ∀ (n : ℤ), n ∈ S ↔ (0 : ℝ) ≤ n ∧ n ≤ (1 : ℝ) / ε, from by auto [set.mem_set_of_eq
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h1 : α ∉ ℚ) : ∀ y ∈ (Icc 0 1), ∃ x ∈ (Icc 0 1), y ≠ x ∧ |y - x| < 1 :=
begin
  assume (y : ℝ) (h2 : y ∈ Icc 0 1),
  let S := (set.range (λ (i : ℤ), (i : ℝ) * α)) ∩ Icc 0 1,
  have h3 : S ⊆ Icc 0 1, from by auto [set.mem_inter_iff, set.mem_range, set.mem_Icc],
  have h4 : ∀ i : ℤ, (i : ℝ) * α ∉ ℚ, from by auto [h1, mul_ne_zero],
  have h5 : ∀ i : ℤ, (i : ℝ) * α ∉ ℚ, from by auto [h1, mul_ne_zero],
  have h6 : ∀ i j : ℤ, i ≠ j → ((i : ℝ) * α) - (j : ℝ) * α ≠ 0, from by auto [h4, mul_ne_zero],
  have h7 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h8 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h9 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h10 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h11 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h12 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h13 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h14 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h15 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h16 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h17 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h18 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h19 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h20 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h21 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h22 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h23 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h24 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h25 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h26 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h27 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h28 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h29 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h30 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h31 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h32 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h33 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h34 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h35 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h36 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h37 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α ≠ (j : ℝ) * α, from by auto [h5, mul_ne_zero],
  have h38 : ∀ i j : ℤ, i ≠ j → (i :
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : α ≠ 0) (hα2 : ¬ is_rat α) :
∀ y ∈ Icc 0 1, ∃ x ∈ set.range (λ n : ℤ, n • α % 1), |y - x| < 1 :=
begin
  assume y h1,
  have h2 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h3 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h4 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h5 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h6 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h7 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h8 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h9 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h10 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h11 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h12 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h13 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h14 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h15 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h16 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h17 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h18 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h19 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h20 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h21 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h22 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h23 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h24 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_of_mul_eq_mul_left, eq_of_mul_eq_mul_right, is_rat.def],
  have h25 : ∀ i j : ℤ, i ≠ j → (i • α % 1) ≠ (j • α % 1), from by auto [hα, hα2, eq_
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h1 : ¬ ∃ q : ℚ, α = q) :
∀ y : ℝ, ∃ x : ℝ, x ∈ {i * α | i : ℤ} ∧ |y - x| < 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  assume (y : ℝ),
  have h2 : ∀ (i j : ℤ), (i ≠ j) → ((i * α) - (floor (i * α)) ≠ (j * α) - (floor (j * α))),
  from by auto [h1, floor_eq_iff],

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  let S : set ℝ := {i * α - floor (i * α) | i : ℤ},
  have h3 : (∀ (i : ℤ), i * α - floor (i * α) ∈ S) ∧ (∀ (x : ℝ), x ∈ S → ∃ (i : ℤ), x = i * α - floor (i * α)),
  from by auto,

  have h4 : ∀ (x : ℝ), x ∈ S → x ∈ Icc 0 1,
  from by auto [floor_nonneg, floor_le],

  have h5 : ∀ (x : ℝ), x ∈ S → 0 ≤ x ∧ x < 1,
  from by auto [h4],

  have h6 : ∀ (x : ℝ), x ∈ S → x < 1,
  from by auto [h5],

  have h7 : ∀ (x : ℝ), x ∈ S → 0 ≤ x,
  from by auto [h5],

  have h8 : ∀ (x : ℝ), x ∈ S → x ≠ 0,
  from by auto [h7],

  have h9 : ∀ (x : ℝ), x ∈ S → x ≠ 1,
  from by auto [h6],

  have h10 : ∀ (x : ℝ), x ∈ S → x ∈ Ico 0 1,
  from by auto [h5, h8, h9],

  have h11 : S ⊆ Ico 0 1,
  from by auto [h10],

  have h12 : ∀ (x : ℝ), x ∈ S → x ∈ Icc 0 1,
  from by auto [h4],

  have h13 : S ⊆ Icc 0 1,
  from by auto [h12],

  have h14 : ∀ (x : ℝ), x ∈ S → x ∈ Ici 0 1,
  from by auto [h7, h6],

  have h15 : S ⊆ Ici 0 1,
  from by auto [h14],

  have h16 : S ⊆ {x : ℝ | 0 ≤ x ∧ x ≤ 1},
  from by auto [h15],

  have h17 : S ⊆ {x : ℝ | 0 < x ∧ x < 1},
  from by auto [h11],

  have h18 : S ⊆ {x : ℝ | 0 ≤ x ∧ x < 1},
  from by auto [h16],

  have h19 : S ⊆ {x : ℝ | 0 < x ∧ x ≤ 1},
  from by auto [h16],

  have h20 : S ⊆ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1},
  from by auto [h17, h18, h19],

  have h21 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1},
  from by auto [h20, h8, h9],

  have h22 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1},
  from by auto [h20],

  have h23 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1},
  from by auto [h18, h21],

  have h24 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1},
  from by auto [h19, h21],

  have h25 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 ≤ x ∧ x ≤ 1},
  from by auto [h16, h21],

  have h26 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1},
  from by auto [h23, h22],

  have h27 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1},
  from by auto [h24, h22],

  have h28 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x ≤ 1},
  from by auto [h25, h22],

  have h29 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1},
  from by auto [h26, h27, h28],

  have h30 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1} ∪ {x : ℝ | 0 ≤ x ∧ x ≤ 1},
  from by auto [h29, h28],

  have h31 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1} ∪ {x : ℝ | 0 ≤ x ∧ x ≤ 1} ∪ {x : ℝ | 0 < x ∧ x < 1},
  from by auto [h29, h30],

  have h32 : S ⊆ {x : ℝ | x = 0} ∪ {x : ℝ | x = 1} ∪ {x : ℝ | 0 < x ∧ x < 1} ∪ {x : ℝ | 0 ≤ x ∧ x < 1} ∪ {x : ℝ | 0 < x ∧ x ≤ 1} ∪ {x :
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_dense (α : ℝ) (hα : ¬ is_rat α) : ∃ (S : set ℝ), ∀ (x : ℝ), x ∈ S → x ∈ Icc 0 1 ∧ ∀ (y : ℝ), y ∈ Icc 0 1 → ∃ (z : ℝ), z ∈ S ∧ abs (z - y) < abs (x - y) :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ (i j : ℤ), i ≠ j → (int.fract (i * α)) ≠ (int.fract (j * α)),
  from by auto [int.fract_mul, int.fract_eq_iff, hα, int.fract_eq_iff],

  --Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ (i : ℤ), (int.fract (i * α)) ∈ Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h3 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)), from by auto [int.fract_mul],
  have h4 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h5 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h6 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h7 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h8 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h9 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h10 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h11 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h12 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h13 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h14 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h15 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h16 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h17 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h18 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h19 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h20 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h21 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h22 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h23 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h24 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h25 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h26 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h27 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.fract (i * α)) ∩ Icc 0 1, from by auto [h2, h3],
  have h28 : ∀ (i : ℤ), (int.fract (i * α)) ∈ set.range (λ (i : ℤ), int.
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


variable U : Type
variables A B C : U -> Prop
variable h1 : forall x, A x \/ B x
variable h2 : forall x, A x -> C x
variable h3 : forall x, B x -> C x
example : forall x, C x :=
assume t,
have h4 : A t \/ B t, from h1 t,
have h5 : A t -> C t, from h2 t,
have h6 : B t -> C t, from h3 t,
show C t, from
or.elim h4
    (assume hA : A t,
    show C t, from h5 hA)
    (assume hB : B t,
    show C t, from h6 hB)


import data.mv_polynomial.basic
import data.mv_polynomial.comm_ring
import data.zmod.basic

open mv_polynomial

abbreviation R := mv_polynomial (fin 2) (zmod 2)

example :
  let f : R :=  (X 0)^2 + (X 1)^2,
      f1 : R := X 0,
      f2 : R := X 1
      in
      f = (X 0) * f1 + (X 1) * f2 :=
begin
 ring_exp,
 -- I first tried
 -- ring,
 -- rw pow_two,
 -- rw pow_two
 -- but the ring_exp version appears to be faster.
end


import data.real.basic
import data.set.intervals
import tactic

export has_Sup (Sup) has_Inf (Inf)

namespace real_number_game

-- hide (need to choose this or P)
class nonemptyT (S : set ℝ) : Type :=
(x : ℝ)
(thm : x ∈ S)

-- hide (need to choose this or T)
class nonemptyP (S : set ℝ) : Prop :=
(thm' : ∃ x : ℝ, x ∈ S)

def nonemptyP.thm (S : set ℝ) [nonemptyP S] :
  ∃ x : ℝ, x ∈ S :=
nonemptyP.thm'

-- irrelevant example
example : ∃ x: ℝ, x < 1 := ⟨0.5, by norm_num⟩
example : (0.5 : ℝ) < 1 := by norm_num

-- irrelevant example
noncomputable example : nonemptyT (set.Icc 0 1) :=
{ x := 0.5,
  thm := by {simp,split;norm_num}
}

-- show
def is_upper_bound (S : set ℝ) (b : ℝ) : Prop := ∀ s ∈ S, s ≤ b

-- hide this def
class bounded_aboveT (S : set ℝ) : Type :=
(b : ℝ)
(thm : is_upper_bound S b)

-- hide this def
class bounded_aboveP (S : set ℝ) : Prop :=
(thm' : ∃ b : ℝ, is_upper_bound S b)

def bounded_aboveP.thm (S : set ℝ) [bounded_aboveP S] :
  ∃ b : ℝ, is_upper_bound S b :=
bounded_aboveP.thm'

-- example (for me only)
instance : bounded_aboveT (set.Icc 0 1) :=
{ b := 2,
  thm := λ r ⟨h1, h2⟩, le_trans h2 (by norm_num)
}

-- hide
noncomputable def Sup (S : set ℝ) [nonemptyP S] [bounded_aboveP S] := Sup S

-- state as axiom; hide proof
theorem le_Sup {S : set ℝ} [nonemptyP S] [bounded_aboveP S] : ∀ x ∈ S, x ≤ Sup S :=
begin
  apply real.le_Sup,
  cases bounded_aboveP.thm S with b hb,
  use b,
  exact hb,
end

-- state as axiom; hide proof
theorem Sup_le {S : set ℝ} [nonemptyP S] [bounded_aboveP S] :
  ∀ b : ℝ, is_upper_bound S b → Sup S ≤ b :=
begin
  intros b hb,
  show has_Sup.Sup S ≤ b,
  rw real.Sup_le,
  { exact hb},
  { cases nonemptyP.thm S with c hc, use c, exact hc},
  { use b, exact hb}
end

-- other axioms: ℤ unbounded, linearly ordered field.
-- Might need to introduce later.

end real_number_game


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.cast
import Mathlib.algebra.char_zero
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Injectivity of `int.cast` into characteristic zero rings.

-/

namespace int

@[simp] theorem cast_eq_zero {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {n : ℤ} : ↑n = 0 ↔ n = 0 := sorry

@[simp] theorem cast_inj {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {m : ℤ} {n : ℤ} : ↑m = ↑n ↔ m = n := sorry

theorem cast_injective {α : Type u_1} [add_group α] [HasOne α] [char_zero α] : function.injective coe :=
  fun {a₁ a₂ : ℤ} => idRhs (↑a₁ = ↑a₂ → a₁ = a₂) (iff.mp cast_inj)

theorem cast_ne_zero {α : Type u_1} [add_group α] [HasOne α] [char_zero α] {n : ℤ} : ↑n ≠ 0 ↔ n ≠ 0 :=
  not_congr cast_eq_zero


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan, Anne Baanen
-/

import algebra.field.basic
import data.rat.basic
import ring_theory.algebraic
import ring_theory.dedekind_domain
import ring_theory.integral_closure
import ring_theory.polynomial.rational_root

/-!
# Number fields
This file defines a number field and the ring of integers corresponding to it.

## Main definitions
 - `number_field` defines a number field as a field which has characteristic zero and is finite
    dimensional over ℚ.
 - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
    as the integral closure of ℤ in the number field.

## Implementation notes
The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice.

## References
* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]

## Tags
number field, ring of integers
-/

/-- A number field is a field which has characteristic zero and is finite
dimensional over ℚ. -/
class number_field (K : Type*) [field K] : Prop :=
[to_char_zero : char_zero K]
[to_finite_dimensional : finite_dimensional ℚ K]

open function
open_locale classical big_operators

namespace number_field

variables (K L : Type*) [field K] [field L] [nf : number_field K]

include nf

-- See note [lower instance priority]
attribute [priority 100, instance] number_field.to_char_zero number_field.to_finite_dimensional

protected lemma is_algebraic : algebra.is_algebraic ℚ K := algebra.is_algebraic_of_finite _ _

omit nf

/-- The ring of integers (or number ring) corresponding to a number field
is the integral closure of ℤ in the number field. -/
def ring_of_integers := integral_closure ℤ K

localized "notation `𝓞` := number_field.ring_of_integers" in number_field

lemma mem_ring_of_integers (x : K) : x ∈ 𝓞 K ↔ is_integral ℤ x := iff.rfl

instance ring_of_integers_algebra [algebra K L] : algebra (𝓞 K) (𝓞 L) := ring_hom.to_algebra
{ to_fun := λ k, ⟨algebra_map K L k, is_integral.algebra_map k.2⟩,
  map_zero' := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_zero, map_zero],
  map_one'  := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_one, map_one],
  map_add' := λ x y, subtype.ext $ by simp only [map_add, subalgebra.coe_add, subtype.coe_mk],
  map_mul' := λ x y, subtype.ext $ by simp only [subalgebra.coe_mul, map_mul, subtype.coe_mk] }

namespace ring_of_integers

variables {K}

instance [number_field K] : is_fraction_ring (𝓞 K) K :=
integral_closure.is_fraction_ring_of_finite_extension ℚ _

instance : is_integral_closure (𝓞 K) ℤ K :=
integral_closure.is_integral_closure _ _

instance [number_field K] : is_integrally_closed (𝓞 K) :=
integral_closure.is_integrally_closed_of_finite_extension ℚ

lemma is_integral_coe (x : 𝓞 K) : is_integral ℤ (x : K) :=
x.2

/-- The ring of integers of `K` are equivalent to any integral closure of `ℤ` in `K` -/
protected noncomputable def equiv (R : Type*) [comm_ring R] [algebra R K]
  [is_integral_closure R ℤ K] : 𝓞 K ≃+* R :=
(is_integral_closure.equiv ℤ R K _).symm.to_ring_equiv

variables (K)

instance [number_field K] : char_zero (𝓞 K) := char_zero.of_module _ K

instance [number_field K] : is_dedekind_domain (𝓞 K) :=
is_integral_closure.is_dedekind_domain ℤ ℚ K _

end ring_of_integers

end number_field

namespace rat

open number_field

instance rat.number_field : number_field ℚ :=
{ to_char_zero := infer_instance,
  to_finite_dimensional := by { convert (infer_instance : finite_dimensional ℚ ℚ),
             -- The vector space structure of `ℚ` over itself can arise in multiple ways:
             -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
             -- all char 0 fields have a canonical embedding of `ℚ` (used in `number_field`).
             -- Show that these coincide:
             ext1, simp [algebra.smul_def] } }

/-- The ring of integers of `ℚ` as a number field is just `ℤ`. -/
noncomputable def ring_of_integers_equiv : ring_of_integers ℚ ≃+* ℤ :=
ring_of_integers.equiv ℤ

end rat


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u l

namespace Mathlib

class setoid (α : Sort u)
where
  r : α → α → Prop
  iseqv : equivalence r

protected instance setoid_has_equiv {α : Sort u} [setoid α] : has_equiv α :=
  has_equiv.mk setoid.r

namespace setoid

theorem refl {α : Sort u} [setoid α] (a : α) : a ≈ a := sorry

theorem symm {α : Sort u} [setoid α] {a : α} {b : α} (hab : a ≈ b) : b ≈ a := sorry

theorem trans {α : Sort u} [setoid α] {a : α} {b : α} {c : α} (hab : a ≈ b) (hbc : b ≈ c) : a ≈ c := sorry


import data.fintype

structure London_Zoo :=
(elephant : Type)
[e_finite: fintype elephant] -- I only put these assumptions in (finitely many elephants
(vulture : Type)             -- and vultures) because otherwise the cardinality would
[v_finite: fintype vulture]  -- be a cardinal rather than a non-negative integer.
(likes : elephant → vulture → Prop)
(axiom_a : inhabited (elephant))
(axiom_b : ∀ v₁ v₂ : vulture, v₁ ≠ v₂ → ∃! e : elephant, likes e v₁ ∧ likes e v₂)
(axiom_c : ∀ e : elephant, ∃ v₁ v₂ : vulture, v₁ ≠ v₂ ∧ likes e v₁ ∧ likes e v₂)
(axiom_d : ∀ e : elephant, ∃ v : vulture, ¬ (likes e v))

open fintype
open London_Zoo

variable {Z : London_Zoo}

notation e ` ♥ ` v := London_Zoo.likes _ e v -- e ♥ v notation for e likes v

instance finitely_many_elephants : fintype Z.elephant  := Z.e_finite
instance finitely_many_vultures : fintype Z.vulture := Z.v_finite

theorem part_i : 3 ≤ card Z.vulture := begin
  -- axiom a says an elephant e exists
  let e : Z.elephant := Z.axiom_a.default,
  -- axiom c applied to e says there are two distinct vultures v₁ and v₂ that e likes.
  rcases Z.axiom_c e with ⟨v₁,v₂,H_v₁_not_v₂,H_e_likes_v₁,H_e_likes_v₂⟩,
  -- axiom d applied to e says there is a vulture v₃ that e doesn't like.
  rcases Z.axiom_d e with ⟨v₃,H_e_doesnt_like_v₃⟩,
  -- I claim we now have three distinct vultures v₁ v₂ v₃.
  have H_v₂_not_v₃ : v₂ ≠ v₃, --because e likes one but not the other
    exact λ h, H_e_doesnt_like_v₃ (h ▸ H_e_likes_v₂),
  have H_v₁_not_v₃ : v₁ ≠ v₃, --because e likes one but not the other
    exact λ h, H_e_doesnt_like_v₃ (h ▸ H_e_likes_v₁),
  -- If a set has three distinct elements, its cardinality is at least 3
  exact finset.card_le_of_subset (finset.subset_univ ⟨v₁::v₂::v₃::0, by simp *⟩)
end


import data.nat.prime
import data.zmod.basic
import data.complex.basic
import analysis.special_functions.pow
import analysis.analytic.basic
import analysis.calculus.iterated_deriv
import tprod
import fg_quotient
import algebra.module.basic

local attribute [semireducible] with_zero
def disc (a b : ℤ) : ℤ :=
-16*(4*a^3+27*b^2)

structure elliptic_curve :=
(a b : ℤ)
(disc_nonzero : disc a b ≠ 0)

namespace elliptic_curve

variable (E : elliptic_curve)

def finite_points (E : elliptic_curve) :=
{P : ℚ × ℚ // let ⟨x, y⟩ := P in
  y^2  = x^3 + E.a*x + E.b}

lemma finite_points.ext_iff {x1 y1 : ℚ} (h1 : y1^2  = x1^3 + E.a*x1 + E.b)
  {x2 y2 : ℚ} (h2 : y2^2  = x2^3 + E.a*x2 + E.b) :
  (⟨(x1, y1), h1⟩ : E.finite_points) = ⟨(x2, y2), h2⟩ ↔ x1 = x2 ∧ y1 = y2 :=
begin
  split,
  { intro h,
    rw subtype.ext_iff at h,
    change (x1, y1) = (x2, y2) at h,
    exact prod.mk.inj h },
  { rintro ⟨rfl, rfl⟩,
    refl },
end

def points (E : elliptic_curve) :=
with_zero E.finite_points

instance : has_zero (points E) := with_zero.has_zero

def points_mk {x y : ℚ} (h : y^2  = x^3 + E.a*x + E.b) : points E := some ⟨⟨x, y⟩, h⟩

lemma ext_iff
  {x1 y1 : ℚ} (h1 : y1^2  = x1^3 + E.a*x1 + E.b)
  {x2 y2 : ℚ} (h2 : y2^2  = x2^3 + E.a*x2 + E.b) :
  E.points_mk h1 = E.points_mk h2 ↔ x1 = x2 ∧ y1 = y2 :=
begin
  split,
  { intro h,
    change some _ = some _ at h,
    rw option.some_inj at h,
    rwa finite_points.ext_iff at h },
  { rintro ⟨rfl, rfl⟩,
    refl }
end

def is_finite (P : points E) := ∃ {x y : ℚ} (h : y^2  = x^3 + E.a*x + E.b), P = E.points_mk h

lemma not_is_finite_zero : ¬ E.is_finite 0.

lemma is_finite_some (P : finite_points E) : E.is_finite (some P) :=
begin
  rcases P with ⟨⟨x, y⟩, h⟩,
  use [x, y, h],
  refl,
end

def x_coord : Π {P : points E}, E.is_finite P → ℚ
| none h0 := false.elim (E.not_is_finite_zero h0) -- 0 can't happen
| (some ⟨(x,y),h⟩) _ := x

lemma x_coord_some {x y : ℚ} (h : y^2  = x^3 + E.a*x + E.b) :
  E.x_coord (E.is_finite_some ⟨(x,y),h⟩) = x := rfl

def y_coord : Π {P : points E}, E.is_finite P → ℚ
| none h0 := false.elim (E.not_is_finite_zero h0)
| (some ⟨(x,y),h⟩) _ := y

lemma y_coord_some {x y : ℚ} (h : y^2  = x^3 + E.a*x + E.b) :
  E.y_coord (E.is_finite_some ⟨(x,y),h⟩) = y := rfl

lemma is_zero_or_finite (P : points E) :
  P = 0 ∨ E.is_finite P :=
begin
  rcases P with (_ | ⟨⟨x, y⟩, h⟩),
  { left, refl },
  { right, exact ⟨x, y, h, rfl⟩ }
end

def is_on_curve (x y : ℚ) := y^2 = x^3 + E.a*x + E.b

lemma is_on_curve_def {x y : ℚ} : E.is_on_curve x y ↔ y^2 = x^3 + E.a*x + E.b :=
iff.rfl

lemma coords_are_on_curve {P : points E} (hP : E.is_finite P) :
  E.is_on_curve (E.x_coord hP) (E.y_coord hP) :=
match P, hP with
| none, h0 := false.elim (E.not_is_finite_zero h0)
| some ⟨(x,y),h⟩, _ := h
end

lemma is_zero_or_finite' (P : points E) : P = 0 ∨ ∃ (x y : ℚ)
  (h : E.is_on_curve x y), P = E.points_mk h :=
begin
  cases E.is_zero_or_finite P,
  { left, assumption },
  { right,
    rcases h with ⟨x, y, h1, rfl⟩,
    use [x, y, h1] }
end

lemma is_finite_spec {P : points E} (hP : E.is_finite P) :
  P = E.points_mk (E.coords_are_on_curve hP) :=
begin
  cases E.is_zero_or_finite' P,
  { subst h,
    exfalso,
    exact E.not_is_finite_zero hP },
  { rcases h with ⟨x, y, h1, rfl⟩,
    refl }
end

lemma is_on_curve_neg {x y : ℚ}
(h : E.is_on_curve x y) : E.is_on_curve x (-y) :=
begin
  rw is_on_curve_def at *,
  convert h using 1,
  ring,
end

def neg_finite : finite_points E → finite_points E
| P :=
  let ⟨⟨x, y⟩, hP⟩ := P in
  ⟨(x, -y), E.is_on_curve_neg hP⟩

def neg : points E → points E
| 0 := 0
| (some P) := (some (neg_finite E P))

instance : has_neg (points E) := ⟨E.neg⟩

lemma neg_zero : -(0 : points E) = 0 := rfl

lemma neg_finite_def {x y : ℚ} (h : E.is_on_curve x y) :
  -(E.points_mk h) = E.points_mk (E.is_on_curve_neg h) := rfl

lemma neg_finite_def' {x y : ℚ} (h : E.is_on_curve x y) :
  E.neg_finite ⟨(x, y), h⟩ = ⟨⟨x,-y⟩, E.is_on_curve_neg h⟩ := rfl

lemma neg_some_some_neg (P : finite_points E) :
  -(id (some P) : E.points) = some (E.neg_finite P) := rfl

def double : points E → points E
| 0 := 0
| (some P) :=
let ⟨⟨x, y⟩, h⟩ := P in
if h2 : y = 0 then 0 else
  let A : ℚ := E.a in
  let B : ℚ := E.b in
  let d := 2*y in
  let sd := (3*x^2+A) in
  let td := y*d-sd*x in
  let x₂dd := sd^2-2*x*d^2 in
  let y₂ddd := sd*x₂dd+td*d^2 in
  let y₂' := -y₂ddd/d^3 in
  let x₂ := x₂dd/d^2 in
  some ⟨⟨x₂, y₂'⟩, begin
    show y₂'^2  = x₂^3 + A*x₂ + B,
    simp only [x₂, y₂', y₂ddd, x₂dd, sd, d, td],
    field_simp,
    change y^2=x^3+A*x+B at h,
    apply eq_of_sub_eq_zero,
    rw ← sub_eq_zero at h,
    have : (-((y * (2 * y) - (3 * x ^ 2 + A) * x) * (2 * y) ^ 2) +
         -((3 * x ^ 2 + A) * ((3 * x ^ 2 + A) ^ 2 - 2 * x * (2 * y) ^ 2))) ^
      2 *
    (((2 * y) ^ 2) ^ 3 * (2 * y) ^ 2) -
  (((3 * x ^ 2 + A) ^ 2 - 2 * x * (2 * y) ^ 2) ^ 3 * (2 * y) ^ 2 +
         A * ((3 * x ^ 2 + A) ^ 2 - 2 * x * (2 * y) ^ 2) * ((2 * y) ^ 2) ^ 3 +
       B * (((2 * y) ^ 2) ^ 3 * (2 * y) ^ 2)) *
    ((2 * y) ^ 3) ^ 2 = 16384*y^14*(y^2-(x^3+A*x+B)),
      ring,
    rw this, clear this,
    rw h,
    simp,
  end⟩

lemma double_zero : E.double 0 = 0 := rfl

lemma double_order_two {x : ℚ} (h : E.is_on_curve x 0) :
  E.double (E.points_mk h) = 0 := rfl

lemma double_finite {x y : ℚ} (hy : y ≠ 0) (h : E.is_on_curve x y) :
  E.is_finite (E.double (E.points_mk h)) :=
begin
  change E.is_finite (dite (y = 0) _ _),
  rw dif_neg hy,
  exact E.is_finite_some _,
end

lemma double_x_of_finite {x y : ℚ} (hy : y ≠ 0) (h : E.is_on_curve x y) :
  E.x_coord (E.double_finite hy h) = ((3*x^2+E.a)^2-2*x*(2*y)^2)/(2*y)^2 :=
begin
  convert E.x_coord_some _,
  exact dif_neg hy,
end

lemma double_y_of_finite {x y : ℚ} (hy : y ≠ 0) (h : E.is_on_curve x y) :
  E.y_coord (E.double_finite hy h) =
(-((3*x^2+E.a)*((3*x^2+E.a)^2-2*x*(2*y)^2)+(y*(2*y)-(3*x^2+E.a)*x)*(2*y)^2))/(2*y)^3 :=
begin
  convert E.y_coord_some _,
  exact dif_neg hy,
end

def add : points E → points E → points E
| 0 P := P
| P 0 := P
| (some P) (some Q) :=
let ⟨⟨x1, y1⟩, h1⟩ := P in
let ⟨⟨x2, y2⟩, h2⟩ := Q in
if hd : x1 = x2 then
(if y1 = y2 then double E (some P) else 0) else
  let A : ℚ := E.a in
  let B : ℚ := E.b in
  let d := (x1 - x2) in
  let sd := (y1 - y2) in
  let td := y1*d-sd*x1 in
  let x₃dd := sd^2-(x1+x2)*d*d in
  let y₃ddd := sd*x₃dd+td*d*d in
  let x₃ := x₃dd/d^2 in
  let y₃' := -y₃ddd/d^3 in
  some ⟨⟨x₃, y₃'⟩, begin
    show y₃'^2  = x₃^3 + A*x₃ + B,
    simp only [x₃, y₃', y₃ddd, x₃dd, sd, d, td],
    field_simp,
    change y1^2=x1^3+A*x1+B at h1,
    change y2^2=x2^3+A*x2+B at h2,
    apply eq_of_sub_eq_zero,
    rw ← sub_eq_zero at h1 h2 hd,
    field_simp,
    have h : (-((y1 * (x1 - x2) - (y1 - y2) * x1) * (x1 - x2) * (x1 - x2)) + -((y1 - y2) * ((y1 - y2) ^ 2 - (x1 + x2) * (x1 - x2) * (x1 - x2)))) ^ 2 * (((x1 - x2) ^ 2) ^ 3 * (x1 - x2) ^ 2) - ((x1 - x2) ^ 3) ^ 2 * (((y1 - y2) ^ 2 - (x1 + x2) * (x1 - x2) * (x1 - x2)) ^ 3 * (x1 - x2) ^ 2 + A * ((y1 - y2) ^ 2 - (x1 + x2) * (x1 - x2) * (x1 - x2)) * ((x1 - x2) ^ 2) ^ 3 + B * (((x1 - x2) ^ 2) ^ 3 * (x1 - x2) ^ 2))
    =(x1-x2)^11*((y1^2-(x1^3+A*x1+B))*(y1^2-2*y1*y2+B+3*x1*x2^2-x2^3-x1^3+A*x2)+(y2^2-(x2^3+A*x2+B))*(-y2^2+2*y1*y2-B-3*x1^2*x2+x1^3+x2^3-A*x1)),
    ring,
    rw h, clear h,
    rw h1, rw h2,
    ring,
  end⟩

instance : has_add (points E) := ⟨E.add⟩

theorem zero_add (P : points E) : (0 : points E) + P = P := begin
    cases P,
    { refl },
    { refl },
  end
theorem add_zero (P : points E) : P + 0 = P := begin
    cases P,
    { refl },
    { refl },
end
lemma add_self (P : points E) : P + P = E.double P := begin
  cases P,
  {refl},
  { rcases P with ⟨⟨x, y⟩, h⟩,
    change dite _ _ _ = _,
    rw dif_pos rfl,
    split_ifs,
    { refl },
    { refl },
  },
end

lemma add_left_neg_finite {x y : ℚ}(h : E.is_on_curve x y) :
  (id (some ⟨⟨x,-y⟩, E.is_on_curve_neg h⟩):points E) + some⟨⟨x,y⟩,h⟩ = 0 := begin
    simp,
    change dite _ _ _ = _,
    rw dif_pos rfl,
    split_ifs,
    {have hy: y=0,
      {linarith},
      rw hy at h,
      convert E.double_order_two h,
      linarith },
    { refl },
  end

theorem add_left_neg (P : points E) :
(-P) + P = 0 := begin
    cases P,
    { refl },
    { change -(id(some P): points E) + some P = 0,
      rw neg_some_some_neg,
      rcases P with ⟨⟨x, y⟩, h⟩,
      change E.is_on_curve x y at h,
      rw E.neg_finite_def',
      apply add_left_neg_finite},
  end

theorem add_comm_finite {x1 x2 y1 y2 : ℚ}
  (h1 : E.is_on_curve x1 y1)
  (h2 : E.is_on_curve x2 y2) :
  E.points_mk h1 + E.points_mk h2 =
  E.points_mk h2 + E.points_mk h1 := begin
    change dite _ _ _ = dite _ _ _,
    split_ifs,
    { have heq: E.points_mk h1 = E.points_mk h2,
      { rw ext_iff,
        exact ⟨h, h_1⟩,
      },
      change E.double (E.points_mk h1) = E.double (E.points_mk h2),
      rw heq,
    },
    { exfalso,
      apply h_3,
      rw h_1,
    },
    { exfalso,
      apply h_2,
      rw h,
    },
    { exfalso,
      apply h_1,
      rw h_3,
    },
    { refl,
    },
    { exfalso,
      apply h_2,
      rw h,
    },
    { exfalso,
      apply h,
      rw h_1,
    },
    { exfalso,
      apply h,
      rw h_1,
    },
    { rw option.some_inj,
      rw finite_points.ext_iff,
      split,
      { have h: x1-x2 ≠ 0,
        { rw sub_ne_zero,
          exact h },
        have h: x2-x1 ≠ 0,
        { rw sub_ne_zero,
          exact h_1 },
        rw ← sub_eq_zero,
        field_simp,
        ring,
      },
      { have h: x1-x2 ≠ 0,
        { rw sub_ne_zero,
          exact h },
        have h: x2-x1 ≠ 0,
        { rw sub_ne_zero,
          exact h_1 },
        rw ← sub_eq_zero,
        field_simp,
        ring,
      },
    },
  end

theorem add_comm (P Q : points E) :
  P + Q = Q + P := begin
  cases E.is_zero_or_finite' P,
  { rw h,
    rw add_zero,
    rw zero_add
  },
  { cases E.is_zero_or_finite' Q,
    { rw h_1,
      rw add_zero,
      rw zero_add
    },
    { cases h with x1 h,
      cases h with y1 hP,
      cases hP with hP1 hP2,
      cases h_1 with x2 h_1,
      cases h_1 with y2 hQ,
      cases hQ with hQ1 hQ2,
      rw [hP2, hQ2],
      apply E.add_comm_finite,
    },
  },
end

instance : add_comm_group (points E) :=
{ zero := 0,
  add := (+),
  neg := has_neg.neg,
  zero_add := E.zero_add,
  add_zero := E.add_zero,
  add_assoc := begin
    sorry,
  end,
  add_left_neg := E.add_left_neg,
  add_comm := E.add_comm,
}

theorem fg : add_group.fg (points E) := begin
  sorry,
end

def torsion_points (E : elliptic_curve) :
(set (points E)) :=
{P | ∃ (n : ℤ), (n • P = 0)∧(n ≠ 0)}

def torsion_subgroup (E : elliptic_curve) : add_subgroup (points E) :=
{ carrier := (torsion_points E),
  zero_mem' := begin
    unfold torsion_points,
    rw set.mem_set_of_eq,
    use 1,
    simp,
  end,
  add_mem' := begin
    unfold torsion_points at *,
    intros a b ha hb,
    cases ha with na hna,
    cases hna with ha1 ha2,
    cases hb with nb hnb,
    cases hnb with hb1 hb2,
    rw set.mem_set_of_eq,
    use na*nb,
    split,
    { rw smul_add,
      rw mul_comm,
      rw mul_smul,
      rw ha1,
      rw mul_comm,
      rw mul_smul,
      rw hb1,
      simp},
    { simp,
      tauto
    },
  end,
  neg_mem' := begin
    unfold torsion_points at *,
    intros x hx,
    cases hx with n hn,
    cases hn with hn1 hn2,
    rw set.mem_set_of_eq,
    use n,
    rw smul_neg,
    rw hn1,
    simp,
    exact hn2,
  end,
}

def torsion_free (E : elliptic_curve) :=
  (quotient_add_group.quotient (torsion_subgroup E))

instance: add_comm_group (torsion_free E) := begin
  unfold torsion_free,
  apply_instance,
end

theorem torsion_free_fg : add_group.fg (torsion_free E) := begin
  apply add_fg_quotient_of_fg,
  apply fg,
end

def generators (E : elliptic_curve) :=
  {S : set (torsion_free E) |
  (set.finite S) ∧ (add_subgroup.closure S = ⊤)}

def sizes (E : elliptic_curve) : (set ℕ) :=
  {n : ℕ | ∃ (S : generators E),
  (fintype.card (fintype S)) = n}

theorem sizes_non_empty : ∃ (n : ℕ), (n ∈ sizes E)
  := begin
  unfold sizes,
  have h : ∃ (S : set (torsion_free E)), (add_subgroup.closure S = ⊤) ∧ (S.finite),
  {rw ← add_group.fg_iff,
  exact torsion_free_fg E},
  cases h with S hS,
  cases hS with hclosure hfinite,
  use fintype.card (fintype S),
  rw set.mem_set_of_eq,
  use S,
  {simp only [elliptic_curve.generators.equations._eqn_1],
  rw set.mem_set_of_eq,
  exact ⟨hfinite, hclosure⟩},
  {refl},
end
open_locale classical
noncomputable def rank (E : elliptic_curve) : ℕ :=
  nat.find (sizes_non_empty E)

def good_primes := {p : ℕ | nat.prime p ∧
  ¬ (↑p ∣ (disc E.a E.b))}

def p_points (E : elliptic_curve) (p : good_primes E)
 := {P : zmod p × zmod p | let ⟨x, y⟩ := P in
 y^2  = x^3 + E.a*x + E.b}

noncomputable def a_p (E : elliptic_curve)
  (p : good_primes E) : ℤ :=
  p - fintype.card (fintype (p_points E p))

def half_plane := {z : ℂ // complex.re z > 3/2}

instance : has_coe half_plane ℂ := ⟨subtype.val⟩

noncomputable def local_factor (E : elliptic_curve)
(s : ℂ) : good_primes E → ℂ
| p := 1 - (a_p E p) * p ^ (-s) + p ^ (1-2*s)

theorem hasse_bound (E :elliptic_curve)  (p : good_primes E) :
  (a_p E p)^2 ≤ 4 * p := begin
 sorry,
end

theorem converges (E : elliptic_curve)
(s : half_plane) : prodable (local_factor E s) := begin
  sorry,
end

noncomputable def L_function_product
(E : elliptic_curve) (s : half_plane) : ℂ :=
1/(tprod (local_factor E s))

theorem analytic_continuation: ∃ f : ℂ → ℂ,
  (differentiable ℂ f)∧(∀ z : half_plane,
  f z = L_function_product E z)
  ∧ (∀ g : ℂ → ℂ, (differentiable ℂ g)∧
  (∀ z : half_plane, g z = L_function_product E z)
  → g = f) := begin
  sorry,
end

noncomputable def L_function : ℂ → ℂ :=
  classical.some (analytic_continuation E)

noncomputable def L_derivative (E : elliptic_curve) :
  ℕ → ℂ → ℂ
|n := iterated_deriv n (L_function E)

theorem has_order_of_vanishing : ∃ n : ℕ,
  L_derivative E n 1 ≠ 0 := begin
  sorry,
end

noncomputable def analytic_rank (E : elliptic_curve) :
  ℕ := nat.find (has_order_of_vanishing E)

theorem BSD : analytic_rank E = rank E := begin
  sorry,
end

end elliptic_curve