-- author: Ben Sherman

import galois.network.network_monad

universes u v

lemma fin_inhabited_pos {n : ℕ} (x : fin n)
  : 0 < n
:= begin
apply lt_of_le_of_lt, tactic.swap, apply x.is_lt,
apply nat.zero_le,
end

namespace network

def message_t := list byte

@[reducible]
def socket := remote_name

inductive poll_label : Type
| timeout : poll_label
| receive : time → remote_name → message_t → poll_label

instance poll_label_decidable_eq
  : decidable_eq poll_label
  := by tactic.mk_dec_eq_instance

structure agent_label : Type :=
  (plabel : poll_label)
  (messages : list (remote_name × message_t))

instance agent_label_decidable_eq : decidable_eq agent_label
  := by tactic.mk_dec_eq_instance

inductive receives (P : socket → message_t → Prop) : agent_label → Prop
| mk : ∀ (t : time) (rn : remote_name) (mess : message_t) ms,
       P rn mess → receives (agent_label.mk (poll_label.receive t rn mess) ms)

namespace receives
lemma invert {P : socket → message_t → Prop} {plabel} {ms}
  (H : receives P (agent_label.mk plabel ms)) : (match plabel with
  | poll_label.timeout := false
  | poll_label.receive t rn mess := P rn mess
  end : Prop)
:= begin
induction plabel; cases H,
dsimp, assumption,
end
end receives

inductive timeouts : agent_label → Prop
| mk : ∀ ms, timeouts (agent_label.mk poll_label.timeout ms)

instance timeouts_decidable : decidable_pred timeouts
:= begin
intros x, induction x, induction plabel,
{ apply decidable.is_true, constructor, },
{ apply decidable.is_false, intros contra, cases contra, }
end

inductive receives_or_timeout (P : remote_name → message_t → Prop) (l : agent_label) : Prop
| receives : receives P l → receives_or_timeout
| timeouts : timeouts l -> receives_or_timeout

def receives_message (sock : socket) (mess : message_t) : agent_label → Prop :=
  receives (λ s m, s = sock ∧ m = mess)

namespace poll_result
section poll_result_facts
parameters {ports : list port} {sockets : list socket} {timeout : time}
def to_label  : poll_result ports sockets timeout → poll_label
| poll_result.timeout := poll_label.timeout
| (poll_result.message elapsed sock mess _) :=
   poll_label.receive elapsed.val sock.value mess

lemma receives_bound_pos
  (r : poll_result ports sockets timeout)
  {elapsed : fin timeout} {sock : sockets.member} {mess : message_t}
  {elapsed_gt0 : 0 < elapsed.val}
  (Hr : r = poll_result.message elapsed sock mess elapsed_gt0)
  : 0 < timeout
:= begin
induction r; injection Hr, repeat {subst h },
apply fin_inhabited_pos, assumption
end

end poll_result_facts
end poll_result
end network


import category_theory.full_subcategory
import category_theory.limits.creates
import category_theory.reflects_isomorphisms
import category_theory.limits.preserves.shapes.binary_products
import category_theory.adjunction.fully_faithful
import category_theory.adjunction.limits
import category_theory.closed.cartesian
import cartesian_closed
import power

namespace category_theory

open category_theory category_theory.category category_theory.limits
open classifier

universes v u u₂
noncomputable theory
variables (C : Type u) [category.{v} C]

local attribute [instance] has_finite_products_of_has_finite_limits

class topos :=
[lim : has_finite_limits.{v} C]
[sub : has_subobject_classifier.{v} C]
[cc : cartesian_closed.{v} C]

attribute [instance] topos.lim topos.sub topos.cc

variables [topos.{v} C]

variable {C}

lemma prod_iso_pb {B : C} (f : over B) : prod.functor.obj f = star f ⋙ over.forget _ := rfl

def prod_iso_pb' {B : C} (f : over B) : prod.functor.obj f ≅ real_pullback f.hom ⋙ dependent_sum f.hom :=
calc star f ⋙ over.forget _ ≅ star f ⋙ (over.iterated_slice_equiv _).functor ⋙ (over.iterated_slice_equiv f).inverse ⋙ over.forget _ :
            iso_whisker_left (star f) (iso_whisker_right f.iterated_slice_equiv.unit_iso (over.forget _))
     ... ≅ (star f ⋙ (over.iterated_slice_equiv _).functor) ⋙ ((over.iterated_slice_equiv f).inverse ⋙ over.forget _) : iso.refl _
     ... ≅ (star f ⋙ (over.iterated_slice_equiv _).functor) ⋙ dependent_sum f.hom : iso.refl _
     ... ≅ real_pullback f.hom ⋙ dependent_sum f.hom :
      begin
        refine iso_whisker_right _ (dependent_sum f.hom),
        have : f = over.mk f.hom,
          cases f, congr, apply subsingleton.elim,
        convert iso_pb f.hom,
      end

def prod_iso_pb'' {B : C} (f : over B) : prod.functor.obj f ≅ real_pullback f.hom ⋙ over.map f.hom :=
calc star f ⋙ over.forget _ ≅ star f ⋙ (over.iterated_slice_equiv _).functor ⋙ (over.iterated_slice_equiv f).inverse ⋙ over.forget _ :
           iso_whisker_left (star f) (iso_whisker_right f.iterated_slice_equiv.unit_iso (over.forget _))
     ... ≅ (star f ⋙ (over.iterated_slice_equiv _).functor) ⋙ ((over.iterated_slice_equiv f).inverse ⋙ over.forget _) : iso.refl _
     ... ≅ (star f ⋙ (over.iterated_slice_equiv _).functor) ⋙ dependent_sum f.hom : iso.refl _
     ... ≅ real_pullback f.hom ⋙ dependent_sum f.hom :
      begin
        refine iso_whisker_right _ (dependent_sum f.hom),
        have : f = over.mk f.hom,
          cases f, congr, apply subsingleton.elim,
        convert iso_pb f.hom,
      end

def pullback_sum_iso {X Y Z W : C} {f : X ⟶ Y} {g : X ⟶ Z} {h : Y ⟶ W} {k : Z ⟶ W}
  {comm : f ≫ h = g ≫ k} (t : is_limit (pullback_cone.mk f g comm)) :
  real_pullback g ⋙ over.map f ≅ over.map k ⋙ real_pullback h :=
begin
  apply nat_iso.of_components _ _,
  { intro m,
    apply over_iso _ _,
    { refine ⟨_, _, _, _⟩,
      { apply pullback.lift pullback.fst (pullback.snd ≫ f) _,
        change pullback.fst ≫ _ ≫ k = _,
        simp only [pullback.condition_assoc, assoc, comm] },
      { apply pullback.lift pullback.fst _ _,
        refine (pullback_cone.is_limit.lift' t pullback.snd (pullback.fst ≫ m.hom) _).1,
        rw [← pullback.condition, assoc], refl,
        erw (pullback_cone.is_limit.lift' t pullback.snd (pullback.fst ≫ m.hom) _).2.2 },
      { apply pullback.hom_ext,
        { simp },
        { rw [assoc, id_comp, pullback.lift_snd],
          apply pullback_cone.is_limit.hom_ext t,
          { rw [assoc, (pullback_cone.is_limit.lift' t _ _ _).2.1, pullback.lift_snd], refl },
          { rw [assoc, (pullback_cone.is_limit.lift' t _ _ _).2.2, pullback.lift_fst_assoc,
                pullback.condition], refl } } },
      { apply pullback.hom_ext,
        { simp },
        { rw [id_comp, assoc, pullback.lift_snd, pullback.lift_snd_assoc],
          apply (pullback_cone.is_limit.lift' t _ _ _).2.1 } } },
    { apply pullback.lift_snd } },
  { intros,
    ext1,
    change pullback.lift _ _ _ ≫ pullback.lift _ _ _ = pullback.lift _ _ _ ≫ pullback.lift (pullback.fst ≫ f_1.left) _ _,
    ext1;
    simp }
end

def test' {A B : C} (f : over A) (k : B ⟶ A) :
  over.map k ⋙ prod.functor.obj f ≅ prod.functor.obj ((real_pullback k).obj f) ⋙ over.map k :=
calc over.map k ⋙ prod.functor.obj f ≅ over.map k ⋙ real_pullback f.hom ⋙ over.map f.hom :
              iso_whisker_left (over.map k) (prod_iso_pb'' _)
     ... ≅ real_pullback pullback.snd ⋙ over.map pullback.fst ⋙ over.map f.hom :
              iso_whisker_right (pullback_sum_iso (cone_is_pullback _ _)).symm (dependent_sum f.hom)
     ... ≅ real_pullback pullback.snd ⋙ over.map (_ ≫ f.hom) : iso_whisker_left (real_pullback _) (over_map_comp _ _).symm
     ... ≅ real_pullback pullback.snd ⋙ over.map (pullback.snd ≫ k) : iso_whisker_left (real_pullback _) (by rw pullback.condition)
     ... ≅ real_pullback ((real_pullback k).obj f).hom ⋙ over.map pullback.snd ⋙ over.map k : iso_whisker_left (real_pullback _) (over_map_comp _ _)
     ... ≅ prod.functor.obj ((real_pullback k).obj f) ⋙ over.map k : iso_whisker_right (prod_iso_pb' _).symm (over.map k)

def test {A B : C} (f : over A) (k : B ⟶ A) :
  exp f ⋙ real_pullback k ≅ real_pullback k ⋙ exp ((real_pullback k).obj f) :=
begin
  apply adjunction.right_adjoint_uniq,
  apply adjunction.comp _ _ (radj k) (exp.adjunction _),
  apply adjunction.of_nat_iso_left _ (test' f k).symm,
  apply adjunction.comp _ _ (exp.adjunction _) (radj k),
end

/-- Pullback respects exponentials! (Natural in `g`) -/
def pullback_exp {X Y A B : C} (f g : over A) (k : B ⟶ A) :
  (real_pullback k).obj (f ⟹ g) ≅ (real_pullback k).obj f ⟹ (real_pullback k).obj g :=
(test f k).app g

instance subq_cc (A : C) : cartesian_closed (subq A) :=
@cartesian_closed_of_equiv _ _ (id _) _ _ _ (sub_one_over A).symm (top_cc _)

/-- The bottom of the subobject category. -/
def sub_bot (B : C) : sub B := sub.mk' (initial.to B)
@[simp] lemma sub_bot_left {B : C} : (↑(sub_bot B) : over B).left = ⊥_ C := rfl
@[simp] lemma sub_bot_arrow {B : C} : (sub_bot B).arrow = initial.to B := rfl
def subq_bot (B : C) : subq B := ⟦sub_bot B⟧

instance {B : C} : order_bot (subq B) :=
{ bot := subq_bot B,
  bot_le := quotient.ind
  begin
    intro a,
    refine ⟨sub.hom_mk (initial.to _) _⟩,
    dsimp,
    apply subsingleton.elim
  end,
  ..category_theory.subq.partial_order B }

lemma pullback_bot {A B : C} (f : A ⟶ B) : (subq.pullback f).obj ⊥ = ⊥ :=
begin
  apply quotient.sound,
  symmetry,
  refine ⟨sub.iso_mk _ _⟩,
  refine (as_iso pullback.fst).symm,
  dsimp,
  apply subsingleton.elim,
end

-- local attribute [instance] limits.has_coequalizers_of_has_finite_colimits
local attribute [instance] has_finite_coproducts_of_has_finite_colimits

example (A B : C) (f : A ⟶ B) : regular_epi (factor_thru_image f) := by apply_instance

variables {A B : C}

-- def union' : sub' A → sub' A → sub' A := λ f g,
-- sub'.mk' (image.ι (coprod.desc f.arrow.hom g.arrow.hom))

-- lemma left_le_union' (f g : sub' A) : f ≤ union' f g :=
-- begin
--   refine ⟨_, _⟩,
--   apply coprod.inl ≫ factor_thru_image _,
--   dsimp [union'],
--   rw [assoc, image.fac, coprod.inl_desc],
-- end
-- lemma right_le_union' (f g : sub' A) : g ≤ union' f g :=
-- begin
--   refine ⟨_, _⟩,
--   apply coprod.inr ≫ factor_thru_image _,
--   dsimp [union'],
--   rw [assoc, image.fac, coprod.inr_desc],
-- end

-- lemma union'_le (f g h : sub' A) : f ≤ h → g ≤ h → union' f g ≤ h :=
-- begin
--   rintros ⟨hf, hf₁⟩ ⟨hg, hg₁⟩,
--   refine ⟨_, _⟩,
--   refine image.lift ⟨_, h.arrow.hom, coprod.desc hf hg⟩,
--   apply image.lift_fac,
-- end

-- lemma union'_mono {f₁ f₂ g₁ g₂ : sub' A} : f₁ ≤ f₂ → g₁ ≤ g₂ → union' f₁ g₁ ≤ union' f₂ g₂ :=
-- begin
--   intros hf hg,
--   apply union'_le,
--   apply le_trans hf (left_le_union' _ _),
--   apply le_trans hg (right_le_union' _ _),
-- end

-- def union : sub A → sub A → sub A := quotient.map₂ union'
-- begin
--   rintro f₁ f₂ ⟨hf₁, hf₂⟩ g₁ g₂ ⟨hg₁, hg₂⟩,
--   exact ⟨union'_mono hf₁ hg₁, union'_mono hf₂ hg₂⟩,
-- end

def equiv_to_iff {P Q : Prop} (h : P ≃ Q) : P ↔ Q :=
⟨h.to_fun, h.inv_fun⟩

lemma exp_transpose (a b c : subq A) : a ⊓ b ≤ c ↔ b ≤ (a ⟹ c) :=
begin
  rw ← prod_eq_inter,
  apply equiv_to_iff,
  apply equiv.plift.symm.trans (equiv.ulift.symm.trans (((exp.adjunction a).hom_equiv b c).trans (equiv.ulift.trans equiv.plift))),
end

-- def exist' (f : B ⟶ A) (a : sub' B) : sub' A :=
-- sub'.mk' (image.ι (a.arrow.hom ≫ f))

-- def exist'' (f : B ⟶ A) : sub' B ⥤ sub' A :=
-- preorder_functor (exist' f)
-- begin
--   rintros a₁ a₂ ⟨k, hk⟩,
--   refine ⟨_, _⟩,
--   refine image.lift {I := _, m := image.ι _, e := k ≫ factor_thru_image _, fac' := _},
--   rw [assoc, image.fac, reassoc_of hk],
--   apply image.lift_fac,
-- end

-- def exist (f : B ⟶ A) : sub B ⥤ sub A := lower_functor (exist'' f)

-- def pb_adj (f : B ⟶ A) : exist'' f ⊣ pullback_sub' f
  -- equiv.trans equiv.plift.symm $ equiv.trans equiv.ulift.symm $ equiv.trans ((exp.adjunction a).hom_equiv b c) _
-- begin
--   have : ulift (plift _) ≃ ulift (plift _) := (exp.adjunction a).hom_equiv b c,

-- end

instance : bounded_lattice (subq A) :=
{ ..category_theory.subq.semilattice_inf_top,
  ..category_theory.subq.semilattice_sup,
  ..category_theory.subq.order_bot }

lemma coprod_eq_union {A : C} {f₁ f₂ : subq A} : (f₁ ⨿ f₂) = f₁ ⊔ f₂ :=
begin
  apply le_antisymm,
  apply le_of_hom,
  apply coprod.desc,
  apply hom_of_le,
  apply le_sup_left,
  apply hom_of_le,
  apply le_sup_right,
  apply sup_le,
  apply le_of_hom,
  apply coprod.inl,
  apply le_of_hom,
  apply coprod.inr
end

-- (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ⊓ z
lemma subq.distrib (x y z : subq A) : x ⊓ (y ⊔ z) ≤ (x ⊓ y) ⊔ (x ⊓ z) :=
begin
  rw [exp_transpose],
  apply sup_le,
  rw [← exp_transpose],
  exact le_sup_left,
  rw [← exp_transpose],
  exact le_sup_right,
end

lemma le_sup_inf_of_inf_sup_le {α : Type*} [lattice α]
  (inf_sup_le : ∀ x y z : α, x ⊓ (y ⊔ z) ≤ (x ⊓ y) ⊔ (x ⊓ z)) :
  ∀ x y z : α, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z) :=
begin
  have : ∀ (x y z : α), x ⊓ (y ⊔ z) = (x ⊓ y) ⊔ (x ⊓ z),
    intros x y z,
    apply le_antisymm (inf_sup_le x y z) (sup_le (inf_le_inf_left x le_sup_left) (inf_le_inf_left x le_sup_right)),
  intros,
  rw this,
  change ((x ⊔ y) ⊓ x) ⊔ ((x ⊔ y) ⊓ z) ≤ x ⊔ (y ⊓ z),
  apply sup_le,
    transitivity x,
      simp,
    simp,
  rw inf_comm,
  rw this,
  apply sup_le_sup,
  apply inf_le_right,
  rw inf_comm,
end

def sub.pullback_image_aux {A' : C} (f : A ⟶ B) (g : A' ⟶ B) :
  (sub.pullback f).obj (sub.image.obj (over.mk g)) ≅ sub.image.obj ((real_pullback f).obj (over.mk g)) :=
{ hom := sub.hom_mk (pullback_image _ _).hom (pullback_image_fac _ _),
  inv := sub.hom_mk (pullback_image _ _).inv (pullback_image_inv_fac _ _) }

/-- Image commutes with pullback. -/
def sub.pullback_image (f : A ⟶ B) :
  sub.image ⋙ sub.pullback f ≅ real_pullback f ⋙ sub.image :=
nat_iso.of_components (λ g, sub.pullback_image_aux f _) (by tidy)

/-- Lemma A1.3.3 of the Elephant. -/
def frobenius {A B : C} (f : A ⟶ B) (A' : sub A) (B' : sub B) :
    (sub.intersection.obj ((sub.exists f).obj A')).obj B' ≅
    (sub.exists f).obj ((sub.intersection.obj A').obj ((sub.pullback f).obj B')) :=
begin
  refine sub.iso_mk _ _,
  apply unique_factorise
    ((pullback.snd ≫ A'.arrow) ≫ f)
    (pullback B'.arrow (image.ι (A'.arrow ≫ f))) _ (pullback.fst ≫ B'.arrow) _,
  { apply pullback.lift (pullback.fst ≫ pullback.fst) (pullback.snd ≫ factor_thru_image _) _,
    rw [assoc, pullback.condition, assoc, image.fac],
    apply pullback.condition_assoc },
  { rw pullback.lift_fst_assoc,
    change (pullback.fst ≫ pullback.fst) ≫ B'.arrow = (pullback.snd ≫ A'.arrow) ≫ f,
    erw [assoc, pullback.condition, pullback.condition_assoc, assoc] },
  { apply category_theory.strong_epi_of_regular_epi _,
    apply regular_epi_of_is_pullback_alt _ pullback.snd pullback.snd (factor_thru_image (A'.arrow ≫ f)) _ _,
    apply pullback.lift_snd,
    refine both_pb_to_left_pb _ _ _ _ _ _ _ _ _ (cone_is_pullback _ _) _,
    simp only [pullback.lift_fst],
    have : factor_thru_image (A'.arrow ≫ f) ≫ image.ι (A'.arrow ≫ f) = A'.arrow ≫ f := image.fac _,
    convert left_pb_to_both_pb _ _ _ _ _ _ _ _ _ (cone_is_pullback pullback.snd A'.arrow) (cone_is_pullback B'.arrow f) },
  { erw unique_factorise_hom_comp_image, apply pullback.condition },
end

lemma subq.frobenius {A B : C} (f : A ⟶ B) (A' : subq A) (B' : subq B) :
  (subq.exists f).obj A' ⊓ B' = (subq.exists f).obj (A' ⊓ (subq.pullback f).obj B') :=
quotient.induction_on₂ A' B' $ λ a' b', quotient.sound ⟨frobenius f _ _⟩

instance pb_frob {A B : C} (f : A ⟶ B) (x : subq A) (y : subq B) :
  is_iso (frobenius_map y x (subq.exists_pull_adj f)) :=
{ inv :=
  begin
    refine ⟨⟨_⟩⟩,
    rw [prod_eq_inter, prod_eq_inter, inf_comm, subq.frobenius, inf_comm],
  end }

instance pb_preserves_lim (f : A ⟶ B) : preserves_limits (subq.pullback f) :=
adjunction.right_adjoint_preserves_limits (subq.exists_pull_adj f)

instance pullback_cc (f : A ⟶ B) : cartesian_closed_functor (subq.pullback f) :=
cartesian_closed_of_frobenius_iso (subq.exists_pull_adj f)

lemma subq.pullback_exp (f : A ⟶ B) (x y : subq B) :
  (subq.pullback f).obj (x ⟹ y) = ((subq.pullback f).obj x ⟹ (subq.pullback f).obj y) :=
begin
  apply skel_is_skel,
  have := (category_theory.pullback_cc f).comparison_iso,
  refine @as_iso _ _ _ _ _ (this x y),
end

instance : bounded_distrib_lattice (subq A) :=
{ le_sup_inf := le_sup_inf_of_inf_sup_le subq.distrib,
  ..category_theory.subq.bounded_lattice }

instance : has_compl (subq A) := { compl := λ x, x ⟹ ⊥ }

variables (x y z : subq A)

lemma imp_eq_top_iff_le : (x ⟹ y) = ⊤ ↔ x ≤ y :=
by rw [eq_top_iff, ← exp_transpose, inf_top_eq]

@[simp]
lemma imp_self : (x ⟹ x) = ⊤ :=
by rw [imp_eq_top_iff_le].

lemma classifier_of_pullback {E F A : C} (m : A ⟶ E) (f : F ⟶ E) [mono m] : f ≫ classifier_of m = classifier_of (pullback.snd : pullback m f ⟶ F) :=
begin
  symmetry,
  apply uniquely,
  apply left_right_hpb_to_both_hpb _ has_pullback_top_of_pb (classifies m),
end

lemma class_lift_of_is_iso {A₁ A₂ E : C} {m₁ : A₁ ⟶ E} {m₂ : A₂ ⟶ E} [mono m₁] [mono m₂] (h : A₁ ⟶ A₂) [is_iso h] :
  h ≫ m₂ = m₁ → classifier_of m₁ = classifier_of m₂ :=
begin
  intros k,
  apply uniquely,
  change has_pullback_top _ _ _,
  rw ← id_comp (classifier_of m₂),
  apply left_right_hpb_to_both_hpb m₂,
  apply top_iso_has_pullback_top h,
    simpa,
  apply classifies,
end

lemma class_lift_of_iso {A₁ A₂ E : C} {m₁ : A₁ ⟶ E} {m₂ : A₂ ⟶ E} [mono m₁] [mono m₂] (h : A₁ ≅ A₂) (l : h.hom ≫ m₂ = m₁) :
  classifier_of m₁ = classifier_of m₂ :=
class_lift_of_is_iso h.hom l

lemma class_lift_of_both_factor {A₁ A₂ E : C} {m₁ : A₁ ⟶ E} {m₂ : A₂ ⟶ E} [mono m₁] [mono m₂] (hom : A₁ ⟶ A₂) (inv : A₂ ⟶ A₁) :
  hom ≫ m₂ = m₁ → inv ≫ m₁ = m₂ → classifier_of m₁ = classifier_of m₂ :=
begin
  intros k l,
  apply class_lift_of_iso ⟨hom, inv, _, _⟩ k,
  rw ← cancel_mono m₁, simp [k, l],
  rw ← cancel_mono m₂, simp [k, l],
end

def how_inj_is_classifier {E A₁ A₂ : C} (m₁ : A₁ ⟶ E) (m₂ : A₂ ⟶ E) [mono m₁] [mono m₂]
  (h : classifier_of m₁ = classifier_of m₂) :
A₁ ≅ A₂ :=
{ hom := (pullback_cone.is_limit.lift' (classifies m₂).is_pb (classifies m₁).top m₁ (h ▸ (classifies m₁).comm)).1,
  inv := (pullback_cone.is_limit.lift' (classifies m₁).is_pb (classifies m₂).top m₂ (h.symm ▸ (classifies m₂).comm)).1,
  hom_inv_id' := by erw [← cancel_mono_id m₁, assoc, lift'_right, lift'_right],
  inv_hom_id' := by erw [← cancel_mono_id m₂, assoc, lift'_right, lift'_right] }

lemma c_very_inj {E A₁ A₂ : C} {m₁ : A₁ ⟶ E} {m₂ : A₂ ⟶ E} [mono m₁] [mono m₂] (h : classifier_of m₁ = classifier_of m₂) :
  (how_inj_is_classifier _ _ h).hom ≫ m₂ = m₁ :=
lift'_right _ _ _ _

def get_subobject_obj {B : C} (c : B ⟶ Ω C) : C := pullback (truth C) c
def get_subobject {B : C} (c : B ⟶ Ω C) : get_subobject_obj c ⟶ B := pullback.snd
instance get_subobject_mono {B : C} (c : B ⟶ Ω C) : mono (get_subobject c) := pullback.snd_of_mono

lemma classify_inv {E : C} (c : E ⟶ Ω C) : classifier_of (get_subobject c) = c :=
(uniquely _ _ has_pullback_top_of_pb)

set_option pp.universes false

@[simps]
def classification {B : C} : (B ⟶ Ω C) ≃ subq B :=
{ to_fun := λ k, ⟦sub.mk' (get_subobject k)⟧,
  inv_fun :=
  begin
    refine quotient.lift (λ (k : sub B), _) _,
    exact classifier_of k.arrow,
    rintro a₁ a₂ ⟨⟨k₁, k₂, _, _⟩⟩,
    apply class_lift_of_both_factor _ _ (sub.w k₁) (sub.w k₂),
  end,
  left_inv := λ k, classify_inv k,
  right_inv := quotient.ind
  begin
    intro k,
    apply quotient.sound,
    refine equiv_of_both_ways
      (sub.hom_mk _ ((classifies k.arrow).is_pb.fac _ walking_cospan.right))
      (sub.hom_mk _ (pullback.lift_snd _ _ (classifies k.arrow).comm)),
  end }

abbreviation classify {B : C} : subq B → (B ⟶ Ω C) := classification.symm

lemma classify_eq_iff_eq {B : C} (m n : subq B) : classify m = classify n ↔ m = n :=
classification.right_inv.injective.eq_iff

lemma classify_pullback {B B' : C} (f : B ⟶ B') :
  ∀ m, classify ((subq.pullback f).obj m) = f ≫ classify m :=
quotient.ind $ by { intro m, exact (classifier_of_pullback _ _).symm }

lemma classification_natural_symm {B B' : C} (f : B ⟶ B') (c : B' ⟶ Ω C) :
  classification (f ≫ c) = (subq.pullback f).obj (classification c) :=
begin
  rw [← classification.eq_symm_apply],
  change _ = classify _,
  rw [classify_pullback],
  congr',
  symmetry,
  apply classification.symm_apply_apply c,
end
-- def indicators {B : C} (m : B ⟶ Ω C) (n : B ⟶ Ω C) : B ⟶ Ω C :=
-- classify (classification m ⊓ classification n)

-- def indicators_natural {B B' : C} (f : B' ⟶ B) (m : B ⟶ Ω C) (n : B ⟶ Ω C) :
--   f ≫ indicators m n = indicators (f ≫ m) (f ≫ n) :=
-- begin
--   dunfold indicators,
--   rw [classification_natural_symm, classification_natural_symm, ← intersect_pullback,
--       classification.eq_symm_apply, classification_natural_symm, classification.apply_symm_apply],
-- end

-- variable (C)
-- def and_arrow : Ω C ⨯ Ω C ⟶ Ω C := indicators limits.prod.fst limits.prod.snd
-- variable {C}h

/-- Complement commutes with pullback. -/
lemma compl_natural (m : subq B) (f : A ⟶ B) : (subq.pullback f).obj mᶜ = ((subq.pullback f).obj m)ᶜ :=
by { erw [subq.pullback_exp, pullback_bot], refl }

def neg_arrow_aux (m : B ⟶ Ω C) : B ⟶ Ω C :=
classify (classification m)ᶜ

lemma neg_arrow_aux_natural {B B' : C} (f : B' ⟶ B) (m : B ⟶ Ω C) :
  f ≫ neg_arrow_aux m = neg_arrow_aux (f ≫ m) :=
begin
  rw [neg_arrow_aux, neg_arrow_aux, classification.eq_symm_apply, classification_natural_symm,
      classification_natural_symm, classification.apply_symm_apply, compl_natural],
end

variable (C)
def not : Ω C ⟶ Ω C := neg_arrow_aux (𝟙 _)
variable {C}

lemma not_prop (f : subq B) : classify fᶜ = classify f ≫ not C :=
by rw [not, neg_arrow_aux_natural, comp_id, neg_arrow_aux, classification.apply_symm_apply]

end category_theory


import tactic --hide

/-Lemma
Are we there yet?
-/
lemma lemma_10 (P Q : Prop) : (((P → Q) → Q) → Q) → (P → Q) :=
begin
  intros h1 hP,
  apply h1,
  intro hPQ,
  exact hPQ hP,

end


import util.meta.tactic

example : list.perm [1,2,3] [3,2,1] :=
by { prove_perm }

example : list.perm [1,2,3,4] [3,2,4,1] :=
by { prove_perm }

example : list.perm [1,2,3,4] [3,1,4] :=
by { success_if_fail { prove_perm }, admit }

example : list.perm [1,2,3,4] [3,2,4,5] :=
by { success_if_fail { prove_perm }, admit }

example : list.perm [1,2,3,4] [1,3,2,4,5] :=
by { success_if_fail { prove_perm }, admit }

example : list.perm [1,2,3,4] [1,3,2,4,5] :=
by { success_if_fail { prove_perm }, admit }


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

The Kleisli construction on the Type category

TODO: generalise this to work with category_theory.monad
-/
import category_theory.category

universes u v

namespace category_theory

def Kleisli (m) [monad.{u v} m] := Type u

def Kleisli.mk (m) [monad.{u v} m] (α : Type u) : Kleisli m := α

instance Kleisli.category_struct {m} [monad m] : category_struct (Kleisli m) :=
{ hom := λ α β, α → m β,
  id := λ α x, (pure x : m α),
  comp := λ X Y Z f g, f >=> g }

instance Kleisli.category {m} [monad m] [is_lawful_monad m] : category (Kleisli m) :=
by refine { hom := λ α β, α → m β,
            id := λ α x, (pure x : m α),
            comp := λ X Y Z f g, f >=> g,
            id_comp' := _, comp_id' := _, assoc' := _ };
   intros; ext; simp only [(>=>)] with functor_norm

@[simp] lemma Kleisli.id_def {m} [monad m] [is_lawful_monad m] (α : Kleisli m) :
  𝟙 α = @pure m _ α := rfl

lemma Kleisli.comp_def {m} [monad m] [is_lawful_monad m] (α β γ : Kleisli m)
  (xs : α ⟶ β) (ys : β ⟶ γ) (a : α) :
  (xs ≫ ys) a = xs a >>= ys := rfl

end category_theory


import ExtParser.AST
namespace Parsing
  open AST
  open Grammar

  inductive PreAST.TrueToGrammar : PreAST n b → GProd n → PEG n → Prop where
    | skip : TrueToGrammar (.skip s e G) Pexp G
    | ε : TrueToGrammar (.ε s e) Pexp .ε
    | any : TrueToGrammar (.any s e x) Pexp .any
    | terminal : TrueToGrammar (.terminal s e a x) Pexp (.terminal a)
    | nonTerminal : TrueToGrammar T Pexp (Pexp.f A) → TrueToGrammar (.nonTerminal s e A T) Pexp (.nonTerminal A)
    | seq : TrueToGrammar T1 Pexp e1 → TrueToGrammar T2 Pexp e2 → TrueToGrammar (.seq s e T1 T2) Pexp (.seq e1 e2)
    | prior : TrueToGrammar T1 Pexp e1 → TrueToGrammar T2 Pexp e2 → TrueToGrammar (.prior s e T1 T2) Pexp (.prior e1 e2)
    | star : TrueToGrammar T0 Pexp e0 → TrueToGrammar TS Pexp (.star e0) → TrueToGrammar (.star s e T0 TS) Pexp (.star e0)
    | notP : TrueToGrammar T Pexp e0 → TrueToGrammar (.notP s e T) Pexp (.notP e0)

  def AST.TrueToGrammar : AST n b → GProd n → PEG n → Prop := fun T => PreAST.TrueToGrammar T.T

  theorem PreAST.unique_grammar : ∀ {T : PreAST n b} {G1 G2 : PEG n} {Pexp : GProd n}, TrueToGrammar T Pexp G1 → TrueToGrammar T Pexp G2 → G1 = G2 := by
    intro T G1 G2 Pexp h1 h2;
    cases T;
    {cases h1; cases h2; rfl}
    {cases h1; cases h2; rfl}
    {cases h1; cases h2; rfl}
    {cases h1; cases h2; rfl}
    {cases h1; cases h2; rfl}
    {
      match h1, h2 with
      | .seq h11 h12, .seq h21 h22 => rw [unique_grammar h11 h21, unique_grammar h12 h22];
    }
    {
      match h1, h2 with
      | .prior h11 h12, .prior h21 h22 => rw [unique_grammar h11 h21, unique_grammar h12 h22];
    }
    {
      match h1, h2 with
      | .star h11 _, .star h21 h22 => rw [unique_grammar h11 h21];
    }
    {
      match h1, h2 with
      | .notP h11, .notP h21 => rw [unique_grammar h11 h21];
    }

  theorem AST.unique_grammar : ∀ {T : AST n b} {G1 G2 : PEG n} {Pexp : GProd n}, TrueToGrammar T Pexp G1 → TrueToGrammar T Pexp G2 → G1 = G2 := by
    intro T;
    exact PreAST.unique_grammar (T := T.T);

  def Input (b : Nat) := Fin b → Char

  inductive PreAST.TrueToInput : PreAST n b → (inp : Input b) → Prop where
    | skip : TrueToInput (.skip s e G) inp
    | ε : TrueToInput (.ε s e) inp
    | any : inp s = x → TrueToInput (.any s e x) inp
    | terminal : inp s = x → TrueToInput (.terminal s e a x) inp
    | nonTerminal : TrueToInput T inp → TrueToInput (.nonTerminal s e A T) inp
    | seq : TrueToInput T1 inp → TrueToInput T2 inp → TrueToInput (.seq s e T1 T2) inp
    | prior : TrueToInput T1 inp → TrueToInput T2 inp → TrueToInput (.prior s e T1 T2) inp
    | star : TrueToInput T0 inp → TrueToInput TS inp → TrueToInput (.star s e T0 TS) inp
    | notP : TrueToInput T inp → TrueToInput (.notP s e T) inp

  def AST.TrueToInput : AST n b → Input b → Prop := fun T => PreAST.TrueToInput T.T

  theorem AST.unique_input : ∀ {T : AST n b} {inp1 inp2 : Input b}, TrueToInput T inp1 → TrueToInput T inp2 → T.start ≤ i → i < T.end → inp1 i = inp2 i := by
    intro (.mk T valid_T wf_T) inp1 inp2 h1 h2 hstart hend;
    match T with
    | .skip _ _ _ => cases wf_T
    | .ε _ _ => match wf_T with
      | .ε (Or.inl (.ε h)) =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          rw [h] at hstart; have g : i < i := Nat.lt_of_lt_of_le hend hstart;
          apply absurd g (Nat.lt_irrefl i);
        }
    | .any s e x => match h1, h2 with
      | .any heq1, .any heq2 =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match wf_T with
          | .any (Or.inl (.any h)) =>
            {
              match Nat.eq_or_lt_of_le hstart with
              | Or.inl g => simp [←Fin.eq_of_val_eq g, heq1, heq2];
              | Or.inr g =>
                {
                  apply absurd (Fin.val_eq_of_eq h);
                  simp [Fin.inbound_succ];
                  apply Nat.ne_of_lt;
                  exact Nat.lt_of_lt_of_le (Nat.succ_lt_succ g) hend;
                }
            }
          | .any (Or.inr (.any h _)) =>
            {
              rw [h] at hstart;
              apply absurd hstart;
              exact Nat.not_le_of_gt hend;
            }

        }
    | .terminal s e a x => match h1, h2 with
      | .terminal (s := s) (e := e) heq1, .terminal heq2 =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match wf_T with
          | .terminal (Or.inl (.terminal h _)) =>
            {
              match Nat.eq_or_lt_of_le hstart with
              | Or.inl g => simp [←Fin.eq_of_val_eq g, heq1, heq2];
              | Or.inr g =>
                {
                  apply absurd (Fin.val_eq_of_eq h);
                  simp [Fin.inbound_succ];
                  apply Nat.ne_of_lt;
                  exact Nat.lt_of_lt_of_le (Nat.succ_lt_succ g) hend;
                }
            }
          | .terminal (Or.inr (.terminal_mismatch h _)) =>
            {
              match Nat.eq_or_lt_of_le hstart with
              | Or.inl g => simp [←Fin.eq_of_val_eq g, heq1, heq2];
              | Or.inr g =>
                {
                  apply absurd (Fin.val_eq_of_eq h);
                  simp [Fin.inbound_succ];
                  apply Nat.ne_of_lt;
                  exact Nat.lt_of_lt_of_le (Nat.succ_lt_succ g) hend;
                }
            }
          | .terminal (Or.inr (.terminal_empty h _)) =>
            {
              rw [h] at hstart;
              apply absurd hstart;
              exact Nat.not_le_of_gt hend;
            }
        }
    | .nonTerminal s e A sub_T => match h1, h2 with
      | .nonTerminal (T := sub_T) h1, .nonTerminal h2 =>
        {
          match valid_T, wf_T with
          | .nonTerminal hv _, .nonTerminal hssT heeT hwf =>
            {
              let T' := AST.mk sub_T hv hwf;
              apply unique_input (T := T') h1 h2;
              rw [AST.start, ←hssT]; exact hstart;
              rw [AST.end, ←heeT]; exact hend;
            }
        }
    | .seq s e T1 T2 => match h1, h2 with
      | .seq h11 h12, .seq h21 h22 =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match valid_T, wf_T with
          | .seq hv1 _ _, .seq_F hss1 he1s2 hee2 hs2e2 hwf1 _ _ =>
            {
              let T' := AST.mk T1 hv1 hwf1;
              apply unique_input (T := T') h11 h21;
              rw [AST.start, ←hss1]; exact hstart;
              rw [AST.end, he1s2, hs2e2, ←hee2]; exact hend;
            }
          | .seq hv1 hv2 _, .seq_S hss1 he1s2 hee2 hwf1 _ hwf2 =>
            {
              let T1' := AST.mk T1 hv1 hwf1;
              let T2' := AST.mk T2 hv2 hwf2;
              match Nat.lt_or_ge i (T1.end) with
              | Or.inl g =>
                {
                  apply unique_input (T := T1') h11 h21;
                  simp [AST.start, ←hss1]; exact hstart;
                  exact g;
                }
              | Or.inr g =>
                {
                  apply unique_input (T := T2') h12 h22;
                  simp [AST.start, ←he1s2]; exact g;
                  simp [AST.end, ←hee2]; exact hend;
                }
            }
        }
    | .prior s e T1 T2 => match h1, h2 with
      | .prior h11 h12, .prior h21 h22 =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match valid_T, wf_T with
          | .prior hv1 _ _, .prior_S hss1 _ _ hee1 hwf1 _ _ =>
            {
              let T' := AST.mk T1 hv1 hwf1;
              apply unique_input (T := T') h11 h21;
              simp [AST.start, ←hss1]; exact hstart;
              simp [AST.end, ←hee1]; exact hend;
            }
          | .prior _ hv2 _, .prior_F _ hss2 hee2 _ _ hwf2 =>
            {
              let T' := AST.mk T2 hv2 hwf2;
              apply unique_input (T := T') h12 h22;
              simp [AST.start, ←hss2]; exact hstart;
              simp [AST.end, ←hee2]; exact hend;
            }
        }
    | .star s e T0 TS => match h1, h2 with
      | .star h10 h1S, .star h20 h2S =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match valid_T, wf_T with
          | .star hv1 hv2 _ _, .star_F _ _ _ hse _ _ _ =>
            {
              rw [hse] at hstart;
              have g : e < e := Nat.lt_of_le_of_lt hstart hend;
              apply absurd g (Nat.lt_irrefl e);
            }
          | .star hv0 hvS _ _, .star_S hss0 he0sS heeS hwf0 _ hwfS =>
            {
              let T0' := AST.mk T0 hv0 hwf0;
              let TS' := AST.mk TS hvS hwfS;
              match Nat.lt_or_ge i (T0.end) with
              | Or.inl g =>
                {
                  apply unique_input (T := T0') h10 h20;
                  simp [AST.start, ←hss0]; exact hstart;
                  exact g;
                }
              | Or.inr g =>
                {
                  apply unique_input (T := TS') h1S h2S;
                  simp [AST.start, ←he0sS]; exact g;
                  simp [AST.end, ←heeS]; exact hend;
                }
            }
        }
    | .notP s e T => match h1, h2 with
      | .notP (T := sub_T) h1, .notP h2 =>
        {
          simp [AST.start, PreAST.start, AST.end, PreAST.end] at hstart hend;
          match valid_T, wf_T with
          | .notP hv _, .notP hse _ _ =>
            {
              rw [hse] at hstart;
              have g : e < e := Nat.lt_of_le_of_lt hstart hend;
              apply absurd g (Nat.lt_irrefl e);
            }
        }

  theorem AST.unique_tree : ∀ {T1 T2 : AST n b} {inp : Input b} {G : PEG n} {Pexp : GProd n},
                            AST.TrueToInput T1 inp → AST.TrueToInput T2 inp →
                            AST.TrueToGrammar T1 Pexp G → AST.TrueToGrammar T2 Pexp G →
                            T1.start = T2.start → T1 = T2 := by
    intro (.mk T1 valid_T1 wf_T1) (.mk T2 valid_T2 wf_T2) inp G Pexp hi1 hi2 hg1 hg2 hstart;
    induction T1 generalizing T2 inp G with
    | skip _ _ _ => cases wf_T1;
    | ε s1 e1 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | ε s2 e2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2 with
        | .ε (Or.inl (.ε h1)), .ε (Or.inl (.ε h2)) => rw [←h1, hstart, h2];
      }
      | _ => cases hg1; cases hg2;
    | any s1 e1 x1 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | any s2 e2 x2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        have hx : x1 = x2 := by
          {
            simp [hstart] at hi1;
            cases hi1; cases hi2;
            apply Eq.trans; apply Eq.symm; assumption; assumption;
          }
        simp [hx];
        match wf_T1, wf_T2 with
        | .any (Or.inl (.any h1)), .any (Or.inl (.any h2)) =>
          {
            simp [hstart] at h1;
            exact Eq.trans (Eq.symm h1) h2;
          }
        | .any (Or.inl (.any h1)), .any (Or.inr (.any h2 hb2)) =>
          {
            rw [←h2, ←hstart, Fin.IsMax] at hb2;
            contradiction;
          }
        | .any (Or.inr (.any h1 hb1)), .any (Or.inl (.any h2)) =>
          {
            rw [←h1, hstart, Fin.IsMax] at hb1;
            contradiction;
          }
        | .any (Or.inr (.any h1 _)), .any (Or.inr (.any h2 _)) =>
          {
            rw [←h1, hstart, h2];
          }
      }
      | _ => cases hg1; cases hg2;
    | terminal s1 e1 a1 x1 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | terminal s2 e2 a2 x2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        have hx : x1 = x2 := by
          {
            simp [hstart] at hi1;
            cases hi1; cases hi2;
            apply Eq.trans; apply Eq.symm; assumption; assumption;
          }
        simp [hx];
        cases hg1; cases hg2; simp;
        match wf_T1, wf_T2 with
        | .terminal (Or.inl (.terminal h1 g1)), .terminal (Or.inl (.terminal h2 g2)) =>
          {
            simp [g1, ←g2];
            apply Fin.eq_of_val_eq;
            simp [←Fin.val_eq_of_eq h1, ←Fin.val_eq_of_eq h2, Fin.inbound_succ];
            exact Fin.val_eq_of_eq hstart;
          }
        | .terminal (Or.inl (.terminal h1 g1)), .terminal (Or.inr (.terminal_mismatch h2 g2)) =>
          {
            rw [hx] at g1;
            contradiction;
          }
        | .terminal (Or.inl (.terminal _ _)), .terminal (Or.inr (.terminal_empty h2 hb2)) =>
          {
            simp [←h2, ←hstart, Fin.IsMax] at hb2;
            contradiction;
          }
        | .terminal (Or.inr (.terminal_mismatch h1 g1)), .terminal (Or.inl (.terminal h2 g2)) =>
          {
            rw [hx] at g1; contradiction;
          }
        | .terminal (Or.inr (.terminal_mismatch h1 _)), .terminal (Or.inr (.terminal_mismatch h2 _)) =>
          {
            apply Fin.eq_of_val_eq;
            simp [←Fin.val_eq_of_eq h1, ←Fin.val_eq_of_eq h2, Fin.inbound_succ];
            exact Fin.val_eq_of_eq hstart;
          }
        | .terminal (Or.inr (.terminal_mismatch _ _)), .terminal (Or.inr (.terminal_empty h2 hb2)) =>
          {
            simp [←h2, ←hstart, Fin.IsMax] at hb2;
            contradiction;
          }
        | .terminal (Or.inr (.terminal_empty h1 hb1)), .terminal (Or.inl (.terminal _ _)) =>
          {
            simp [←h1, hstart, Fin.IsMax] at hb1;
            contradiction;
          }
        | .terminal (Or.inr (.terminal_empty h1 hb1)), .terminal (Or.inr (.terminal_mismatch _ _)) =>
          {
            simp [←h1, hstart, Fin.IsMax] at hb1;
            contradiction;
          }
        | .terminal (Or.inr (.terminal_empty h1 _)), .terminal (Or.inr (.terminal_empty h2 _)) =>
          {
            simp [←h1, hstart, h2];
          }
      }
      | _ => cases hg1; cases hg2;
    | nonTerminal s1 e1 A1 T1 ih => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | nonTerminal s2 e2 A2 T2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2, valid_T1, valid_T2 with
        | .nonTerminal hss1 hee1 hwfT1, .nonTerminal hss2 hee2 hwfT2, .nonTerminal hvT1 _ , .nonTerminal hvT2 _ =>
        {
          cases hi1; cases hi2; cases hg1; cases hg2;
          have g : AST.mk T1 hvT1 hwfT1 = AST.mk T2 hvT2 hwfT2 := by
          {
            apply ih; assumption; assumption; assumption; assumption;
            simp [AST.start, ←hss1, ←hss2, hstart];
          }
          cases g; simp [hee1, hee2];
        }
      }
      | _ => cases hg1; cases hg2;
    | seq s1 e1 T11 T21 ih1 ih2 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | seq s2 e2 T12 T22 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2 with
        | .seq_F hss11 he11s21 hee21 hs21e21 hwf11 hf11 hskip21, .seq_F hss12 he12s22 hee22 hs22e22 hwf12 hf12 hskip22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .seq hg11 hg21, .seq hg12 hg22, .seq hv11 _ _, .seq hv12 _ _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              cases hskip21; cases hskip22;
              cases hg21; cases hg22;
              simp [PreAST.start, PreAST.end] at hs21e21 hee21 hs22e22 hee22;
              simp [PreAST.start] at he11s21 he12s22;
              simp [hee21, hee22, ←he11s21, ←he12s22, ←hs21e21, ←hs22e22];
            }
          }
        | .seq_F hss11 he11s21 hee21 hs21e21 hwf11 hf11 _, .seq_S hss12 he12s22 hee22 hwf12 hs12 _ =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .seq hg11 _, .seq hg12 _, .seq hv11 _ _, .seq hv12 _ _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              exact absurd hf11 (hs12.ne_failure (by assumption));
            }
          }
        | .seq_S hss11 he11s21 hee21 hwf11 hs11 _, .seq_F hss12 he12s22 hee22 hs22e22 hwf12 hf12 _ =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .seq hg11 _, .seq hg12 _, .seq hv11 _ _, .seq hv12 _ _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              exact absurd hs11 (hf12.ne_success (by assumption));
            }
          }
        | .seq_S hss11 he11s21 hee21 hwf11 hs11 hwf21, .seq_S hss12 he12s22 hee22 hwf12 hs12 hwf22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .seq hg11 hg21, .seq hg12 hg22, .seq hv11 hv21 _, .seq hv12 hv22 _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              have g2 : AST.mk T21 hv21 hwf21 = AST.mk T22 hv22 hwf22 := by
              {
                apply ih2; assumption; assumption; assumption; assumption;
                simp [AST.start, ←he11s21, ←he12s22];
              }
              cases g2; simp;
              simp [hee21, hee22];
            }
          }
      }
      | _ => cases hg1; cases hg2;
    | prior s1 e1 T11 T21 ih1 ih2 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | prior s2 e2 T12 T22 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2 with
        | .prior_F hss11 hss21 hee21 hwf11 hf11 hwf21, .prior_F hss12 hss22 hee22 hwf12 hf12 hwf22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .prior hg11 hg21, .prior hg12 hg22, .prior hv11 hv21 _, .prior hv12 hv22 _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              have g2 : AST.mk T21 hv21 hwf21 = AST.mk T22 hv22 hwf22 := by
              {
                apply ih2; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss21, ←hss22, hstart];
              }
              cases g1; cases g2; simp;
              simp [hee21, hee22];
            }
          }
        | .prior_F hss11 hss21 hee21 hwf11 hf11 hwf21, .prior_S hss12 hss22 hse22 hee12 hwf12 hs12 hskip22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .prior hg11 _, .prior hg12 _, .prior hv11 _ _, .prior hv12 _ _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              exact absurd hf11 (hs12.ne_failure (by assumption));
            }
          }
        | .prior_S hss11 hss21 hse21 hee11 hwf11 hs11 hskip21, .prior_F hss12 hss22 hee22 hwf12 hf12 hwf22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .prior hg11 _, .prior hg12 _, .prior hv11 _ _, .prior hv12 _ _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              exact absurd hs11 (hf12.ne_success (by assumption));
            }
          }
        | .prior_S hss11 hss21 hse21 hee11 hwf11 hs11 hskip21, .prior_S hss12 hss22 hse22 hee12 hwf12 hs12 hskip22 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .prior hg11 hg21, .prior hg12 hg22, .prior hv11 hv21 _, .prior hv12 hv22 _ =>
            {
              have g1 : AST.mk T11 hv11 hwf11 = AST.mk T12 hv12 hwf12 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss11, ←hss12, hstart];
              }
              cases g1; simp;
              cases hskip21; cases hskip22;
              cases hg21; cases hg22;
              simp [PreAST.start] at hss21 hss22;
              simp [PreAST.end] at hse21 hse22;
              simp [hee11, hee12, ←hss21, ←hse21, ←hss22, ←hse22, hstart];
            }
          }
      }
      | _ => cases hg1; cases hg2;
    | star s1 e1 T01 TS1 ih1 ih2 => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | star s2 e2 T02 TS2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2 with
        | .star_F hss01 he01sS1 hsS1eS1 hse1 hwf01 hf01 hskipS1, .star_F hss02 he02sS2 hsS2eS2 hse2 hwf02 hf02 hskipS2 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .star hg01 hgS1, .star hg02 hgS2, .star hv01 hvS1 _ _, .star hv02 hvS2 _ _ =>
            {
              have g1 : AST.mk T01 hv01 hwf01 = AST.mk T02 hv02 hwf02 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss01, ←hss02, hstart];
              }
              cases g1; simp;
              cases hskipS1; cases hskipS2;
              cases hgS1; cases hgS2;
              simp [PreAST.start, PreAST.end] at hsS1eS1 hsS2eS2;
              simp [PreAST.start] at he01sS1 he02sS2;
              simp [←hse1, ←hse2, ←hsS1eS1, ←hsS2eS2, ←he01sS1, ←he02sS2, hstart];
            }
          }
        | .star_F hss01 he01sS1 hsS1eS1 hse1 hwf01 hf01 hskipS1, .star_S hss02 he02sS2 heeS2 hwf02 hs02 hwfS2 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .star hg01 _, .star hg02 _, .star hv01 _ _ _, .star hv02 _ _ _ =>
            {
              have g1 : AST.mk T01 hv01 hwf01 = AST.mk T02 hv02 hwf02 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss01, ←hss02, hstart];
              }
              cases g1; simp;
              exact absurd hf01 (hs02.ne_failure (by assumption));
            }
          }
        | .star_S hss01 he01sS1 heeS1 hwf01 hs01 hwfS1, .star_F hss02 he02sS2 hsS2eS2 hse2 hwf02 hf02 hskipS2 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .star hg01 _, .star hg02 _, .star hv01 _ _ _, .star hv02 _ _ _ =>
            {
              have g1 : AST.mk T01 hv01 hwf01 = AST.mk T02 hv02 hwf02 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss01, ←hss02, hstart];
              }
              cases g1; simp;
              exact absurd hs01 (hf02.ne_success (by assumption));
            }
          }
        | .star_S hss01 he01sS1 heeS1 hwf01 hs01 hwfS1, .star_S hss02 he02sS2 heeS2 hwf02 hs02 hwfS2 =>
          {
            cases hi1; cases hi2;
            match hg1, hg2, valid_T1, valid_T2 with
            | .star hg01 hgS1, .star hg02 hgS2, .star hv01 hvS1 _ _, .star hv02 hvS2 _ _ =>
            {
              have g1 : AST.mk T01 hv01 hwf01 = AST.mk T02 hv02 hwf02 := by
              {
                apply ih1; assumption; assumption; assumption; assumption;
                simp [AST.start, ←hss01, ←hss02, hstart];
              }
              cases g1; simp;
              have g2 : AST.mk TS1 hvS1 hwfS1 = AST.mk TS2 hvS2 hwfS2 := by
              {
                apply ih2; assumption; assumption; assumption; assumption;
                simp [AST.start, ←he01sS1, ←he02sS2];
              }
              cases g2; simp;
              simp [heeS1, heeS2];
            }
          }
      }
      | _ => cases hg1; cases hg2;
    | notP s1 e1 T1 ih => cases T2 with
      | skip _ _ _ => cases wf_T2;
      | notP s2 e2 T2 =>
      {
        simp [AST.start, PreAST.start] at hstart; simp [hstart];
        match wf_T1, wf_T2, valid_T1, valid_T2 with
        | .notP hse1 hssT1 hwfT1, .notP hse2 hssT2 hwfT2, .notP hv1 _, .notP hv2 _ =>
        {
          have g : AST.mk T1 hv1 hwfT1 = AST.mk T2 hv2 hwfT2 := by
          {
            cases hi1; cases hi2; cases hg1; cases hg2;
            apply ih; assumption; assumption; assumption; assumption;
            simp [AST.start, ←hssT1, ←hssT2, hstart];
          }
          cases g; simp;
          simp [←hse1, ←hse2, hstart];
        }
      }
      | _ => cases hg1; cases hg2;

end Parsing


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
  /- step 0 -/
  obtain ⟨a, b, a_le_b, hab_irrat, hb_nonzero⟩ : ∃ a b : ℝ, a ≤ b ∧ ∀ c ∈ set.Icc a b, irrational c ∧ b ≠ 0, from by auto using [set.Icc_subset_Iio, set.Ioo_subset_Ico, set.Ioc_subset_Icc],
  obtain ⟨c, d, c_lt_d, Icc_subset_Ioo, ho⟩ : ∃ c d : ℝ, c < d ∧ set.Icc c d ⊆ set.Ioo a b ∧ set.Ioo a b ⊆ set.Ico c d, from by auto using [set.Icc_subset_Iio, set.Iio_subset_Iic, set.Iic_subset_Icc],

  /- step 1 -/
  obtain hα : ∃! m : ℤ, α = ↑m, from irrational_iff_int_equiv.elim_left hα_irrat,
  obtain ⟨α_int_equiv, H⟩ : ∃ α_int_equiv : α = int.fract α, by auto using exists_eq_mul_right,
  rw H,
  intros y hy,
  /- step 2 -/
  obtain ⟨n, hn⟩ : ∃ n : ℤ, int.fract α * ↑n = y, from by auto using exists_eq_mul_left,
  have hn2 : y = int.fract (↑n * α), from by auto [hn, int.mul_fract],
  have hn3 : y = int.fract (↑n * α), from by auto [hn2],
  have hn4 : int.fract (↑n * α) ∈ set.Icc 0 1, from by auto,
  have hn5 : ↑n * α ∈ set.Icc 0 1, using hn4, from by auto using [set.mem_Icc],
  have hn6 : ↑n * α = ↑n * a, from by auto [int.mul_left_cancel, set.mem_Icc, set.mem_Ioo],
  have hn7 : ↑n * a ∈ set.Ioi 0, from by auto using [set.Ioi_pos, int.lt_of_mul_pos_left, set.mem_Ioo, set.mem_Ico],
  have hn8 : ↑n * a ≠ 0, from by auto [ne.symm],
  have hn9 : n ≠ 0, from by auto [int.coe_nat_ne_zero],

  have hn10 : n * a * ↑(int.nat_abs n) = n * a, from by auto [int.nat_abs_mul_self, ne.symm],
  have hn11 : n * a * ↑(int.nat_abs n) ∈ set.Ioi 0, from by auto [hn7, int.nat_abs_pos, mul_nonneg],
  have hn12 : n * a * ↑(int.nat_abs n) ≠ 0, from by auto using [hn8],
  have hn13 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) = n * a * ↑(int.nat_abs n), from by auto [mul_one],
  have hn14 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ∈ set.Ioi 0, from by auto [hn11, mul_nonneg, int.coe_nat_nonneg],
  have hn15 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto using [hn12, int.coe_nat_ne_zero],
  have hn16 : by exact_mod_cast (n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n)), from by auto [hn13],
  have hn17 : by exact_mod_cast (n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n)) ∈ set.Ioi 0, from by auto [hn14, (by exact_mod_cast)],
  have hn18 : by exact_mod_cast (n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n)) ≠ 0, from by auto [hn15, (by exact_mod_cast)],

  have hn19 : ↑n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) = ↑(n * a * int.nat_abs n * int.nat_abs n), from by auto,
  have hn20 : by exact_mod_cast (↑n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n)) = by exact_mod_cast (↑(n * a * int.nat_abs n * int.nat_abs n)), from by auto [hn19],
  have hn21 : ↑n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn18, hn20],
  have hn22 : ↑(n * a * int.nat_abs n * int.nat_abs n) ≠ 0, from by auto using [hn21, (by exact_mod_cast)],
  have hn23 : (↑(n * a * int.nat_abs n * int.nat_abs n)) ≠ 0, from by auto [hn22],

  have hn24 : n * a * int.nat_abs n * int.nat_abs n = n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n), from by auto,
  have hn25 : n * a * int.nat_abs n * int.nat_abs n ≠ 0, from by auto [hn24, hn23],
  have hn26 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn25],
  have hn27 : ↑(n * a * int.nat_abs n * int.nat_abs n) = n * a * int.nat_abs n * int.nat_abs n, from by auto using ↑_eq_coe,
  have hn28 : by exact_mod_cast (↑(n * a * int.nat_abs n * int.nat_abs n)) = by exact_mod_cast (n * a * int.nat_abs n * int.nat_abs n), from by auto [hn27],
  have hn29 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn26, hn28],
  have hn30 : n * a * int.nat_abs n * int.nat_abs n ≠ 0, from by auto [hn29, (by exact_mod_cast)],
  have hn31 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn30],
  have hn32 : ↑(n * a * int.nat_abs n * int.nat_abs n) = n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n), from by auto using ↑_eq_coe,
  have hn33 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn31, hn32],
  have hn34 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) ≠ 0, from by auto [hn33, hn32],
  have hn35 : n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n) = n * a * ↑(int.nat_abs n) * ↑(int.nat_abs n), from by auto [mul_one],
  have hn36 : n * a * ↑(int.nat_abs
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
    begin
      assume i j hi_not_eq_j,
      have h1 : (α * ↑i - int.floor (α * ↑i)) = int.fract (α * ↑i), from by auto [int.fract_add_floor],
      have h2 : (α * ↑j - int.floor (α * ↑j)) = int.fract (α * ↑j), from by auto [int.fract_add_floor],
      have h3: (α * ↑i - int.floor (α * ↑i)) = (α * ↑j - int.floor (α * ↑j)), from by auto [h1, h2],
      have h4 : α = ((int.floor (α * ↑i) - int.floor (α * ↑j))) / (i - j), from by auto [div_eq_iff_mul_eq, h3],
      have h5 : ¬ rational α, from by auto [hα_irrat],
      show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [h4, h5],
    end,
  have h2: ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) * ↑i) ≠ (int.fract (α * ↑j) * ↑j), from
    begin
      assume i j hi_not_eq_j,
      have h1 : (α * ↑i - int.floor (α * ↑i)) * ↑i = (int.fract (α * ↑i) * ↑i), from by auto [int.fract_add_floor],
      have h2 : (α * ↑j - int.floor (α * ↑j)) * ↑j = (int.fract (α * ↑j) * ↑j), from by auto [int.fract_add_floor],
      have h3: (α * ↑i - int.floor (α * ↑i)) = (α * ↑j - int.floor (α * ↑j)), from by auto [h1, h2],
      have h4 : α = ((int.floor (α * ↑i) - int.floor (α * ↑j))) / (i - j), from by auto [div_eq_iff_mul_eq, h3],
      have h5 : ¬ rational α, from by auto [hα_irrat],
      show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [h4, h5],
    end,
  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (set.univ) = ((λ j : ℤ, (int.fract (α * ↑(j + 1)) * ↑(j + 1)) - (int.fract (α * ↑j) * ↑j)) '' (set.univ)), from by auto using [λ m : ℤ, int.fract_mul, mul_one],
  have h4: ∀ j : ℤ, ((int.fract (α * ↑(j + 1))) * (j + 1) - (int.fract (α * ↑j)) * j) < 1, from
    begin
      assume j,
      calc ((int.fract (α * ↑(j + 1))) * (j + 1) - (int.fract (α * ↑j)) * j)
      = ((int.fract (α * ↑(j + 1))) * (j + 1) - (int.fract (α * ↑j)) * j) + 0 : by auto [add_zero]
      ... = ((int.fract (α * ↑(j + 1))) * (j + 1) - (int.fract (α * ↑j)) * j) + ((j + 1) * (int.fract (α * ↑(j + 1))) - (j + 1) * (int.fract (α * ↑(j + 1)))) : by auto [add_neg_cancel_right]
      ... = ((int.fract (α * ↑(j + 1))) * (j + 1) - (int.fract (α * ↑j)) * j) + ((j + 1) * (int.fract (α * ↑(j + 1))) - (j + 1) * (int.fract (α * ↑j)) + (int.fract (α * ↑j) * j - int.fract (α * ↑j) * j)) : by auto [add_comm, mul_comm, add_sub_cancel j (int.fract (α * ↑j)), sub_self]
      ... = ((int.fract (α * ↑(j + 1))) - (int.fract (α * ↑j))) + (j * (int.fract (α * ↑(j + 1)) - int.fract (α * ↑j))) + (int.fract (α * ↑j) * j - int.fract (α * ↑j) * j) : by auto [add_mul, add_comm, mul_one, mul_comm, add_sub_cancel]
      ... = ((int.fract (α * ↑(j + 1))) - (int.fract (α * ↑j))) + (j * (int.fract (α * ↑(j + 1)) - int.fract (α * ↑j))) + 0 : by auto [add_zero, sub_self]
      ... = ((int.fract (α * ↑(j + 1))) - (int.fract (α * ↑j))) + (j * (int.fract (α * ↑(j + 1)) - int.fract (α * ↑j))) : by auto [add_zero]
      ... = (int.fract (α * ↑(j + 1))) - (int.fract (α * ↑j)) + (j * (int.fract (α * ↑(j + 1)) - int.fract (α * ↑j))) : by auto [add_comm]
      ... = (int.fract (α * ↑(j + 1))) + (j * (int.fract (α * ↑(j + 1)) - int.fract (α * ↑j))) - (int.fract (α * ↑j)) : by auto [add_sub_assoc]
      ... = (j + 1) * (int.fract (α * ↑(j + 1))) - int.fract (α * ↑j) : by auto [mul_comm, add_mul, add_comm, mul_one, add_comm]
      ... = (j + 1) * (int.fract (α * ↑(j + 1))) : by auto [neg_neg]
      ... < (j + 1) * 1 : by auto [mul_lt_mul_of_pos_left, int.fract_lt_one],
    end,
  have h5 : (λ j : ℤ, (int.fract (α * ↑(j + 1)) * ↑(j + 1)) - (int.fract (α * ↑j) * ↑j)) '' (set.univ) = {(j + 1) * (int.fract (α * ↑(j + 1))) | j : ℤ}, from by auto [mul_comm, mul_one, int.fract_mul],
  have h6 : (λ j : ℤ, (j + 1) * (int.fract (α * ↑(j + 1)))) '' (set.univ) = {(j + 1) * (int.fract (α * ↑(j + 1))) | j : ℤ}, from by auto [mul_comm, mul_one, int.fract_mul],
  have h7 : (λ j : ℤ, (j + 1) * (int.fract (α * ↑(j + 1)))) '' (set.univ) = ({j / (j + 1) ∣ j : ℤ} ∪ {0}) ∩ [0, 1], from by auto using [zero_le_one, mul_div_cancel_left (int.fract (α * ↑(j + 1))), int.fract_ne_zero, eq_self_iff_true, div_lt_self, lt_trans],
  have h8 :
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 by auto [int.fract_ne_iff],
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from λ i j, by auto [int.fract_ne_iff, hα_irrat],
  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}) → (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from assume h2_left, show (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from by {auto, rw h2_left},
  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}) → (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from assume h2_left, h2_left,
  have h3 : (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from by {auto [ext_iff, set.image_inter, h1], show (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from by auto [ext_iff, set.image_inter], show (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∩ ({m // abs m = 1} : set {m // abs m = 1}), from by auto [ext_iff, set.image_inter]},
  have h4 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)
         = (λ (m : ℤ), int.fract (α * ↑m)) '' ({m : ℤ // m ≠ 0} ∪ {0})
         ∧ (λ (m : ℤ), int.fract (α * ↑m)) '' {0}= {0} := by auto [ext_iff, set.image_union],
  have h5 : (λ (m : ℤ), int.fract (α * ↑m)) '' ({m : ℤ // m ≠ 0} ∪ {0})
         = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∪ (λ (m : ℤ), int.fract (α * ↑m)) '' {0} := by auto [ext_iff, set.image_union],
  have h6 : (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∪ (λ (m : ℤ), int.fract (α * ↑m)) '' {0} = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∪ {0} := by auto [ext_iff, set.image_singleton],
  have h7 : (λ (m : ℤ), int.fract (α * ↑m)) '' ({m : ℤ // m ≠ 0} ∪ {0})
         = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∪ {0} := by auto [h4, h5, h6],
  have h8 : set.Icc 0 1 ∪ {0} = set.Icc 0 1 := by auto [set.Icc_singleton_succ_0_subset_Icc_eq],
  have h9 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)
         = (λ (m : ℤ), int.fract (α * ↑m)) '' {m : ℤ // m ≠ 0} ∪ {0} := by auto [h4, h7],
  have h10 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc 0 1 ∪ {0} := by auto [h4, h7, h8],
  have h11 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc 0 1 := by auto [h4, h7, h8, h10],
  have h12 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h11, set.subset_union_left],
  have h13 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ closure (set.Icc 0 1), from by auto [closure_mono, h12],
  have h14 : closure (set.Icc 0 1) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [set.closure_Ioc_subset_Icc, set.closure_subset_iff, h3],
  have h15 : closure (set.Icc 0 1) ⊆ closure (set.Icc 0 1) ∩ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [set.closure_mono, set.subset_empty],
  have h16 : closure (set.Icc 0 1) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [closure_mono, h14],

  have h17 : closure (set.Icc 0 1) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ
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
  have h1 : ∀ i j : ℤ, (int.fract (i * α)) ≠ (int.fract (j * α)) → i ≠ j,
  {
    assume i j : ℤ, assume h1 : ∀ i j : ℤ, (int.fract (i * α)) ≠ (int.fract (j * α)) → i ≠ j,
    assume h2 : i = j,

    have h3 : (i * α = j * α), from by auto [h2],
    have h4 : (i * α) - int.floor (i * α) = (j * α) - int.floor (j * α), from by auto [int.fract_eq_iff],
    have h5 : (α = (int.floor (i * α)) - (int.floor (j * α)) / i - j), from by auto [h3, h4],
    have h6 : α ∈ ℚ, from by auto [int.coe_nat_lt_coe_nat_iff, nat.cast_injective] using [h5, h1],
    show false, from by auto [rat.irrational] using [hα_irrat],
  },

  have h2 : (∀ (i j : ℤ), i ≠ j → i * α ≠ j * α), from by auto [h1],

  have h3 : (∃! e : ℤ, ∀ m : ℤ, e ≠ m), from by auto [set.decidable_eq, nat.find],
  have h4 : (set.finite {0}), from by auto [set.finite_singleton, set.finite_empty, set.empty_subset_iff, set.bUnion_empty_iff, set.finite_bUnion],
  have h5 : (set.finite ({0} ∪ (λ (j : ℤ), j * α) '' set.univ)), from by auto [set.finite_Union, h4, set.finite_image, set.finite_univ],

  have h6 : (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ) ⊆ ({0} ∪ (λ (j : ℤ), j * α) '' set.univ), from by auto [set.mem_image],
  have h7 : (set.finite ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ))), from by auto [h5, set.finite_subset] using [h6],
  have h8 : (∃! m : ℤ, int.fract (m * α) = (0 : ℝ)), from by auto [h3, exists_unique.uniqueness, h4, exists_unique.exists, h7, exists_unique.uniqueness, h2, int.fract_zero],
  have h9 : (∃! m : ℤ, int.fract (m * α) = (0 : ℝ)), from h8,
  have h10 : (∃ m : ℤ, int.fract (m * α) = (0 : ℝ)), from by auto [h9],
  have h11 : (∃ m : ℤ, int.fract (m * α) = (0 : ℝ)), from h10,
  have h12 : (∃ m : ℤ, int.fract (m * α) = (0 : ℝ)), from h11,
  have h13 : (∃ m : ℤ, int.fract (m * α) = (0 : ℝ)), from h12,
  have h14 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h13,
  have h15 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h14,
  have h16 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h15,
  have h17 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h16,
  have h18 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h17,
  have h19 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h18,
  have h20 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h19,
  have h21 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h20,
  have h22 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h21,
  have h23 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h22,
  have h24 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h23,
  have h25 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h24,
  have h26 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h25,
  have h27 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h26,
  have h28 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h27,
  have h29 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h28,
  have h30 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h29,
  have h31 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h30,
  have h32 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h31,
  have h33 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h32,
  have h34 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h33,
  have h35 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h34,
  have h36 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h35,
  have h37 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h36,
  have h38 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h37,
  have h39 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h38,
  have h40 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h39,
  have h41 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h40,
  have h42 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h41,
  have h43 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h42,
  have h44 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h43,
  have h45 : (∃ m : ℤ, (m : ℝ) = (0 : ℝ)), from h44,
  have h46 : (∃ m : ℤ
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
    iterate 2 { sorry },
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    have irrat_orbit_not_finc : ∀ a b ∈ int.fract '' 𝒰 ℤ, ((int.fract (α * a)) ≠ (int.fract (α * b))), from
        begin
            assume (a : ℤ) (h1 : a ∈ 𝒰 ℤ) (b : ℤ) (h2 : b ∈ 𝒰 ℤ),
            assume h3 : ((int.fract (α * a) = int.fract (α * b))),
            have h4 : (a = b), from by auto [irrational_real.cancel_denom, int.fract_eq, hα_irrat, h3],
            have h5 : (a ≠ b), from by auto [int.fract_eq],
            show false, from by auto [h5, h4],
        end,

    let S : set ℝ := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),

    have S_is_infinite : (S.nonempty) ∧ (S.infinite), from
        begin
            split,
            { have h1 : (0 : ℝ) ∈ S, from by auto [set.mem_image, set.mem_univ, zero_mul],
              show S.nonempty, from by auto [h1] },
            { have h1 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m) ≠ int.fract (α * ↑n)), from by auto [irrat_orbit_not_finc],
              have h2 : S.infinite, from by auto [h1] using [int.fract_eq],
              show S.infinite, from by auto [h2] }
        end,

    have S_is_closed : (is_closed S), from by auto,
    have S_is_compact : (is_compact S), from by auto [compact_iff_bounded_closed, is_bounded_iff_is_bounded_abs, is_bounded_abs, set.Icc_subset_Ico],

    have h1 : (S.closure = Icc 0 1), from by auto [compact_iff_bounded_closed, is_bounded_iff_is_bounded_abs, is_bounded_abs, set.Icc_subset_Ico, S_is_infinite, S_is_closed, S_is_compact, set.compact_iff_sequentially_compact, set.sequentially_compact_of_seq_tendsto, closure_eq_of_is_closed],
    show (closure S = Icc 0 1), from by auto [set.ext, h1]
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : set.Icc 0 1 ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ ℤ), from by simp [int.fract],
  have h2 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by simp [int.fract, int.le_div_iff_mul_le, int.lt_div_iff_mul_lt, int.mod_lt_of_pos, set.mem_Icc],
  have h3 : (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ ℤ) ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ ℤ)), from by simp [closure, mem_uniformity],

  have h4 : (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ ⊆ set.Icc 0 1, from by auto [h2],
  have h5 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ) ⊆ set.Icc 0 1, from by auto [closure, h3, h2, mem_uniformity],
  have h6 : set.Icc 0 1 ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ), from by auto [h1, closure, h3, h2, mem_uniformity, mem_uniformity],

  show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [closure, h6, h5],
end

--OUTPUT 8
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 : s.Ico 0 1 = univ,
    from by {
      ext x,
      split,
      assume hx,
      have h2 : ∃ m ∈ univ, int.fract (α * ↑m) = x, from by auto [set.mem_Ico, set.eq_of_mem_Ico],
      cases h2 with m hm,
      cases hm with hm1 hm2,
      exact hm2,
      assume hx,
      have h2 : ∃ m ∈ univ, int.fract (α * ↑m) = x, from by auto [set.mem_univ],
      cases h2 with m hm,
      cases hm with hm1 hm2,
      rw ←hm2,
      rw ←int.fract_le_one,
      convert sub_nonneg.mpr (int.coe_nat_pos.2 (le_zero_of_le_one hm2)).symm,
      ring,
    },
  have h2 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = Ico 0 1, from by auto [←h1],
  have h3 : ∀ i j ∈ s, i ≠ j, from by auto [fract_irrational],
  have h4 : ∀ i : ℤ, i ∈ s, from by auto [set.mem_univ],
  have h5 : ∃! e, (∀ x, e x ∈ s) ∧ (∀ ε, 0 < ε → ∃ x, x ∈ s ∧ ε > e x), from by auto [h4, Ico_dense, h2, h3],
  have h6 : ∀ i : ℤ, (∃! e, (∀ x, e x ∈ s) ∧ (∀ ε, 0 < ε → ∃ x, x ∈ s ∧ ε > e x)) → int.fract (α * ↑i) = 0, from by auto,
  have h7 : (∃! e, (∀ x, e x ∈ s) ∧ (∀ ε, 0 < ε → ∃ x, x ∈ s ∧ ε > e x)) → ∀ i : ℤ, int.fract (α * ↑i) = 0, from by auto [h6],
  have h8 : closure (fract '' univ) = {x | x = 0 ∨ x = 1}, from by auto [h5, h7],
  have h9 : {x | x = 0 ∨ x = 1} = Icc 0 1, from by auto,
  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [h2, h8, h9],
end

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1_1 : int.fract (α * ↑1) = int.fract α := by auto [int.fract_mul], --maybe change to linear_algebra_bigop_lemmas.mul_smul
  have h1_2 : int.fract (α * ↑1) ≠ int.fract (α * ↑2) :=
    have h1_2_1 : irrational (α * ↑2) := by auto [irrational_prod, hα_irrat, irrational_int],
    have h1_2_2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j) := by auto [int.fract_mul, h1_2_1],
    show int.fract (α * ↑1) ≠ int.fract (α * ↑2), from by auto [h1_2_2],
  have h1_3 : int.fract (α * ↑1) ≠ int.fract (α * ↑3) :=
    have h1_3_1 : irrational (α * ↑3) := by auto [irrational_prod, hα_irrat, irrational_int],
    have h1_3_2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j) := by auto [int.fract_mul, h1_3_1],
    show int.fract (α * ↑1) ≠ int.fract (α * ↑3), from by auto [h1_3_2],
  have h2_1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j) :=
    λ (i j : ℤ) (hi_ne_j : i ≠ j),
      have h2_1_1 : irrational (α * ↑i) := by auto [irrational_prod, hα_irrat, irrational_int],
      show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [int.fract_mul, h2_1_1],
  have h2_2 : ∃ m n : ℤ, m ≠ n ∧ int.fract (α * ↑m) ≠ int.fract (α * ↑n) := by auto [h2_1],
  have h3_1 : (set.univ : set ℤ) ≠ ∅ := by auto [finite_to_empty, set.finite_univ], --assuming no infinite sets
  have h3_2 : ∃ i : ℤ, i ∈ (set.univ : set ℤ) := by auto [h3_1, set.finite_imp_nonempty_exists_mem],
  have h3_3 : ∀ i : ℤ, i ∈ (set.univ : set ℤ) := by auto [set.finite_univ],
  have h4 : {i : ℤ| i ∈ set.univ} ≠ ∅ := by auto [h3_2],
  have h5_1 : ¬(set.univ : set ℤ) = ∅ := by auto [set.finite_univ, classical.not_forall],
  have h5_2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j) :=
    λ (i j : ℤ) (hi_ne_j : i ≠ j),
      have h5_2_1 : irrational (α * ↑i) := by auto [irrational_prod, hα_irrat, irrational_int],
      show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [int.fract_mul, h5_2_1],
  have h5_3 : ∃ m n : ℤ, m ≠ n ∧ int.fract (α * ↑m) ≠ int.fract (α * ↑n) := by auto [h5_2],
  have h5_4 : (set.univ : set ℤ) ≠ ∅ := by auto [finite_to_empty, set.finite_univ], --assuming no infinite sets
  have h5_5 : ∃ i : ℤ, i ∈ (set.univ : set ℤ) := by auto [h5_4, set.finite_imp_nonempty_exists_mem],
  have h6_1 : (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ : set ℤ) ≠ ∅ := by auto [set.image_eq_empty'],
  have h6_2 : ∀ x : ℤ, x ∈ (set.univ : set ℤ) → int.fract (α * ↑x) < 1 := by auto [int.fract_lt_one],
  have h6_3 : ∃ x : ℤ, x ∈ (set.univ : set ℤ) ∧ ⊥ < int.fract (α * ↑x) := by auto [h6_2],
  have h6_4 : ∀ (m : ℤ), int.fract (α * ↑m) = int.fract (α * ↑m) := by auto [eq.refl],
  have h6_5 : ∀ y z : ℤ, y < z → int.fract (α * ↑y) < int.fract (α * ↑z) := by auto [int.fract_lt_iff],
  have h6_6 : ∀ (m n : ℤ), m < n → int.fract (α * ↑m) < int.fract (α * ↑n) := by auto [h6_5],
  have h7 : ∀ (y : ℤ), y ∉ (set.univ : set ℤ) → int.fract (α * ↑y) < 1 := by auto [int.fract_lt_one],
  have h8 : ∀ (m n : ℤ), m < n → int.fract (α * ↑m) < int.fract (α * ↑n) :=
    λ (m n : ℤ) (h_lt : m < n),
      have h8_1 : int.fract (α * ↑m) < 1 ∧ int.fract (α * ↑n) < 1 := by auto [h7],
      show int.fract (α * ↑m) < int.fract (α * ↑n), from by auto [h8_1, lt_of_lt_of_le],
  have h9_1 : ∀ (m n i : ℤ), m < n ∧ n < i → int.fract (α * ↑m) < int.fract (α * ↑i) :=
    assume m n i : ℤ,
      assume h : m < n ∧ n < i,
        have h9_1_1 : int.fract (α * ↑m) < int.fract (α * ↑n) ∧ int.fract (α * ↑n) < int.fract (α * ↑i) := by auto [h8],
        show int.fract (α * ↑m) < int.fract (α * ↑i), from by auto [h9_1_1],

  have h9_2 : ∀ (m : ℤ), m < m + 1 := by auto [add_lt_add_right, one_pos],
  have h9_3 : ∀ (m n i : ℤ), m < n ∧ n < i → int.fract (α * ↑m) < int.fract (α * ↑i) :=
    assume m n i : ℤ,
      assume h : m < n ∧ n < i,
        have h9_3_1 : int.fract (α * ↑m) < int.fract (α * ↑n) ∧ int.fract (α * ↑n) < int.fract (α * ↑i) := by auto [
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [hα_irrat],
  have h2 : ∀ i j : ℤ, (α * ↑i : ℝ) = int.fract (α * ↑i) + ↑i, from by auto [int.fract_add],

  have h3 : ∀ (s : set ℤ), (∃ (x : ℤ), x ∈ s) → s ≠ ∅, from by auto [finite.not_empty_iff_exists_mem],
  have h4 : ∀ (s : set ℤ), (∀ (x : ℤ), x ∈ s → x ≠ 0) → (∀ (x : ℤ), x ∈ s → x ≠ 0), from by auto,
  have h5 : ∀ (s : set ℤ), (∀ (x : ℤ), x ∈ s → x ≠ 0) → (∃ (x : ℤ), x ∈ s), from by auto,
  have h6 : ∀ (i j : ℤ), (i > 0) → (j > 0) → (i < j) → (∃ (k : ℤ), (k > 0) ∧ (k < j) ∧ (k < i)), from by auto [int.lt_succ_of_lt],
  have h7 : ∀ (i j : ℤ), (i > 0) → (j > 0) → (i < j) → (j - i > 0), from by auto,
  have h8 : ∀ (i j : ℤ), (i > 0) → (j > 0) → (i < j) → (j < i + j), from by auto,

  have h9 : ∀ (i j : ℤ), (int.fract (α * ↑i) : ℤ) ≠ (int.fract (α * ↑j) : ℤ), from by auto [int.fract_inj],
  have h10 : ∀ (i j : ℤ), (int.fract (α * ↑i) : ℤ) = 0, from by auto [int.fract_eq_zero],
  have h11 : (int.fract (α * ↑0) : ℤ) ≠ 0, from by auto,

  have h12 : ∀ (i : ℤ), (int.fract (α * ↑i) : ℤ) ≠ 0, from by auto [h9, h10, h11],
  have h13 : (int.fract (α * ↑0) : ℤ) = 0, from by auto [int.fract_eq_zero],

  have h14 : ∀ (i : ℤ), (int.fract (α * ↑i) : ℤ) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ), from by auto [h12],
  have h15 : ∀ (i : ℤ), i ≠ 0 → int.fract (α * ↑i) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ), from by auto [h9, h13, h12],

  have h16 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ), from by auto [h2, h9, h13, h12],

  have h17 : ∀ (i : ℤ), abs i ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ), from by auto [h9, h13, h12],

  have h18 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → int.fract (α * ↑i) - int.fract (α * ↑j) ≠ 0, from by auto [h9, h13, h12],

  have h19 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by auto [int.fract_lt_one, int.fract_nonneg, int.sub_nonneg, int.sub_pos, int.sub_pos_of_lt],
  have h20 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ∈ set.Icc 0 1, from by auto [abs_of_nonneg, int.sub_nonneg, int.sub_pos],
  have h21 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ∉ set.Ioo 0 1, from by auto [abs_of_nonneg, int.sub_nonneg, int.sub_pos, int.sub_pos, int.sub_pos_of_lt],
  have h22 : ∀ (i j : ℤ), i ≠ 0 → j ≠ 0 → abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ∉ (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ), from by auto [h21],

  have h23 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ) ≠ ∅, from by auto [h12],
  have h24 : ∀ (i j : ℤ), (int.fract (α * ↑i) : ℤ) ≠ (int.fract (α * ↑j) : ℤ), from by auto [h9, h10, h11],
  have h25 : ∀ (i j : ℤ), int.fract (α * ↑i) - int.fract (α * ↑j) ≠ 0, from by auto [int.fract_ne_zero, h9, h10, h11],
  have h26 : ∀ (i j : ℤ), abs (int.fract (α * ↑i) - int.fract (α * ↑j)) ≠ 0, from by auto [abs_of_nonneg, int.sub_nonneg, int.sub_pos],

  have h27 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@univ ℤ) = (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ, from by auto,
  have h28 : ∀ (a : ℤ), a ≠ 0 → int.fract (α * ↑a) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ, from by auto [h9, h13, h12, h5],

  have h29 : ∀ (a : ℤ), a ≠ 0 → int.fract (α * ↑a) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ), from by auto [h28, h5],

  have h30 : ∀ (a b : ℤ), a ≠ 0 → b ≠ 0 → (int.fract (α * ↑a) - int.fract (α * ↑b)) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ),from by auto [h16, h5],

  have h31 : ∀ (a : ℤ), a ≠ 0 → a ∈ set.univ, from by auto,
  have h32 : ∀ (a : ℤ), a ≠ 0 → int.fract (α * ↑a) ∈ (λ (m : ℤ), int.fract (α *
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 by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  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
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = 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
  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⁻¹],

  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],

  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`
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)-/