/-
Copyright (c) 2021 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma

! This file was ported from Lean 3 source module analysis.asymptotics.superpolynomial_decay
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Asymptotics.Asymptotics
import Mathbin.Analysis.Normed.Order.Basic
import Mathbin.Data.Polynomial.Eval
import Mathbin.Topology.Algebra.Order.LiminfLimsup

/-!
# Super-Polynomial Function Decay

This file defines a predicate `asymptotics.superpolynomial_decay f` for a function satisfying
  one of following equivalent definitions (The definition is in terms of the first condition):

* `x ^ n * f` tends to `𝓝 0` for all (or sufficiently large) naturals `n`
* `|x ^ n * f|` tends to `𝓝 0` for all naturals `n` (`superpolynomial_decay_iff_abs_tendsto_zero`)
* `|x ^ n * f|` is bounded for all naturals `n` (`superpolynomial_decay_iff_abs_is_bounded_under`)
* `f` is `o(x ^ c)` for all integers `c` (`superpolynomial_decay_iff_is_o`)
* `f` is `O(x ^ c)` for all integers `c` (`superpolynomial_decay_iff_is_O`)

These conditions are all equivalent to conditions in terms of polynomials, replacing `x ^ c` with
  `p(x)` or `p(x)⁻¹` as appropriate, since asymptotically `p(x)` behaves like `X ^ p.nat_degree`.
These further equivalences are not proven in mathlib but would be good future projects.

The definition of superpolynomial decay for `f : α → β` is relative to a parameter `k : α → β`.
Super-polynomial decay then means `f x` decays faster than `(k x) ^ c` for all integers `c`.
Equivalently `f x` decays faster than `p.eval (k x)` for all polynomials `p : β[X]`.
The definition is also relative to a filter `l : filter α` where the decay rate is compared.

When the map `k` is given by `n ↦ ↑n : ℕ → ℝ` this defines negligible functions:
https://en.wikipedia.org/wiki/Negligible_function

When the map `k` is given by `(r₁,...,rₙ) ↦ r₁*...*rₙ : ℝⁿ → ℝ` this is equivalent
  to the definition of rapidly decreasing functions given here:
https://ncatlab.org/nlab/show/rapidly+decreasing+function

# Main Theorems

* `superpolynomial_decay.polynomial_mul` says that if `f(x)` is negligible,
    then so is `p(x) * f(x)` for any polynomial `p`.
* `superpolynomial_decay_iff_zpow_tendsto_zero` gives an equivalence between definitions in terms
    of decaying faster than `k(x) ^ n` for all naturals `n` or `k(x) ^ c` for all integer `c`.
-/

namespace Asymptotics

open Topology Polynomial

open Filter

/-- `f` has superpolynomial decay in parameter `k` along filter `l` if
  `k ^ n * f` tends to zero at `l` for all naturals `n` -/
def SuperpolynomialDecay {α β : Type _} [TopologicalSpace β] [CommSemiring β] (l : Filter α)
    (k : α → β) (f : α → β) :=
  ∀ n : ℕ, Tendsto (fun a : α => k a ^ n * f a) l (𝓝 0)
#align asymptotics.superpolynomial_decay Asymptotics.SuperpolynomialDecay

variable {α β : Type _} {l : Filter α} {k : α → β} {f g g' : α → β}

section CommSemiring

variable [TopologicalSpace β] [CommSemiring β]

theorem SuperpolynomialDecay.congr' (hf : SuperpolynomialDecay l k f) (hfg : f =ᶠ[l] g) :
    SuperpolynomialDecay l k g := fun z =>
  (hf z).congr' (EventuallyEq.mul (EventuallyEq.refl l _) hfg)
#align asymptotics.superpolynomial_decay.congr' Asymptotics.SuperpolynomialDecay.congr'

theorem SuperpolynomialDecay.congr (hf : SuperpolynomialDecay l k f) (hfg : ∀ x, f x = g x) :
    SuperpolynomialDecay l k g := fun z =>
  (hf z).congr fun x => (congr_arg fun a => k x ^ z * a) <| hfg x
#align asymptotics.superpolynomial_decay.congr Asymptotics.SuperpolynomialDecay.congr

@[simp]
theorem superpolynomialDecay_zero (l : Filter α) (k : α → β) : SuperpolynomialDecay l k 0 :=
  fun z => by simpa only [Pi.zero_apply, MulZeroClass.mul_zero] using tendsto_const_nhds
#align asymptotics.superpolynomial_decay_zero Asymptotics.superpolynomialDecay_zero

theorem SuperpolynomialDecay.add [ContinuousAdd β] (hf : SuperpolynomialDecay l k f)
    (hg : SuperpolynomialDecay l k g) : SuperpolynomialDecay l k (f + g) := fun z => by
  simpa only [mul_add, add_zero, Pi.add_apply] using (hf z).add (hg z)
#align asymptotics.superpolynomial_decay.add Asymptotics.SuperpolynomialDecay.add

theorem SuperpolynomialDecay.mul [ContinuousMul β] (hf : SuperpolynomialDecay l k f)
    (hg : SuperpolynomialDecay l k g) : SuperpolynomialDecay l k (f * g) := fun z => by
  simpa only [mul_assoc, one_mul, MulZeroClass.mul_zero, pow_zero] using (hf z).mul (hg 0)
#align asymptotics.superpolynomial_decay.mul Asymptotics.SuperpolynomialDecay.mul

theorem SuperpolynomialDecay.mul_const [ContinuousMul β] (hf : SuperpolynomialDecay l k f) (c : β) :
    SuperpolynomialDecay l k fun n => f n * c := fun z => by
  simpa only [← mul_assoc, MulZeroClass.zero_mul] using tendsto.mul_const c (hf z)
#align asymptotics.superpolynomial_decay.mul_const Asymptotics.SuperpolynomialDecay.mul_const

theorem SuperpolynomialDecay.const_mul [ContinuousMul β] (hf : SuperpolynomialDecay l k f) (c : β) :
    SuperpolynomialDecay l k fun n => c * f n :=
  (hf.mul_const c).congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.const_mul Asymptotics.SuperpolynomialDecay.const_mul

theorem SuperpolynomialDecay.param_mul (hf : SuperpolynomialDecay l k f) :
    SuperpolynomialDecay l k (k * f) := fun z =>
  tendsto_nhds.2 fun s hs hs0 =>
    l.sets_of_superset ((tendsto_nhds.1 (hf <| z + 1)) s hs hs0) fun x hx => by
      simpa only [Set.mem_preimage, Pi.mul_apply, ← mul_assoc, ← pow_succ'] using hx
#align asymptotics.superpolynomial_decay.param_mul Asymptotics.SuperpolynomialDecay.param_mul

theorem SuperpolynomialDecay.mul_param (hf : SuperpolynomialDecay l k f) :
    SuperpolynomialDecay l k (f * k) :=
  hf.param_mul.congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.mul_param Asymptotics.SuperpolynomialDecay.mul_param

theorem SuperpolynomialDecay.param_pow_mul (hf : SuperpolynomialDecay l k f) (n : ℕ) :
    SuperpolynomialDecay l k (k ^ n * f) :=
  by
  induction' n with n hn
  · simpa only [one_mul, pow_zero] using hf
  · simpa only [pow_succ, mul_assoc] using hn.param_mul
#align asymptotics.superpolynomial_decay.param_pow_mul Asymptotics.SuperpolynomialDecay.param_pow_mul

theorem SuperpolynomialDecay.mul_param_pow (hf : SuperpolynomialDecay l k f) (n : ℕ) :
    SuperpolynomialDecay l k (f * k ^ n) :=
  (hf.param_pow_mul n).congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.mul_param_pow Asymptotics.SuperpolynomialDecay.mul_param_pow

theorem SuperpolynomialDecay.polynomial_mul [ContinuousAdd β] [ContinuousMul β]
    (hf : SuperpolynomialDecay l k f) (p : β[X]) :
    SuperpolynomialDecay l k fun x => (p.eval <| k x) * f x :=
  Polynomial.induction_on' p (fun p q hp hq => by simpa [add_mul] using hp.add hq) fun n c => by
    simpa [mul_assoc] using (hf.param_pow_mul n).const_mul c
#align asymptotics.superpolynomial_decay.polynomial_mul Asymptotics.SuperpolynomialDecay.polynomial_mul

theorem SuperpolynomialDecay.mul_polynomial [ContinuousAdd β] [ContinuousMul β]
    (hf : SuperpolynomialDecay l k f) (p : β[X]) :
    SuperpolynomialDecay l k fun x => f x * (p.eval <| k x) :=
  (hf.polynomial_mul p).congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.mul_polynomial Asymptotics.SuperpolynomialDecay.mul_polynomial

end CommSemiring

section OrderedCommSemiring

variable [TopologicalSpace β] [OrderedCommSemiring β] [OrderTopology β]

theorem SuperpolynomialDecay.trans_eventuallyLE (hk : 0 ≤ᶠ[l] k) (hg : SuperpolynomialDecay l k g)
    (hg' : SuperpolynomialDecay l k g') (hfg : g ≤ᶠ[l] f) (hfg' : f ≤ᶠ[l] g') :
    SuperpolynomialDecay l k f := fun z =>
  tendsto_of_tendsto_of_tendsto_of_le_of_le' (hg z) (hg' z)
    (hfg.mp (hk.mono fun x hx hx' => mul_le_mul_of_nonneg_left hx' (pow_nonneg hx z)))
    (hfg'.mp (hk.mono fun x hx hx' => mul_le_mul_of_nonneg_left hx' (pow_nonneg hx z)))
#align asymptotics.superpolynomial_decay.trans_eventually_le Asymptotics.SuperpolynomialDecay.trans_eventuallyLE

end OrderedCommSemiring

section LinearOrderedCommRing

variable [TopologicalSpace β] [LinearOrderedCommRing β] [OrderTopology β]

variable (l k f)

theorem superpolynomialDecay_iff_abs_tendsto_zero :
    SuperpolynomialDecay l k f ↔ ∀ n : ℕ, Tendsto (fun a : α => |k a ^ n * f a|) l (𝓝 0) :=
  ⟨fun h z => (tendsto_zero_iff_abs_tendsto_zero _).1 (h z), fun h z =>
    (tendsto_zero_iff_abs_tendsto_zero _).2 (h z)⟩
#align asymptotics.superpolynomial_decay_iff_abs_tendsto_zero Asymptotics.superpolynomialDecay_iff_abs_tendsto_zero

theorem superpolynomialDecay_iff_superpolynomialDecay_abs :
    SuperpolynomialDecay l k f ↔ SuperpolynomialDecay l (fun a => |k a|) fun a => |f a| :=
  (superpolynomialDecay_iff_abs_tendsto_zero l k f).trans
    (by simp_rw [superpolynomial_decay, abs_mul, abs_pow])
#align asymptotics.superpolynomial_decay_iff_superpolynomial_decay_abs Asymptotics.superpolynomialDecay_iff_superpolynomialDecay_abs

variable {l k f}

theorem SuperpolynomialDecay.trans_eventually_abs_le (hf : SuperpolynomialDecay l k f)
    (hfg : abs ∘ g ≤ᶠ[l] abs ∘ f) : SuperpolynomialDecay l k g :=
  by
  rw [superpolynomial_decay_iff_abs_tendsto_zero] at hf⊢
  refine' fun z =>
    tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds (hf z)
      (eventually_of_forall fun x => abs_nonneg _) (hfg.mono fun x hx => _)
  calc
    |k x ^ z * g x| = |k x ^ z| * |g x| := abs_mul (k x ^ z) (g x)
    _ ≤ |k x ^ z| * |f x| := (mul_le_mul le_rfl hx (abs_nonneg _) (abs_nonneg _))
    _ = |k x ^ z * f x| := (abs_mul (k x ^ z) (f x)).symm

#align asymptotics.superpolynomial_decay.trans_eventually_abs_le Asymptotics.SuperpolynomialDecay.trans_eventually_abs_le

theorem SuperpolynomialDecay.trans_abs_le (hf : SuperpolynomialDecay l k f)
    (hfg : ∀ x, |g x| ≤ |f x|) : SuperpolynomialDecay l k g :=
  hf.trans_eventually_abs_le (eventually_of_forall hfg)
#align asymptotics.superpolynomial_decay.trans_abs_le Asymptotics.SuperpolynomialDecay.trans_abs_le

end LinearOrderedCommRing

section Field

variable [TopologicalSpace β] [Field β] (l k f)

theorem superpolynomialDecay_mul_const_iff [ContinuousMul β] {c : β} (hc0 : c ≠ 0) :
    (SuperpolynomialDecay l k fun n => f n * c) ↔ SuperpolynomialDecay l k f :=
  ⟨fun h => (h.mul_const c⁻¹).congr fun x => by simp [mul_assoc, mul_inv_cancel hc0], fun h =>
    h.mul_const c⟩
#align asymptotics.superpolynomial_decay_mul_const_iff Asymptotics.superpolynomialDecay_mul_const_iff

theorem superpolynomialDecay_const_mul_iff [ContinuousMul β] {c : β} (hc0 : c ≠ 0) :
    (SuperpolynomialDecay l k fun n => c * f n) ↔ SuperpolynomialDecay l k f :=
  ⟨fun h => (h.const_mul c⁻¹).congr fun x => by simp [← mul_assoc, inv_mul_cancel hc0], fun h =>
    h.const_mul c⟩
#align asymptotics.superpolynomial_decay_const_mul_iff Asymptotics.superpolynomialDecay_const_mul_iff

variable {l k f}

end Field

section LinearOrderedField

variable [TopologicalSpace β] [LinearOrderedField β] [OrderTopology β]

variable (f)

theorem superpolynomialDecay_iff_abs_isBoundedUnder (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k f ↔ ∀ z : ℕ, IsBoundedUnder (· ≤ ·) l fun a : α => |k a ^ z * f a| :=
  by
  refine'
    ⟨fun h z => tendsto.is_bounded_under_le (tendsto.abs (h z)), fun h =>
      (superpolynomial_decay_iff_abs_tendsto_zero l k f).2 fun z => _⟩
  obtain ⟨m, hm⟩ := h (z + 1)
  have h1 : tendsto (fun a : α => (0 : β)) l (𝓝 0) := tendsto_const_nhds
  have h2 : tendsto (fun a : α => |(k a)⁻¹| * m) l (𝓝 0) :=
    MulZeroClass.zero_mul m ▸
      tendsto.mul_const m ((tendsto_zero_iff_abs_tendsto_zero _).1 hk.inv_tendsto_at_top)
  refine'
    tendsto_of_tendsto_of_tendsto_of_le_of_le' h1 h2 (eventually_of_forall fun x => abs_nonneg _)
      ((eventually_map.1 hm).mp _)
  refine' (hk.eventually_ne_at_top 0).mono fun x hk0 hx => _
  refine' Eq.trans_le _ (mul_le_mul_of_nonneg_left hx <| abs_nonneg (k x)⁻¹)
  rw [← abs_mul, ← mul_assoc, pow_succ, ← mul_assoc, inv_mul_cancel hk0, one_mul]
#align asymptotics.superpolynomial_decay_iff_abs_is_bounded_under Asymptotics.superpolynomialDecay_iff_abs_isBoundedUnder

theorem superpolynomialDecay_iff_zpow_tendsto_zero (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k f ↔ ∀ z : ℤ, Tendsto (fun a : α => k a ^ z * f a) l (𝓝 0) :=
  by
  refine' ⟨fun h z => _, fun h n => by simpa only [zpow_ofNat] using h (n : ℤ)⟩
  by_cases hz : 0 ≤ z
  · lift z to ℕ using hz
    simpa using h z
  · have : tendsto (fun a => k a ^ z) l (𝓝 0) :=
      tendsto.comp (tendsto_zpow_atTop_zero (not_le.1 hz)) hk
    have h : tendsto f l (𝓝 0) := by simpa using h 0
    exact MulZeroClass.zero_mul (0 : β) ▸ this.mul h
#align asymptotics.superpolynomial_decay_iff_zpow_tendsto_zero Asymptotics.superpolynomialDecay_iff_zpow_tendsto_zero

variable {f}

theorem SuperpolynomialDecay.param_zpow_mul (hk : Tendsto k l atTop)
    (hf : SuperpolynomialDecay l k f) (z : ℤ) : SuperpolynomialDecay l k fun a => k a ^ z * f a :=
  by
  rw [superpolynomial_decay_iff_zpow_tendsto_zero _ hk] at hf⊢
  refine' fun z' => (hf <| z' + z).congr' ((hk.eventually_ne_at_top 0).mono fun x hx => _)
  simp [zpow_add₀ hx, mul_assoc, Pi.mul_apply]
#align asymptotics.superpolynomial_decay.param_zpow_mul Asymptotics.SuperpolynomialDecay.param_zpow_mul

theorem SuperpolynomialDecay.mul_param_zpow (hk : Tendsto k l atTop)
    (hf : SuperpolynomialDecay l k f) (z : ℤ) : SuperpolynomialDecay l k fun a => f a * k a ^ z :=
  (hf.param_zpow_mul hk z).congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.mul_param_zpow Asymptotics.SuperpolynomialDecay.mul_param_zpow

theorem SuperpolynomialDecay.inv_param_mul (hk : Tendsto k l atTop)
    (hf : SuperpolynomialDecay l k f) : SuperpolynomialDecay l k (k⁻¹ * f) := by
  simpa using hf.param_zpow_mul hk (-1)
#align asymptotics.superpolynomial_decay.inv_param_mul Asymptotics.SuperpolynomialDecay.inv_param_mul

theorem SuperpolynomialDecay.param_inv_mul (hk : Tendsto k l atTop)
    (hf : SuperpolynomialDecay l k f) : SuperpolynomialDecay l k (f * k⁻¹) :=
  (hf.inv_param_mul hk).congr fun _ => mul_comm _ _
#align asymptotics.superpolynomial_decay.param_inv_mul Asymptotics.SuperpolynomialDecay.param_inv_mul

variable (f)

theorem superpolynomialDecay_param_mul_iff (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k (k * f) ↔ SuperpolynomialDecay l k f :=
  ⟨fun h =>
    (h.inv_param_mul hk).congr'
      ((hk.eventually_ne_atTop 0).mono fun x hx => by simp [← mul_assoc, inv_mul_cancel hx]),
    fun h => h.param_mul⟩
#align asymptotics.superpolynomial_decay_param_mul_iff Asymptotics.superpolynomialDecay_param_mul_iff

theorem superpolynomialDecay_mul_param_iff (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k (f * k) ↔ SuperpolynomialDecay l k f := by
  simpa [mul_comm k] using superpolynomial_decay_param_mul_iff f hk
#align asymptotics.superpolynomial_decay_mul_param_iff Asymptotics.superpolynomialDecay_mul_param_iff

theorem superpolynomialDecay_param_pow_mul_iff (hk : Tendsto k l atTop) (n : ℕ) :
    SuperpolynomialDecay l k (k ^ n * f) ↔ SuperpolynomialDecay l k f :=
  by
  induction' n with n hn
  · simp
  ·
    simpa [pow_succ, ← mul_comm k, mul_assoc,
      superpolynomial_decay_param_mul_iff (k ^ n * f) hk] using hn
#align asymptotics.superpolynomial_decay_param_pow_mul_iff Asymptotics.superpolynomialDecay_param_pow_mul_iff

theorem superpolynomialDecay_mul_param_pow_iff (hk : Tendsto k l atTop) (n : ℕ) :
    SuperpolynomialDecay l k (f * k ^ n) ↔ SuperpolynomialDecay l k f := by
  simpa [mul_comm f] using superpolynomial_decay_param_pow_mul_iff f hk n
#align asymptotics.superpolynomial_decay_mul_param_pow_iff Asymptotics.superpolynomialDecay_mul_param_pow_iff

variable {f}

end LinearOrderedField

section NormedLinearOrderedField

variable [NormedLinearOrderedField β]

variable (l k f)

theorem superpolynomialDecay_iff_norm_tendsto_zero :
    SuperpolynomialDecay l k f ↔ ∀ n : ℕ, Tendsto (fun a : α => ‖k a ^ n * f a‖) l (𝓝 0) :=
  ⟨fun h z => tendsto_zero_iff_norm_tendsto_zero.1 (h z), fun h z =>
    tendsto_zero_iff_norm_tendsto_zero.2 (h z)⟩
#align asymptotics.superpolynomial_decay_iff_norm_tendsto_zero Asymptotics.superpolynomialDecay_iff_norm_tendsto_zero

theorem superpolynomialDecay_iff_superpolynomialDecay_norm :
    SuperpolynomialDecay l k f ↔ SuperpolynomialDecay l (fun a => ‖k a‖) fun a => ‖f a‖ :=
  (superpolynomialDecay_iff_norm_tendsto_zero l k f).trans (by simp [superpolynomial_decay])
#align asymptotics.superpolynomial_decay_iff_superpolynomial_decay_norm Asymptotics.superpolynomialDecay_iff_superpolynomialDecay_norm

variable {l k}

variable [OrderTopology β]

theorem superpolynomialDecay_iff_isO (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k f ↔ ∀ z : ℤ, f =O[l] fun a : α => k a ^ z :=
  by
  refine' (superpolynomial_decay_iff_zpow_tendsto_zero f hk).trans _
  have hk0 : ∀ᶠ x in l, k x ≠ 0 := hk.eventually_ne_at_top 0
  refine' ⟨fun h z => _, fun h z => _⟩
  · refine' is_O_of_div_tendsto_nhds (hk0.mono fun x hx hxz => absurd (zpow_eq_zero hxz) hx) 0 _
    have : (fun a : α => k a ^ z)⁻¹ = fun a : α => k a ^ (-z) := funext fun x => by simp
    rw [div_eq_mul_inv, mul_comm f, this]
    exact h (-z)
  · suffices : (fun a : α => k a ^ z * f a) =O[l] fun a : α => (k a)⁻¹
    exact is_O.trans_tendsto this hk.inv_tendsto_at_top
    refine'
      ((is_O_refl (fun a => k a ^ z) l).mul (h (-(z + 1)))).trans
        (is_O.of_bound 1 <| hk0.mono fun a ha0 => _)
    simp only [one_mul, neg_add z 1, zpow_add₀ ha0, ← mul_assoc, zpow_neg,
      mul_inv_cancel (zpow_ne_zero z ha0), zpow_one]
#align asymptotics.superpolynomial_decay_iff_is_O Asymptotics.superpolynomialDecay_iff_isO

theorem superpolynomialDecay_iff_isOCat (hk : Tendsto k l atTop) :
    SuperpolynomialDecay l k f ↔ ∀ z : ℤ, f =o[l] fun a : α => k a ^ z :=
  by
  refine' ⟨fun h z => _, fun h => (superpolynomial_decay_iff_is_O f hk).2 fun z => (h z).IsO⟩
  have hk0 : ∀ᶠ x in l, k x ≠ 0 := hk.eventually_ne_at_top 0
  have : (fun x : α => (1 : β)) =o[l] k :=
    is_o_of_tendsto' (hk0.mono fun x hkx hkx' => absurd hkx' hkx)
      (by simpa using hk.inv_tendsto_at_top)
  have : f =o[l] fun x : α => k x * k x ^ (z - 1) := by
    simpa using this.mul_is_O ((superpolynomial_decay_iff_is_O f hk).1 h <| z - 1)
  refine' this.trans_is_O (is_O.of_bound 1 (hk0.mono fun x hkx => le_of_eq _))
  rw [one_mul, zpow_sub_one₀ hkx, mul_comm (k x), mul_assoc, inv_mul_cancel hkx, mul_one]
#align asymptotics.superpolynomial_decay_iff_is_o Asymptotics.superpolynomialDecay_iff_isOCat

end NormedLinearOrderedField

end Asymptotics


import tactic

open tactic

/-!
This file contains three tactic-programming exercises of increasing difficulty.
They were (hastily) written to follow the metaprogramming tutorial at
Lean for the Curious Mathematician 2020.
If you're looking for more (better) exercises, we strongly recommend the
exercises by Blanchette et al
for the course Logical Verification at the Vrije Universiteit Amsterdam,
and the corresponding chapter of the course notes:
https://github.com/blanchette/logical_verification_2020/blob/master/lean/love07_metaprogramming_exercise_sheet.lean
https://github.com/blanchette/logical_verification_2020/raw/master/hitchhikers_guide.pdf
## Exercise 1
Write a `contradiction` tactic.
The tactic should look through the hypotheses in the local context
trying to find two that contradict each other,
i.e. proving `P` and `¬ P` for some proposition `P`.
It should use this contradiction to close the goal.
Bonus: handle `P → false` as well as `¬ P`.
This exercise is to practice manipulating the hypotheses and goal.
Note: this exists as `tactic.interactive.contradiction`.
-/

meta def find_absurd_proof (e : expr) (ctx : list expr) : tactic unit :=
  do prf ← ctx.mfirst (λ h, to_expr ``(%%e %%h)),
    exact prf

meta def tactic.interactive.contr : tactic unit :=
do exfalso,
  ctx ← local_context,
  ctx.mfirst (λ e, find_absurd_proof e ctx)

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : ¬ Q) : false :=
by contr

example (P Q R : Prop) (hnq : ¬ Q) (hp : P) (hq : Q) (hr : ¬ R) : 0 = 1 :=
by contr

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : Q → false) : false :=
by contr

/-!
## Exercise 2
Write a tactic that proves a given `nat`-valued declaration is nonnegative.
The tactic should take the name of a declaration whose return type is `ℕ`
(presumably with some arguments), e.g. `nat.add : ℕ → ℕ → ℕ`
or `list.length : Π α : Type, list α → ℕ`.
It should add a new declaration to the environment which proves all applications
of this function are nonnegative,
e.g. `nat.add_nonneg : ∀ m n : ℕ, 0 ≤ nat.add m n`.
Bonus: create reasonable names for these declarations, and/or take an optional argument
for the new name.
This tactic is not useful by itself, but it's a good way to practice
querying and modifying an environment and working under binders.
It is not a tactic to be used during a proof, but rather as a command.
Hints:
* For looking at declarations in the environment, you will need the `declaration` type,
  as well as the tactics `get_decl` and `add_decl`.
* You will have to manipulate an expression under binders.
  The tactics `mk_local_pis` and `pis`, or their lambda equivalents, will be helpful here.
* `mk_mapp` is a variant of `mk_app` that lets you provide implicit arguments.
-/

meta def add_nonneg_proof (n : name) : tactic unit :=

do d ← get_decl n,
  --- d is Π x y z ..., body
  (args, body) ← mk_local_pis d.type,
  -- option exprs
  let args_with_some := args.map some,
  -- d_body is ℕ
  d_body ← mk_mapp n args_with_some,
  -- prove nonneg
  nonneg_prf_body ← mk_app `nat.zero_le [d_body],
  -- abstract
  nonneg_prf ← lambdas args nonneg_prf_body,
  -- name
  let new_decl_name := n.append `nonneg,
  -- type
  decl_tp ← infer_type nonneg_prf,
  -- term of type declaration
  let new_decl := mk_theorem new_decl_name d.univ_params decl_tp nonneg_prf,
  -- add env
  add_decl new_decl

-- these test cases should succeed when you're done

run_cmd add_nonneg_proof `nat.add
run_cmd add_nonneg_proof `list.length

#check nat.add.nonneg
#check list.length.nonneg

/-!
## Exercise 3 (challenge!)
The mathlib tactic `cancel_denoms` is intended to get rid of division by numerals
in expressions where this makes sense. For example,
-/

example (q : ℚ) (h : q / 3 > 0) : q > 0 :=
begin
  cancel_denoms at h, exact h
end

/-!
But it is not complete. In particular, it doesn't like nested division
or other operators in denominators. These all fail:
-/

-- example (q : ℚ) (h : q / (3 / 4) > 0) : false :=
-- begin
--   -- cancel_denoms at h,
--   sorry
-- end

-- example (p q : ℚ) (h : q / 2 / 3 < q) : false :=
-- begin
--   -- cancel_denoms at h,
--   sorry
-- end

-- example (p q : ℚ) (h : q / 2 < 3 / (4*q)) : false :=
-- begin
--   -- cancel_denoms at h,
--   sorry
-- end

-- -- this one succeeds but doesn't do what it should
-- example (p q : ℚ) (h : q / (2*3) < q) : false :=
-- begin
--   -- cancel_denoms at h,
--   sorry
-- end

/-!
Look at the code in `src/tactic/cancel_denoms.lean` and try to fix it.
See if you can solve any or all of these failing test cases.
If you succeed, a pull request to mathlib is strongly encouraged!
-/


variables (X Y Z : Type) (f : X → Y) (g : Y → Z)

open function

example (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  intros x₁ x₂ h,
  apply hf,
  apply hg,
  exact h,
end


/-
abbrev ℕ := Nat
def bije {α β} (f: α → β) := (∀y: β, ∃x: α, f x = y) ∧ (∀x x', f x = f x' → x = x')
def bije_contraposition {α β} {f: α → β} (h: bije f) : (∀y, ∃x, f x = y) ∧ (∀x x', x ≠ x' → f x ≠ f x') := by {
  simp [bije] at h;
  have ⟨hl, hr⟩ := h;
  apply And.intro;
  assumption;
  intro x x' h1 h2;
  specialize hr x x' h2;
  contradiction;
}
def Bijection (α β) := {f: α → β // bije f}

syntax "bije" : tactic
macro_rules
  | `(tactic| bije) => `(tactic| simp [Bijection, bije]; apply And.intro; )

def Bijection.comp {α β γ} (g: Bijection β γ) (f: Bijection α β) : Bijection α γ := ⟨λx => g.val (f.val x), by {
  bije <;>
  have ⟨gl, gr⟩ := g.property <;>
  have ⟨fl, fr⟩ := f.property;
  case left => {
    intro y;
    specialize gl y;
    have ⟨glw, glp⟩ := gl;
    specialize fl glw;
    have ⟨flw, flp⟩ := fl;
    exists flw;
    simp [←glp];
    apply congrArg;
    assumption;
  };
  case right => {
    intro x x' h;
    apply fr;
    apply gr;
    assumption;
  };
}⟩

instance {α: Type u} {β: Type v} {γ: Type w} : HMul (Bijection β γ) (Bijection α β) (Bijection α γ) where hMul := Bijection.comp
instance {α: Type u} : Mul (Bijection α α) where mul := Bijection.comp

theorem Bijection.assoc {α β γ δ} : ∀(a: Bijection γ δ) (b: Bijection β γ) (c: Bijection α β), (a * b) * c = a * (b * c) := by {
  intros;
  rfl;
}

def Bijection.id {α} : Bijection α α := ⟨λ x => x, by {
  bije;
  intro y;
  exists y;
  trivial;
  intros;
  trivial;
}⟩

theorem Bijection.leftIdentity {α β} : ∀f: Bijection α β, @Bijection.id β * f = f := by {
  intro f;
  rfl;
}

theorem Bijection.rightIdentity {α β} : ∀f: Bijection α β, f = f * @Bijection.id α := by {
  intro f;
  rfl;
}

def Bijection.inv {α β} (f: Bijection α β) : Bijection β α := ⟨λy => let ⟨fl, fr⟩ := f.property; let ⟨w, _⟩ := fl y; w, by {
  simp [bije];
  intro x;
  have ⟨hl, hr⟩ := (f.property (f.val x)).2;
  specialize hr x hl;
  exists f.val x;
  simp;
  rw [hr];
  apply And.intro;
  case left => {
    rfl;
  };
  case right => {
    intro x';
    intro h1;
    have ⟨hlx', hrx'⟩ := (f.property x').2;
    rw [←h1] at  hlx';
    assumption;
  };
}⟩

postfix:max "⁻¹" => Bijection.inv

theorem Bijection.leftInverse {α β} : ∀f: Bijection α β, f⁻¹ * f = id := by {
  intro f;
  have h: ∀x, (f⁻¹ * f).val x = id.val x := by {
    intro x;
    simp [inv, HMul.hMul, comp];
    induction f with
    | mk f p => {
      have ⟨h1l, h1r⟩ := (p (f x)).2;
      specialize h1r x h1l;
      rw [h1r];
      rfl;
    };
  };
  exact Subtype.eq (funext h);
}
theorem Bijection.rightInverse {α β} : ∀f: Bijection α β, id = f * f⁻¹ := by {
  intro f;
  have h: ∀x, id.val x = (f * f⁻¹).val x := by {
    intro x;
    --generalize h: f⁻¹ = f';
    simp [inv, HMul.hMul, comp] at *;
    induction f with
    | mk f p => {
      simp;
      have ⟨h1l, h1r⟩ := (p x).2;
      rw [h1l];
      rfl;
    }
  };
  exact Subtype.eq (funext h);
}

def Perm (n: ℕ) := Bijection (Fin n) (Fin n)
instance {n: ℕ} : Mul (Perm n) where mul := Bijection.comp
def Perm.id {n: ℕ} : Perm n := @Bijection.id (Fin n)
def Transposition {n: ℕ} (i j: Fin n) := {t: Perm n // i.val < j.val ∧ t.val i = j ∧ t.val j = i ∧ ∀k: Fin n, k ≠ i ∧ k ≠ j → t.val k = k}
instance {n: ℕ} : Coe (Fin n) (Fin (n + 1)) :=
  ⟨λx => ⟨x.val, Nat.lt.step x.isLt⟩⟩
instance {n: ℕ} : Coe (Perm n) (Perm (n + 1)) :=
  ⟨λp => ⟨λx => if h: x < n then ↑(p.val ⟨x, h⟩) else x, by {
    simp [bije];
    intro y;
    have h2 := Nat.lt_irrefl n;
    by_cases h: y = n;
    case inl => {
      exists y;
      rw [h];
      simp [h2];
      intro x' h1;
      induction x' with
      | mk v lt => {
        by_cases h3: v = n;
        simp [h3, h2] at h1;
        apply Fin.eq_of_val_eq;
        simp [h1, h3];
        have h4 := Nat.lt_of_le_of_ne (Nat.le_of_lt_succ lt) h3;
        simp [h4] at h1;
        generalize h5: p.val ⟨v, h4⟩ = v';
        rw [h5] at h1;
        have h6: y.val < n := by {
          rw [h1];
          exact v'.isLt;
        };
        rw [h] at h6;
        contradiction;
      };
    };
    case inr => {
      have h1: y.val < n := Nat.lt_of_le_of_ne (Nat.le_of_lt_succ y.isLt) h;
      have ⟨w, ⟨h2l, h2r⟩⟩ := p.property ⟨y.val, h1⟩;
      let w': Fin (n + 1) := ↑w;
      exists w';
      have h3: w'.val < n := w.isLt;
      have h4: ⟨w'.val, h3⟩ = w := Fin.eq_of_val_eq rfl;
      simp [h3];
      apply And.intro;
      case left => {
        rw [h4, h2l];
      };
      case right => {
        intro x' h5;
        rw [h4] at h5;
        rw [h2l] at h5;
        induction x' with
        | mk v lt => {
          by_cases h6: v = n;
          simp [h6, h2] at h5;
          have h7: y.val = v := Eq.trans h5 (Eq.symm h6);
          rw [h6] at h7;
          contradiction;
          have h8 := Nat.lt_of_le_of_ne (Nat.le_of_lt_succ lt) h6;
          simp [h8] at h5;
          generalize h9: (⟨v, h8⟩:Fin n) = v';
          generalize h10: (⟨y, h1⟩:Fin n) = y';
          rw [h9] at h5;
          rw [h10] at h2l;
          have h11: y' = p.val v' := by {
            have h12 := @Fin.eq_of_val_eq (n+1) y (p.val v') h5;
            rw [←h10];
            apply Fin.eq_of_val_eq;
            assumption;
          };
          rw [h11] at h2l;
          specialize h2r v' h2l;
          apply Fin.eq_of_val_eq;
          have h12: v = v'.val := by {
            have h13 := Fin.val_eq_of_eq h9;
            simp at h13;
            assumption;
          };
          simp;
          rw [h12];
          have h13 := Fin.val_eq_of_eq h2r;
          assumption;
        };
      };
    };
  }⟩⟩

theorem perm_compose_trans {n: ℕ} : ∀p: Perm (n + 1), ∃q: Perm n, p = ↑q * Perm.id ∨ ∃i: Fin (n + 1), ∃t: Transposition i (Fin.ofNat n), p = t.val * ↑q := by {
  --Perm (n + 1) からPerm nを構成して p n = n かどうかで場合分け
  --intro perm;
  --let ⟨p, h⟩ := perm;
  intro ⟨p, h⟩;
  let nFin: Fin (n + 1) := ⟨n, Nat.lt_succ_self n⟩;
  generalize pn: p nFin = pnFin;
  let downcast: (x: Fin (n + 1)) → (x ≠ nFin) → Fin n := λx h => ⟨x.val, by {
    have h1 := x.isLt;
    by_cases h2: x.val = nFin.val;
    have h3 := Fin.eq_of_val_eq h2;
    contradiction;
    simp at h2;
    have h4 := Nat.le_of_succ_le_succ (Nat.succ_le_of_lt h1);
    exact Nat.lt_of_le_of_ne h4 h2;
  }⟩;
  have downcast_aux: ∀x: Fin n, ↑x ≠ nFin := by {
    intro x h;
    have h1 := x.isLt;
    by_cases h2: x = n;
    rw [h2] at h1;
    have h3 := Nat.lt_irrefl n;
    contradiction;
    have h3 := Fin.val_eq_of_eq h;
    simp at h3;
    contradiction;
  };
  have ltn: ∀x:Fin (n + 1), x ≠ nFin → x < n := by {
    intro x h2;
    have h1 := x.isLt;
    have h2 := Fin.val_ne_of_ne h2;
    apply Nat.lt_of_le_and_ne;
    apply Nat.le_of_lt_succ;
    assumption;
    exact h2;

  };
  have coe_downcast: ∀(x: Fin (n + 1)) h, ↑(downcast x h) = x := by {
    intro x h;
    apply Fin.eq_of_val_eq;
    rfl;
  };
  --whnFinは nFin = p whnFinとなるような数．
  have ⟨whnFin, ⟨prop_hnFinl, prop_hnFinr⟩⟩ := h nFin;
  have ⟨whpnFin, ⟨prop_hpnFinl, prop_hpnFinr⟩⟩ := h (p nFin);
  --写した先がnFinなら代わりにpnFinを返し，それ以外は p xを返す関数
  let f: Fin n → Fin n := λx => ⟨if cond: ↑x = whnFin then pnFin else p ↑x, by {
    have f_aux: ∀x, x ≠ whnFin → p x < n := by {
      intros x h3;
      by_cases h4: (p x) < n;
      assumption;
      have h5 := (p x).isLt;
      have h6: (p x).val = n := by {
        apply Nat.le_antisymm;
        apply Nat.le_of_lt_succ;
        assumption;
        have h7: ∀m n: Nat, ¬(m < n) → n ≤ m := by {
          intro m n h;
          have or := Nat.lt_or_ge m n;
          cases or with
          | inl contra => contradiction
          | inr assum => assumption
        };
        exact h7 (p x).val n h4;
      };
      specialize prop_hnFinr x;
      have h7: n = nFin.val := rfl;
      have h9 := Fin.eq_of_val_eq (Eq.trans h6 h7);
      rw [h9] at prop_hnFinr;
      specialize prop_hnFinr prop_hnFinl;
      exact absurd (Eq.symm prop_hnFinr) h3;
    };
    by_cases h1: nFin = p nFin;
    all_goals by_cases h2: ↑x = whnFin;
    all_goals simp [h2];
    specialize prop_hnFinr nFin (Eq.trans prop_hnFinl h1);
    have _ := downcast_aux x;
    have _ := Eq.trans h2 prop_hnFinr;
    contradiction;
    rotate_left;
    have h3: nFin ≠ whnFin := by {
      intro h2;
      rw [←h2] at prop_hnFinl;
      rw [prop_hnFinl] at h1;
      simp at h1;
    };
    specialize f_aux nFin h3;
    rw [pn] at f_aux;
    assumption;
    all_goals exact f_aux x h2;
  }⟩;
  let q: Perm n := ⟨f, by {
    simp [bije];
    intro y;
    by_cases h1: nFin = p nFin;
    case inl => {
      specialize prop_hnFinr nFin (Eq.trans prop_hnFinl h1);
      have h3: ∀x: Fin n, ↑x ≠ whnFin := by {
        intro x;
        rw [prop_hnFinr];
        exact downcast_aux x;
      };
      have ⟨w, ⟨h4l, h4r⟩⟩ := h ↑y;
      have h5 := h3 y;
      by_cases h6: w = whnFin;
      rw [h6, prop_hnFinl, ←prop_hnFinr] at h4l;
      exact absurd (Eq.symm h4l) h5;
      rw [prop_hnFinr] at h6;
      let w' := downcast w h6;
      exists w';
      simp;
      apply And.intro;
      case left => {
        apply Fin.eq_of_val_eq;
        simp;
        have h7 := Fin.val_eq_of_eq h4l;
        have h8: (↑y:Fin (n + 1)).val = y.val := rfl;
        rw [←h8, ←h7];
        specialize h3 w';
        simp [h3];
      };
      case right => {
        intro x' h7;
        have w'_ne := h3 w';
        have x'_ne := h3 x';
        generalize h8: { val := w.val, isLt := (_ : w'.val < Nat.succ n): Fin (n + 1)} = w'';
        generalize h9: { val := x'.val, isLt := (_ : x'.val < Nat.succ n): Fin (n + 1)} = x'';
        --rw [h8, h9] at h7;
        simp [w'_ne, x'_ne] at h7;
        apply Fin.eq_of_val_eq;
        simp;
        have h10 := Fin.val_eq_of_eq h9;
        simp at h10;
        rw [h10];
        apply Fin.val_eq_of_eq;
        apply h4r;
        have h11 := Fin.eq_of_val_eq h7;
        simp [←h9];
        rw [←h11];
        /-
        have h12 := Fin.val_eq_of_eq h8;
        simp at h12;
        apply congrArg;
        apply Fin.eq_of_val_eq;
        assumption;
        -/
      };
    };
    case inr => {
      have h3: nFin ≠ whnFin := by {
        intro h4;
        rw [←h4] at prop_hnFinl;
        exact absurd (Eq.symm prop_hnFinl) h1;
      };
      by_cases h4: ↑y = pnFin;
      case inl => {
        exists downcast whnFin (Ne.symm h3);
        have h5 := coe_downcast whnFin (Ne.symm h3);
        have h6: y.val = pnFin.val := Fin.val_eq_of_eq h4;
        apply And.intro;
        case left => {
          apply Fin.eq_of_val_eq;
          simp [h6, h5];
        };
        case right => {
          intro x' h7;
          simp [h5] at h7;
          by_cases h8: ↑x' = whnFin;
          apply Fin.eq_of_val_eq;
          simp;
          have h9 := Eq.symm (Fin.val_eq_of_eq h8);
          assumption;
          simp [h8] at h7;
          have h10: ↑x' ≠ nFin := by {
            intro h11;
            have h12 := Fin.val_eq_of_eq h11;
            simp at h12;
            have h13: (↑x':Fin (n + 1)).val = x'.val := rfl;
            rw [h13] at h12;
            have h14 := x'.isLt;
            rw [h12] at h14;
            have h15 := Nat.lt_irrefl n;
            contradiction;
          };
          have h11 := prop_hpnFinr nFin prop_hpnFinl;
          rw [h11] at prop_hpnFinr;
          have h12: { val := x'.val, isLt := (_ : x'.val < Nat.succ n) : Fin (n + 1) } = x' := rfl;
          rw [←pn, h12] at h7;
          have h13 := Fin.eq_of_val_eq h7;
          have h14 := Eq.symm (prop_hpnFinr ↑x' h13);
          contradiction;
        };
      };
      case inr => {
        have h5 := prop_hpnFinr nFin prop_hpnFinl;
        have ⟨w, ⟨h6l, h6r⟩⟩ := h ↑y;
        have h7: w ≠ nFin := by {
          intro h8;
          rw [h8, pn] at h6l;
          exact absurd (Eq.symm h6l) h4;
        };
        exists downcast w h7;
        have h8 := coe_downcast w h7;
        apply And.intro;
        case left => {
          apply Fin.eq_of_val_eq;
          simp [h8];
          by_cases h9: w = whnFin;
          rw [h9, prop_hnFinl] at h6l;
          have h10: n = y.val := by {
            have h11 := Fin.val_eq_of_eq h6l;
            simp at h11;
            assumption;
          };
          have h11: n ≠ y.val := by {
            have h12 := y.isLt;
            intro h13;
            have h14 := Nat.lt_irrefl n;
            rw [←h13] at h12;
            contradiction;
          };
          contradiction;
          simp [h9];
          have h13: { val := w.val, isLt := (_ : (downcast w h7).val < Nat.succ n) : Fin (n + 1)} = ↑(downcast w h7) := rfl;
          --rw [h13, h8];
          have h14 := Fin.val_eq_of_eq h6l;
          assumption;
        };
        case right => {
          intro x' h9;
          simp [h8] at h9;
          by_cases h10: w = whnFin;
          all_goals by_cases h11: ↑x' = whnFin;
          all_goals simp [h10, h11] at h9;
          apply Fin.eq_of_val_eq;
          simp;
          have h12 := Fin.val_eq_of_eq (Eq.trans h10 (Eq.symm h11));
          assumption;
          rw [←pn, ←prop_hpnFinl] at h9;
          have h12 := Fin.eq_of_val_eq h9;
          specialize prop_hpnFinr ↑x' h12;
          rw [h5] at prop_hpnFinr;
          have h13 := Fin.val_eq_of_eq prop_hpnFinr;
          simp at h13;
          have h14 := x'.isLt;
          have h15 := Nat.lt_irrefl n;
          have h16: (↑x':(Fin (n + 1))).val = x'.val := rfl;
          rw [←h16, ←h13] at h14;
          contradiction;
          rw [←pn, ←prop_hpnFinl] at h9;
          have h12 := Fin.eq_of_val_eq h9;
          specialize prop_hpnFinr ↑(downcast w h7) (Eq.symm h12);
          rw [h5, h8] at prop_hpnFinr;
          have h13 := Eq.symm prop_hpnFinr;
          contradiction;
          have h12: { val := w.val, isLt := (_ : (downcast w h7).val < Nat.succ n) : Fin (n + 1) } = ↑(downcast w h7) := rfl;
          have h13: { val := x'.val, isLt := (_ : x'.val < Nat.succ n) : Fin (n + 1) } = ↑x' := rfl;
          --rw [h12];
          rw [h13] at h9;
          specialize h6r ↑x' (Fin.eq_of_val_eq h9);
          apply Fin.eq_of_val_eq;
          simp;
          have h14 := Fin.val_eq_of_eq h6r;
          rw [h14];
          --rfl;
        };
      };
    };
  }⟩;
  by_cases h1: nFin = p nFin;
  --恒等写像との合成になる場合
  case inl => {
    specialize prop_hnFinr nFin (Eq.trans prop_hnFinl h1);
    exists q;
    apply Or.intro_left;
    simp [Perm.id];
    --rw [←Bijection.rightIdentity];
    apply Subtype.eq;
    --simp [coe, CoeT.coe, CoeHTCT.coe, coeTC, CoeTC.coe, coeB, Coe.coe];
    --simp;
    apply funext;
    intro x;
    by_cases h4: x = whnFin;
    case inl => {
      rw [h4];
      have h5: ¬whnFin < n := by {
        rw [prop_hnFinr];
        simp;
        exact Nat.lt_irrefl n;
      };
      simp [h5];
      exact Eq.trans prop_hnFinl (Eq.symm prop_hnFinr);
    };
    case inr => {
      rw [prop_hnFinr] at h4;
      have h5 := ltn x h4;
      simp [h5];
      rw [←Bijection.rightIdentity];
      apply Fin.eq_of_val_eq;
      simp;
      --generalize h6: { val := x.val, isLt := (_ : { val := x.val, isLt := (_ : x.val < n): Fin n}.val < Nat.succ n) : Fin (n + 1)} = x'';
      /-have h7: x'' = x := by {
        apply Fin.eq_of_val_eq;
        rw [←h6];
      };-/
      --rw [h7];
      have h4' : ¬x.val = n := by {
        intro aa;
        have bb : n = nFin.val := rfl;
        have cc := Fin.eq_of_val_eq (Eq.trans aa bb);
        contradiction;
      };
      simp [prop_hnFinr, h4'];
    };
  };
  --置換との合成になる場合
  case inr => {
    exists q;
    apply Or.intro_right;
    exists pnFin;
    let t: Transposition pnFin (Fin.ofNat n) :=
      let p': Perm (n + 1) :=
        ⟨λx => if x = pnFin then nFin else if x = nFin then pnFin else x, by {
          simp [bije];
          intro y;
          by_cases h2: y = nFin;
          exists pnFin;
          simp;
          rw [h2];
          simp;
          intro x' h3;
          by_cases h4: x' = pnFin;
          exact Eq.symm h4;
          simp [h4] at h3;
          by_cases h5: x' = nFin;
          simp [h5] at h3;
          rw [pn] at h1;
          contradiction;
          simp [h5] at h3;
          rw [←h3] at h5;
          simp at h5;
          by_cases h3: y = pnFin;
          exists nFin;
          simp [←pn, h1, h3];
          intro x' h4;
          by_cases h5: x' = pnFin;
          simp [pn, h5] at h4;
          rw [pn, h4] at h1;
          exact absurd rfl h1;
          simp [pn, h5] at h4;
          by_cases h6: x' = nFin;
          rw [h6];
          simp [h6] at h4;
          rw [h4] at h5;
          simp at h5;
          exists y;
          simp [h3, h2];
          intro x' h4;
          by_cases h5: x' = pnFin;
          simp [h5] at h4;
          contradiction;
          simp [h5] at h4;
          by_cases h6: x' = nFin;
          simp [h6] at h4;
          contradiction;
          simp [h6] at h4;
          assumption;
        }⟩;
      ⟨p' , by {
        have eq_nFin: (Fin.ofNat n) = nFin := by {
          apply Fin.eq_of_val_eq;
          simp [Fin.ofNat];
          apply Nat.mod_eq_of_lt;
          exact Nat.lt.base n;
        };
        rw [eq_nFin];
        apply And.intro;
        case left => {
          rw [pn] at h1;
          exact ltn pnFin (Ne.symm h1);
        };
        case right => {
          apply And.intro;
          simp;
          apply And.intro;
          rw [pn] at h1;
          simp [h1];
          intro k ⟨h2l, h2r⟩;
          simp [h2l, h2r];
        };
      }⟩;
    exists t;
    apply Subtype.eq;
    simp;
    apply funext;
    intro x;
    simp [HMul.hMul, Mul.mul, Bijection.comp];
    by_cases h2: x = nFin;
    case inl => {
      simp [h2];
      have h3: (↑q:Perm (n + 1)).val nFin = nFin := by {
        apply Fin.eq_of_val_eq;
        simp;
        --simp [coe, CoeT.coe, CoeHTCT.coe, coeTC, CoeTC.coe, coeB, Coe.coe];
        have h3 := Nat.lt_irrefl n;
        simp [h3];
      };
      simp [h3];
      have h3' := Nat.lt_irrefl n;
      simp [h3'];
      rw [←pn];
      simp [h1];
    };
    case inr => {
      --simp [coe, CoeT.coe, CoeHTCT.coe, coeTC, CoeTC.coe, coeB, Coe.coe];
      have h3 := ltn x h2;
      simp [h3];
      by_cases h4: x = whnFin;
      have h5: (↑q: Perm (n + 1)).val whnFin = pnFin := by {
        --simp [coe, CoeT.coe, CoeHTCT.coe, coeTC, CoeTC.coe, coeB, Coe.coe];
        have h6 := Fin.val_eq_of_eq h4;
        rw [h6] at h3;
        simp [h3];
        apply Fin.eq_of_val_eq;
        simp;
        /-
        have h7: ∀p, {val := whnFin.val, isLt := p} = whnFin := by {
          intro p;
          apply Fin.eq_of_val_eq;
          simp;
        };
        simp [h7];
        -/
      };
      have hoge : ∀p, {val := x.val, isLt := p} = x := by {
        intro p;
        apply Fin.eq_of_val_eq;
        simp;
      };
      simp [h4, h5];
      have fuga : ∀n p, {val := x.val, isLt := p : Fin n}.val = x.val := by {
        intros;
        simp;
      };
      have poyo : { val := x.val, isLt := (_ : { val := x.val, isLt := (_ : x.val < n) : Fin n}.val < Nat.succ n) : Fin (n + 1)} = whnFin := by {
        rw [←h4];
      };
      --assumption;
      simp [fuga, poyo];

      have h5: (↑q: Perm (n + 1)).val x = p x := by {
        --simp [coe, CoeT.coe, CoeHTCT.coe, coeTC, CoeTC.coe, coeB, Coe.coe];
        simp [h3];
        have h7: ∀p, {val := x.val, isLt := p} = x := by {
          intro p;
          apply Fin.eq_of_val_eq;
          simp;
        };
        apply Fin.eq_of_val_eq;
        simp [h7, h4];
        rw [prop_hnFinl];
      };
      rw [h5];
      have ⟨w, ⟨h6l, h6r⟩⟩ := bije_contraposition h pnFin;
      rw [←pn, ←prop_hpnFinl] at h6l;
      have h7 := prop_hpnFinr w (Eq.symm h6l);
      specialize prop_hpnFinr nFin prop_hpnFinl;
      rw [←prop_hpnFinr, h7] at h2;
      specialize h6r x (Ne.symm h2);
      rw [←h7, prop_hpnFinr] at h6r;
      have h8 := Ne.symm h6r;
      rw [←pn];
      simp [h8];
      have ⟨w', ⟨h9l, h9r⟩⟩ := bije_contraposition h nFin;
      rw [←h9l] at prop_hnFinl;
      have h10 := prop_hnFinr w' prop_hnFinl;
      rw [h10] at h4;
      specialize h9r x (Ne.symm h4);
      rw [←h9l];
      simp [(Ne.symm h9r)];
    };
  };
}
-/


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
  let S := (λ (m : ℤ), @int.fract ℝ _ (α * m)) '' (@set.univ ℤ),
  have h1 : ∀ m n : ℤ, (m ≠ n) → (int.fract (α * m) ≠ int.fract (α * n)), from assume m n, assume hmn,
    by {
      assume heq : (int.fract (α * m)) = int.fract (α * n),
      have h2 : ∃ (q : ℤ), ↑m*α = int.fract (m*α) + q, from by {
        apply int.of_rat_add_one,
      },
      have h3 : ∃ (q : ℤ), ↑n*α = int.fract (n*α) + q, from by {
        apply int.of_rat_add_one,
      },
      have h4 : ↑m*α = ↑n*α, from by {
        rw heq,
        rw int.fract_eq_of_lt,
        apply int.coe_nat_pos,
      },
      have h5 : ∃ a : ℤ, ↑m*α = a, from ⟨by exact int.fract (m*α),by exact h2.right⟩,
      have h6 : ∃ a : ℤ, ↑n*α = a, from ⟨by exact int.fract (n*α),by exact h3.right⟩,
      exact hα_irrat (int.eq_of_mul_eq_mul_right ((h5.left - h6.left)/(↑m-↑n)) zero_lt_one),
    },
  have hS_inf : ∃ m : ℤ, m ∈ S, from ⟨0, by exact set.mem_univ 0⟩,
  have hS_limpt : ∃ z : ℝ, z ∈ ↥S ∧ z ∈ S, from by {
    have h1 : set.Ico (0 : ℝ) 1 ⊆ ↥S, from by {apply set.inter_subset_right, apply set.image_subset_iff.2, apply set.mem_univ,},
    have h2 : ∃ z : ℝ, z ∈ set.Ico 0 1, from @is_compact_real.exists_mem_inter_Ico (0 : ℝ) 1,
    exact ⟨h2.w, by {split, apply set.mem_closure_iff.2, exact ⟨z, by {apply h1,exact h2.h}⟩, apply set.mem_univ, exact h2.h}⟩,
  },

  have hS_dense : ∀ y ∈ set.Ico 0 1, ∀ ε > 0, ∃ x ∈ S, abs(x-y) < ε, from assume y hy, assume ε hε,
    by {
      have h1 : ∃ z ∈ S, ∀ x ∈ S, abs(x-z) < ε, from by exact set.finite_complete (λ x, abs(x-y) < ε) hS_inf,
      exact ⟨h1.w, by exact h1.h.left, by {rcases h1.h.right m with ⟨_,_,h_abs⟩, have key := h_abs, show abs(m-y) < ε, from key, show m ∈ S, from set.mem_image_of_mem _ hS_limpt.h.right.left }}
  },
  show closure S = set.Icc 0 1, from le_antisymm
    (by exact ⟨set.inter_subset_left _ _, set.inter_subset_right _ _, hS_dense⟩)
    (by apply set.closure_minimal, from ⟨set.mem_set_of_eq (by {rw ← int.fract_zero, rw ← int.fract_one, rw ← int.fract_add, rw ← int.fract_mul, rw int.mul_assoc, rw int.coe_nat_mul, norm_num, rw ← int.fract_add, rw ← int.fract_add, rw ← int.fract_mul, rw ← int.fract_mul, rw int.mul_assoc, rw int.mul_assoc, rw int.coe_nat_mul, norm_num, rw int.mul_comm, rw int.fract_add, rw int.fract_of_nat_of_nonneg, simp, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw ← int.fract_add, rw ← int.fract_add, rw ← int.fract_mul, rw int.mul_assoc, rw int.mul_comm, rw int.coe_nat_mul, norm_num, rw int.mul_assoc, rw int.mul_assoc, rw int.coe_nat_mul, norm_num, rw int.mul_comm, rw int.fract_add, rw int.fract_of_nat_of_nonneg, simp, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw ← int.fract_add, rw ← int.fract_add, rw ← int.fract_mul, rw int.mul_assoc, rw int.mul_comm, rw int.coe_nat_mul, norm_num, rw int.mul_assoc, rw int.mul_comm, rw int.coe_nat_mul, norm_num, rw int.fract_mul, rw int.fract_of_nat_of_nonneg, simp, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw ← int.fract_add, rw ← int.fract_add, rw ← int.fract_mul, rw int.mul_assoc, rw int.mul_comm, rw int.coe_nat_mul, norm_num, rw int.mul_comm, rw int.fract_mul, rw int.fract_of_nat_of_nonneg, simp, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.mul_comm, rw int.mul_comm, rw ← int.fract_add, rw ← int.fract_add, rw ← int.fract_mul, rw int.mul_assoc, rw int.coe_nat_mul, norm_num, rw int.mul_comm, rw int.fract_mul, rw int.fract_of_nat_of_nonneg, simp, norm_num, rw int.mul_comm, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.coe_nat_add, norm_num, rw int.mul_comm, rw int.mul_comm, rw ← int.fract_add, rw ← int
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 h0 : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from
    assume i j : ℤ, assume h : i ≠ j, assume h' : int.fract (α * ↑i) = int.fract (α * ↑j),
    have hirrat : irrational α, from hα_irrat,
    have hmul : i * α ≠ j * α, from by {rw ← int.fract_eq at h',assumption},
    have hit : ∃ intΦ : ℤ, i * α - intΦ ∈ ℤ, from by {use int.floor (i * α), apply int.fract_eq},
    have hjt : ∃ intΨ : ℤ, j * α - intΨ ∈ ℤ, from by {use int.floor (j * α), apply int.fract_eq},
    have h1 : int.fract (i * α) = int.fract (j * α), from by {rw [← int.fract_eq,h']},
    have hα : α = (int.floor (i * α) - int.floor (j * α))/(i - j), from by {rw [int.fract_eq,int.fract_eq,int.fract_eq,int.fract_eq,int.fract_eq,int.fract_eq,h1]},
    have hα_rat : α ∈ ℚ, from
      by {have hα_ne : i - j ≠ 0, from mt int.eq_zero_of_mul_eq_mul_left hmul,
        have hα_ne' : i - j ≠ 0, from mt int.eq_zero_of_mul_eq_mul_right (int.mul_right_inj hα_ne),
        have hα_div : (int.floor (i * α) - int.floor (j * α))/(i - j) ∈ ℚ, from int.div_in_rat _ hα_ne',
        assumption,
      },
    have hirrat_rat : irrational α → ¬α ∈ ℚ, from by {assume hirrat, assume hα_rat, assumption},
    show false, from hirrat_rat hirrat hα_rat,
  have h1 : ∀ i j : ℤ, (int.fract (α * ↑i) ≠ int.fract (α * ↑j)) → (i ≠ j), from
    assume i j : ℤ, assume h : (int.fract (α * ↑i) ≠ int.fract (α * ↑j)),
    have hcontr : i = j → int.fract (α * ↑i) = int.fract (α * ↑j), from
      (assume h' : i = j, by {rw [h',h']}),
    have hirrat : irrational α, from hα_irrat,
    have hmul : (α * ↑i) ≠ (α * ↑j), from mt int.eq_of_fract_eq_fract h,
    have hit : ∃ intΦ : ℤ, i * α - intΦ ∈ ℤ, from by {use int.floor (i * α), apply int.fract_eq},
    have hjt : ∃ intΨ : ℤ, j * α - intΨ ∈ ℤ, from by {use int.floor (j * α), apply int.fract_eq},
    have h1 : int.fract ((α * ↑i) - (α * ↑j)) = 0, from by {rw [(hit).right], rw [(hjt).right], ring},
    show i ≠ j, from mt int.eq_of_mul_eq_mul_left h,
  have h2 : ∀ i j : ℤ, (int.fract (α * ↑i) ≠ int.fract (α * ↑j)) ↔ (i ≠ j), from
    assume i j : ℤ, ⟨h1 i j, h0 i j⟩,
  have h3 : ∀ i j : ℤ, (∃ i' j' : ℤ, (i ≠ j') ∧ (j ≠ i') ∧ abs (int.fract (α * ↑j') - int.fract (α * ↑i')) < abs (int.fract (α * ↑i) - int.fract (α * ↑j))), from
    assume i j : ℤ, ⟨⟨i, j, by {simp [h2 i j]}⟩, ⟨i, j, by {simp [h2 i j]}⟩,
      by {rw abs_of_pos,apply int.fract_pos}⟩,
  have h4 : ∀ y : ℝ, ∃ y' : ℝ, (((∃ i' j' : ℤ, (i' ≠ j') ∧ (int.fract (α * ↑i') ≠ int.fract (α * ↑j')) ∧ abs (int.fract (α * ↑j') - int.fract (α * ↑i')) < abs (int.fract (α * ↑i') - y))) ∧ (y < y') ∧ (y' < int.fract (α * ↑(i' + 1)))), from
    assume y : ℝ,
    by {use int.fract (α * ↑(i + 1)),
      show (∃ (i' j' : ℤ), i' ≠ j' ∧ int.fract (α * ↑i') ≠ int.fract (α * ↑j') ∧ abs (int.fract (α * ↑j') - int.fract (α * ↑i')) < abs (int.fract (α * ↑i') - y)) ∧ y < int.fract (α * ↑(i + 1)) ∧ int.fract (α * ↑(i + 1)) < int.fract (α * ↑(i + 1)), from
      by {split, split,
        show ∃ (i' j' : ℤ), i' ≠ j' ∧ int.fract (α * ↑i') ≠ int.fract (α * ↑j') ∧ abs (int.fract (α * ↑j') - int.fract (α * ↑i')) < abs (int.fract (α * ↑i') - y), from
          by {use i, use i, split, simp, split, simp,
          rw abs_of_pos, apply int.fract_pos},
        show y < int.fract (α * ↑(i + 1)), from by {rw ← int.fract_eq, apply int.add_fract_lt_one,},
        show int.fract (α * ↑(i + 1)) < int.fract (α * ↑(i + 1)), from by {rw ← int.fract_eq, apply int.add_fract_lt_one,},
       },
    },
  have h5 : ∀ x : ℝ, x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from
    assume x : ℝ, assume hx : x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
    have hx' : ∃ n : ℤ, x = int.fract (α * ↑n), from hx,
    have hx'' : ∃ n : ℤ, ∃ i j : ℤ, (i ≠ j) ∧ (int.fract (α * ↑i) = x) ∧ (int.fract (α * ↑j) = int.fract (α * ↑n)), from
      by {use (hx').fst, use (hx').fst, use (hx').fst
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 S : (set ℝ) := set.range (λ m : ℤ, int.fract (α * ↑m)),
  have hnonempty : S ≠ ∅, -- by using m=0 we have α*0 = 0, hence {0} is in S
  from begin
    assume h : S = ∅,
    have h1 : (0 : ℤ) ∉ set.univ, from by {
      intro h2,
      have h3 : (0 : ℝ) ∈ S, from by {unfold S,exact set.mem_range.mpr ⟨0,rfl⟩},
      exact set.eq_empty_iff_forall_not_mem.mp h h3,
    },
    show false, from h1 trivial,
  end,

  have h_inf : infinite S, -- using the fact that α is irrational and def of irrational,
  -- we have {iα} ≠ {jα} if i≠j. Since det(iα) ∉ S and S is nonempty, it follows S is infinite
  from begin
    assume h : finite S,
    have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
    from begin
      assume i j : ℤ,
      assume hneq : i ≠ j,

      assume h1 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)),
      have h2 : (int.fract (α * ↑i)) = ((int.fract (α * ↑i)) - (int.fract (α * ↑i)) + (int.fract (α * ↑i)))
      ∧ (int.fract (α * ↑j)) = ((int.fract (α * ↑j)) - (int.fract (α * ↑j)) + (int.fract (α * ↑j))) ↔ true, from by {split;assumption,},
      have h3 : ((int.fract (α * ↑i)) - (int.fract (α * ↑i))) + (int.fract (α * ↑i)) = ((int.fract (α * ↑j)) - (int.fract (α * ↑j))) + (int.fract (α * ↑j))
      ∧ ((int.fract (α * ↑j)) - (int.fract (α * ↑j))) + (int.fract (α * ↑j)) = ((int.fract (α * ↑i)) - (int.fract (α * ↑i))) + (int.fract (α * ↑i)) ↔ true, from by {split;assumption,},
      have h4 : ∀ x y : ℝ, x = y → (int.fract x) = (int.fract y),
      from begin
        assume x y : ℝ,
        assume hxy : x = y,
        rw ← hxy,
      end,
      have h5 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)), from eq.trans (h4 (α*↑i) (α*↑j) (congr_arg int.fract h1)) (eq.symm (h4 (α*↑j) (α*↑i) (congr_arg int.fract (eq.symm h1)))),
      have h6 : (int.fract (α * ↑i)) = (α* ↑i - int.nat_abs (α* ↑i)) ∧ (int.fract (α * ↑j)) = (α* ↑j - int.nat_abs (α* ↑j)) ↔ true, from by {split;assumption,},
      have h7 : ∀ x : ℝ, x - int.nat_abs x = (int.fract x),
      from begin
        assume x : ℝ,
        rw int.fract_def,
      end,
      have h8 : ∀ x : ℝ, (int.fract x) = (x - int.nat_abs x), from
        by {assume x : ℝ, rw ← (h7 x),ring},
      have h9 : (α*↑i - int.nat_abs (α * ↑i)) = (α* ↑j - int.nat_abs (α * ↑j)),
      from eq.trans (h8 (α*↑i)) (eq.trans h5 (eq.symm (h8 (α*↑j)))),
      have h10 : ∀ x y : ℝ, x = y → (int.nat_abs x) = (int.nat_abs y), from begin
        assume x y : ℝ,
        assume hx : x = y,
        rw ← hx,
      end,
      have h11 : (int.nat_abs (α * ↑i)) = (int.nat_abs (α * ↑j)), from
        eq.trans (h10 (α*↑i) (α*↑j) (eq.symm h9)) (eq.symm (h10 (α*↑j) (α*↑i) h9)),
      have h12 : (int.nat_abs (α * ↑i)) = (int.nat_abs (int.fract (α* ↑i))) ∧ (int.nat_abs (α * ↑j)) = (int.nat_abs (int.fract (α * ↑j))) ↔ true, from by {split;assumption,},
      have h13 : (int.nat_abs (int.fract (α * ↑i))) = (int.nat_abs (int.fract (α * ↑j))) ↔ true, from by {rw ← h12,ring,},
      have h14 : (abs (int.fract (α * ↑i))) = (abs (int.fract (α * ↑j))) ↔ true, from by {rw h13,ring,},
      have h15 : ∀ x : ℝ, (abs (int.fract x)) = (int.nat_abs (int.fract x)), from
        by {assume x : ℝ, rw ← int.nat_abs_of_nonneg (int.fract_nonneg x),rw abs_of_nonneg,},
      have h16 : (abs (int.fract (α * ↑i))) = (abs (int.fract (α * ↑j))) ↔ true, from by {rw (h15 (α * ↑i)),rw (h15 (α * ↑j)),ring},
      have h17 : abs (int.fract (α * ↑i)) = abs (int.fract (α * ↑j)), from
        eq.trans (eq.symm h16) h14,
      have h18 : (abs (int.fract (α * ↑i))) = (int.nat_abs (α * ↑i)) ∧ (abs (int.fract (α * ↑j))) = (int.nat_abs (α * ↑j)) ↔ true, from by {rw h12,ring,},
      have h19 : (int.nat_abs (α * ↑i)) = (int.nat_abs (α * ↑j)) ↔ true, from by {rw ← h18,ring,},
      have h20 : (↥(α * ↑i)) ≠ 0 ∧ (↥(α * ↑j)) ≠ 0 ↔ true, from by {split;assumption,},
      have h21 : (abs (int.fract (α * ↑i))) ≠ 0 ∧ (abs (int.fract (α * ↑j))) ≠ 0 ↔ true, from by {rw h18,rw h20,},
      have h22 : (abs (int.fract (α * ↑i))) ≠ 0 ∧ (int.nat_abs (α * ↑i)) = (int.nat_abs (α * ↑j)) ↔ true, from by { rw h12,split;assumption,},
      have h23 : (abs (int.fract (α * ↑i))) ≠ 0 ∧ (int.fract (α * ↑i)) = (int.fract (α * ↑j)) ↔ true, from by {rw ← h12,ring,},
      have h24 : (int.fract (α
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
apply le_antisymm,

{
  -- show left-to-right
  assume y : ℝ,
  assume hy : y ∈ closure ((λ (m : int), int.fract (α * ↑m)) '' univ),
  show y ∈ set.Icc 0 1,
  have hy2 : y ∈ closure (set.range (λ (m : int), int.fract (α * ↑m))), from hy,
  have hy3 : y ∈ closure (set.Icc 0 1), from set.subset.trans hy2 (set.subset_closure_Icc_Ico),
  rw closure_eq_of_is_closed (is_closed_Icc 0 1) at hy3,
  assumption,
},

{
  -- show right-to-left
  assume y : ℝ,
  assume hy : y ∈ set.Icc 0 1,
  show y ∈ closure ((λ (m : int), int.fract (α * ↑m)) '' univ),
  from closure_mono (set.subset_univ (λ (m : int), int.fract (α * ↑m))) hy,
},

end

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

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have f : ∀ i : ℤ, ∃ j : ℤ, abs (i - j) ≤ 1, begin
    assume (i : ℤ),
    have h : 0 < abs i, begin
      assume h,
      have : 0 < 0, begin
        rw h,
      end,
      exact dec_trivial this,
    end,
    have : 0 ≤ abs i, begin
      rw abs_of_nonneg,
      apply_instance,
    end,
    have h2 : 0 < 1, begin
      norm_num,
    end,
    have h3 : 1 ≤ abs i, begin
      exact le_of_lt (lt_of_lt_of_le h2 h),
    end,
    have h4 : i ≤ abs i, begin
      rw ← nat_int.coe_nat_add,
      calc i + -i ≤ abs i + -i : by apply add_le_add_right
      ... = abs i : by {rw ← abs_neg, rw sub_eq_add_neg, refl,},
    end,
    have h5 : abs i ≤ 1 + i, begin
      apply le_of_lt,
      apply lt_add_of_le_of_pos' h h2,
      apply le_of_sqr_le_sqr,
      rw abs_of_nonneg,
      simp,
    end,
    use (-i),
    split,
    apply le_trans h4 h5,
    exact (show 1 + -i ≤ 1 + i, from by {rw <- sub_eq_add_neg, norm_num}),
  end,

  have f2 : ∀ i j : ℤ, abs (i - j) ≤ 1 → abs (int.fract i - int.fract j) ≤ 1, begin
    assume (i j : ℤ) (h : abs (i - j) ≤ 1),
    by_cases h₁ : i = j,
      rw h₁,
      norm_num,
    have h₂ : abs (i - j) ≠ 0,
      assume h₃ : abs (i - j) = 0,
      rw h₃ at h,
      have h₄ : 0 < 0,
        exact h,
      exact dec_trivial h₄,
    have h₅ : 1 ∣ abs (i - j),
      apply dvd_of_abs_mul_abs_le_one,
      norm_num,
    rw @abs_int_fract i j (h₂) at h₅,
    rw ← int.coe_nat_dvd at h₅,
    have h₆ : 1 ∣ (i - j),
      rw abs_mul at h₅,
      rwa mul_one at h₅,
    rw dvd_iff_mod_eq_zero at h₆,
    rw int.mod_eq_of_lt (int.mod_lt i) at h₆,
    rw int.mod_eq_of_lt (int.mod_lt j) at h₆,
    rw int.sub_mod at h₆,
    rw add_assoc (-i) i at h₆,
    rw add_right_neg i at h₆,
    rw @add_comm _ (-j) at h₆,
    rw add_assoc (-j) j at h₆,
    rw add_right_neg j at h₆,
    rw ← int.sub_mod at h₆,
    rw ← add_assoc (-i) (int.mod j) at h₆,
    rw add_right_neg i at h₆,
    rw add_assoc (-j) (int.mod i) at h₆,
    rw add_right_neg j at h₆,
    have h₇ : -i + int.mod j = -j + int.mod i,
      rwa (show -i + int.mod j + i + j = -j + int.mod i + i + j, by ring),
    rw ← h₇ at h₆,
    rw @int.sub_mod _ _ (int.mod_lt i) at h₆,
    rw @int.sub_mod _ _ (int.mod_lt j) at h₆,
    rw int.sub_self at h₆,
    rw int.sub_self at h₆,
    rw h₆,
    norm_num,
  end,

  have f3 : ∀ x y : ℤ, abs (x - y) ≤ 1 → abs (int.fract x - int.fract y) ≤ 1 →
    abs (int.fract x - int.fract y) ≤ abs (x - y), begin
      assume x y h₁ h₂,
      apply le_trans h₂,
      exact h₁,
    end,
  have f4 : ∀ x y z : ℤ, abs (x - y) ≤ 1 → abs (int.fract x - int.fract y) ≤ 1 →
    abs (int.fract x - int.fract y) ≤ abs (z - y), begin
      assume x y z h₁ h₂,
      have h₃ : abs (x - y) ≤ abs (z - y), begin
        apply le_trans h₁,
        apply abs_abs_sub_abs_sub_le,
      end,
      apply le_trans h₂,
      exact h₃,
    end,

  have f5 : ∀ i j k : ℤ, abs (i - j) ≤ 1 → abs (int.fract i - int.fract j) ≤ 1 →
    0 < abs (int.fract i - int.fract j) → 0 < abs (k - j), begin
    assume i j k H₁ H₂ H₃,
    have H₄ : abs (int.fract i - int.fract j) = abs (k - j), begin
      apply eq.trans,
      rw ← abs_sub,
      rw ← abs_sub,
      exact abs_sub_of_abs_abs_sub_abs_sub_le (f3 i j k H₁ H₂),
      exact abs_sub_of_abs_abs_sub_abs_sub_le (f4 i j k H₁ H₂),
    end,
    rw ← H₄ at H₃,
    exact H₃,
  end,

  have f6 : ∀ i j k : ℤ, abs (i - j) ≤ 1 → abs (int.fract i - int.fract j) ≤ 1 →
    0 < abs (int.fract i - int.fract j) → 0 < abs (k - i), begin
    assume i j k H₁ H₂ H₃,
    rw add_comm at H₁,
    rw add_comm at H₂,
    rw ← sub_eq_add_neg at H₃,
    have H₄ : 0 < abs (int.fract k - int.fract j),
      rw ← abs_neg,
      exact H₃,
    apply f5 k i j H₁ H₂ H₄,
  end,

  have f7 : ∀ (i j : ℤ), abs (i - j) ≤ 1 → abs (int.fract i - int.fract j) ≤ 1 →
    int.fract i = int.fract j, begin
    assume i j H₁ H₂,
    cases le_or_gt 0 (int.fract i - int.fract j) with H₃ H₄,
      have H₅ : int.fract i - int.fract j < 0,
        rwa not_lt at H₄,

end --Needs more than 2000 tokens!

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ m n : ℤ, m < n → α * ↑m - (floor (α * ↑m)) ≤ α * ↑n - (floor (α * ↑n)), from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : (α * ↑m) < (α * ↑n), from mul_lt_mul_of_pos_left h (by norm_num),
    apply (floor_mono h1),
  },
  have h2 : ∀ m n : ℤ, m < n → (floor (α * ↑m)) - (floor (α * ↑n)) ≤ 0, from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : (α * ↑m) < (α * ↑n), from mul_lt_mul_of_pos_left h (by norm_num),
    have h2 : (floor (α * ↑n)) ≤ (floor (α * ↑m)), from floor_mono h1,
    apply nat.sub_le_self h2,
  },
  have h3 : ∀ m n : ℤ, m < n → (α * ↑n) - (α * ↑m) = (floor (α * ↑n)) - (floor (α * ↑m)), from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : (α * ↑m) < (α * ↑n), from mul_lt_mul_of_pos_left h (by norm_num),
    have h2 : (α * ↑m) - (floor (α * ↑m)) ≤ (α * ↑n) - (floor (α * ↑n)), from h1 ▸ h1,
    have h3 : (α * ↑n) - (floor (α * ↑n)) - ((α * ↑m) - (floor (α * ↑m))) = (floor (α * ↑n)) - (floor (α * ↑m)), from by
      {repeat{rw ← sub_eq_iff_eq_add}, rw ← fractional_part_eq, rw ← fractional_part_eq},
    have h4 : (α * ↑n) - (floor (α * ↑n)) - ((α * ↑m) - (floor (α * ↑m))) - ((floor (α * ↑n)) - (floor (α * ↑m))) = 0, from by
      {ring},
    apply eq_zero_of_sub_eq_zero h4,
  },
  have h4 : ∀ m n : ℤ, m < n → 0 < (α * ↑n) - (α * ↑m), from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : (α * ↑m) < (α * ↑n), from mul_lt_mul_of_pos_left h (by norm_num),
    have h2 : (floor (α * ↑n)) ≤ (floor (α * ↑m)), from floor_mono h1,
    have h3 : (α * ↑n) - (floor (α * ↑n)) - ((α * ↑m) - (floor (α * ↑m))) = (floor (α * ↑n)) - (floor (α * ↑m)), from by
      {repeat{rw ← sub_eq_iff_eq_add}, rw ← fractional_part_eq, rw ← fractional_part_eq},
    have h4 : (α * ↑n) - (floor (α * ↑n)) - ((α * ↑m) - (floor (α * ↑m))) - ((floor (α * ↑n)) - (floor (α * ↑m))) = 0, from by
      {ring},
    have h5 : (α * ↑n) - (floor (α * ↑n)) - ((α * ↑m) - (floor (α * ↑m))) = ((floor (α * ↑n)) - (floor (α * ↑m))), from by
      {rw ← eq_zero_of_sub_eq_zero h4,},
    have h6 : (α * ↑n) - (α * ↑m) = ((floor (α * ↑n)) - (floor (α * ↑m))), from by
      {rw h3 at h5, rw h5,},
    have h7 : 0 < (α * ↑n) - (α * ↑m), from by
      {rw ← sub_pos (h2 ▸ rfl) at h6, rw h6, rw int.coe_nat_lt_coe_nat_iff, norm_num,},
    exact h7,
  },
  have h5 : ∀ m n : ℤ, m < n →  (floor (α * ↑m)) - (floor (α * ↑n)) < m - n, from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : 0 < (α * ↑n) - (α * ↑m), from h ▸ h4,
    have h2 : (α * ↑n) - (α * ↑m) = (floor (α * ↑n)) - (floor (α * ↑m)), from h ▸ h3,
    have h3 : 0 < (floor (α * ↑n)) - (floor (α * ↑m)), from by
      {rw ← sub_pos rfl at h1, rw h2 at h1, rw ← int.coe_nat_lt_coe_nat_iff at h1, norm_num,},
    have h4 : 0 ≤ (floor (α * ↑n)) - (floor (α * ↑m)) - (m - n), from by
      {rw ← int.coe_nat_le_coe_nat_iff, have h5 : (floor (α * ↑n)) - (floor (α * ↑m)) ∈ ℕ, from by
        exact int.coe_nat_sub_coe_nat_of_le (h2 ▸ h1), have h6 : m - n ∈ ℕ, from by
        norm_num, norm_num,},
    have h5 : 0 < m - n + ((floor (α * ↑n)) - (floor (α * ↑m)) - (m - n)), from by
      {rw int.coe_nat_lt_coe_nat_iff, rw nat.add_sub_of_le h4, norm_num,},
    show (floor (α * ↑m)) - (floor (α * ↑n)) < m - n, from by {rw ← h2, rw ← sub_pos rfl at h5, rw h5,},
  },
  have h6 : ∀ m n : ℤ, m < n → abs ((floor (α * ↑m)) - (floor (α * ↑n))) < abs (m - n), from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : (floor (α * ↑m)) - (floor (α * ↑n)) < m - n, from h ▸ h5,
    have h2 : abs ((floor (α * ↑m)) - (floor (α * ↑n))) < abs (m - n), from by {
      rw abs_lt_iff, split, exact h1, split,
      {rw nat.sub_lt_iff_lt_add',split,
      norm_num, rw abs_pos_iff, exact h1,},
      {exact nat.sub_nonneg (floor (α * ↑n)) (floor (α * ↑m)),},
    },
    exact h2,
  },
  have h7 : ∀ m n : ℤ, m < n → abs (α * ↑m - (floor (α * ↑m))) < abs (m - n), from by {
    assume (m n : ℤ) (h : m < n),
    have h1 : α * ↑m - (floor (α * ↑m)) ≤ α * ↑n - (floor (α * ↑n)), from h ▸ h1,
    have h2 : (floor (α * ↑m)) - (floor (α * ↑n)) < m - n, from h ▸ h5,
    have h3 : abs ((floor (α * ↑m)) - (floor (α * ↑n))) < abs (m - n), from h ▸ h6,
    have h
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ,
    assume h_distinct : i ≠ j,
    have h_fract_ne : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
      assume h_eq : int.fract (α * ↑i) = int.fract (α * ↑j),
      calc α = α*i-(α*↑i-int.fract (α*↑i)) : by {rw sub_eq_add_neg,ring}
      ... = α*(i-j)-(α*↑i-int.fract (α*↑i)) : by rw [h_eq,mul_add,mul_one]
      ... = α*(i-j)-(α*(i-j)) : by rw [← sub_eq_add_neg,← sub_eq_add_neg,mul_comm (i-j) α]
      ... = 0 : by ring,
      },
    exact h_fract_ne,
    },
  have h2 : ∀ i j : ℤ, int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ,
    by_cases h_eq : i = j,
    from by simp [h2],
    from by {exact h1 i j h_eq },
    },
  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = ⋃ i : ℤ, {int.fract (α * ↑i)}, from
    by {
      have h_mem : ∀ i : ℤ, int.fract (α * ↑i) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        assume i : ℤ,
        have h_m : m ∈ (@set.univ ℤ), from set.mem_univ i,
        show int.fract (α * ↑i) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by
          {
            apply set.mem_image_of_mem i, exact h_m,
          },
        },
      have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ ⋃ i : ℤ, {int.fract (α * ↑i)}, from by
        {
          exact set.subset_sUnion_of_mem h_mem,
        },
      have h5 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by
        {
          exact set.subset.refl _,
        },
      have h6 : ∀ i : ℤ, int.fract (α * ↑i) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by
        {
          assume i : ℤ,
          have h_m : (i : ℤ) ∈ (@set.univ ℤ), from by {
            exact set.mem_univ i,
          },
          have h_mem : int.fract (α * ↑i) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by
            {
              apply set.mem_image_of_mem i, exact h_m,
            },
          exact h_mem,
        },
      have h7 : ⋃ i : ℤ, {int.fract (α * ↑i)} ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        have h_subset : ∀ i : ℤ, {int.fract (α * ↑i)} ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
          assume i : ℤ,
          have h_subset : ∅ ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
            have h_subset : ∅ ⊆ {(i : ℤ)}, from by {
              exact set.subset.refl _,
            },
            have h_subset : {(i : ℤ)} ⊆ (@set.univ ℤ), from by
              {
                exact set.subset_univ _,
              },
            have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by
              {
                have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' {(i : ℤ)}, from by
                  {
                    have h_subset : {(i : ℤ)} ⊆ {(i : ℤ)}, from
                      by {
                        exact set.subset.refl _,
                      },
                    have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' {(i : ℤ)}, from
                      by {
                        exact set.subset_image_of_subset h_subset,
                      },
                    exact h_subset,
                  },
                have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by
                  {
                    have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from
                      by {
                        have h_subset : {(i : ℤ)} ⊆ (λ (m : ℤ), int.fract (α * ↑m)) '' {(i : ℤ)}, from
                          by {
                            exact set.subset_inter_right h_subset,
                          },
                        exact h_subset,
                      },
                    exact h_subset,
                  },
                exact h_subset,
              },
            have h_subset : ∅ ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from
              by {
                exact set.subset_sUnion_of_mem h_subset,
              },
            exact h_subset,
          },
          have h_subset : {int.fract (α * ↑i)} ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by
            {
              exact set.subset_sUnion_of_mem h_subset,
            },
          exact h_subset,
        },
        exact set.sUnion_subset h_subset,
      },
      have h_eq : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = ⋃ i : ℤ, {int.fract (α * ↑i)}, from
        by {
          exact set.subset.antisymm h4 h7,
        },
      exact h_eq,
      },
  have h_infinite : ∀ i j : ℤ, i ≠ j → int.
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  let the_set : set ℝ := set.range int.fract ∩ set.Icc 0 1,
  let the_naturals : set ℕ := set.range (λ x : ℕ, set.finite_int_range 0 x),
  let the_ints : set ℤ := ⋃ (n : ℕ) (h : n ∈ the_naturals), (λ x : ℕ, x - n) '' (set.finite_int_range 0 n),
  have the_ints_subset_range : the_ints ⊆ set.range int.fract, from
    by {intros x hx, rcases hx with ⟨y, hy⟩, rcases hy with ⟨⟨n, hn⟩, ⟨h1, h2⟩⟩, use int.fract (x + n),
        rw ← int.fract_add, rw set.mem_image, use (x-n), simp [h2, int.fract_add, nat.add_sub_cancel_right]},
  have the_ints_subset_Icc : the_ints ⊆ set.Icc 0 1, from
    by {intros x hx, rcases hx with ⟨y, hy⟩, rcases hy with ⟨⟨n, hn⟩, ⟨h1, h2⟩⟩, simp [h2, int.fract_add, nat.add_sub_cancel_right],
        rw ← int.fract_add, rw ← ← set.mem_Icc, rw set.mem_range, use (y+n), simp [h1]},
  have the_ints_subset_the_set : the_ints ⊆ the_set, from set.subset.trans the_ints_subset_Icc (set.inter_subset_left _ the_set.2),

  have h1 : set.range int.fract ∩ set.Icc 0 1 ⊆ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from
    by {intros x hx, rcases hx with ⟨h1, h2⟩,
        have h3 : ∃n : ℕ, ∀ m : ℕ, m > n → ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑m, from sorry,
        rcases h3 with ⟨n,h3⟩,
        have h4 : ∃ N : ℤ, ∀ k : ℤ, (k ≥ N) → int.fract x - α * ↑k < (1 : ℝ) / ↑n, from sorry,
        rcases h4 with ⟨N,h4⟩,
        use (int.fract x - α * ↑N), rw ← set.mem_Icc, rw set.mem_range, use int.fract x, simp [h2],
        have h5 : ∀ m : ℤ, m ≥ 0 → ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(m - N), from
          assume (m : ℤ) (h : m ≥ 0), begin
            have h5 : ∃k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(((m : ℕ) - N) : ℕ), from h4 (m - N) (int.le_of_lt (nat.lt_of_lt_of_le h (nat.le_add_right (m - N) N))),
            rcases h5 with ⟨k, h5⟩, use k, simp [h5], end,
        have h6 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(N), from h5 (N) (int.zero_le N),
        rcases h6 with ⟨k, h6⟩,
        have h7 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(1), from h5 1 (int.le_add_left N 1),
        rcases h7 with ⟨k1, h7⟩,
        have h8 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(2), from h5 2 (int.le_add_left N 2),
        rcases h8 with ⟨k2, h8⟩,
        have h9 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(3), from h5 3 (int.le_add_left N 3),
        rcases h9 with ⟨k3, h9⟩,
        have h10 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(4), from h5 4 (int.le_add_left N 4),
        rcases h10 with ⟨k4, h10⟩,
        have h11 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(5), from h5 5 (int.le_add_left N 5),
        rcases h11 with ⟨k5, h11⟩,
        have h12 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(6), from h5 6 (int.le_add_left N 6),
        rcases h12 with ⟨k6, h12⟩,
        have h13 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(7), from h5 7 (int.le_add_left N 7),
        rcases h13 with ⟨k7, h13⟩,
        have h14 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(8), from h5 8 (int.le_add_left N 8),
        rcases h14 with ⟨k8, h14⟩,
        have h15 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(9), from h5 9 (int.le_add_left N 9),
        rcases h15 with ⟨k9, h15⟩,
        have h16 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(10), from h5 10 (int.le_add_left N 10),
        rcases h16 with ⟨k10, h16⟩,
        have h17 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(11), from h5 11 (int.le_add_left N 11),
        rcases h17 with ⟨k11, h17⟩,
        have h18 : ∃ k : ℤ, int.fract x - α * ↑(k : ℤ) < (1 : ℝ) / ↑(12), from h5 12 (int.le_add_left N 12),
        rcases h18 with ⟨k12, h18⟩,
        show x ∈ closure ((λ (m : ℤ), int.fract (
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 : ∀ (m n : ℤ), (α ∈ ℚ) → (int.fract (α * ↑m) = int.fract (α * ↑n)) → m = n, from
    assume (m n : ℤ) (hα_rat : α ∈ ℚ) (hmαn_eq : int.fract (α * ↑m) = int.fract (α * ↑n)),
    have h2 : int.fract (α * (↑m - ↑n)) = 0, from by rw [←add_neg_self, ←sub_eq_add_neg, ←hmαn_eq, ←add_assoc],
    have h3 : ∃ (q : ℤ), int.fract (α * (↑m - ↑n)) = q, from ⟨int.floor (α * ↑(m - n)), by rw [int.add_fract, add_comm, int.add_fract]⟩,
    have h4 : α = (int.floor (α * ↑(m - n)) : ℤ) / (↑(m - n) : ℤ), from
      show α = (int.floor (α * ↑(m - n)) : ℤ)/(↑(m - n) : ℤ),
      begin
        have h1 : α * (↑m - ↑n : ℤ) = int.floor (α * ↑(m - n)), from
          begin exact (int.add_fract (α * ↑m) (- ↑n)) ⟨(int.fract_ne_zero_of_ne_zero (α * ↑m)).1,by rw [mul_comm, neg_one_mul]⟩⟩ h2, end,
        rw h1,
        have h2 : ↑(m - n) = (↑(m - n) : ℤ), from rfl,
        rw h2,
        ring,
      end,
    have h5 : α ∈ ℚ, from by {rw hα_rat, exact ⟨(m - n : ℤ), by rw h4⟩},
    show m = n, from rat_unique_denom h5 (by rw [h4, mul_comm]) (neg_ne_zero (m - n)),

  have h2 : ∀ (m n : ℤ), (int.fract (α * ↑m) = int.fract (α * ↑n)) → m = n, from by {
    assume (m n : ℤ) (hmαn_eq : int.fract (α * ↑m) = int.fract (α * ↑n)),
    have h3 : ∃ q : ℤ, ↑q * α < ↑n, from ⟨m, by rwa [←mul_one, ←hmαn_eq, int.lt_iff_add_one_le, int.fract_le_iff_floor_add_one_le]⟩,
    have h4 : ∃ q : ℤ, ↑n < ↑q * α, from ⟨m + 1, by rwa [←mul_one, ←hmαn_eq, int.lt_iff_add_one_le, int.fract_le_iff_floor_add_one_le]⟩,
    show m = n, from (hα_irrat h3 h4),
  },

  have h3 : ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ @set.univ ℝ, from by {
    assume x : ℝ, assume h1 : x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),
    show x ∈ @set.univ ℝ, from by {
      obtain ⟨m, h2⟩ := h1,
      have h3 : m ∈ @set.univ ℤ, from by {exact set.mem_univ m},
      show x ∈ @set.univ ℝ, from by {rw h2, exact set.mem_univ (int.fract (α * ↑m))},
    },
  },

  have h4 : ∀ (m n : ℤ), int.fract (α * ↑m) = int.fract (α * ↑n), from by {
    assume (m n : ℤ) ,
    have h1 : int.fract (α * ↑m) = int.fract (α * ↑n), from by {rw [mul_comm α m, mul_comm α n]},
    show int.fract (α * ↑m) = int.fract (α * ↑n), from by {rw h1},
  },

  have h5 : ∀ (m n : ℤ), m = n, from
    assume (m n : ℤ), h2 m n (h4 m n),

  have h6 : ∀ (m n : ℤ), int.fract (α * ↑m) = int.fract (α * ↑n), from
    assume (m n : ℤ), by rw [h5 m n],

  have h7 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = (@set.univ ℝ), from set.eq_univ_iff_forall.1 (by {assume x, rw h7}),

  have h8 : (@set.univ ℝ) ⊆ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    assume x : ℝ, assume hx_univ : x ∈ (@set.univ ℝ),
    obtain ⟨ m, hm⟩ := exists_rat_between_two_irrat_gt hα_irrat ⟨0, by norm_num⟩ hx_univ,
    have h1 : ∀ n, ∃ y : ℝ, n * ↑m ∈ set.Icc (x - int.fract (α * n * ↑m)) (x + int.fract (α * n * ↑m)), from
      assume n : ℝ, ⟨int.fract (α * n * ↑m), by have h1 := int.add_fract (α * n * ↑m) (- n * ↑m);
                                                     have h2 := int.le_add_iff_nonpos_left (- n * ↑m);
                                                     have h3 := int.fract_nonneg _;
                                                     have h4 : ↑x ≤ ↑x + int.fract (α * ↑n * ↑m), from by rw [add_comm, ←add_assoc, ←add_assoc, h1],
                                                     have h5 : ↑x - int.fract (α * ↑n * ↑m) ≤ ↑x, from by rw [add_comm, ←add_assoc, ←add_assoc, h1]; norm_num,
                                                     rw [set.mem_Icc, h3, h2, h5, h4]⟩,
    have h2 : ∃ n : ℕ, ∃ y : ℝ, n * ↑m ∈ set.Icc (x - int.fract (α * n * ↑m)) (x + int.fract (α * n * ↑m)), from
      ⟨nat.succ (↑m / 2), int.fract (α * ↑(nat.succ (↑m / 2 * ↑m)) * ↑m), by have h1 := by rwa [←mul_assoc, ←int.right_distrib, ←int.distrib_int_cast, ←nat.cast_mul, ←nat.cast_one, nat.cast_mul_one, mul_comm, ←nat.one_mul, ←nat.mul_add_mul_div_left];
                                                                                have h2 := int.le_add_iff_nonpos_left (- nat.succ (↑m / 2) * ↑m);

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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  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
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = 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}
  ... = 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
  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, },

  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,

  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`
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) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module logic.embedding.set
! leanprover-community/mathlib commit fc2ed6f838ce7c9b7c7171e58d78eaf7b438fb0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Embedding.Basic
import Mathlib.Data.Set.Image

/-!
# Interactions between embeddings and sets.

-/

universe u v w x

section Equiv

variable {α : Sort u} {β : Sort v} (f : α ≃ β)

@[simp]
theorem Equiv.asEmbedding_range {α β : Sort _} {p : β → Prop} (e : α ≃ Subtype p) :
    Set.range e.asEmbedding = setOf p :=
  Set.ext fun x ↦ ⟨fun ⟨y, h⟩ ↦ h ▸ Subtype.coe_prop (e y), fun hs ↦ ⟨e.symm ⟨x, hs⟩, by simp⟩⟩
#align equiv.as_embedding_range Equiv.asEmbedding_range

end Equiv

namespace Function

namespace Embedding

/-- Embedding into `WithTop α`. -/
@[simps]
def coeWithTop {α} : α ↪ WithTop α :=
  { Embedding.some with toFun := WithTop.some }
#align function.embedding.coe_with_top Function.Embedding.coeWithTop
#align function.embedding.coe_with_top_apply Function.Embedding.coeWithTop_apply

/-- Given an embedding `f : α ↪ β` and a point outside of `Set.range f`, construct an embedding
`Option α ↪ β`. -/
@[simps]
def optionElim {α β} (f : α ↪ β) (x : β) (h : x ∉ Set.range f) : Option α ↪ β :=
  ⟨Option.elim' x f, Option.injective_iff.2 ⟨f.2, h⟩⟩
#align function.embedding.option_elim Function.Embedding.optionElim
#align function.embedding.option_elim_apply Function.Embedding.optionElim_apply

/-- Equivalence between embeddings of `Option α` and a sigma type over the embeddings of `α`. -/
@[simps]
def optionEmbeddingEquiv (α β) : (Option α ↪ β) ≃ Σ f : α ↪ β, ↥(Set.range fᶜ) where
  toFun f := ⟨coeWithTop.trans f, f none, fun ⟨x, hx⟩ ↦ Option.some_ne_none x <| f.injective hx⟩
  invFun f := f.1.optionElim f.2 f.2.2
  left_inv f := ext <| by rintro (_ | _) <;> simp [Option.coe_def] ; rfl
  right_inv := fun ⟨f, y, hy⟩ ↦ by ext <;> simp [Option.coe_def] ; rfl
#align function.embedding.option_embedding_equiv Function.Embedding.optionEmbeddingEquiv
#align function.embedding.option_embedding_equiv_apply_snd_coe Function.Embedding.optionEmbeddingEquiv_apply_snd_coe
#align function.embedding.option_embedding_equiv_symm_apply Function.Embedding.optionEmbeddingEquiv_symm_apply
#align function.embedding.option_embedding_equiv_apply_fst Function.Embedding.optionEmbeddingEquiv_apply_fst

/-- Restrict the codomain of an embedding. -/
def codRestrict {α β} (p : Set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
  ⟨fun a ↦ ⟨f a, H a⟩, fun _ _ h ↦ f.injective (congr_arg Subtype.val h)⟩
#align function.embedding.cod_restrict Function.Embedding.codRestrict

@[simp]
theorem codRestrict_apply {α β} (p) (f : α ↪ β) (H a) : codRestrict p f H a = ⟨f a, H a⟩ :=
  rfl
#align function.embedding.cod_restrict_apply Function.Embedding.codRestrict_apply

open Set

/-- `Set.image` as an embedding `Set α ↪ Set β`. -/
@[simps apply]
protected def image {α β} (f : α ↪ β) : Set α ↪ Set β :=
  ⟨image f, f.2.image_injective⟩
#align function.embedding.image Function.Embedding.image
#align function.embedding.image_apply Function.Embedding.image_apply

end Embedding

end Function

namespace Set

/-- The injection map is an embedding between subsets. -/
@[simps apply]
def embeddingOfSubset {α} (s t : Set α) (h : s ⊆ t) : s ↪ t :=
  ⟨fun x ↦ ⟨x.1, h x.2⟩, fun ⟨x, hx⟩ ⟨y, hy⟩ h ↦ by
    congr
    injection h⟩
#align set.embedding_of_subset Set.embeddingOfSubset
#align set.embedding_of_subset_apply Set.embeddingOfSubset_apply

end Set

section Subtype

variable {α : Type _}

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
`Disjoint p q`.

See also `Equiv.sumCompl`, for when `IsCompl p q`.  -/
@[simps apply]
def subtypeOrEquiv (p q : α → Prop) [DecidablePred p] (h : Disjoint p q) :
    { x // p x ∨ q x } ≃ { x // p x } ⊕ { x // q x } where
  toFun := subtypeOrLeftEmbedding p q
  invFun :=
    Sum.elim (Subtype.impEmbedding _ _ fun x hx ↦ (Or.inl hx : p x ∨ q x))
      (Subtype.impEmbedding _ _ fun x hx ↦ (Or.inr hx : p x ∨ q x))
  left_inv x := by
    by_cases hx : p x
    · rw [subtypeOrLeftEmbedding_apply_left _ hx]
      simp [Subtype.ext_iff]
    · rw [subtypeOrLeftEmbedding_apply_right _ hx]
      simp [Subtype.ext_iff]
  right_inv x := by
    cases x with
    | inl x =>
        simp only [Sum.elim_inl]
        rw [subtypeOrLeftEmbedding_apply_left]
        · simp
        · simpa using x.prop
    | inr x =>
        simp only [Sum.elim_inr]
        rw [subtypeOrLeftEmbedding_apply_right]
        · simp
        · suffices ¬p x by simpa
          intro hp
          simpa using h.le_bot x ⟨hp, x.prop⟩
#align subtype_or_equiv subtypeOrEquiv
#align subtype_or_equiv_apply subtypeOrEquiv_apply

@[simp]
theorem subtypeOrEquiv_symm_inl (p q : α → Prop) [DecidablePred p] (h : Disjoint p q)
    (x : { x // p x }) : (subtypeOrEquiv p q h).symm (Sum.inl x) = ⟨x, Or.inl x.prop⟩ :=
  rfl
#align subtype_or_equiv_symm_inl subtypeOrEquiv_symm_inl

@[simp]
theorem subtypeOrEquiv_symm_inr (p q : α → Prop) [DecidablePred p] (h : Disjoint p q)
    (x : { x // q x }) : (subtypeOrEquiv p q h).symm (Sum.inr x) = ⟨x, Or.inr x.prop⟩ :=
  rfl
#align subtype_or_equiv_symm_inr subtypeOrEquiv_symm_inr

end Subtype


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import data.int.cast
import data.nat.cast_field

/-!
# Cast of integers into fields

This file concerns the canonical homomorphism `ℤ → F`, where `F` is a field.

## Main results

 * `int.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
-/

namespace int

open nat
variables {α : Type*}

/--
Auxiliary lemma for norm_cast to move the cast `-↑n` upwards to `↑-↑n`.

(The restriction to `field` is necessary, otherwise this would also apply in the case where
`R = ℤ` and cause nontermination.)
-/
@[norm_cast]
lemma cast_neg_nat_cast {R} [field R] (n : ℕ) : ((-n : ℤ) : R) = -n := by simp

@[simp] theorem cast_div [field α] {m n : ℤ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
  ((m / n : ℤ) : α) = m / n :=
begin
  rcases n_dvd with ⟨k, rfl⟩,
  have : n ≠ 0, { rintro rfl, simpa using n_nonzero },
  rw [int.mul_div_cancel_left _ this, int.cast_mul, mul_div_cancel_left _ n_nonzero],
end

end int


import Lean.Data.Json
import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Tactic.LibrarySearch
import Mathlib.Data.Equiv.Basic
import Mathlib.Init.Data.Int.Order

open Lean

structure ScalarDate where
  day : Int
deriving Repr, ToJson, FromJson

theorem ScalarDate.val_eq_of_eq : ∀ {d₁ d₂ : ScalarDate} (h : d₁ = d₂), d₁.day = d₂.day
| ⟨_⟩, _, rfl => rfl

theorem ScalarDate.eq_of_val_eq : ∀ {d₁ d₂ : ScalarDate} (h : d₁.day = d₂.day), d₁ = d₂
| ⟨_⟩, _, rfl => rfl

instance : LE ScalarDate where
  le := InvImage Int.le ScalarDate.day

instance : LT ScalarDate where
  lt := InvImage Int.lt ScalarDate.day

theorem ScalarDate.le_def {d₁ d₂ : ScalarDate} : (d₁ <= d₂) = (d₁.day <= d₂.day) := rfl
theorem ScalarDate.lt_def {d₁ d₂ : ScalarDate} : (d₁ < d₂) = (d₁.day < d₂.day) := rfl

instance instDecidableLEScalarDate (d₁ d₂ : ScalarDate) : Decidable (d₁ <= d₂) := inferInstanceAs (Decidable (d₁.day <= d₂.day))
instance instDecidableLTScalarDate (d₁ d₂ : ScalarDate) : Decidable (d₁ < d₂) := inferInstanceAs (Decidable (d₁.day < d₂.day))

instance : LinearOrder ScalarDate where
  le_refl (a) := le_refl a.day
  le_trans (a b c) := Int.le_trans
  lt_iff_le_not_le (a b) := Int.lt_iff_le_not_le
  le_antisymm (a b h1 h2) := by
    apply ScalarDate.eq_of_val_eq
    exact le_antisymm h1 h2
  le_total := by simp [ScalarDate.le_def, le_total]
  decidable_le := inferInstance

instance : Ord ScalarDate := ⟨fun d₁ d₂ => compareOfLessAndEq d₁ d₂⟩

def Int.rataDie (scalarScalarDate : Int) : Int := Int.fmod scalarScalarDate 7

@[reducible, simp]
abbrev ScalarDate.dayOfWeek (d : ScalarDate) : Int := d.day.rataDie

abbrev sunday : Nat := 0
abbrev monday : Nat := 1
abbrev tuesday : Nat := 2
abbrev wednesday : Nat := 3
abbrev thursday : Nat := 4
abbrev friday : Nat := 5
abbrev saturday : Nat := 6

abbrev ScalarDate.isSunday (d : ScalarDate) : Bool := d.dayOfWeek = sunday
abbrev ScalarDate.isMonday (d : ScalarDate) : Bool := d.dayOfWeek = monday
abbrev ScalarDate.isTuesday (d : ScalarDate) : Bool := d.dayOfWeek = tuesday
abbrev ScalarDate.isWednesday (d : ScalarDate) : Bool := d.dayOfWeek = wednesday
abbrev ScalarDate.isThursday (d : ScalarDate) : Bool := d.dayOfWeek = thursday
abbrev ScalarDate.isFriday (d : ScalarDate) : Bool := d.dayOfWeek = friday
abbrev ScalarDate.isSaturday (d : ScalarDate) : Bool := d.dayOfWeek = saturday

def ScalarDate.addDays : ScalarDate → Nat → ScalarDate
| ⟨d⟩, ds => ⟨d + ds⟩

def ScalarDate.subDays : ScalarDate → Nat → ScalarDate
| ⟨d⟩, ds => ⟨d - ds⟩

instance : Inhabited ScalarDate where
  default := ScalarDate.mk 0


inductive Mem (a : α) : List α → Prop where
  | head {as} : Mem a (a::as)
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

example (a b : Nat) (h : a ∈ [b]) : b = a :=
  match h with
  | Mem.head => rfl

example {as : List α} (h : a ∈ b :: as) : b = a ∨ a ∈ as :=
  match h with
  | Mem.head    => Or.inl rfl
  | Mem.tail h' => Or.inr h'

example (a b : Nat) (h : a.succ.succ = b.succ.succ.succ) : a = b.succ :=
  match h with
  | rfl => rfl

inductive Vec (α : Type u) : Nat → Type u where
  | nil  : Vec α 0
  | cons : α → Vec α n → Vec α (n + 1)

def hv (xs : Vec Nat (n+1)) : Nat :=
  match xs with
  | Vec.cons a .. => a

def addHead (p : Vec Nat n × Vec Nat n) : Nat :=
  match p with
  | (Vec.cons a _, Vec.cons b _) => a + b
  | (Vec.nil, Vec.nil) => 0

inductive HVec : {n : Nat} → Vec (Type u) n → Type (u+1)
  | nil  : HVec Vec.nil
  | cons : {αs : Vec (Type u) n} → α → HVec αs → HVec (Vec.cons α αs)

abbrev HVec.TypeHead {αs : Vec (Type u) n} (xs : HVec αs) : Type u :=
  match xs with
  | HVec.nil => PUnit
  | HVec.cons (α := α) .. => α

def HVec.head {αs : Vec (Type u) n} (xs : HVec αs) : TypeHead xs :=
  match xs with
  | HVec.cons a _ => a
  | HVec.nil      => PUnit.unit