/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin, Patrick Massot

! This file was ported from Lean 3 source module algebra.order.with_zero
! leanprover-community/mathlib commit 655994e298904d7e5bbd1e18c95defd7b543eb94
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Equiv.Units.GroupWithZero
import Mathlib.Algebra.GroupWithZero.InjSurj
import Mathlib.Algebra.Order.Group.Units
import Mathlib.Algebra.Order.Monoid.Basic
import Mathlib.Algebra.Order.Monoid.WithZero.Defs
import Mathlib.Algebra.Order.Group.Instances
import Mathlib.Algebra.Order.Monoid.TypeTags

/-!
# Linearly ordered commutative groups and monoids with a zero element adjoined

This file sets up a special class of linearly ordered commutative monoids
that show up as the target of so-called “valuations” in algebraic number theory.

Usually, in the informal literature, these objects are constructed
by taking a linearly ordered commutative group Γ and formally adjoining a zero element: Γ ∪ {0}.

The disadvantage is that a type such as `nnreal` is not of that form,
whereas it is a very common target for valuations.
The solutions is to use a typeclass, and that is exactly what we do in this file.

Note that to avoid issues with import cycles, `LinearOrderedCommMonoidWithZero` is defined
in another file. However, the lemmas about it are stated here.
-/

/-- A linearly ordered commutative group with a zero element. -/
class LinearOrderedCommGroupWithZero (α : Type _) extends LinearOrderedCommMonoidWithZero α,
  CommGroupWithZero α
#align linear_ordered_comm_group_with_zero LinearOrderedCommGroupWithZero

variable {α : Type _}

variable {a b c d x y z : α}

instance [LinearOrderedAddCommMonoidWithTop α] :
    LinearOrderedCommMonoidWithZero (Multiplicative αᵒᵈ) :=
  { Multiplicative.orderedCommMonoid, Multiplicative.linearOrder with
    zero := Multiplicative.ofAdd (⊤ : α)
    zero_mul := @top_add _ (_)
    -- Porting note:  Here and elsewhere in the file, just `zero_mul` worked in Lean 3.  See
    -- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/Type.20synonyms
    mul_zero := @add_top _ (_)
    zero_le_one := (le_top : (0 : α) ≤ ⊤) }
#align multiplicative.linear_ordered_comm_monoid_with_zero instLinearOrderedCommMonoidWithZeroMultiplicativeOrderDual

instance [LinearOrderedAddCommGroupWithTop α] :
    LinearOrderedCommGroupWithZero (Multiplicative αᵒᵈ) :=
  { Multiplicative.divInvMonoid, instLinearOrderedCommMonoidWithZeroMultiplicativeOrderDual,
    instNontrivialMultiplicative with
    inv_zero := @LinearOrderedAddCommGroupWithTop.neg_top _ (_)
    mul_inv_cancel := @LinearOrderedAddCommGroupWithTop.add_neg_cancel _ (_) }

instance [LinearOrderedCommMonoid α] : LinearOrderedCommMonoidWithZero (WithZero α) :=
  { WithZero.linearOrder, WithZero.commMonoidWithZero with
    mul_le_mul_left := fun _ _ ↦ mul_le_mul_left', zero_le_one := WithZero.zero_le _ }
#align with_zero.linear_ordered_comm_monoid_with_zero instLinearOrderedCommMonoidWithZeroWithZero

instance [LinearOrderedCommGroup α] : LinearOrderedCommGroupWithZero (WithZero α) :=
  { instLinearOrderedCommMonoidWithZeroWithZero, WithZero.commGroupWithZero with }

section LinearOrderedCommMonoid

variable [LinearOrderedCommMonoidWithZero α]

/-
The following facts are true more generally in a (linearly) ordered commutative monoid.
-/
/-- Pullback a `LinearOrderedCommMonoidWithZero` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def Function.Injective.linearOrderedCommMonoidWithZero {β : Type _} [Zero β] [One β] [Mul β]
    [Pow β ℕ] [Sup β] [Inf β] (f : β → α) (hf : Function.Injective f) (zero : f 0 = 0)
    (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ (x) (n : ℕ), f (x ^ n) = f x ^ n)
    (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) :
    LinearOrderedCommMonoidWithZero β :=
  { LinearOrder.lift f hf hsup hinf, hf.orderedCommMonoid f one mul npow,
    hf.commMonoidWithZero f zero one mul npow with
    zero_le_one :=
      show f 0 ≤ f 1 by simp only [zero, one, LinearOrderedCommMonoidWithZero.zero_le_one] }
#align function.injective.linear_ordered_comm_monoid_with_zero Function.Injective.linearOrderedCommMonoidWithZero

@[simp]
theorem zero_le' : 0 ≤ a := by simpa only [mul_zero, mul_one] using mul_le_mul_left' zero_le_one a
#align zero_le' zero_le'

@[simp]
theorem not_lt_zero' : ¬a < 0 :=
  not_lt_of_le zero_le'
#align not_lt_zero' not_lt_zero'

@[simp]
theorem le_zero_iff : a ≤ 0 ↔ a = 0 :=
  ⟨fun h ↦ le_antisymm h zero_le', fun h ↦ h ▸ le_rfl⟩
#align le_zero_iff le_zero_iff

theorem zero_lt_iff : 0 < a ↔ a ≠ 0 :=
  ⟨ne_of_gt, fun h ↦ lt_of_le_of_ne zero_le' h.symm⟩
#align zero_lt_iff zero_lt_iff

theorem ne_zero_of_lt (h : b < a) : a ≠ 0 := fun h1 ↦ not_lt_zero' <| show b < 0 from h1 ▸ h
#align ne_zero_of_lt ne_zero_of_lt

instance : LinearOrderedAddCommMonoidWithTop (Additive αᵒᵈ) :=
  { Additive.orderedAddCommMonoid, Additive.linearOrder with
    top := (0 : α)
    top_add' := fun a ↦ zero_mul (Additive.toMul a)
    le_top := fun _ ↦ zero_le' }
#align additive.linear_ordered_add_comm_monoid_with_top instLinearOrderedAddCommMonoidWithTopAdditiveOrderDual

end LinearOrderedCommMonoid

variable [LinearOrderedCommGroupWithZero α]

-- TODO: Do we really need the following two?
/-- Alias of `mul_le_one'` for unification. -/
theorem mul_le_one₀ (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 :=
  mul_le_one' ha hb
#align mul_le_one₀ mul_le_one₀

/-- Alias of `one_le_mul'` for unification. -/
theorem one_le_mul₀ (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b :=
  one_le_mul ha hb
#align one_le_mul₀ one_le_mul₀

theorem le_of_le_mul_right (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b := by
  simpa only [mul_inv_cancel_right₀ h] using mul_le_mul_right' hab c⁻¹
#align le_of_le_mul_right le_of_le_mul_right

theorem le_mul_inv_of_mul_le (h : c ≠ 0) (hab : a * c ≤ b) : a ≤ b * c⁻¹ :=
  le_of_le_mul_right h (by simpa [h] using hab)
#align le_mul_inv_of_mul_le le_mul_inv_of_mul_le

theorem mul_inv_le_of_le_mul (hab : a ≤ b * c) : a * c⁻¹ ≤ b := by
  by_cases h : c = 0
  · simp [h]
  · exact le_of_le_mul_right h (by simpa [h] using hab)
#align mul_inv_le_of_le_mul mul_inv_le_of_le_mul

theorem inv_le_one₀ (ha : a ≠ 0) : a⁻¹ ≤ 1 ↔ 1 ≤ a :=
  @inv_le_one' _ _ _ _ <| Units.mk0 a ha
#align inv_le_one₀ inv_le_one₀

theorem one_le_inv₀ (ha : a ≠ 0) : 1 ≤ a⁻¹ ↔ a ≤ 1 :=
  @one_le_inv' _ _ _ _ <| Units.mk0 a ha
#align one_le_inv₀ one_le_inv₀

theorem le_mul_inv_iff₀ (hc : c ≠ 0) : a ≤ b * c⁻¹ ↔ a * c ≤ b :=
  ⟨fun h ↦ inv_inv c ▸ mul_inv_le_of_le_mul h, le_mul_inv_of_mul_le hc⟩
#align le_mul_inv_iff₀ le_mul_inv_iff₀

theorem mul_inv_le_iff₀ (hc : c ≠ 0) : a * c⁻¹ ≤ b ↔ a ≤ b * c :=
  ⟨fun h ↦ inv_inv c ▸ le_mul_inv_of_mul_le (inv_ne_zero hc) h, mul_inv_le_of_le_mul⟩
#align mul_inv_le_iff₀ mul_inv_le_iff₀

theorem div_le_div₀ (a b c d : α) (hb : b ≠ 0) (hd : d ≠ 0) : a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b :=
  by rw [mul_inv_le_iff₀ hb, mul_right_comm, le_mul_inv_iff₀ hd]
#align div_le_div₀ div_le_div₀

@[simp]
theorem Units.zero_lt (u : αˣ) : (0 : α) < u :=
  zero_lt_iff.2 <| u.ne_zero
#align units.zero_lt Units.zero_lt

theorem mul_lt_mul_of_lt_of_le₀ (hab : a ≤ b) (hb : b ≠ 0) (hcd : c < d) : a * c < b * d :=
  have hd : d ≠ 0 := ne_zero_of_lt hcd
  if ha : a = 0 then by
    rw [ha, zero_mul, zero_lt_iff]
    exact mul_ne_zero hb hd
  else
    if hc : c = 0 then by
      rw [hc, mul_zero, zero_lt_iff]
      exact mul_ne_zero hb hd
    else
      show Units.mk0 a ha * Units.mk0 c hc < Units.mk0 b hb * Units.mk0 d hd from
        mul_lt_mul_of_le_of_lt hab hcd
#align mul_lt_mul_of_lt_of_le₀ mul_lt_mul_of_lt_of_le₀

theorem mul_lt_mul₀ (hab : a < b) (hcd : c < d) : a * c < b * d :=
  mul_lt_mul_of_lt_of_le₀ hab.le (ne_zero_of_lt hab) hcd
#align mul_lt_mul₀ mul_lt_mul₀

theorem mul_inv_lt_of_lt_mul₀ (h : x < y * z) : x * z⁻¹ < y := by
  contrapose! h
  simpa only [inv_inv] using mul_inv_le_of_le_mul h
#align mul_inv_lt_of_lt_mul₀ mul_inv_lt_of_lt_mul₀

theorem inv_mul_lt_of_lt_mul₀ (h : x < y * z) : y⁻¹ * x < z := by
  rw [mul_comm] at *
  exact mul_inv_lt_of_lt_mul₀ h
#align inv_mul_lt_of_lt_mul₀ inv_mul_lt_of_lt_mul₀

theorem mul_lt_right₀ (c : α) (h : a < b) (hc : c ≠ 0) : a * c < b * c := by
  contrapose! h
  exact le_of_le_mul_right hc h
#align mul_lt_right₀ mul_lt_right₀

theorem inv_lt_inv₀ (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ < b⁻¹ ↔ b < a :=
  show (Units.mk0 a ha)⁻¹ < (Units.mk0 b hb)⁻¹ ↔ Units.mk0 b hb < Units.mk0 a ha from
    have : CovariantClass αˣ αˣ (· * ·) (· < ·) :=
      LeftCancelSemigroup.covariant_mul_lt_of_covariant_mul_le αˣ
    inv_lt_inv_iff
#align inv_lt_inv₀ inv_lt_inv₀

theorem inv_le_inv₀ (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
  show (Units.mk0 a ha)⁻¹ ≤ (Units.mk0 b hb)⁻¹ ↔ Units.mk0 b hb ≤ Units.mk0 a ha from
    have : CovariantClass αˣ αˣ (Function.swap (· * ·)) (· ≤ ·) :=
      OrderedCommMonoid.to_covariantClass_right αˣ
    have : CovariantClass αˣ αˣ (· * ·) (· ≤ ·) :=
      OrderedCommGroup.to_covariantClass_left_le αˣ
    inv_le_inv_iff
#align inv_le_inv₀ inv_le_inv₀

theorem lt_of_mul_lt_mul_of_le₀ (h : a * b < c * d) (hc : 0 < c) (hh : c ≤ a) : b < d := by
  have ha : a ≠ 0 := ne_of_gt (lt_of_lt_of_le hc hh)
  simp_rw [← inv_le_inv₀ ha (ne_of_gt hc)] at hh
  have := mul_lt_mul_of_lt_of_le₀ hh (inv_ne_zero (ne_of_gt hc)) h
  simpa [inv_mul_cancel_left₀ ha, inv_mul_cancel_left₀ (ne_of_gt hc)] using this
#align lt_of_mul_lt_mul_of_le₀ lt_of_mul_lt_mul_of_le₀

theorem mul_le_mul_right₀ (hc : c ≠ 0) : a * c ≤ b * c ↔ a ≤ b :=
  ⟨le_of_le_mul_right hc, fun hab ↦ mul_le_mul_right' hab _⟩
#align mul_le_mul_right₀ mul_le_mul_right₀

theorem mul_le_mul_left₀ (ha : a ≠ 0) : a * b ≤ a * c ↔ b ≤ c := by
  simp only [mul_comm a]
  exact mul_le_mul_right₀ ha
#align mul_le_mul_left₀ mul_le_mul_left₀

theorem div_le_div_right₀ (hc : c ≠ 0) : a / c ≤ b / c ↔ a ≤ b := by
  rw [div_eq_mul_inv, div_eq_mul_inv, mul_le_mul_right₀ (inv_ne_zero hc)]
#align div_le_div_right₀ div_le_div_right₀

theorem div_le_div_left₀ (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) : a / b ≤ a / c ↔ c ≤ b := by
  simp only [div_eq_mul_inv, mul_le_mul_left₀ ha, inv_le_inv₀ hb hc]
#align div_le_div_left₀ div_le_div_left₀

theorem le_div_iff₀ (hc : c ≠ 0) : a ≤ b / c ↔ a * c ≤ b := by
  rw [div_eq_mul_inv, le_mul_inv_iff₀ hc]
#align le_div_iff₀ le_div_iff₀

theorem div_le_iff₀ (hc : c ≠ 0) : a / c ≤ b ↔ a ≤ b * c := by
  rw [div_eq_mul_inv, mul_inv_le_iff₀ hc]
#align div_le_iff₀ div_le_iff₀

/-- `Equiv.mulLeft₀` as an `OrderIso` on a `LinearOrderedCommGroupWithZero.`.

Note that `OrderIso.mulLeft₀` refers to the `LinearOrderedField` version. -/
@[simps! (config := { simpRhs := true }) apply toEquiv]
def OrderIso.mulLeft₀' {a : α} (ha : a ≠ 0) : α ≃o α :=
  { Equiv.mulLeft₀ a ha with map_rel_iff' := mul_le_mul_left₀ ha }
#align order_iso.mul_left₀' OrderIso.mulLeft₀'
#align order_iso.mul_left₀'_to_equiv OrderIso.mulLeft₀'_toEquiv
#align order_iso.mul_left₀'_apply OrderIso.mulLeft₀'_apply

theorem OrderIso.mulLeft₀'_symm {a : α} (ha : a ≠ 0) :
    (OrderIso.mulLeft₀' ha).symm = OrderIso.mulLeft₀' (inv_ne_zero ha) := by
  ext
  rfl
#align order_iso.mul_left₀'_symm OrderIso.mulLeft₀'_symm

/-- `Equiv.mulRight₀` as an `OrderIso` on a `LinearOrderedCommGroupWithZero.`.

Note that `OrderIso.mulRight₀` refers to the `LinearOrderedField` version. -/
@[simps! (config := { simpRhs := true }) apply toEquiv]
def OrderIso.mulRight₀' {a : α} (ha : a ≠ 0) : α ≃o α :=
  { Equiv.mulRight₀ a ha with map_rel_iff' := mul_le_mul_right₀ ha }
#align order_iso.mul_right₀' OrderIso.mulRight₀'
#align order_iso.mul_right₀'_apply OrderIso.mulRight₀'_apply
#align order_iso.mul_right₀'_to_equiv OrderIso.mulRight₀'_toEquiv

theorem OrderIso.mulRight₀'_symm {a : α} (ha : a ≠ 0) :
    (OrderIso.mulRight₀' ha).symm = OrderIso.mulRight₀' (inv_ne_zero ha) := by
  ext
  rfl
#align order_iso.mul_right₀'_symm OrderIso.mulRight₀'_symm

instance : LinearOrderedAddCommGroupWithTop (Additive αᵒᵈ) :=
  { Additive.subNegMonoid, instLinearOrderedAddCommMonoidWithTopAdditiveOrderDual,
    instNontrivialAdditive with
    neg_top := @inv_zero _ (_)
    add_neg_cancel := fun a ha ↦ mul_inv_cancel (id ha : Additive.toMul a ≠ 0) }


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 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    assume i j h,
    assume heq : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h2 : (α * ↑i) - ↑(int.nat_abs (α * ↑i)) = (α * ↑j) - ↑(int.nat_abs (α * ↑j)), from by {
      rw heq,
    },
    have h3 : (α * ↑i) - ↑(int.nat_abs (α * ↑i)) = ↑i * α - ↑i * α + (↑(int.nat_abs (α * ↑i)) - ↑i * α), from by {
      rw int.fract_eq_of_nat_abs_add_sub_nat_abs_le (α * ↑i),
    },
    have h4 : (α * ↑j) - ↑(int.nat_abs (α * ↑j)) = ↑j * α - ↑j * α + (↑(int.nat_abs (α * ↑j)) - ↑j * α), from by {
      rw int.fract_eq_of_nat_abs_add_sub_nat_abs_le (α * ↑j),
    },
    have h5 : ↑i * α - ↑i * α + (↑(int.nat_abs (α * ↑i)) - ↑i * α) = ↑j * α - ↑j * α + (↑(int.nat_abs (α * ↑j)) - ↑j * α), from by {
      rw h2,
    },
    have h6 : ↑i * α - ↑i * α = ↑j * α - ↑j * α, from by {
      rw h5,
    },
    have h7 : ↑i * α = ↑j * α, from by {
      rw h6,
    },
    have h8 : i * α = j * α, from by {
      rw h7,
    },
    let h9 : (α = (i/j : ℤ)) ∨ (α = -(i/j : ℤ)), from by {
      apply exists_rat_btwn, exact hα_irrat,
    },
    rw h8 at h9,
    cases h9,
    {
    have h10 : α = i/j, from by {
      rw h9,
    },
    have h11 : α = (j/i : ℤ), from by {
      rw h10,
      rw mul_comm,
      rw int.mul_inv_cancel i,
    },
    have h12 : α = -(i/j : ℤ), from by {
      rw h11,
      rw int.mul_neg_self_iff,
    },
    rw h12 at hα_irrat,
    exact absurd hα_irrat (irrational_of_int_div_int h),
    },
    {
    have h10 : α = -(i/j : ℤ), from by {
      rw h9,
    },
    have h11 : α = (j/i : ℤ), from by {
      rw h10,
      rw mul_comm,
      rw int.mul_inv_cancel i,
    },
    have h12 : α = -(i/j : ℤ), from by {
      rw h11,
      rw int.mul_neg_self_iff,
    },
    rw h12 at hα_irrat,
    exact absurd hα_irrat (irrational_of_int_div_int h),
    },
  },
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∉ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    assume i j h3,
    assume h4 : int.fract (α * ↑i) ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
    cases h4 with j h5,
    cases h5 with h6 h7,
    have h8 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {
      rw h7,
    },
    have h9 : i ≠ j, from by {
      exact h1 i j h3 h8,
    },
    exact absurd h3 h9,
  },
  have h3 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by {
    apply closure_eq_of_is_closed,
    apply is_closed_Icc,
  },
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∈ (set.Icc 0 1), from by {
    assume i j h,
    have h5 : 0 ≤ int.fract (α * ↑i), from by {
      rw int.fract_eq_of_nat_abs_add_sub_nat_abs_le (α * ↑i),
    },
    have h6 : int.fract (α * ↑i) < 1, from by {
      rw int.fract_eq_of_nat_abs_add_sub_nat_abs_le (α * ↑i),
    },
    split,
    exact h5,
    exact h6,
  },
  have h5 : ∀ i : ℤ, (int.fract (α * ↑i)) ∈ (set.Icc 0 1), from by {
    assume i,
    apply h4 i i,
    exact int.ne_of_nat_ne_nat (nat.succ_ne_zero 0),
  },
  have h6 : set.Icc 0 1 = ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    apply set.ext,
    split,
    {
      assume x h7,
      use 0,
      split,
      exact set.mem_univ 0,
      have h8 : int.fract (α * ↑0) = int.fract (α * ↑0), from rfl,
      rw h8,
    },
    {
      assume x h7,
      cases h7 with i h8,
      cases h8 with h9 h10,
      have h11 : int.fract (α * ↑i) = x, from by {
        rw h10,
      },
      rw h11,
      exact h5 i,
    },
  },
  rw h6,
  apply set.ext,
  split,
  {
    assume x h7,
    cases h7 with i h8,
    cases h8 with h9 h10,
    have h11 : int.fract (α * ↑i) = x, from by {
      rw h10,
    },
    rw h11,
    exact h5 i,
  },
  {
    assume x h7,
    use 0,
    split,
    exact set.mem_univ 0,
    have h8 : int.fract (α * ↑0) = int.fract (α * ↑0), from rfl,
    rw h8,
  },
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --$\alpha$ is an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * i) ≠ int.fract (α * j),
  from by {
    assume (i j : ℤ) (hneq : i ≠ j),
    have h2 : int.fract (α * i) = α * i - ⌊α * i⌋, from by {rw int.fract},
    have h3 : int.fract (α * j) = α * j - ⌊α * j⌋, from by {rw int.fract},
    have h4 : i ≠ j → α ≠ (⌊α * i⌋ - ⌊α * j⌋) / (i-j), from by {
      assume hneq1 : i ≠ j,
      assume h5 : α = (⌊α * i⌋ - ⌊α * j⌋) / (i-j),
      have h6 : (⌊α * i⌋ - ⌊α * j⌋) = (i-j) * α, from by {rw h5, ring},
      have h7 : ⌊α * i⌋ = ⌊(i-j) * α⌋, from by {rw ← h6, ring},
      have h8 : ⌊α * j⌋ = ⌊(i-j) * α⌋, from by {rw ← h6, ring},
      have h9 : ⌊(i-j) * α⌋ ∈ ℤ, from by {rw int.cast_coe_int, apply int.cast_le.mp, apply int.floor_nonneg},
      have h10 : ⌊α * i⌋ = ⌊α * j⌋, from by {rw h7, rw h8},
      have h11 : α * i = ⌊α * i⌋, from by {rw int.cast_coe_int, apply int.cast_le.mp, apply int.floor_nonneg},
      have h12 : α * j = ⌊α * j⌋, from by {rw int.cast_coe_int, apply int.cast_le.mp, apply int.floor_nonneg},
      have h13 : α * i = α * j, from by {rw h10, rw h11, rw h12},
      have h14 : i = j, from by {linarith, linarith},
      exact h14 hneq1,
    },
    have h15 : i - j ≠ 0, from by {intro h16, exact hneq (eq_of_sub_eq_zero h16)},
    have h16 : rational ((⌊α * i⌋ - ⌊α * j⌋) / (i-j)), from by {rw ← h2, rw ← h3, apply rational.add_sub_div, apply rational.mul_self_floor, apply rational.mul_self_floor, apply rational.mul_self_floor, apply rational.mul_self_floor, apply irrational.floor_div_irrational, exact hα_irrat, exact h15, exact h15},
    exact hα_irrat h4 h16,
  },

  --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]$.
  have h2 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * m)) i ≠ (λ m : ℤ, int.fract (α * m)) j,
  from by {
    assume (i j : ℤ) (hneq : i ≠ j),
    have h3 : (λ m : ℤ, int.fract (α * m)) i = int.fract (α * i), from by {rw (λ m : ℤ, int.fract (α * m))},
    have h4 : (λ m : ℤ, int.fract (α * m)) j = int.fract (α * j), from by {rw (λ m : ℤ, int.fract (α * m))},
    rw h3, rw h4, exact h1 i j hneq,
  },
  have h3 : (λ m : ℤ, int.fract (α * m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1,
  from by {
    assume x,
    assume h4 : x ∈ (λ m : ℤ, int.fract (α * m)) '' (@set.univ ℤ),
    cases h4 with y h5,
    cases h5 with h6 h7,
    have h8 : (λ m : ℤ, int.fract (α * m)) y = x, from by {rw h7, apply h6},
    have h9 : y ∈ @set.univ ℤ, from by {exact h7},
    rw h8,
    have h10 : 0 ≤ int.fract (α * y), from by {rw h8, apply int.fract_nonneg},
    have h11 : int.fract (α * y) < 1, from by {rw h8, apply int.fract_lt_one},
    split,
    exact h10,
    exact h11,
  },
  have h4 : set.Icc 0 1 ⊆ (λ m : ℤ, int.fract (α * m)) '' (@set.univ ℤ),
  from by {
    assume x,
    assume h5 : x ∈ set.Icc 0 1,
    cases h5 with h6 h7,
    have h8 : ∃ i : ℤ, int.fract (α * i) = x, from by {
      have h9 : ∃ i : ℤ, int.fract (α * i) ≤ x, from by {
        have h10 : ∃ i : ℤ, 0 ≤ int.fract (α * i), from by {
          existsi (0 : ℤ),
          have h11 : (α * (0 : ℤ)) = 0, from by {rw mul_zero},
          rw h11,
          apply int.fract_nonneg,
        },
        existsi (⌈x⌉ : ℤ),
        have h12 : x < int.fract (α * ⌈x⌉), from by {rw int.fract, linarith},
        have h13 : x < α * ⌈x⌉ - ⌊α * ⌈x⌉⌋, from by {rw int.fract, linarith},
        have h14 : x < α * ⌈x⌉, from by {exact lt_of_lt_of_le h13 (int.floor_le _)},
        have h15 : x ≤ ⌈x⌉, from by {apply le_of_lt, exact h14},
        have h16 : x ≤ α * ⌈x⌉, from by {linarith, linarith},
        have h17 : x ≤ int.fract (α * ⌈x⌉), from by {rw int.fract, linarith, linarith},
        exact le_trans h17 (int.fract_le _),
      },
      cases
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
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * i) ≠ int.fract (α * j),
  from by {
    assume i j,
    assume h2 : i ≠ j,
    assume h3 : int.fract (α * i) = int.fract (α * j),
    have h4 : α * i - (int.fract (α * i)) = int.fract (α * i), from by rw [h3,int.fract_eq_of_lt (by linarith)],
    have h5 : α * j - (int.fract (α * j)) = int.fract (α * j), from by rw [h3,int.fract_eq_of_lt (by linarith)],
    have h6 : α = (int.fract (α * i) - int.fract (α * j)) / (i - j), from by rw [←h4,←h5],
    have h7 : (int.fract (α * i) - int.fract (α * j)) / (i - j) ∈ ℚ, from by apply quotient.exact h6,
    have h8 : α ∈ ℚ, from by apply rational_iff_exists_rat.mp h7,
    have h9 : irrational α, from by assumption,
    contradiction,
  },

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h10 : ∀ i : ℤ, int.fract (α * i) ∈ set.Icc 0 1, from by {
    assume i : ℤ,
    have h11 : ↑i * α - ↑(int.fract (α * i)) = int.fract (α * i), from by apply int.fract_eq_of_lt (by linarith),
    have h12 : ↑i * α - int.fract (α * i) < ↑i * α, from by linarith,
    have h13 : 0 < int.fract (α * i), from by linarith,
    have h14 : 0 ≤ int.fract (α * i) ∧ int.fract (α * i) < 1, from by rw [←h11,int.fract_lt_one],
    exact set.mem_Icc.mpr h14,
  },
  have h15 : set.finite (∅ : set ℤ), from by apply set.finite_empty,
  have h16 : set.finite {z : ℤ | z = 0}, from by apply set.finite_singleton,
  have h17 : set.finite {z : ℤ | z = -1}, from by apply set.finite_singleton,
  have h18 : set.finite {z : ℤ | z = 1}, from by apply set.finite_singleton,
  have h19 : set.finite {z : ℤ | (0 < z) ∧ (z < 1)}, from by apply set.finite_Ico,
  have h20 : set.finite {z : ℤ | (z < 0) ∧ (-1 < z)}, from by apply set.finite_Icc,
  have h21 : set.finite {z : ℤ | (z < 0) ∧ (z < -1)}, from by apply set.finite_Icc,
  have h22 : set.finite {z : ℤ | (0 < z) ∧ (1 < z)}, from by apply set.finite_Ico,
  have h23 : set.finite {z : ℤ | z = -2}, from by apply set.finite_singleton,
  have h24 : set.finite {z : ℤ | z = 2}, from by apply set.finite_singleton,
  have h25 : set.finite {z : ℤ | (z < -2) ∧ (-3 < z)}, from by apply set.finite_Icc,
  have h26 : set.finite {z : ℤ | (z < -3) ∧ (-4 < z)}, from by apply set.finite_Icc,
  have h27 : set.finite {z : ℤ | (z < -4) ∧ (-5 < z)}, from by apply set.finite_Icc,
  have h28 : set.finite {z : ℤ | (z < -5) ∧ (-6 < z)}, from by apply set.finite_Icc,
  have h29 : set.finite {z : ℤ | (z < -6) ∧ (-7 < z)}, from by apply set.finite_Icc,
  have h30 : set.finite {z : ℤ | (z < -7) ∧ (-8 < z)}, from by apply set.finite_Icc,
  have h31 : set.finite {z : ℤ | (z < -8) ∧ (-9 < z)}, from by apply set.finite_Icc,
  have h32 : set.finite {z : ℤ | (z < -9) ∧ (-10 < z)}, from by apply set.finite_Icc,
  have h33 : set.finite {z : ℤ | (2 < z) ∧ (z < 3)}, from by apply set.finite_Ico,
  have h34 : set.finite {z : ℤ | (3 < z) ∧ (z < 4)}, from by apply set.finite_Ico,
  have h35 : set.finite {z : ℤ | (4 < z) ∧ (z < 5)}, from by apply set.finite_Ico,
  have h36 : set.finite {z : ℤ | (5 < z) ∧ (z < 6)}, from by apply set.finite_Ico,
  have h37 : set.finite {z : ℤ | (6 < z) ∧ (z < 7)}, from by apply set.finite_Ico,
  have h38 : set.finite {z : ℤ | (7 < z) ∧ (z < 8)}, from by apply set.finite_Ico,
  have h39 : set.finite {z : ℤ | (8 < z) ∧ (z < 9)}, from by apply set.finite_Ico,
  have h40 : set.finite {z : ℤ | (9 < z) ∧ (z < 10)}, from by apply set.finite_Ico,
  have h41 : set.finite {z : ℤ | (10 < z) ∧ (z < 11)}, from by apply set.finite_Ico,
  have h42 : set.finite {z : ℤ | (11 < z) ∧ (z < 12)}, from by apply set.finite_Ico,
  have h43 : set.finite {z : ℤ | (12 < z) ∧ (z < 13)}, from by apply set.finite_Ico,
  have h44 : set.finite {z : ℤ | (13 < z) ∧ (z < 14)}, from by apply set.finite_Ico,
  have h45 : set.finite {z : ℤ | (14 < z) ∧ (z < 15)}, from by apply set.finite_Ico,
  have h46 : set.finite {z : ℤ | (15 < z) ∧ (z < 16)}, from by apply set.finite_Ico,
  have h47 : set.finite {z : ℤ | (16 < z) ∧ (z < 17)}, from by apply set.finite_Ico,
  have h48 : set.finite {z : ℤ | (17 < z) ∧ (z < 18
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 : ∀ m n : ℤ, ↑(m * n) = (↑m : ℝ) * n, from by {
    assume m n : ℤ,
    have h1 : (↑m : ℝ) * n = ↑m * n, from by {
      have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
        have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
          have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
            have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
              have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                  have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                    have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                      have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                        have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                          have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                            have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                              have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                  have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                    have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                      have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                        have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                          have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                            have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                              have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                  have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                    have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                      have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                        have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                          have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                            have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                              have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                  have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                    have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                      have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                        have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                          have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                            have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                              have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑m : ℝ) * n = ↑m * ↑n, from by {
                                                                                have h1 : (↑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
  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  let S : set ℝ := {int.fract (α * ↑m) | m : ℤ},
  have h1 : ∃ x : ℝ, x ∈ closure S, from by {
    have h2 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m)) ≠ int.fract (α * ↑n), from by {
      assume m n hmn,
      have h3 : m ≠ n, from by {
        cases hmn, exact hmn,
      },
      have h4 : α ≠ ↑n / ↑m, from by {
        rw hmn at hα_irrat, exact hα_irrat,
      },
      have h5 : (α * ↑m) ≠ (α * ↑n), from by {
        rw mul_comm (α * ↑m) (α * ↑n),
        rw mul_assoc α ↑m ↑n,
        rw mul_comm ↑m ↑n,
        rw mul_assoc ↑m α ↑n,
        rw mul_comm ↑m α,
        rw mul_assoc ↑m ↑n α,
        rw mul_comm ↑n α,
        rw mul_assoc ↑n ↑m α,
        rw hmn,
        rw mul_comm ↑m ↑n,
        rw ← mul_assoc,
        rw mul_comm α,
        rw mul_inv_cancel α,
        rw mul_one,
        rw mul_comm ↑n ↑m,
        rw h4,
        rw mul_comm ↑n ↑m,
        rw mul_one,
      },
      exact int.fract_ne_of_ne h5,
    },
    exact exists_mem_of_finite_image_ne_empty h2,
  },

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h2 : ∀ ε > 0, ∃ x y ∈ S, ∀ z ∈ S, |z - x| < ε ∧ |z - y| < ε, from by {
    assume ε hε,
    cases h1 with x hx,
    cases (mem_closure_iff.1 hx ε hε) with h3 h4,
    cases h3 with y hy,
    use x, use y,
    intros z hz,
    rw [mem_image, exists_prop],
    use z,
    split,
    exact hz,
    have h5 : ∀ z' ∈ S, ∃ m : ℤ, z' = int.fract (α * ↑m), from by {
      assume z' hz',
      rw mem_image at hz',
      rcases hz' with ⟨m, rfl⟩,
      use m,
      exact rfl,
    },
    cases h4 z with h6 h7,
    rcases (h5 z h6) with ⟨m, rfl⟩,
    rcases (h5 y hy) with ⟨n, rfl⟩,
    have h8 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m)) ≠ int.fract (α * ↑n), from by {
      assume m n hmn,
      have h9 : m ≠ n, from by {
        cases hmn, exact hmn,
      },
      have h10 : α ≠ ↑n / ↑m, from by {
        rw hmn at hα_irrat, exact hα_irrat,
      },
      have h11 : (α * ↑m) ≠ (α * ↑n), from by {
        rw mul_comm (α * ↑m) (α * ↑n),
        rw mul_assoc α ↑m ↑n,
        rw mul_comm ↑m ↑n,
        rw mul_assoc ↑m α ↑n,
        rw mul_comm ↑m α,
        rw mul_assoc ↑m ↑n α,
        rw mul_comm ↑n α,
        rw mul_assoc ↑n ↑m α,
        rw hmn,
        rw mul_comm ↑m ↑n,
        rw ← mul_assoc,
        rw mul_comm α,
        rw mul_inv_cancel α,
        rw mul_one,
        rw mul_comm ↑n ↑m,
        rw h10,
        rw mul_comm ↑n ↑m,
        rw mul_one,
      },
      exact int.fract_ne_of_ne h11,
    },
    have h12 : (int.fract (α * ↑m)) ≠ int.fract (α * ↑n), from by {
      apply h8, exact h7,
    },
    have h13 : (α * ↑m) ≠ (α * ↑n), from by {
      exact int.fract_ne_of_ne h12,
    },
    have h14 : ↑m ≠ ↑n, from by {
      intro h,
      rw [← mul_assoc, mul_comm ↑m ↑n, h] at h13,
      have h15 : (α * ↑n) = (α * ↑m), from h13,
      have h16 : ↑n = ↑m, from by {
        rw ← mul_assoc,
        rw mul_comm ↑n α,
        rw mul_inv_cancel α,
        rw mul_one,
      },
      contradiction,
    },
    have h17 : (int.fract (α * ↑n)) = z, from by {
      rw int.fract_mul,
      rw int.fract_mul,
      rw mul_comm ↑n α,
      rw mul_assoc ↑n ↑m α,
      rw ← mul_assoc,
      rw mul_comm ↑n ↑m,
      rw h16,
      rw mul_assoc ↑m α ↑n,
      rw mul_comm ↑m α,
      rw ← mul_assoc,
      rw mul_comm α ↑m,
      rw mul_inv_cancel α,
      rw mul_one,
    },
    have h18 : (int.fract (α * ↑m)) = y, from by {
      rw int.fract_mul,
      rw int.fract_mul,
      rw mul_comm ↑m α,
      rw mul_assoc ↑m ↑n α,
      rw ← mul_assoc,
      rw mul_comm ↑m ↑n,
      rw h16,
      rw mul_assoc ↑n α ↑m,
      rw mul_comm ↑n α,
      rw ← mul_assoc,
      rw mul_comm α ↑n,
      rw mul_inv_cancel α,
      rw mul_one,
    },
    have h19 : (int.fract (α * ↑m)) - (int.fract (α * ↑n)) = y - z, from by {
      rw h17,
      rw h18,
    },
    have h20 : ↑m - ↑n = (y - z) / α, from by {
      rw [← mul_assoc, mul_comm α ↑n, mul_assoc α ↑n ↑m, ← mul_assoc] at h19,
      rw mul_comm α ↑m at h19,
      rw ← mul_assoc at h19,
      rw mul_comm ↑m α at h19,
      rw mul_inv_cancel α at h19,
      rw mul_one at h19,
      rw h19,
      rw mul_sub,
      rw mul_comm ↑m ↑n,
      rw mul_sub,
      rw mul_comm ↑m ↑n,
    },
    have h21 : ↑m - ↑n ≠ 0, from by {
      linarith,
    },
    have h
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from by {
    assume i j : ℤ,
    assume h2 : i ≠ j,
    assume h3 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h4 : α = (int.fract (α * ↑i)) / (i-j), from by {
      rw h3,
      have h5 : (int.fract (α * ↑i)) / (i-j) = ((α * ↑i) - int.nat_abs (α * ↑i)) / (i-j), from by {
        rw int.fract_def,
        have h6 : int.nat_abs (α * ↑i) = int.nat_abs ((α * ↑i) - ((α * ↑i) - int.nat_abs (α * ↑i))), from by {
          apply int.nat_abs_of_nonneg,
          rw int.nat_abs_of_nonneg,
          linarith,
        },
        rw h6, ring,
      },
      rw h5, ring,
    },
    have h5 : α ∈ ℚ, from by {
      have h6 := (set.mem_rat.mpr (⟨α, h4⟩ : ℚ × ℚ)),
      apply set.mem_rat_iff.mp h6,
      },
    apply irrational.not_mem_of_mem_rat hα_irrat h5,
  },

  --$S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  --$S$ is an infinite subset of $\left[0,1\right]$.
  have h2 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' set.univ), from by {
    have h3 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h4 : i ≠ j,
      have h5 : int.fract (α * ↑i) ∉ {int.fract (α * ↑j)}, from by {
        rw set.not_mem_singleton,
        apply h1 i j h4,
      },
      exact h5,
    },
    have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
      assume i j : ℤ,
      assume h5 : i ≠ j,
      apply h3 i j h5,
    },
    have h5 : ∀ i j : ℤ, i ≠ j → ↑i ≠ ↑j, from by {
      assume i j : ℤ,
      assume h6 : i ≠ j,
      apply int.cast_ne_int.mpr h6,
    },
    have h6 : ∀ i j : ℤ, i ≠ j → ↑i ≠ ↑j, from by {
      assume i j : ℤ,
      assume h7 : i ≠ j,
      apply h5 i j h7,
    },
    have h7 : ∀ i j : ℤ, i ≠ j → (α * ↑i) ≠ (α * ↑j), from by {
      assume i j : ℤ,
      assume h8 : i ≠ j,
      apply int.cast_ne_int.mpr h8,
    },
    have h8 : ∀ i j : ℤ, i ≠ j → (α * ↑i) ≠ (α * ↑j), from by {
      assume i j : ℤ,
      assume h9 : i ≠ j,
      apply h7 i j h9,
    },
    have h9 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h10 : i ≠ j,
      apply h4 i j h10,
    },
    have h10 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h11 : i ≠ j,
      apply h9 i j h11,
    },
    have h11 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h12 : i ≠ j,
      apply h10 i j h12,
    },
    have h12 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h13 : i ≠ j,
      apply h11 i j h13,
    },
    have h13 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h14 : i ≠ j,
      apply h12 i j h14,
    },
    have h14 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h15 : i ≠ j,
      apply h13 i j h15,
    },
    have h15 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h16 : i ≠ j,
      apply h14 i j h16,
    },
    have h16 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h17 : i ≠ j,
      apply h15 i j h17,
    },
    have h17 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h18 : i ≠ j,
      apply h16 i j h18,
    },
    have h18 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h19 : i ≠ j,
      apply h17 i j h19,
    },
    have h19 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h20 : i ≠ j,
      apply h18 i j h20,
    },
    have h20 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h21 : i ≠ j,
      apply h19 i j h21,
    },
    have h21 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume i j : ℤ,
      assume h22 : i ≠ j,

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
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (i * α) ≠ int.fract (j * α), from assume (i j : ℤ) (h2 : i ≠ j),
  by {
    rw [int.fract_eq, int.fract_eq] at h2,
    have h3 : α = (int.nat_abs (i - j))⁻¹ * (i * α - j * α), from by {
      rw mul_comm,
      rw sub_mul,
      rw h2,
      ring,
    },
    rw [int.nat_abs_of_nonneg (le_of_lt (int.coe_nat_pos.2 hα_irrat))] at h3,
    have h4 : α ∈ ℚ, from by {
      rw int.coe_nat_dvd,
      use (i - j),
      simp [h3],
    },
    have h5 : irrational α, from hα_irrat,
    have h6 : ¬(α ∈ ℚ), from h5,
    contradiction,
  },
  --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]$.
  have h7 : set.infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    have h8 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume (i j : ℤ) (h9 : i ≠ j),
      rw [mul_comm α i, mul_comm α j] at h9,
      exact h1 i j h9,
    },
    have h9 : ∀ (i j : ℤ), i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ≠ (λ m : ℤ, int.fract (α * ↑m)) j, from by {
      assume (i j : ℤ) (h10 : i ≠ j),
      rw [eq_comm, ← function.funext_iff],
      exact h8 i j h10,
    },
    show set.infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from
    by {
      apply set.infinite_of_injective_of_univ,
      exact h9,
      exact set.univ_mem_univ,
    },
  },
  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h10 : set.has_limit_point ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) (Icc 0 1), from by {
    apply set.has_limit_point_of_infinite_of_compact_of_nonempty,
    exact h7,
    exact is_compact_Icc,
    simp,
  },
  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h11 : ∀ (ε : ℝ), ε > 0 → ∃ (x y : ℤ), x ≠ y ∧ (λ m : ℤ, int.fract (α * ↑m)) x ≠ (λ m : ℤ, int.fract (α * ↑m)) y ∧ int.fract (α * ↑y) - int.fract (α * ↑x) < ε, from by {
    assume (ε : ℝ) (h12 : ε > 0),
    apply set.has_limit_point.has_limit_point_of_finite_cover,
    exact h10,
    exact h12,
    exact set.univ_mem_univ,
    use (set.Icc 0 1),
    use (set.Ioo (ε / 2) (1 - (ε / 2))),
    split,
    {
      rw [← set.image_univ],
      rw [← set.image_univ],
      apply set.finite_inter_finite,
      apply set.finite_Icc,
      apply set.finite_Ioo,
    },
    {
      rw [← set.image_univ],
      rw [← set.image_univ],
      apply set.finite_inter_finite,
      apply set.finite_Icc,
      apply set.finite_Ioo,
    },
    {
      rw [← set.image_univ],
      rw [← set.image_univ],
      rw [← set.image_univ],
      rw [← set.image_univ],
      apply set.finite_inter_finite,
      apply set.finite_Icc,
      apply set.finite_Ioo,
    },
    {
      rw [← set.image_inter],
      rw [← set.image_inter],
      rw [← set.image_inter],
      rw [← set.image_inter],
      intros x h13,
      cases h13 with x1 h14,
      cases h14 with x2 h15,
      cases h15 with h16 h17,
      cases h17 with h18 h19,
      cases h19 with h20 h21,
      cases h21 with h22 h23,
      cases h23 with h24 h25,
      cases h25 with h26 h27,
      cases h27 with h28 h29,
      cases h29 with h30 h31,
      cases h31 with h32 h33,
      cases h33 with h34 h35,
      cases h35 with h36 h37,
      cases h37 with h38 h39,
      cases h39 with h40 h41,
      cases h41 with h42 h43,
      cases h43 with h44 h45,
      cases h45 with h46 h47,
      cases h47 with h48 h49,
      cases h49 with h50 h51,
      cases h51 with h52 h53,
      cases h53 with h54 h55,
      cases h55 with h56 h57,
      cases h57 with h58 h59,
      cases h59 with h60 h61,
      cases h61 with h62 h63,
      cases h63 with h64 h65,
      cases h65 with h66 h67,
      cases h67 with h68 h69,
      cases h69 with h70 h71,
      cases h71 with h72 h73,
      cases h73 with h74 h75,
      cases h75 with h76 h77,
      cases h77 with h78 h79,
      cases h79 with h80 h81,
      cases h81 with h82 h83,
      cases h83 with h84 h85,
      cases h85 with h86 h87,
      cases h87 with h88 h89,
      cases h89 with h90 h91,
      cases h91 with h92 h93,
      cases h93 with h94 h95,
      cases h95 with h96 h97,
      cases h97 with h98 h99,

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
  -- let S := $\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  have h1 : ∀ m : ℤ, int.fract (α * ↑m) ∈ set.Icc 0 1, by {
    assume m,
    have h1_1 : 0 ≤ int.fract (α * ↑m), by linarith,
    have h1_2 : int.fract (α * ↑m) ≤ 1, by linarith,
    show int.fract (α * ↑m) ∈ set.Icc 0 1, from ⟨h1_1,h1_2⟩,
  },
  have h2 : ∀ m : ℤ, int.fract (α * ↑m) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), by {
    assume m,
    have h2_1 : (m : ℤ) ∈ set.univ, from set.mem_univ m,
    show int.fract (α * ↑m) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from ⟨m, h2_1⟩,
  },
  let S := (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ),

  -- then S is infinite set
  have h3 : infinite S, from by {
    have h3_1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
      begin
        assume i j,
        assume h3_1_1,
        have h3_1_2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) * (i - j)⁻¹, from by {
          rw ← int.fract_add_int,
          rw ← mul_int_fract,
          rw ← mul_int_fract,
          ring,
        },
        have h3_1_3 : ((i - j) : ℤ) ≠ 0, from by {
          assume h3_1_3_1,
          have h3_1_3_2 := int.eq_iff_exists_int.mpr h3_1_3_1,
          cases h3_1_3_2,
          have h3_1_3_3 := int.cast_inj.mp h3_1_3_2_h,
          rw h3_1_3_3 at h3_1_2,
          have h3_1_3_4 : α ∈ ℚ, from by {
            exact h3_1_2.symm,
          },
          have h3_1_3_5 : α ∉ ℚ, from by {
            apply hα_irrat,
          },
          exact h3_1_3_5 h3_1_3_4,
        },
        have h3_1_4 : (i - j)⁻¹ ∈ ℚ, from by {
          exact inv_in_rational (int.cast_ne_zero.mp h3_1_3),
        },
        have h3_1_5 : (i - j)⁻¹ ∉ ℚ, from by {
          apply hα_irrat,
        },
        exact h3_1_5 h3_1_4,
      end,
    have h3_1_1 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
      begin
        assume i j,
        assume h3_1_1_1,
        have h3_1_1_2 := h3_1 i j h3_1_1_1,
        show int.fract (α * ↑i) ≠ int.fract (α * ↑j),
        from h3_1_1_2,
      end,
    have h3_1_2 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹, from
      begin
        assume i j,
        assume h3_1_2_1,
        have h3_1_2_2 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
          by {exact h3_1_1_1 i j h3_1_2_1},
        rw int.fract_eq_of_ne at h3_1_2_2,
        show (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹,
        from by {
          exact inv_ne_of_ne_of_ne h3_1_2_2 h3_1_2_2,
        },
      end,
    have h3_1_3 : ∀ (i j : ℤ), (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹ → i ≠ j, from
      begin
        assume i j,
        assume h3_1_3_1,
        have h3_1_3_2 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
          by {exact inv_ne_of_ne_of_ne h3_1_3_1 h3_1_3_1},
        rw int.fract_eq_of_ne at h3_1_3_2,
        show i ≠ j, from h3_1_1_1 i j h3_1_3_2,
      end,
    have h3_1_4 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹, from
      begin
        assume i j,
        assume h3_1_4_1,
        have h3_1_4_2 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
          by {exact h3_1_1_1 i j h3_1_4_1},
        rw int.fract_eq_of_ne at h3_1_4_2,
        show (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹, from
          by {exact inv_ne_of_ne_of_ne h3_1_4_2 h3_1_4_2},
      end,
    have h3_1_5 : ∀ (i j : ℤ), (int.fract (α * ↑i)) ⁻¹ = (int.fract (α * ↑j)) ⁻¹ → i = j, from
      begin
        assume i j,
        assume h3_1_5_1,
        have h3_1_5_2 : int.fract (α * ↑i) = int.fract (α * ↑j), from
          by {exact inv_inj h3_1_5_1},
        show i = j, from int.fract_eq_of_eq h3_1_5_2,
      end,
    have h3_1_6 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ⁻¹ ≠ (int.fract (α * ↑j)) ⁻¹, from
      begin
        assume i j,
        assume h3_1_6_1,
        have h3_1_6_2 : int.fract (α * ↑i) ≠ int.fract (α * ↑j
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

  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) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

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

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

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

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

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

Let $\epsilon > 0$.

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

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

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

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

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

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

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

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

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

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

Hence the result.
{{qed}}

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

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

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

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

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

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

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
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)-/


/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux, Jon Bannon
-/

import algebra.star.star_alg_hom
import analysis.normed_space.star.basic
import analysis.normed_space.operator_norm
import analysis.special_functions.pow
import analysis.normed_space.star.mul

/-!
# Multiplier Algebra of a C⋆-algebra

Define the multiplier algebra of a C⋆-algebra as the algebra (over `𝕜`) of double centralizers,
for which we provide the localized notation `𝓜(𝕜, A)`.  A double centralizer is a pair of
continuous linear maps `L R : A →L[𝕜] A` satisfying the intertwining condition `R x * y = x * L y`.

There is a natural embedding `A → 𝓜(𝕜, A)` which sends `a : A` to the continuous linear maps
`L R : A →L[𝕜] A` given by left and right multiplication by `a`, and we provide this map as a
coercion.

The multiplier algebra corresponds to a non-commutative Stone–Čech compactification in the sense
that when the algebra `A` is commutative, it can be identified with `C₀(X, ℂ)` for some locally
compact Hausdorff space `X`, and in that case `𝓜(𝕜, A)` can be identified with `C(β X, ℂ)`.

## Implementation notes

We make the hypotheses on `𝕜` as weak as possible so that, in particular, this construction works
for both `𝕜 = ℝ` and `𝕜 = ℂ`.

The reader familiar with C⋆-algebra theory may recognize that one
only needs `L` and `R` to be functions instead of continuous linear maps, at least when `A` is a
C⋆-algebra. Our intention is simply to eventually provide a constructor for this situation.

We pull back the `normed_algebra` structure (and everything contained therein) through the
ring (even algebra) homomorphism
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` which
sends `a : 𝓜(𝕜, A)` to `(a.fst, mul_opposite.op a.snd)`. The star structure is provided
separately.

## References

* https://en.wikipedia.org/wiki/Multiplier_algebra

## TODO

+ Define a type synonym for `𝓜(𝕜, A)` which is equipped with the strict uniform space structure
  and show it is complete
+ Show that the image of `A` in `𝓜(𝕜, A)` is an essential ideal
+ Prove the universal property of `𝓜(𝕜, A)`
+ Construct a double centralizer from a pair of maps (not necessarily linear or continuous)
  `L : A → A`, `R : A → A` satisfying the centrality condition `∀ x y, R x * y = x * L y`.
+ Show that if `A` is unital, then `A ≃⋆ₐ[𝕜] 𝓜(𝕜, A)`.
-/

open_locale nnreal ennreal
open nnreal continuous_linear_map mul_opposite

universes u v

/-- The type of *double centralizers*, also known as the *multiplier algebra* and denoted by
`𝓜(𝕜, A)`, of a non-unital normed algebra.

If `x : 𝓜(𝕜, A)`, then `x.fst` and `x.snd` are what is usually referred to as $L$ and $R$. -/
@[ext]
structure double_centralizer (𝕜 : Type u) (A : Type v) [nontrivially_normed_field 𝕜]
  [non_unital_normed_ring A] [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A]
  extends (A →L[𝕜] A) × (A →L[𝕜] A) :=
(central : ∀ x y : A, snd x * y = x * fst y)

localized "notation `𝓜(` 𝕜 `, ` A `)` := double_centralizer 𝕜 A" in multiplier_algebra

namespace double_centralizer

section nontrivially_normed

variables (𝕜 A : Type*) [nontrivially_normed_field 𝕜] [non_unital_normed_ring A]
variables [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A]

/-!
### Algebraic structure

Because the multiplier algebra is defined as the algebra of double centralizers, there is a natural
injection `double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`
defined by `λ a, (a.fst, mul_opposite.op a.snd)`. We use this map to pull back the ring, module and
algebra structure from `(A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` to `𝓜(𝕜, A)`. -/

variables {𝕜 A}

instance : has_add 𝓜(𝕜, A) :=
{ add := λ a b,
  { to_prod := a.to_prod + b.to_prod,
    central := λ x y, show (a.snd + b.snd) x * y = x * (a.fst + b.fst) y,
      by simp only [continuous_linear_map.add_apply, mul_add, add_mul, central] } }

instance : has_zero 𝓜(𝕜, A) :=
{ zero :=
  { to_prod := 0,
    central := λ x y, (zero_mul y).trans (mul_zero x).symm } }

instance : has_neg 𝓜(𝕜, A) :=
{ neg := λ a,
  { to_prod := -a.to_prod,
    central := λ x y, show -a.snd x * y = x * -a.fst y,
      by simp only [continuous_linear_map.neg_apply, neg_mul, mul_neg, central] } }

instance : has_sub 𝓜(𝕜, A) :=
{ sub := λ a b,
  { to_prod := a.to_prod - b.to_prod,
    central := λ x y, show (a.snd - b.snd) x * y = x * (a.fst - b.fst) y,
      by simp only [continuous_linear_map.sub_apply, sub_mul, mul_sub, central] } }

section scalars

variables {S : Type*} [monoid S] [distrib_mul_action S A] [smul_comm_class 𝕜 S A]
  [has_continuous_const_smul S A] [is_scalar_tower S A A] [smul_comm_class S A A]

instance : has_smul S 𝓜(𝕜, A) :=
{ smul := λ s a,
  { to_prod := s • a.to_prod,
    central := λ x y, show (s • a.snd) x * y = x * (s • a.fst) y,
      by simp only [continuous_linear_map.smul_apply, mul_smul_comm, smul_mul_assoc, central] } }

@[simp] lemma smul_to_prod (s : S) (a : 𝓜(𝕜, A)) : (s • a).to_prod = s • a.to_prod := rfl
lemma smul_fst (s : S) (a : 𝓜(𝕜, A)) : (s • a).fst = s • a.fst := rfl
lemma smul_snd (s : S) (a : 𝓜(𝕜, A)) : (s • a).snd = s • a.snd := rfl

variables {T : Type*} [monoid T] [distrib_mul_action T A] [smul_comm_class 𝕜 T A]
  [has_continuous_const_smul T A] [is_scalar_tower T A A] [smul_comm_class T A A]

instance [has_smul S T] [is_scalar_tower S T A] : is_scalar_tower S T 𝓜(𝕜, A) :=
{ smul_assoc := λ _ _ a, ext _ _ $ smul_assoc _ _ a.to_prod }

instance [smul_comm_class S T A] : smul_comm_class S T 𝓜(𝕜, A) :=
{ smul_comm := λ _ _ a, ext _ _ $ smul_comm _ _ a.to_prod }

instance {R : Type*} [semiring R] [module R A] [smul_comm_class 𝕜 R A]
  [has_continuous_const_smul R A] [is_scalar_tower R A A] [smul_comm_class R A A]
  [module Rᵐᵒᵖ A] [is_central_scalar R A] : is_central_scalar R 𝓜(𝕜, A) :=
{ op_smul_eq_smul := λ _ a, ext _ _ $ op_smul_eq_smul _ a.to_prod }

end scalars

instance : has_one 𝓜(𝕜, A) := ⟨⟨1, λ x y, rfl⟩⟩

instance : has_mul 𝓜(𝕜, A) :=
{ mul := λ a b,
  { to_prod := (a.fst.comp b.fst, b.snd.comp a.snd),
    central := λ x y, show b.snd (a.snd x) * y = x * a.fst (b.fst y),
      by simp only [central] } }

instance : has_nat_cast 𝓜(𝕜, A) :=
{ nat_cast := λ n, ⟨n, λ x y,
  begin
    rw [prod.snd_nat_cast, prod.fst_nat_cast],
    simp only [←nat.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc],
  end⟩ }

instance : has_int_cast 𝓜(𝕜, A) :=
{ int_cast := λ n, ⟨n, λ x y,
  begin
    rw [prod.snd_int_cast, prod.fst_int_cast],
    simp only [←int.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc],
  end⟩ }

instance : has_pow 𝓜(𝕜, A) ℕ :=
{ pow := λ a n, ⟨a.to_prod ^ n, λ x y,
  begin
    induction n with k hk generalizing x y,
    { refl },
    { rw [prod.pow_snd, prod.pow_fst] at hk ⊢,
      rw [pow_succ a.snd, mul_apply, a.central, hk, pow_succ' a.fst, mul_apply] },
  end⟩ }

instance : inhabited 𝓜(𝕜, A) := ⟨0⟩

@[simp] lemma add_to_prod (a b : 𝓜(𝕜, A)) : (a + b).to_prod = a.to_prod + b.to_prod := rfl
@[simp] lemma zero_to_prod : (0 : 𝓜(𝕜, A)).to_prod = 0 := rfl
@[simp] lemma neg_to_prod (a : 𝓜(𝕜, A)) : (-a).to_prod = -a.to_prod := rfl
@[simp] lemma sub_to_prod (a b : 𝓜(𝕜, A)) : (a - b).to_prod = a.to_prod - b.to_prod := rfl
@[simp] lemma one_to_prod : (1 : 𝓜(𝕜, A)).to_prod = 1 := rfl
@[simp] lemma nat_cast_to_prod (n : ℕ) : (n : 𝓜(𝕜 , A)).to_prod = n := rfl
@[simp] lemma int_cast_to_prod (n : ℤ) : (n : 𝓜(𝕜 , A)).to_prod = n := rfl
@[simp] lemma pow_to_prod (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).to_prod = a.to_prod ^ n := rfl

lemma add_fst (a b : 𝓜(𝕜, A)) : (a + b).fst = a.fst + b.fst := rfl
lemma add_snd (a b : 𝓜(𝕜, A)) : (a + b).snd = a.snd + b.snd := rfl
lemma zero_fst : (0 : 𝓜(𝕜, A)).fst = 0 := rfl
lemma zero_snd : (0 : 𝓜(𝕜, A)).snd = 0 := rfl
lemma neg_fst (a : 𝓜(𝕜, A)) : (-a).fst = -a.fst := rfl
lemma neg_snd (a : 𝓜(𝕜, A)) : (-a).snd = -a.snd := rfl
lemma sub_fst (a b : 𝓜(𝕜, A)) : (a - b).fst = a.fst - b.fst := rfl
lemma sub_snd (a b : 𝓜(𝕜, A)) : (a - b).snd = a.snd - b.snd := rfl
lemma one_fst : (1 : 𝓜(𝕜, A)).fst = 1 := rfl
lemma one_snd : (1 : 𝓜(𝕜, A)).snd = 1 := rfl
@[simp] lemma mul_fst (a b : 𝓜(𝕜, A)) : (a * b).fst = a.fst * b.fst := rfl
@[simp] lemma mul_snd (a b : 𝓜(𝕜, A)) : (a * b).snd = b.snd * a.snd := rfl
lemma nat_cast_fst (n : ℕ) : (n : 𝓜(𝕜 , A)).fst = n := rfl
lemma nat_cast_snd (n : ℕ) : (n : 𝓜(𝕜 , A)).snd = n := rfl
lemma int_cast_fst (n : ℤ) : (n : 𝓜(𝕜 , A)).fst = n := rfl
lemma int_cast_snd (n : ℤ) : (n : 𝓜(𝕜 , A)).snd = n := rfl
lemma pow_fst (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).fst = a.fst ^ n := rfl
lemma pow_snd (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).snd = a.snd ^ n := rfl

/-- The natural injection from `double_centralizer.to_prod` except the second coordinate inherits
`mul_opposite.op`. The ring structure on `𝓜(𝕜, A)` is the pullback under this map. -/
def to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ :=
λ a, (a.fst, mul_opposite.op a.snd)

lemma to_prod_mul_opposite_injective :
  function.injective (to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ) :=
λ a b h, let h' := prod.ext_iff.mp h in ext _ _ $ prod.ext h'.1 $ mul_opposite.op_injective h'.2

lemma range_to_prod_mul_opposite :
  set.range to_prod_mul_opposite = {lr : (A →L[𝕜] A) × _ | ∀ x y, unop lr.2 x * y = x * lr.1 y} :=
set.ext $ λ x,
  ⟨by {rintro ⟨a, rfl⟩, exact a.central}, λ hx, ⟨⟨(x.1, unop x.2), hx⟩, prod.ext rfl rfl⟩⟩

/-- The ring structure is inherited as the pullback under the injective map
`double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` -/
instance : ring 𝓜(𝕜, A) :=
to_prod_mul_opposite_injective.ring _
  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
  (λ x n, prod.ext rfl $ mul_opposite.op_smul _ _)
  (λ x n, prod.ext rfl $ mul_opposite.op_smul _ _)
  (λ x n, prod.ext rfl $ mul_opposite.op_pow _ _)
  (λ _, rfl) (λ _, rfl)

/-- The canonical map `double_centralizer.to_prod` as an additive group homomorphism. -/
@[simps]
def to_prod_hom : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A) :=
{ to_fun := to_prod,
  map_zero' := rfl,
  map_add' := λ x y, rfl }

/-- The canonical map `double_centralizer.to_prod_mul_opposite` as a ring homomorphism. -/
@[simps]
def to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ :=
{ to_fun := to_prod_mul_opposite,
  map_zero' := rfl,
  map_one' := rfl,
  map_add' := λ x y, rfl,
  map_mul' := λ x y, rfl }

/-- The module structure is inherited as the pullback under the additive group monomorphism
`double_centralizer.to_prod : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A)` -/
instance {S : Type*} [semiring S] [module S A] [smul_comm_class 𝕜 S A]
  [has_continuous_const_smul S A] [is_scalar_tower S A A] [smul_comm_class S A A] :
  module S 𝓜(𝕜, A) :=
function.injective.module S to_prod_hom ext (λ x y, rfl)

-- TODO: generalize to `algebra S 𝓜(𝕜, A)` once `continuous_linear_map.algebra` is generalized.
instance : algebra 𝕜 𝓜(𝕜, A) :=
{ to_fun := λ k,
  { to_prod := algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)) k,
    central := λ x y, by simp_rw [prod.algebra_map_apply, algebra.algebra_map_eq_smul_one,
      smul_apply, one_apply, mul_smul_comm, smul_mul_assoc] },
  map_one' := ext _ _ $ map_one $ algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)),
  map_mul' := λ k₁ k₂, ext _ _ $ prod.ext (map_mul (algebra_map 𝕜 (A →L[𝕜] A)) _ _)
    ((map_mul (algebra_map 𝕜 (A →L[𝕜] A)) _ _).trans (algebra.commutes _ _)),
  map_zero' := ext _ _ $ map_zero $ algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)),
  map_add' := λ _ _, ext _ _ $ map_add (algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A))) _ _,
  commutes' := λ _ _, ext _ _ $ prod.ext (algebra.commutes _ _) (algebra.commutes _ _).symm,
  smul_def' := λ _ _, ext _ _ $ prod.ext (algebra.smul_def _ _)
    ((algebra.smul_def _ _).trans $ algebra.commutes _ _) }

@[simp] lemma algebra_map_to_prod (k : 𝕜) :
  (algebra_map 𝕜 𝓜(𝕜, A) k).to_prod = algebra_map 𝕜 _ k := rfl
lemma algebra_map_fst (k : 𝕜) : (algebra_map 𝕜 𝓜(𝕜, A) k).fst = algebra_map 𝕜 _ k := rfl
lemma algebra_map_snd (k : 𝕜) : (algebra_map 𝕜 𝓜(𝕜, A) k).snd = algebra_map 𝕜 _ k := rfl

/-!
### Star structure
-/

section star

variables [star_ring 𝕜] [star_ring A] [star_module 𝕜 A] [normed_star_group A]

/-- The star operation on `a : 𝓜(𝕜, A)` is given by
`(star a).to_prod = (star ∘ a.snd ∘ star, star ∘ a.fst ∘ star)`. -/
instance : has_star 𝓜(𝕜, A) :=
{ star := λ a,
  { fst := (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.snd).comp
      ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A),
    snd := (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.fst).comp
      ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A),
    central := λ x y, by simpa only [star_mul, star_star]
      using (congr_arg star (a.central (star y) (star x))).symm } }

@[simp] lemma star_fst (a : 𝓜(𝕜, A)) (b : A) : (star a).fst b = star (a.snd (star b)) := rfl
@[simp] lemma star_snd (a : 𝓜(𝕜, A)) (b : A) : (star a).snd b = star (a.fst (star b)) := rfl

instance : star_add_monoid 𝓜(𝕜, A) :=
{ star_involutive := λ x, by {ext; simp only [star_fst, star_snd, star_star]},
  star_add := λ x y, by {ext; simp only [star_fst, star_snd, add_fst, add_snd,
    continuous_linear_map.add_apply, star_add]},
  .. double_centralizer.has_star }

instance : star_ring 𝓜(𝕜, A) :=
{ star_mul := λ a b, by {ext; simp only [star_fst, star_snd, mul_fst, mul_snd, star_star,
    continuous_linear_map.coe_mul, function.comp_app]},
  .. double_centralizer.star_add_monoid }

instance : star_module 𝕜 𝓜(𝕜, A) :=
{ star_smul := λ k a, by {ext; exact star_smul _ _},
  .. double_centralizer.star_add_monoid }

end star

/-!
### Coercion from an algebra into its multiplier algebra
-/

/-- The natural coercion of `A` into `𝓜(𝕜, A)` given by sending `a : A` to the pair of linear
maps `Lₐ Rₐ : A →L[𝕜] A` given by left- and right-multiplication by `a`, respectively.

Warning: if `A = 𝕜`, then this is a coercion which is not definitionally equal to the
`algebra_map 𝕜 𝓜(𝕜, 𝕜)` coercion, but these are propositionally equal. See
`double_centralizer.coe_eq_algebra_map` below. -/
noncomputable instance : has_coe_t A 𝓜(𝕜, A) :=
{ coe := λ a,
  { fst := continuous_linear_map.mul 𝕜 A a,
    snd := (continuous_linear_map.mul 𝕜 A).flip a,
    central := λ x y, mul_assoc _ _ _ } }

@[simp, norm_cast]
lemma coe_fst (a : A) : (a : 𝓜(𝕜, A)).fst = continuous_linear_map.mul 𝕜 A a := rfl
@[simp, norm_cast]
lemma coe_snd (a : A) : (a : 𝓜(𝕜, A)).snd = (continuous_linear_map.mul 𝕜 A).flip a := rfl

lemma coe_eq_algebra_map : (coe : 𝕜 → 𝓜(𝕜, 𝕜)) = algebra_map 𝕜 𝓜(𝕜, 𝕜) :=
begin
  ext;
  simp only [coe_fst, mul_apply', mul_one, algebra_map_to_prod, prod.algebra_map_apply, coe_snd,
    flip_apply, one_mul];
  simp only [algebra.algebra_map_eq_smul_one, smul_apply, one_apply, smul_eq_mul, mul_one],
end

/-- The coercion of an algebra into its multiplier algebra as a non-unital star algebra
homomorphism. -/
@[simps]
noncomputable def coe_hom [star_ring 𝕜] [star_ring A] [star_module 𝕜 A] [normed_star_group A] :
  A →⋆ₙₐ[𝕜] 𝓜(𝕜, A) :=
{ to_fun := λ a, a,
  map_smul' := λ k a, by ext; simp only [coe_fst, coe_snd, continuous_linear_map.map_smul,
    smul_fst, smul_snd],
  map_zero' := by ext; simp only [coe_fst, coe_snd, map_zero, zero_fst, zero_snd],
  map_add' := λ a b, by ext; simp only [coe_fst, coe_snd, map_add, add_fst, add_snd],
  map_mul' := λ a b, by ext; simp only [coe_fst, coe_snd, mul_apply', flip_apply, mul_fst, mul_snd,
    continuous_linear_map.coe_mul, function.comp_app, mul_assoc],
  map_star' := λ a, by ext; simp only [coe_fst, coe_snd, mul_apply', star_fst, star_snd,
    flip_apply, star_mul, star_star] }

/-!
### Norm structures
We define the norm structure on `𝓜(𝕜, A)` as the pullback under
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`, which
provides a definitional isometric embedding. Consequently, completeness of `𝓜(𝕜, A)` is obtained
by proving that the range of this map is closed.

In addition, we prove that `𝓜(𝕜, A)` is a normed algebra, and, when `A` is a C⋆-algebra, we show
that `𝓜(𝕜, A)` is also a C⋆-algebra. Moreover, in this case, for `a : 𝓜(𝕜, A)`,
`‖a‖ = ‖a.fst‖ = ‖a.snd‖`. -/

/-- The normed group structure is inherited as the pullback under the ring monomoprhism
`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`. -/
noncomputable instance : normed_ring 𝓜(𝕜, A) :=
normed_ring.induced _ _ (to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ)
  to_prod_mul_opposite_injective

-- even though the definition is actually in terms of `double_centralizer.to_prod_mul_opposite`, we
-- choose to see through that here to avoid `mul_opposite.op` appearing.
lemma norm_def (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.to_prod_hom‖ := rfl
lemma nnnorm_def (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.to_prod_hom‖₊ := rfl

lemma norm_def' (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.to_prod_mul_opposite_hom‖ := rfl
lemma nnnorm_def' (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.to_prod_mul_opposite_hom‖₊ := rfl

instance : normed_space 𝕜 𝓜(𝕜, A) :=
{ norm_smul_le := λ k a, norm_smul_le k a.to_prod_mul_opposite,
  .. double_centralizer.module }

instance : normed_algebra 𝕜 𝓜(𝕜, A) :=
{ ..double_centralizer.algebra, ..double_centralizer.normed_space }

lemma uniform_embedding_to_prod_mul_opposite :
  uniform_embedding (@to_prod_mul_opposite 𝕜 A _ _ _ _ _) :=
uniform_embedding_comap to_prod_mul_opposite_injective

instance [complete_space A] : complete_space 𝓜(𝕜, A) :=
begin
  rw complete_space_iff_is_complete_range
    uniform_embedding_to_prod_mul_opposite.to_uniform_inducing,
  apply is_closed.is_complete,
  simp only [range_to_prod_mul_opposite, set.set_of_forall],
  refine is_closed_Inter (λ x, is_closed_Inter $ λ y, is_closed_eq _ _),
  exact ((continuous_linear_map.apply 𝕜 A _).continuous.comp $
    continuous_unop.comp continuous_snd).mul continuous_const,
  exact continuous_const.mul ((continuous_linear_map.apply 𝕜 A _).continuous.comp continuous_fst),
end

variables [star_ring A] [cstar_ring A]

/-- For `a : 𝓜(𝕜, A)`, the norms of `a.fst` and `a.snd` coincide, and hence these
also coincide with `‖a‖` which is `max (‖a.fst‖) (‖a.snd‖)`. -/
lemma norm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a.snd‖ :=
begin
  -- a handy lemma for this proof
  have h0 : ∀ f : A →L[𝕜] A, ∀ C : ℝ≥0, (∀ b : A, ‖f b‖₊ ^ 2 ≤ C * ‖f b‖₊ * ‖b‖₊) → ‖f‖₊ ≤ C,
  { intros f C h,
    have h1 : ∀ b, C * ‖f b‖₊ * ‖b‖₊ ≤ C * ‖f‖₊ * ‖b‖₊ ^ 2,
    { intros b,
      convert mul_le_mul_right' (mul_le_mul_left' (f.le_op_nnnorm b) C) (‖b‖₊) using 1,
      ring, },
    have := div_le_of_le_mul (f.op_nnnorm_le_bound _ (by simpa only [sqrt_sq, sqrt_mul]
      using (λ b, sqrt_le_sqrt_iff.mpr ((h b).trans (h1 b))))),
    convert rpow_le_rpow this two_pos.le,
    { simp only [rpow_two, div_pow, sq_sqrt], simp only [sq, mul_self_div_self] },
    { simp only [rpow_two, sq_sqrt] } },
  have h1 : ∀ b, ‖a.fst b‖₊ ^ 2 ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊,
  { intros b,
    calc ‖a.fst b‖₊ ^ 2
        = ‖star (a.fst b) * (a.fst b)‖₊
        : by simpa only [←sq] using (cstar_ring.nnnorm_star_mul_self).symm
    ... ≤ ‖a.snd (star (a.fst b))‖₊ * ‖b‖₊ : a.central (star (a.fst b)) b ▸ nnnorm_mul_le _ _
    ... ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊
        : nnnorm_star (a.fst b) ▸ mul_le_mul_right' (a.snd.le_op_nnnorm _) _},
  have h2 : ∀ b, ‖a.snd b‖₊ ^ 2 ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊,
  { intros b,
    calc ‖a.snd b‖₊ ^ 2
        = ‖a.snd b * star (a.snd b)‖₊
        : by simpa only [←sq] using (cstar_ring.nnnorm_self_mul_star).symm
    ... ≤ ‖b‖₊ * ‖a.fst (star (a.snd b))‖₊
        : (a.central b (star (a.snd b))).symm ▸ nnnorm_mul_le _ _
    ... = ‖a.fst (star (a.snd b))‖₊ * ‖b‖₊ : mul_comm _ _
    ... ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊
        : nnnorm_star (a.snd b) ▸ mul_le_mul_right' (a.fst.le_op_nnnorm _) _  },
  exact le_antisymm (h0 _ _ h1) (h0 _ _ h2),
end

lemma nnnorm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a.snd‖₊ := subtype.ext $ norm_fst_eq_snd a
@[simp] lemma norm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a‖ :=
  by simp only [norm_def, to_prod_hom_apply, prod.norm_def, norm_fst_eq_snd, max_eq_right,
    eq_self_iff_true]
@[simp] lemma norm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖ = ‖a‖ := by rw [←norm_fst, norm_fst_eq_snd]
@[simp] lemma nnnorm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a‖₊ := subtype.ext (norm_fst a)
@[simp] lemma nnnorm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖₊ = ‖a‖₊ := subtype.ext (norm_snd a)

end nontrivially_normed

section densely_normed

variables {𝕜 A : Type*} [densely_normed_field 𝕜] [star_ring 𝕜]
variables [non_unital_normed_ring A] [star_ring A] [cstar_ring A]
variables [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A] [star_module 𝕜 A]

instance : cstar_ring 𝓜(𝕜, A) :=
{ norm_star_mul_self := λ a, congr_arg (coe : ℝ≥0 → ℝ) $ show ‖star a * a‖₊ = ‖a‖₊ * ‖a‖₊, from
  begin
    /- The essence of the argument is this: let `a = (L,R)` and recall `‖a‖ = ‖L‖`.
    `star a = (star ∘ R ∘ star, star ∘ L ∘ star)`. Then for any `x y : A`, we have
    `‖star a * a‖ = ‖(star a * a).snd‖ = ‖R (star (L (star x))) * y‖ = ‖star (L (star x)) * L y‖`
    Now, on the one hand,
    `‖star (L (star x)) * L y‖ ≤ ‖star (L (star x))‖ * ‖L y‖ = ‖L (star x)‖ * ‖L y‖ ≤ ‖L‖ ^ 2`
    whenever `‖x‖, ‖y‖ ≤ 1`, so the supremum over all such `x, y` is at most `‖L‖ ^ 2`.
    On the other hand, for any `‖z‖ ≤ 1`, we may choose `x := star z` and `y := z` to get:
    `‖star (L (star x)) * L y‖ = ‖star (L z) * (L z)‖ = ‖L z‖ ^ 2`, and taking the supremum over
    all such `z` yields that the supremum is at least `‖L‖ ^ 2`. It is the latter part of the
    argument where `densely_normed_field 𝕜` is required (for `Sup_closed_unit_ball_eq_nnnorm`). -/
    have hball : (metric.closed_ball (0 : A) 1).nonempty :=
      metric.nonempty_closed_ball.2 (zero_le_one),
    have key : ∀ x y, ‖x‖₊ ≤ 1 → ‖y‖₊ ≤ 1 → ‖a.snd (star (a.fst (star x))) * y‖₊ ≤ ‖a‖₊ * ‖a‖₊,
    { intros x y hx hy,
      rw [a.central],
      calc ‖star (a.fst (star x)) * a.fst y‖₊ ≤ ‖a.fst (star x)‖₊ * ‖a.fst y‖₊
          : nnnorm_star (a.fst (star x)) ▸ nnnorm_mul_le _ _
      ... ≤ (‖a.fst‖₊ * 1) * (‖a.fst‖₊ * 1)
          : mul_le_mul' (a.fst.le_op_norm_of_le ((nnnorm_star x).trans_le hx))
              (a.fst.le_op_norm_of_le hy)
      ... ≤ ‖a‖₊ * ‖a‖₊ : by simp only [mul_one, nnnorm_fst] },
    rw ←nnnorm_snd,
    simp only [mul_snd, ←Sup_closed_unit_ball_eq_nnnorm, star_snd, mul_apply],
    simp only [←@op_nnnorm_mul 𝕜 A],
    simp only [←Sup_closed_unit_ball_eq_nnnorm, mul_apply'],
    refine cSup_eq_of_forall_le_of_forall_lt_exists_gt (hball.image _) _ (λ r hr, _),
    { rintro - ⟨x, hx, rfl⟩,
      refine cSup_le (hball.image _) _,
      rintro - ⟨y, hy, rfl⟩,
      exact key x y (mem_closed_ball_zero_iff.1 hx) (mem_closed_ball_zero_iff.1 hy) },
    { simp only [set.mem_image, set.mem_set_of_eq, exists_prop, exists_exists_and_eq_and],
      have hr' : r.sqrt < ‖a‖₊ := (‖a‖₊).sqrt_mul_self ▸ nnreal.sqrt_lt_sqrt_iff.2 hr,
      simp_rw [←nnnorm_fst, ←Sup_closed_unit_ball_eq_nnnorm] at hr',
      obtain ⟨_, ⟨x, hx, rfl⟩, hxr⟩ := exists_lt_of_lt_cSup (hball.image _) hr',
      have hx' : ‖x‖₊ ≤ 1 := mem_closed_ball_zero_iff.1 hx,
      refine ⟨star x, mem_closed_ball_zero_iff.2 ((nnnorm_star x).trans_le hx'), _⟩,
      refine lt_cSup_of_lt _ ⟨x, hx, rfl⟩ _,
      { refine ⟨‖a‖₊ * ‖a‖₊, _⟩,
        rintros - ⟨y, hy, rfl⟩,
        exact key (star x) y ((nnnorm_star x).trans_le hx') (mem_closed_ball_zero_iff.1 hy) },
      { simpa only [a.central, star_star, cstar_ring.nnnorm_star_mul_self, nnreal.sq_sqrt, ←sq]
          using pow_lt_pow_of_lt_left hxr zero_le' two_pos } }
  end }

end densely_normed

end double_centralizer


import cautomaton utils data.vector
open utils

namespace ww

section ww

inductive cellT | empty | ehead | etail | condu

open cellT

def cellT_str : cellT → string
    | empty := " "
    | ehead := "H"
    | etail := "T"
    | condu := "X"

instance cellT_to_str : has_to_string cellT := ⟨cellT_str⟩

instance cellT_repr : has_repr cellT := ⟨cellT_str⟩

instance cellT_deceq : decidable_eq cellT :=
    λl r,
        begin
            cases l; cases r; try {exact is_true rfl}; apply is_false; trivial
        end

attribute [reducible]
def ww := cautomaton cellT

def step : cellT → ℕ → cellT
  | empty _ := empty
  | ehead _ := etail
  | etail _ := condu
  | condu c := if c = 1 ∨ c = 2 then ehead else condu

def ww_step (cell : cellT) (neigh : list cellT) :=
      step cell $ count_at_single neigh ehead

def mk_ww (g : vec_grid₀ cellT) : ww :=
    ⟨g, empty, cautomatons.moore,
     sum.inr $ @bound_const (vec_grid₀ cellT) _, ww_step⟩

def wire_g :=
  vec_grid₀.mk ⟨1, 5, dec_trivial,
               ⟨[etail, ehead, condu, condu, condu], rfl⟩⟩
               ⟨0, 1⟩

def wire : ww := mk_ww wire_g

def or_g_10 :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[etail, ehead, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                          empty, condu, condu, condu, condu, condu,
                          empty, empty, condu, empty, empty, empty,
                          condu, condu, empty, empty, empty, empty], rfl⟩⟩
                        ⟨0, 1⟩

def or_10 : ww := mk_ww or_g_10

def or_g_01 :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[condu, condu, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                          empty, condu, condu, condu, condu, condu,
                          empty, empty, condu, empty, empty, empty,
                          etail, ehead, empty, empty, empty, empty], rfl⟩⟩
                        ⟨0, 1⟩

def or_01 : ww := mk_ww or_g_01

open cardinals

section ww_or

def or_gate' :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[condu, condu, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                          empty, condu, condu, condu, condu, condu,
                          empty, empty, condu, empty, empty, empty,
                          etail, ehead, empty, empty, empty, empty], rfl⟩⟩
                        ⟨-5, -5⟩

def or_gate : ww := mk_ww or_gate'

def write_input (i₁ : bool) (i₂ : bool) :=
    let (b₁, b₂) := if i₁ then (etail, ehead) else (condu, condu) in
    let (b₃, b₄) := if i₂ then (etail, ehead) else (condu, condu) in
    mod_many
        [(⟨-5, -10⟩, b₁), (⟨-4, -10⟩, b₂), (⟨-5, -6⟩, b₃), (⟨-4, -6⟩, b₄)]
        or_gate

def sim_or (i₁ i₂ : bool) : bool :=
    let sim := step_n (write_input i₁ i₂) 3 in
        yield_at sim ⟨-8, -2⟩ = etail ∧ yield_at sim ⟨-8, -1⟩ = ehead

end ww_or

section ww_xor

inductive direction | N | W | E | S

open direction

structure inout :=
    (p₁ : point)
    (p₂ : point)
    (dir : direction)

structure ww₁ :=
    (aut : ww)
    (ins : list inout)
    (ous : list inout)

def str_of_ww₁ : ww₁ → string
  | ⟨aut, _, _⟩ := to_string aut

instance ww₁_to_str : has_to_string ww₁ := ⟨str_of_ww₁⟩

instance ww₁_repr : has_repr ww₁ := ⟨str_of_ww₁⟩

def mk_ww₁ (g : vec_grid₀ cellT) (inputs outputs : list inout) : ww₁ :=
    ⟨mk_ww g, inputs, outputs⟩

def write (a : ww₁) (n : ℕ) (b : bool) : ww₁ :=
    let input := list.nth a.ins n in
    match input with
        | none := a
        | some ⟨p₁, p₂, dir⟩ :=
          if b then
          match dir with
            | N :=
                ww₁.mk (mod_many [(up p₁ p₂, ehead), (down p₁ p₂, etail)] a.aut)
                        a.ins a.ous
            | S :=
                ww₁.mk (mod_many [(down p₁ p₂, ehead), (up p₁ p₂, etail)] a.aut)
                              a.ins a.ous
            | W :=
              ww₁.mk (mod_many [(left p₁ p₂, ehead), (right p₁ p₂, etail)] a.aut)
                              a.ins a.ous
            | E :=
                ww₁.mk (mod_many [(right p₁ p₂, ehead), (left p₁ p₂, etail)] a.aut)
                              a.ins a.ous
          end
          else ww₁.mk (mod_many [(p₁, condu), (p₂, condu)] a.aut) a.ins a.ous
    end

def read (a : ww₁) (n : ℕ) : bool :=
    let output := list.nth a.ous n in
    match output with
      | none := ff
      | some ⟨p₁, p₂, dir⟩ :=
      match dir with
        | N := yield_at a.aut (up p₁ p₂) = ehead ∧
                      yield_at a.aut (down p₁ p₂) = etail
        | S := yield_at a.aut (up p₁ p₂) = etail ∧
                      yield_at a.aut (down p₁ p₂) = ehead
        | W := yield_at a.aut (left p₁ p₂) = ehead ∧
                      yield_at a.aut (right p₁ p₂) = etail
        | E := yield_at a.aut (left p₁ p₂) = etail ∧
                      yield_at a.aut (right p₁ p₂) = ehead
      end
    end

def xor_gate' :=
    vec_grid₀.mk ⟨7, 7, dec_trivial,
      ⟨[condu, condu, empty, empty, empty, empty, empty,
        empty, empty, condu, empty, empty, empty, empty,
        empty, condu, condu, condu, condu, empty, empty,
        empty, condu, empty, empty, condu, condu, condu,
        empty, condu, condu, condu, condu, empty, empty,
        empty, empty, condu, empty, empty, empty, empty,
        condu, condu, empty, empty, empty, empty, empty], rfl⟩⟩
      ⟨0, 0⟩

def xor_gate_inputs : list inout := [⟨⟨0, 6⟩, ⟨1, 6⟩, E⟩, ⟨⟨0, 0⟩, ⟨1, 0⟩, E⟩]

def xor_gate_outputs : list inout := [⟨⟨5, 3⟩, ⟨6, 3⟩, E⟩]

def mk_xor (a : ww) : ww₁ := ⟨a, xor_gate_inputs, xor_gate_outputs⟩

def xor_gate_w : ww := mk_ww xor_gate'

def xor_gate : ww₁ := mk_xor xor_gate_w

def xor' (b₁ b₂ : bool) : bool :=
    read (mk_xor (step_n (write (write xor_gate 0 b₂) 1 b₁).aut 5)) 0

theorem xor_iff_xor' {b₁ b₂} : bxor b₁ b₂ ↔ xor' b₁ b₂ :=
begin
  cases b₁; cases b₂; split; intros h,
  {
    dsimp at h, contradiction
  },
  {
    have : xor' ff ff = ff, from dec_trivial,
    rw this at h,
    contradiction
  },
  {
    exact dec_trivial
  },
  {
    dsimp, unfold_coes
  },
  {
    exact dec_trivial
  },
  {
    dsimp, unfold_coes
  },
  {
    dsimp at h, contradiction
  },
  {
    have : xor' tt tt = ff, from dec_trivial,
    rw this at h,
    contradiction
  }
end

end ww_xor

end ww

end ww