/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import morphisms.basic
import topology.spectral.hom
import algebraic_geometry.limits

/-!
# Quasi-compact morphisms

A morphism of schemes is quasi-compact if the preimages of quasi-compact open sets are
quasi-compact.

It suffices to check that preimages of affine open sets are compact
(`quasi_compact_iff_forall_affine`).

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universe u

open_locale algebraic_geometry

namespace algebraic_geometry

variables {X Y : Scheme.{u}} (f : X ⟶ Y)

/--
A morphism is `quasi-compact` if the underlying map of topological spaces is, i.e. if the preimages
of quasi-compact open sets are quasi-compact.
-/
@[mk_iff]
class quasi_compact (f : X ⟶ Y) : Prop :=
(is_compact_preimage [] : ∀ U : set Y.carrier,
  is_open U → is_compact U → is_compact (f.1.base ⁻¹' U))

lemma quasi_compact_iff_spectral : quasi_compact f ↔ is_spectral_map f.1.base :=
⟨λ ⟨h⟩, ⟨by continuity, h⟩, λ h, ⟨h.2⟩⟩

/-- The `affine_target_morphism_property` corresponding to `quasi_compact`, asserting that the
domain is a quasi-compact scheme. -/
def quasi_compact.affine_property : affine_target_morphism_property :=
λ X Y f hf, compact_space X.carrier

@[priority 900]
instance quasi_compact_of_is_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] : quasi_compact f :=
begin
  constructor,
  intros U hU hU',
  convert hU'.image (inv f.1.base).continuous_to_fun using 1,
  rw set.image_eq_preimage_of_inverse,
  delta function.left_inverse,
  exacts [is_iso.inv_hom_id_apply f.1.base, is_iso.hom_inv_id_apply f.1.base]
end

instance quasi_compact_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z)
  [quasi_compact f] [quasi_compact g] : quasi_compact (f ≫ g) :=
begin
  constructor,
  intros U hU hU',
  rw [Scheme.comp_val_base, coe_comp, set.preimage_comp],
  apply quasi_compact.is_compact_preimage,
  { exact continuous.is_open_preimage (by continuity) _ hU },
  apply quasi_compact.is_compact_preimage; assumption
end

lemma is_compact_open_iff_eq_finset_affine_union {X : Scheme} (U : set X.carrier) :
  is_compact U ∧ is_open U ↔
    ∃ (s : set X.affine_opens), s.finite ∧ U = ⋃ (i : X.affine_opens) (h : i ∈ s), i :=
begin
  apply opens.is_compact_open_iff_eq_finite_Union_of_is_basis
    (coe : X.affine_opens → opens X.carrier),
  { rw subtype.range_coe, exact is_basis_affine_open X },
  { intro i, exact i.2.is_compact }
end

lemma is_compact_open_iff_eq_basic_open_union {X : Scheme} [is_affine X] (U : set X.carrier) :
  is_compact U ∧ is_open U ↔
    ∃ (s : set (X.presheaf.obj (op ⊤))), s.finite ∧
      U = ⋃ (i : X.presheaf.obj (op ⊤)) (h : i ∈ s), X.basic_open i :=
begin
  apply opens.is_compact_open_iff_eq_finite_Union_of_is_basis,
  { exact is_basis_basic_open X },
  { intro i, exact ((top_is_affine_open _).basic_open_is_affine _).is_compact }
end

lemma quasi_compact_iff_forall_affine : quasi_compact f ↔
  ∀ U : opens Y.carrier, is_affine_open U → is_compact (f.1.base ⁻¹' (U : set Y.carrier)) :=
begin
  rw quasi_compact_iff,
  refine ⟨λ H U hU, H U U.prop hU.is_compact, _⟩,
  intros H U hU hU',
  obtain ⟨S, hS, rfl⟩ := (is_compact_open_iff_eq_finset_affine_union U).mp ⟨hU', hU⟩,
  simp only [set.preimage_Union, subtype.val_eq_coe],
  exact hS.is_compact_bUnion (λ i _, H i i.prop)
end

@[simp] lemma quasi_compact.affine_property_to_property {X Y : Scheme} (f : X ⟶ Y) :
  (quasi_compact.affine_property : _).to_property f ↔
    is_affine Y ∧ compact_space X.carrier :=
by { delta affine_target_morphism_property.to_property quasi_compact.affine_property, simp }

lemma quasi_compact_iff_affine_property :
  quasi_compact f ↔ target_affine_locally quasi_compact.affine_property f :=
begin
  rw quasi_compact_iff_forall_affine,
  transitivity (∀ U : Y.affine_opens, is_compact (f.1.base ⁻¹' (U : set Y.carrier))),
  { exact ⟨λ h U, h U U.prop, λ h U hU, h ⟨U, hU⟩⟩ },
  apply forall_congr,
  exact λ _, is_compact_iff_compact_space,
end

lemma quasi_compact_eq_affine_property :
  @quasi_compact = target_affine_locally quasi_compact.affine_property :=
by { ext, exact quasi_compact_iff_affine_property _ }

lemma is_compact_basic_open (X : Scheme) {U : opens X.carrier} (hU : is_compact (U : set X.carrier))
   (f : X.presheaf.obj (op U)) : is_compact (X.basic_open f : set X.carrier) :=
begin
  classical,
  refine ((is_compact_open_iff_eq_finset_affine_union _).mpr _).1,
  obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_finset_affine_union _).mp ⟨hU, U.prop⟩,
  let g : s → X.affine_opens,
  { intro V,
    use V.1 ⊓ X.basic_open f,
    have : V.1.1 ⟶ U,
    { apply hom_of_le, change _ ⊆ (U : set X.carrier), rw e,
      convert @set.subset_Union₂ _ _ _ (λ (U : X.affine_opens) (h : U ∈ s), ↑U) V V.prop using 1,
      refl },
    erw ← X.to_LocallyRingedSpace.to_RingedSpace.basic_open_res this.op,
    exact is_affine_open.basic_open_is_affine V.1.prop _ },
  haveI : finite s := hs.to_subtype,
  refine ⟨set.range g, set.finite_range g, _⟩,
  refine (set.inter_eq_right_iff_subset.mpr (RingedSpace.basic_open_le _ _)).symm.trans _,
  rw [e, set.Union₂_inter],
  apply le_antisymm; apply set.Union₂_subset,
  { intros i hi,
    refine set.subset.trans _ (set.subset_Union₂ _ (set.mem_range_self ⟨i, hi⟩)),
    exact set.subset.rfl },
  { rintro ⟨i, hi⟩ ⟨⟨j, hj⟩, hj'⟩,
    rw ← hj',
    refine set.subset.trans _ (set.subset_Union₂ j hj),
    exact set.subset.rfl }
end

lemma quasi_compact.affine_property_is_local :
  (quasi_compact.affine_property : _).is_local :=
begin
  split,
  { apply affine_target_morphism_property.respects_iso_mk; rintros X Y Z _ _ _ H,
    exacts [@@homeomorph.compact_space _ _ H (Top.homeo_of_iso (as_iso e.inv.1.base)), H] },
  { introv H,
    delta quasi_compact.affine_property at H ⊢,
    change compact_space ((opens.map f.val.base).obj (Y.basic_open r)),
    rw Scheme.preimage_basic_open f r,
    erw ← is_compact_iff_compact_space,
    rw ← is_compact_univ_iff at H,
    exact is_compact_basic_open X H _ },
  { rintros X Y H f S hS hS',
    resetI,
    rw ← is_affine_open.basic_open_union_eq_self_iff at hS,
    delta quasi_compact.affine_property,
    rw ← is_compact_univ_iff,
    change is_compact ((opens.map f.val.base).obj ⊤).1,
    rw ← hS,
    dsimp [opens.map],
    simp only [opens.coe_supr, set.preimage_Union, subtype.val_eq_coe],
    exacts [is_compact_Union (λ i, is_compact_iff_compact_space.mpr (hS' i)),
      top_is_affine_open _] }
end

lemma quasi_compact.affine_open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_compact f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)],
      ∀ (i : 𝒰.J), compact_space (pullback f (𝒰.map i)).carrier,
    ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J),
      compact_space (pullback f (𝒰.map i)).carrier,
    ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g],
      compact_space (pullback f g).carrier,
    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤) (hU' : ∀ i, is_affine_open (U i)),
      ∀ i, compact_space (f.1.base ⁻¹' (U i).1)] :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.affine_open_cover_tfae f

lemma quasi_compact.is_local_at_target :
  property_is_local_at_target @quasi_compact :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.target_affine_locally_is_local

lemma quasi_compact.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [quasi_compact f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J),
      quasi_compact (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J),
      quasi_compact (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (U : opens Y.carrier), quasi_compact (f ∣_ U),
    ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g],
      quasi_compact (pullback.snd : pullback f g ⟶ _),
    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), ∀ i, quasi_compact (f ∣_ (U i))] :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.target_affine_locally_is_local.open_cover_tfae f

lemma quasi_compact_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] :
  quasi_compact f ↔ compact_space X.carrier :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.affine_target_iff f

lemma compact_space_iff_quasi_compact (X : Scheme) :
  compact_space X.carrier ↔ quasi_compact (terminal.from X) :=
(quasi_compact_over_affine_iff _).symm

lemma quasi_compact.affine_open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y)
  [∀ i, is_affine (𝒰.obj i)] (f : X ⟶ Y) :
  quasi_compact f ↔ ∀ i, compact_space (pullback f (𝒰.map i)).carrier :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.affine_open_cover_iff f 𝒰

lemma quasi_compact.open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y) (f : X ⟶ Y) :
  quasi_compact f ↔ ∀ i, quasi_compact (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.target_affine_locally_is_local.open_cover_iff f 𝒰

lemma quasi_compact_respects_iso : morphism_property.respects_iso @quasi_compact :=
quasi_compact_eq_affine_property.symm ▸
  target_affine_locally_respects_iso quasi_compact.affine_property_is_local.1

lemma quasi_compact_stable_under_composition :
  morphism_property.stable_under_composition @quasi_compact :=
λ _ _ _ _ _ _ _, by exactI infer_instance

local attribute [-simp] PresheafedSpace.as_coe SheafedSpace.as_coe

lemma quasi_compact.affine_property_stable_under_base_change :
  quasi_compact.affine_property.stable_under_base_change :=
begin
  intros X Y S _ _ f g h,
  rw quasi_compact.affine_property at h ⊢,
  resetI,
  let 𝒰 := Scheme.pullback.open_cover_of_right Y.affine_cover.finite_subcover f g,
  haveI : finite 𝒰.J,
  { dsimp [𝒰], apply_instance },
  haveI : ∀ i, compact_space (𝒰.obj i).carrier,
  { intro i, dsimp, apply_instance },
  exact 𝒰.compact_space,
end

lemma quasi_compact_stable_under_base_change :
  morphism_property.stable_under_base_change @quasi_compact :=
quasi_compact_eq_affine_property.symm ▸
  quasi_compact.affine_property_is_local.stable_under_base_change
    quasi_compact.affine_property_stable_under_base_change

variables {Z : Scheme.{u}}

instance (f : X ⟶ Z) (g : Y ⟶ Z) [quasi_compact g] :
  quasi_compact (pullback.fst : pullback f g ⟶ X) :=
quasi_compact_stable_under_base_change.fst f g infer_instance

instance (f : X ⟶ Z) (g : Y ⟶ Z) [quasi_compact f] :
  quasi_compact (pullback.snd : pullback f g ⟶ Y) :=
quasi_compact_stable_under_base_change.snd f g infer_instance

@[elab_as_eliminator]
lemma compact_open_induction_on {P : opens X.carrier → Prop} (S : opens X.carrier)
  (hS : is_compact S.1)
  (h₁ : P ⊥)
  (h₂ : ∀ (S : opens X.carrier) (hS : is_compact S.1) (U : X.affine_opens), P S → P (S ⊔ U)) :
    P S :=
begin
  classical,
  obtain ⟨s, hs, hs'⟩ := (is_compact_open_iff_eq_finset_affine_union S.1).mp ⟨hS, S.2⟩,
  replace hs' : S = supr (λ i : s, (i : opens X.carrier)) := by { ext1, simpa using hs' },
  subst hs',
  apply hs.induction_on,
  { convert h₁, rw supr_eq_bot, rintro ⟨_, h⟩, exact h.elim },
  { intros x s h₃ hs h₄,
    have : is_compact (⨆ i : s, (i : opens X.carrier)).1,
    { refine ((is_compact_open_iff_eq_finset_affine_union _).mpr _).1, exact ⟨s, hs, by simp⟩ },
    convert h₂ _ this x h₄,
    simp only [coe_coe],
    rw [supr_subtype, sup_comm],
    conv_rhs { rw supr_subtype },
    exact supr_insert }
end

lemma exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_affine_open (X : Scheme)
  {U : opens X.carrier} (hU : is_affine_open U) (x f : X.presheaf.obj (op U))
  (H : x |_ X.basic_open f = 0) :
  ∃ n : ℕ, f ^ n * x = 0 :=
begin
  rw ← map_zero (X.presheaf.map (hom_of_le $ X.basic_open_le f : X.basic_open f ⟶ U).op) at H,
  have := (is_localization_basic_open hU f).3,
  obtain ⟨⟨_, n, rfl⟩, e⟩ := this.mp H,
  exact ⟨n, by simpa [mul_comm x] using e⟩,
end

/-- If `x : Γ(X, U)` is zero on `D(f)` for some `f : Γ(X, U)`, and `U` is quasi-compact, then
`f ^ n * x = 0` for some `n`. -/
lemma exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact (X : Scheme)
  {U : opens X.carrier} (hU : is_compact U.1) (x f : X.presheaf.obj (op U))
  (H : x |_ X.basic_open f = 0) :
  ∃ n : ℕ, f ^ n * x = 0 :=
begin
  obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_finset_affine_union U.1).mp ⟨hU, U.2⟩,
  replace e : U = supr (λ i : s, (i : opens X.carrier)),
  { ext1, simpa using e },
  have h₁ : ∀ i : s, i.1.1 ≤ U,
  { intro i, change (i : opens X.carrier) ≤ U, rw e, exact le_supr _ _ },
  have H' := λ (i : s), exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_affine_open X i.1.2
    (X.presheaf.map (hom_of_le (h₁ i)).op x) (X.presheaf.map (hom_of_le (h₁ i)).op f) _,
  swap,
  { delta Top.presheaf.restrict_open Top.presheaf.restrict at H ⊢,
    convert congr_arg (X.presheaf.map (hom_of_le _).op) H,
    { simp only [← comp_apply, ← functor.map_comp], congr },
    { rw map_zero },
    { rw X.basic_open_res, exact set.inter_subset_right _ _ } },
  choose n hn using H',
  haveI := hs.to_subtype,
  casesI nonempty_fintype s,
  use finset.univ.sup n,
  suffices : ∀ (i : s), X.presheaf.map (hom_of_le (h₁ i)).op (f ^ (finset.univ.sup n) * x) = 0,
  { subst e,
    apply X.sheaf.eq_of_locally_eq (λ (i : s), (i : opens X.carrier)),
    intro i,
    rw map_zero,
    apply this },
  intro i,
  replace hn := congr_arg
    (λ x, X.presheaf.map (hom_of_le (h₁ i)).op (f ^ (finset.univ.sup n - n i)) * x) (hn i),
  dsimp at hn,
  simp only [← map_mul, ← map_pow] at hn,
  rwa [mul_zero, ← mul_assoc, ← pow_add, tsub_add_cancel_of_le] at hn,
  apply finset.le_sup (finset.mem_univ i)
end

end algebraic_geometry


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.category.Lattice

/-!
# The category of distributive lattices

This file defines `DistribLattice`, the category of distributive lattices.

Note that [`DistLat`](https://ncatlab.org/nlab/show/DistLat) in the literature doesn't always
correspond to `DistribLattice` as we don't require bottom or top elements. Instead, this `DistLat`
corresponds to `BoundedDistribLattice`.
-/

universes u

open category_theory

/-- The category of distributive lattices. -/
def DistribLattice := bundled distrib_lattice

namespace DistribLattice

instance : has_coe_to_sort DistribLattice Type* := bundled.has_coe_to_sort
instance (X : DistribLattice) : distrib_lattice X := X.str

/-- Construct a bundled `DistribLattice` from a `distrib_lattice` underlying type and typeclass. -/
def of (α : Type*) [distrib_lattice α] : DistribLattice := bundled.of α

@[simp] lemma coe_of (α : Type*) [distrib_lattice α] : ↥(of α) = α := rfl

instance : inhabited DistribLattice := ⟨of punit⟩

instance : bundled_hom.parent_projection @distrib_lattice.to_lattice := ⟨⟩

attribute [derive [large_category, concrete_category]] DistribLattice

instance has_forget_to_Lattice : has_forget₂ DistribLattice Lattice := bundled_hom.forget₂ _ _

/-- Constructs an equivalence between distributive lattices from an order isomorphism between them.
-/
@[simps] def iso.mk {α β : DistribLattice.{u}} (e : α ≃o β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }

/-- `order_dual` as a functor. -/
@[simps] def dual : DistribLattice ⥤ DistribLattice :=
{ obj := λ X, of (order_dual X), map := λ X Y, lattice_hom.dual }

/-- The equivalence between `DistribLattice` and itself induced by `order_dual` both ways. -/
@[simps functor inverse] def dual_equiv : DistribLattice ≌ DistribLattice :=
equivalence.mk dual dual
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)

end DistribLattice

lemma DistribLattice_dual_comp_forget_to_Lattice :
  DistribLattice.dual ⋙ forget₂ DistribLattice Lattice =
    forget₂ DistribLattice Lattice ⋙ Lattice.dual := rfl


/-
-- Copyright (c) 2020 Bhavik Mehta. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Bhavik Mehta, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.preserves.shapes.products
import Mathlib.category_theory.limits.preserves.shapes.equalizers
import Mathlib.PostPort

universes u v u₂

namespace Mathlib

/-!
# Constructing limits from products and equalizers.

If a category has all products, and all equalizers, then it has all limits.
Similarly, if it has all finite products, and all equalizers, then it has all finite limits.

If a functor preserves all products and equalizers, then it preserves all limits.
Similarly, if it preserves all finite products and equalizers, then it preserves all finite limits.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

namespace category_theory.limits

-- We hide the "implementation details" inside a namespace

namespace has_limit_of_has_products_of_has_equalizers

/--
(Implementation) Given the appropriate product and equalizer cones, build the cone for `F` which is
limiting if the given cones are also.
-/
def build_limit {C : Type u} [category C] {J : Type v} [small_category J] {F : J ⥤ C} {c₁ : fan (functor.obj F)} {c₂ : fan fun (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p) => functor.obj F (prod.snd (sigma.fst f))} (s : cone.X c₁ ⟶ cone.X c₂) (t : cone.X c₁ ⟶ cone.X c₂) (hs : ∀ (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p),
  s ≫ nat_trans.app (cone.π c₂) f = nat_trans.app (cone.π c₁) (prod.fst (sigma.fst f)) ≫ functor.map F (sigma.snd f)) (ht : ∀ (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p),
  t ≫ nat_trans.app (cone.π c₂) f = nat_trans.app (cone.π c₁) (prod.snd (sigma.fst f))) (i : fork s t) : cone F :=
  cone.mk (cone.X i) (nat_trans.mk fun (j : J) => fork.ι i ≫ nat_trans.app (cone.π c₁) j)

/--
(Implementation) Show the cone constructed in `build_limit` is limiting, provided the cones used in
its construction are.
-/
def build_is_limit {C : Type u} [category C] {J : Type v} [small_category J] {F : J ⥤ C} {c₁ : fan (functor.obj F)} {c₂ : fan fun (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p) => functor.obj F (prod.snd (sigma.fst f))} (s : cone.X c₁ ⟶ cone.X c₂) (t : cone.X c₁ ⟶ cone.X c₂) (hs : ∀ (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p),
  s ≫ nat_trans.app (cone.π c₂) f = nat_trans.app (cone.π c₁) (prod.fst (sigma.fst f)) ≫ functor.map F (sigma.snd f)) (ht : ∀ (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p),
  t ≫ nat_trans.app (cone.π c₂) f = nat_trans.app (cone.π c₁) (prod.snd (sigma.fst f))) {i : fork s t} (t₁ : is_limit c₁) (t₂ : is_limit c₂) (hi : is_limit i) : is_limit (build_limit s t hs ht i) :=
  is_limit.mk
    fun (q : cone F) =>
      is_limit.lift hi (fork.of_ι (is_limit.lift t₁ (fan.mk (cone.X q) fun (j : J) => nat_trans.app (cone.π q) j)) sorry)

end has_limit_of_has_products_of_has_equalizers

/--
Given the existence of the appropriate (possibly finite) products and equalizers, we know a limit of
`F` exists.
(This assumes the existence of all equalizers, which is technically stronger than needed.)
-/
theorem has_limit_of_equalizer_and_product {C : Type u} [category C] {J : Type v} [small_category J] (F : J ⥤ C) [has_limit (discrete.functor (functor.obj F))] [has_limit
  (discrete.functor
    fun (f : sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p) => functor.obj F (prod.snd (sigma.fst f)))] [has_equalizers C] : has_limit F := sorry

/--
Any category with products and equalizers has all limits.

See https://stacks.math.columbia.edu/tag/002N.
-/
theorem limits_from_equalizers_and_products {C : Type u} [category C] [has_products C] [has_equalizers C] : has_limits C :=
  has_limits.mk
    fun (J : Type v) (𝒥 : small_category J) =>
      has_limits_of_shape.mk fun (F : J ⥤ C) => has_limit_of_equalizer_and_product F

/--
Any category with finite products and equalizers has all finite limits.

See https://stacks.math.columbia.edu/tag/002O.
-/
theorem finite_limits_from_equalizers_and_finite_products {C : Type u} [category C] [has_finite_products C] [has_equalizers C] : has_finite_limits C :=
  fun (J : Type v) (_x : small_category J) (_x_1 : fin_category J) =>
    has_limits_of_shape.mk fun (F : J ⥤ C) => has_limit_of_equalizer_and_product F

/-- If a functor preserves equalizers and the appropriate products, it preserves limits. -/
def preserves_limit_of_preserves_equalizers_and_product {C : Type u} [category C] {J : Type v} [small_category J] {D : Type u₂} [category D] [has_limits_of_shape (discrete J) C] [has_limits_of_shape (discrete (sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p)) C] [has_equalizers C] (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair G] [preserves_limits_of_shape (discrete J) G] [preserves_limits_of_shape (discrete (sigma fun (p : J × J) => prod.fst p ⟶ prod.snd p)) G] : preserves_limits_of_shape J G := sorry

/-- If G preserves equalizers and finite products, it preserves finite limits. -/
def preserves_finite_limits_of_preserves_equalizers_and_finite_products {C : Type u} [category C] {D : Type u₂} [category D] [has_equalizers C] [has_finite_products C] (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair G] [(J : Type v) → [_inst_8 : fintype J] → preserves_limits_of_shape (discrete J) G] (J : Type v) [small_category J] [fin_category J] : preserves_limits_of_shape J G :=
  preserves_limit_of_preserves_equalizers_and_product G

/-- If G preserves equalizers and products, it preserves all limits. -/
def preserves_limits_of_preserves_equalizers_and_products {C : Type u} [category C] {D : Type u₂} [category D] [has_equalizers C] [has_products C] (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair G] [(J : Type v) → preserves_limits_of_shape (discrete J) G] : preserves_limits G :=
  preserves_limits.mk fun (J : Type v) (𝒥 : small_category J) => preserves_limit_of_preserves_equalizers_and_product G


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

import LeanColls.Classes
import LeanColls.Range
import LeanColls.View
import LeanColls.List

namespace LeanColls

namespace IndexedOps

instance [Indexed C τ] : Membership τ C where
  mem x c := ∃ i, x = Indexed.nth c i

instance [Indexed C τ] : Iterable C τ where
  ρ := Σ' (c : C), Iterable'.ρ Nat (Range.mk <| Size.size c)
  toIterator c := ⟨c, Iterable'.toIterator (Range.mk <| Size.size c)⟩
  step := λ ⟨c,r⟩ => Iterable'.step r
                    |>.map (fun (⟨i,h⟩,r) => (Indexed.nth c ⟨i,h⟩, ⟨c,r⟩))

theorem size_pos_iff_mem [Indexed C τ] {c : C}
  : Size.size c > 0 ↔ ∃ x, x ∈ c
  := by
  constructor
  case mp =>
    intro h
    apply Exists.intro (Indexed.nth c ⟨0,h⟩)
    simp [Membership.mem]
    apply Exists.intro ⟨0,h⟩
    rfl
  case mpr =>
    intro h
    cases h; case intro x h =>
    cases h; case intro i _ =>
    exact i.size_positive

instance [Indexed C τ] : Foldable'.Correct C τ inferInstance where
  fold c f init :=
    Foldable'.Correct.fold' (Range.mk <| Size.size c) (λ acc i h =>
      f acc (Indexed.nth c ⟨i,h⟩)
    ) init
  fold' c f init :=
    Foldable'.Correct.fold' (Range.mk <| Size.size c) (λ acc i h =>
      f acc (Indexed.nth c ⟨i,h⟩) ⟨⟨i,h⟩, rfl⟩
    ) init
  foldCorrect := by
    intro β c f acc
    simp [Foldable.fold]
    rw [Foldable'.fold_canonicalToList_fold'_eq_fold']
  memCorrect x c := by
    simp [Foldable.fold, canonicalToList]
    constructor
    case mp =>
      intro h; simp at h; cases h; case intro i h =>
      have := Foldable'.fold'_append_singleton_eq_map
        (⟨Size.size c⟩ : Range)
        (fun i h => Indexed.nth c ⟨i,h⟩)
      simp [Membership.mem] at this ⊢
      simp [this, Foldable.fold]
      rw [List.map'_rw _ (Range.toList_eq_canonicalToList ⟨Size.size c⟩).symm]
      rw [List.map']
      apply (List.mem_of_map_iff _ _ _).mpr
      simp
      cases i; case mk i h_i =>
      have : i ∈ Range.toList ⟨Size.size c⟩ := by
          rw [Range.toList_eq_canonicalToList]
          apply (Range.memCorrect _ _).mp
          assumption
      apply Exists.intro i
      apply Exists.intro this
      simp
      constructor
      case left =>
        simp [List.mem_of_subtypeByMem _ i this]
      case right =>
        exact h.symm
    case mpr =>
      intro h
      rw [Foldable'.Correct.fold'Correct] at h
      rw [List.foldl'_eq_subtypeByMem_foldl] at h
      rw [List.foldl_eq_map] at h
      rw [(List.mem_of_map_iff _ _ _)] at h
      cases h; case intro x h =>
      cases x; case mk i h_i =>
      simp [Membership.mem]
      have h_i' : i < Size.size c := by
        simp [Foldable.fold] at h_i
        rw [←Range.memCorrect] at h_i
        exact h_i
      apply Exists.intro ⟨i, h_i'⟩
      exact h.2.symm
  fold'Correct := by
    intro β c f acc
    simp
    conv => rhs; simp [Foldable'.Correct.fold', Foldable.fold]
    have := Foldable'.canonicalToList_fold'_eq_map'
      (⟨Size.size c⟩ : Range)
      (fun x h => Indexed.nth c ⟨x,h⟩)
    simp [Foldable'.Correct.fold'] at this
    rw [List.foldl'_rw _ _ _ _ this]
    simp [Foldable'.Correct.fold'Correct, List.foldl'_eq_subtypeByMem_foldl]
    sorry

structure Slice (C) (τ : outParam (Type u)) [Indexed C τ] where
  c : C
  off : Nat
  len : Nat
  h_range : off + len ≤ Size.size c

instance [Indexed C τ] : Indexed (Slice C τ) τ where
  size S := S.len
  nth S (i : Fin S.len) := Indexed.nth S.c ⟨S.off + i, Nat.le_trans (Nat.add_lt_add_left i.isLt _) (Slice.h_range S)⟩

def IndexedEq [DecidableEq τ] [Indexed C₁ τ] [Indexed C₂ τ] (c₁ : C₁) (c₂ : C₂)
  {h : Size.size c₁ = Size.size c₂} : Prop :=
  ∀ i, Indexed.nth c₁ i = Indexed.nth c₂ ⟨i.val, by rw [←h]; exact i.isLt⟩

end IndexedOps

class IndexedOps (C) (τ : Type u) [Indexed C τ] where
  slice (c : C) (off len : Nat)
    {h : off + len ≤ Size.size c} : IndexedOps.Slice C τ
  map (c : C) {τ' : Type u} (f : τ → τ') [Initable C' (Size.size c) τ'] : C'
  findi (c : C) (f : τ → Bool) : Option (Fin (Size.size c) × τ)
  findMapi (c : C) {τ' : Type u} (f : τ → Option τ') : Option (Fin (Size.size c) × τ')

namespace IndexedOps

instance [Indexed C τ] : Inhabited (IndexedOps C τ) where
  default := {
    slice := λ c off len h => ⟨c,off,len,h⟩
    map := λ c _ f => Initable.init (fun i => f (Indexed.nth c i))
    findi := λ c f =>
      View.view' (Range.mk (Size.size c))
      |>.map (fun ⟨i,h⟩ => (⟨i,h⟩ : Fin (Size.size c)))
      |> FoldableOps.find (f := fun i => f (Indexed.nth c i))
      |> Option.map (fun i => (i, Indexed.nth c i))
    findMapi := λ c _ f =>
      View.view' (Range.mk (Size.size c))
      |>.map (fun ⟨i,h⟩ => (⟨i,h⟩ : Fin (Size.size c)))
      |> FoldableOps.findMap (f := fun i =>
        f (Indexed.nth c i) |>.map (fun x => (i, x))
        )
  }

instance [Indexed C τ] [Foldable C τ] : FoldableOps C τ
  := { (default : FoldableOps C τ) with
  toList := λ c =>
    let n := Size.size c
    Foldable'.Correct.fold' (Range.mk n) (λ acc i h =>
      Indexed.nth c ⟨n-i-1, by
        simp
        simp [Membership.mem] at h
        rw [Nat.sub_sub]
        apply Nat.sub_lt_of_pos_le
        simp [Nat.add_one, Nat.zero_lt_succ]
        exact h
      ⟩ :: acc
      ) []
  }

theorem toList_eq_range_toList_map [Indexed C τ] (c : C)
  (hL : ∀ {x}, x ∈ canonicalToList (Foldable.fold (Range.mk (Size.size c))) → x < Size.size c)
  : FoldableOps.toList c = (
      canonicalToList ((⟨Size.size c⟩ : Range).foldl)
      |>.map' (fun x h => Indexed.nth c ⟨x, hL h⟩))
  := by
  simp [FoldableOps.toList]
  rw [Foldable'.Correct.fold'Correct]
  -- Get RHS to Range.foldr'
  suffices ∀ L (h : L = canonicalToList (⟨Size.size c⟩ : Range).foldl) f'
    (h_f' : ∃ (h' : ∀ {x}, x ∈ L → _), ∀ x (h : x ∈ L), f' x h = Indexed.nth c ⟨x, h' h⟩),
    _ = List.map' L f'
    from this _ rfl _ (by
      apply Exists.intro _
      intro x h
      simp
      intro x h
      apply (Range.memCorrect _ _).mpr h
      )
  intro L h f' h_f'
  rw [←Range.toList_eq_canonicalToList] at h
  cases h
  conv =>
    rhs
    rw [←List.foldr'_eq_map']
    rw [←Range.foldr'_correct _ (Range.toList_eq_canonicalToList _)
      (f := fun x h acc =>
        f' x (by
          rw [Range.toList_eq_canonicalToList]
          apply (Range.memCorrect _ _).mp h
        ) :: acc)]
    simp
  -- Get LHS to Range.foldl'
  suffices ∀ L (h : L = canonicalToList fun {β} => Foldable.fold (⟨Size.size c⟩ : Range)),
    List.foldl' L (fun acc x h' =>
      Indexed.nth c ⟨Size.size c - x - 1, by
        have : Size.size c > 0 := by
          rw [h] at h'
          rw [←Foldable'.Correct.memCorrect] at h'
          simp [Membership.mem] at h'
          apply Nat.lt_of_le_of_lt (Nat.zero_le x)
          assumption
        rw [Nat.sub_sub]
        apply Nat.sub_lt
        assumption
        apply Nat.zero_lt_succ
      ⟩ :: acc) []
    = _
    from this _ rfl
  intro L h
  simp [Foldable.fold] at h
  rw [←Range.toList_eq_canonicalToList] at h
  cases h
  conv =>
    lhs
    rw [←Range.foldl'_correct _ (Range.toList_eq_canonicalToList _)
      (f := fun acc x h =>
        Indexed.nth c ⟨Size.size c - x - 1, by rw [Nat.sub_sub]; apply Nat.sub_lt; exact Range.size_pos_of_mem h; apply Nat.zero_lt_succ⟩ :: acc)]
  -- Use range lemma
  rw [Range.foldr'_eq_foldl'_mapped]
  congr
  funext acc x h
  rw [h_f'.2]

theorem toList_eq_default_toList [Indexed C τ] (c : C)
  : FoldableOps.toList c = (FoldableOps.defaultImpl C τ).toList c
  := by
  conv =>
    rhs
    rw [FoldableOps.default_toList_eq_canonicalToList]
    simp [canonicalToList]
    unfold Foldable.fold
    simp [Foldable.Correct.toFoldable, Foldable'.Correct.toCorrect,
      instCorrectInferInstanceMembershipInstMembership]
    rw [Foldable'.fold'_append_singleton_eq_map]
  rw [toList_eq_range_toList_map]
  case hL =>
    intro i h
    rw [←Foldable'.Correct.memCorrect] at h
    simp [Membership.mem] at h
    assumption
  rfl

@[simp]
theorem length_toList_eq_size {C τ : Type} [Indexed C τ] (c : C)
  : List.length (FoldableOps.toList c) = Size.size c
  := by
  rw [toList_eq_default_toList]
  simp [FoldableOps.toList, FoldableOps.defaultImpl, Foldable.fold]
  rw [Foldable'.canonicalToList_fold'_eq_map']
  simp [Foldable.fold]
  rw [←Range.toList_eq_canonicalToList]
  simp

theorem get_toList_eq_get [Indexed C τ] (c : C) (i : Nat) (h : i < _)
  : List.get (FoldableOps.toList c) ⟨i, h⟩ = Indexed.nth c ⟨i, by simp at h; exact h⟩
  := by
  suffices ∀ L (hL : L = FoldableOps.toList c),
    List.get L ⟨i, by rw [hL]; exact h⟩ = _
    from this _ rfl
  intro L hL
  simp at h
  rw [toList_eq_default_toList] at hL
  simp [FoldableOps.defaultImpl, canonicalToList, Foldable.fold, Foldable'.Correct.fold'] at hL
  rw [Range.foldl'_correct _ (Range.toList_eq_canonicalToList _)] at hL
  rw [List.foldl'_eq_map'] at hL
  rw [List.map'] at hL
  cases hL
  simp

structure Map (C) [Indexed C τ] where
  val : C

namespace Map

instance [Indexed C τ] : MapLike (Map C) Nat τ where
  fold c f acc :=
    Range.foldl' ⟨Size.size c.val⟩ (λ acc i h_i =>
      f acc (i, Indexed.nth c.val ⟨i,h_i⟩)
    ) acc
  get? i c :=
    if h : i < Size.size c.val then
      some (Indexed.nth c.val ⟨i, h⟩)
    else none


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 :=
begin
  have h1 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h2 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h3 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h4 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h5 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h6 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h7 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h8 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h9 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h10 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h11 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h12 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h13 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h14 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h15 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h16 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h17 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h18 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h19 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h20 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h21 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h22 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h23 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h24 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h25 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h26 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h27 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h28 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h29 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

  have h30 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) = (int.fract (α * ↑m))  ∧ (α * ↑n) - (floor (α * ↑n)) = (int.fract (α * ↑n)),
  from sorry,

  have h31 : ∀ (m n : ℤ), m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n),
  from sorry,

  have h32 : ∀ (m n : ℤ), m ≠ n → (α * ↑m) - (floor (α * ↑m)) ≠ (α * ↑n) - (floor (α * ↑n)),
  from sorry,

end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from sorry,

  have h2 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h3 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h4 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h5 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h6 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h7 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h8 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h9 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h10 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h11 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h12 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h13 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h14 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h15 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h16 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h17 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h18 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h19 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h20 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h21 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h22 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h23 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h24 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h25 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h26 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h27 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h28 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h29 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h30 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h31 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h32 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h33 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h34 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h35 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h36 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h37 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h38 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h39 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h40 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h41 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from sorry,

  have h42 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i))
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 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h2 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h3 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h4 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h5 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h6 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h7 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h8 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h9 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h10 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h11 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h12 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h13 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h14 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h15 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h16 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h17 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h18 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h19 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h20 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h21 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h22 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h23 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h24 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h25 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h26 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h27 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h28 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h29 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h30 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h31 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h32 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h33 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h34 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h35 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h36 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h37 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,

  have h38 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.
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 :=
begin
  let S := (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
  from sorry,
  have h2 : ∀ (x y : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑x) - int.fract (α * ↑y))), from sorry,
  have h3 : ∀ (x y : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑x) + int.fract (α * ↑y))), from sorry,
  have h4 : ∀ (x y : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑x) * int.fract (α * ↑y))), from sorry,
  have h5 : ∀ (x y : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑x) / int.fract (α * ↑y))), from sorry,
  have h6 : ∀ (x y : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑x) ^ int.fract (α * ↑y))), from sorry,

  have h7 : ∀ (a b : ℤ), a ≠ b → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑a) - int.fract (α * ↑b))), from sorry,
  have h8 : ∀ (a b : ℤ), a ≠ b → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑a) + int.fract (α * ↑b))), from sorry,
  have h9 : ∀ (a b : ℤ), a ≠ b → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑a) * int.fract (α * ↑b))), from sorry,
  have h10 : ∀ (a b : ℤ), a ≠ b → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑a) / int.fract (α * ↑b))), from sorry,
  have h11 : ∀ (a b : ℤ), a ≠ b → (∃! (m : ℤ), (int.fract (α * ↑m)) = (int.fract (α * ↑a) ^ int.fract (α * ↑b))), from sorry,

  have h12 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) - int.fract (α * ↑y)) - int.fract (α * ↑z))), from sorry,
  have h13 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) + int.fract (α * ↑y)) - int.fract (α * ↑z))), from sorry,
  have h14 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) * int.fract (α * ↑y)) - int.fract (α * ↑z))), from sorry,
  have h15 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) / int.fract (α * ↑y)) - int.fract (α * ↑z))), from sorry,
  have h16 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) ^ int.fract (α * ↑y)) - int.fract (α * ↑z))), from sorry,

  have h17 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) - int.fract (α * ↑y)) + int.fract (α * ↑z))), from sorry,
  have h18 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) + int.fract (α * ↑y)) + int.fract (α * ↑z))), from sorry,
  have h19 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) * int.fract (α * ↑y)) + int.fract (α * ↑z))), from sorry,
  have h20 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) / int.fract (α * ↑y)) + int.fract (α * ↑z))), from sorry,
  have h21 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) ^ int.fract (α * ↑y)) + int.fract (α * ↑z))), from sorry,

  have h22 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) - int.fract (α * ↑y)) * int.fract (α * ↑z))), from sorry,
  have h23 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) + int.fract (α * ↑y)) * int.fract (α * ↑z))), from sorry,
  have h24 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) * int.fract (α * ↑y)) * int.fract (α * ↑z))), from sorry,
  have h25 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) / int.fract (α * ↑y)) * int.fract (α * ↑z))), from sorry,
  have h26 : ∀ (x y z : ℤ), x ≠ y → (∃! (m : ℤ), (int.fract (α * ↑m)) = ((int.fract (α * ↑x) ^ int.fract (α * ↑
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 :=
begin
  sorry
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := sorry

/--`theorem`
Irrational number has irrational orbit
Let $\alpha$ be an irrational number. Then $\{i \alpha\}$ is irrational for all $i \in \mathbb{Z}$.
`proof`
Suppose $\{i \alpha\}$ is rational for some $i \in \mathbb{Z}$. Then there are integers $p$ and $q$ with $q \neq 0$ such that
$$
i \alpha-\lfloor i \alpha\rfloor=\frac{p}{q}.
$$
Thus
$$
\alpha=\frac{\lfloor i \alpha\rfloor+\frac{p}{q}}{i}=\frac{\lfloor i \alpha\rfloor}{i}+\frac{p}{i q} \in \mathbb{Q},
$$
contradicting the assumption that $\alpha$ is irrational.

QED
-/
theorem irrational_orbit_irrational {α : ℝ} (hα_irrat : irrational α) : ∀ i : ℤ, irrational (int.fract (i * α)) := sorry

/- `theorem`

For any non-empty subset $S$ of $\R$, we have:
$$
\overline{S}=\bigcap_{\epsilon>0}\left\{x \mid \sup_{y \in S}\left|x-y\right|<\epsilon\right\}
$$
`proof`
$\subseteq$: Let $x \in \overline{S}$. Then for all $\epsilon>0$, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$. But then $\sup_{y \in S}\left|x-y\right|<\epsilon$.

$\supseteq$: Let $x \in \bigcap_{\epsilon>0}\left\{x \mid \sup_{y \in S}\left|x-y\right|<\epsilon\right\}$. Then for all $\epsilon>0$, $\sup_{y \in S}\left|x-y\right|<\epsilon$. But then, since $S$ is non-empty, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$.

QED
-/
theorem closure_sup {S : set ℝ} (hS_non_empty : S ≠ ∅) : closure S = (⋂ ε > 0, {x : ℝ | ∃ y ∈ S, |x - y| < ε}) := sorry

/- `theorem`

For any non-empty subset $S$ of $\R$, we have:
$$
\overline{S}=\bigcap_{\delta>0}\bigcup_{y \in S}\left[y-\delta, y+\delta\right]
$$
`proof`
$\subseteq$: Let $x \in \overline{S}$. Then for all $\epsilon>0$, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$. Hence for all $\delta>0$, $\exists y \in S$ such that $y-\delta<x<y+\delta$.

$\supseteq$: Let $x \in \bigcap_{\delta>0}\bigcup_{y \in S}\left[y-\delta, y+\delta\right]$. Then for all $\delta>0$, $\exists y \in S$ such that $y-\delta<x<y+\delta$. Then let $\epsilon=\frac{\delta}{2}$. We have $y-\epsilon<x<y+\epsilon$, so $|x-y|<\epsilon$. But then, since $S$ is non-empty, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$.

QED
-/
theorem closure_union {S : set ℝ} (hS_non_empty : S ≠ ∅) : closure S = (⋂ δ > 0, ⋃ y ∈ S, set.Icc (y - δ) (y + δ)) := sorry

/- `theorem`

For any non-empty subset $S$ of $\R$, we have:
$$
\overline{S}=\bigcap_{\epsilon>0}\left\{x \mid \sup_{y \in S}\left|x-y\right|\leq\epsilon\right\}
$$
`proof`
$\subseteq$: Let $x \in \overline{S}$. Then for all $\epsilon>0$, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$. But then $\sup_{y \in S}\left|x-y\right|\leq\epsilon$.

$\supseteq$: Let $x \in \bigcap_{\epsilon>0}\left\{x \mid \sup_{y \in S}\left|x-y\right|\leq\epsilon\right\}$. Then for all $\epsilon>0$, $\sup_{y \in S}\left|x-y\right|\leq\epsilon$. But then, since $S$ is non-empty, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$.

QED
-/
theorem closure_sup_le {S : set ℝ} (hS_non_empty : S ≠ ∅) : closure S = (⋂ ε > 0, {x : ℝ | ∃ y ∈ S, |x - y| ≤ ε}) := sorry

/- `theorem`

For any non-empty subset $S$ of $\R$, we have:
$$
\overline{S}=\bigcap_{\delta>0}\bigcup_{y \in S}\left[y-\delta, y+\delta\right]
$$
`proof`
$\subseteq$: Let $x \in \overline{S}$. Then for all $\epsilon>0$, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$. Hence for all $\delta>0$, $\exists y \in S$ such that $y-\delta\leq x\leq y+\delta$.

$\supseteq$: Let $x \in \bigcap_{\delta>0}\bigcup_{y \in S}\left[y-\delta, y+\delta\right]$. Then for all $\delta>0$, $\exists y \in S$ such that $y-\delta\leq x\leq y+\delta$. Then let $\epsilon=\frac{\delta}{2}$. We have $y-\epsilon\leq x\leq y+\epsilon$, so $|x-y|<\epsilon$. But then, since $S$ is non-empty, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$.

QED
-/
theorem closure_union_le {S : set ℝ} (hS_non_empty : S ≠ ∅) : closure S = (⋂ δ > 0, ⋃ y ∈ S, set.Icc_le (y - δ) (y + δ)) := sorry

/- `theorem`

For any non-empty subset $S$ of $\R$, we have:
$$
\overline{S}=\bigcap_{\epsilon>0}\left\{x \mid \inf_{y \in S}\left|x-y\right|<\epsilon\right\}
$$
`proof`
$\subseteq$: Let $x \in \overline{S}$. Then for all $\epsilon>0$, $\exists y \in S$ such that $\left|x-y\right|<\epsilon$. But then $\inf_{y \in S}\left|x-y\right|<\epsilon$.

$\supseteq$: Let
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from sorry,
  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' univ ⊆ set.Icc 0 1,
  from sorry,
  have h3 : ∀ i : ℤ, ∃ j : ℤ, (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' univ,
  from sorry,
  have h4 : ∀ i : ℤ, ∃ j : ℤ, int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * ↑j),
  from sorry,
  have h5 : ∀ i : ℤ, ∃ j : ℤ, int.fract (α * ↑i) - int.fract (α * ↑j) = 0,
  from sorry,
  have h6 : ∀ i : ℤ, ∃ j : ℤ, int.fract (α * ↑i) - int.fract (α * ↑j) ∈ set.Icc 0 1,
  from sorry,
  have h7 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, |int.fract (α * ↑j) - y| < ε,
  from sorry,
  have h8 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ set.Icc (y - ε) (y + ε),
  from sorry,
  have h9 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ closure (set.Icc (y - ε) (y + ε)),
  from sorry,
  have h10 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ closure (set.Icc (y - ε) (y + ε)) ∩ set.Icc 0 1,
  from sorry,
  have h11 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' univ ∩ set.Icc (y - ε) (y + ε),
  from sorry,
  have h12 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' univ ∩ set.Icc (y - ε) (y + ε),
  from sorry,
  have h13 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → ∃ j : ℤ, int.fract (α * ↑j) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' univ ∩ set.Icc (y - ε) (y + ε),
  from sorry,
  have h14 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → (λ (m : ℤ), int.fract (α * ↑m)) '' univ ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h15 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h16 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h17 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h18 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h19 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h20 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h21 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h22 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h23 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h24 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.Icc (y - ε) (y + ε) ≠ ∅,
  from sorry,
  have h25 : ∀ (y : ℝ) (ε : ℝ), y ∈ set.Icc 0 1 → ε > 0 → closure ((λ (m : ℤ), int.fract (α * ↑m)) '' univ) ∩ set.I
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from sorry,
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ≠ 0,
  from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) - (int.fract (α * ↑j)) ≠ 0,
  from sorry,

  let S : set ℝ := sorry,
  have h4 : S ⊆ set.Icc 0 1, from sorry,
  have h5 : S ≠ ∅, from sorry,
  have h6 : S ∪ {0} ⊆ set.Icc 0 1, from sorry,
  have h7 : S ∪ {0} ≠ ∅, from sorry,
  have h8 : ∀ x : ℝ, x ∈ S ∪ {0} → x ∈ S, from sorry,
  have h9 : ∀ x : ℝ, x ∈ S ∪ {0} → x ∈ set.Icc 0 1, from sorry,
  have h10 : ∀ x : ℝ, x ∈ S ∪ {0} → x = 0 ∨ x ∈ S, from sorry,
  have h11 : ∀ x : ℝ, x ∈ S ∪ {0} → x ∈ set.Icc 0 1, from sorry,
  have h12 : ∀ x : ℝ, x ∈ S ∪ {0} → x = 0 ∨ x ∈ S, from sorry,
  have h13 : ∀ x : ℝ, x ∈ S ∪ {0} → x ∈ set.Icc 0 1, from sorry,

  have h14 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure (S ∪ {0}), from sorry,

  have h15 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h16 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h17 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h18 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h19 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h20 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h21 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h22 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h23 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h24 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h25 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h26 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h27 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h28 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h29 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h30 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h31 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h32 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h33 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h34 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h35 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h36 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h37 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h38 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h39 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h40 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h41 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h42 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h43 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h44 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h45 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h46 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h47 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h48 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h49 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h50 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h51 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h52 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h53 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h54 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h55 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h56 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h57 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h58 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h59 : ∀ x : ℝ, x ∈ set.Icc 0 1 → x ∈ closure S, from sorry,

  have h60 : ∀ x :
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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
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
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
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
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
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) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from sorry,

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,
  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := sorry,
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from sorry,

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from sorry,

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from sorry,
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  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


example (P Q : Type) : P → (Q → P) :=
begin
    intro p,
    intro q,
    exact p,
end