/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.extreme
import analysis.convex.function
import analysis.normed_space.ordered

/-!
# Exposed sets

This file defines exposed sets and exposed points for sets in a real vector space.

An exposed subset of `A` is a subset of `A` that is the set of all maximal points of a functional
(a continuous linear map `E → 𝕜`) over `A`. By convention, `∅` is an exposed subset of all sets.
This allows for better functoriality of the definition (the intersection of two exposed subsets is
exposed, faces of a polytope form a bounded lattice).
This is an analytic notion of "being on the side of". It is stronger than being extreme (see
`is_exposed.is_extreme`), but weaker (for exposed points) than being a vertex.

An exposed set of `A` is sometimes called a "face of `A`", but we decided to reserve this
terminology to the more specific notion of a face of a polytope (sometimes hopefully soon out
on mathlib!).

## Main declarations

* `is_exposed 𝕜 A B`: States that `B` is an exposed set of `A` (in the literature, `A` is often
  implicit).
* `is_exposed.is_extreme`: An exposed set is also extreme.

## References

See chapter 8 of [Barry Simon, *Convexity*][simon2011]

## TODO

Define intrinsic frontier/interior and prove the lemmas related to exposed sets and points.

Generalise to Locally Convex Topological Vector Spaces™

More not-yet-PRed stuff is available on the branch `sperner_again`.
-/

open_locale classical affine big_operators
open set

variables (𝕜 : Type*) {E : Type*} [normed_linear_ordered_field 𝕜] [normed_group E]
  [normed_space 𝕜 E] {l : E →L[𝕜] 𝕜} {A B C : set E} {X : finset E} {x : E}

/-- A set `B` is exposed with respect to `A` iff it maximizes some functional over `A` (and contains
all points maximizing it). Written `is_exposed 𝕜 A B`. -/
def is_exposed (A B : set E) : Prop :=
B.nonempty → ∃ l : E →L[𝕜] 𝕜, B = {x ∈ A | ∀ y ∈ A, l y ≤ l x}

variables {𝕜}

/-- A useful way to build exposed sets from intersecting `A` with halfspaces (modelled by an
inequality with a functional). -/
def continuous_linear_map.to_exposed (l : E →L[𝕜] 𝕜) (A : set E) : set E :=
{x ∈ A | ∀ y ∈ A, l y ≤ l x}

lemma continuous_linear_map.to_exposed.is_exposed : is_exposed 𝕜 A (l.to_exposed A) := λ h, ⟨l, rfl⟩

lemma is_exposed_empty : is_exposed 𝕜 A ∅ :=
λ ⟨x, hx⟩, by { exfalso, exact hx }

namespace is_exposed

protected lemma subset (hAB : is_exposed 𝕜 A B) : B ⊆ A :=
begin
  rintro x hx,
  obtain ⟨_, rfl⟩ := hAB ⟨x, hx⟩,
  exact hx.1,
end

@[refl] protected lemma refl (A : set E) : is_exposed 𝕜 A A :=
λ ⟨w, hw⟩, ⟨0, subset.antisymm (λ x hx, ⟨hx, λ y hy, by exact le_refl 0⟩) (λ x hx, hx.1)⟩

protected lemma antisymm (hB : is_exposed 𝕜 A B) (hA : is_exposed 𝕜 B A) :
  A = B :=
hA.subset.antisymm hB.subset

/- `is_exposed` is *not* transitive: Consider a (topologically) open cube with vertices
`A₀₀₀, ..., A₁₁₁` and add to it the triangle `A₀₀₀A₀₀₁A₀₁₀`. Then `A₀₀₁A₀₁₀` is an exposed subset
of `A₀₀₀A₀₀₁A₀₁₀` which is an exposed subset of the cube, but `A₀₀₁A₀₁₀` is not itself an exposed
subset of the cube. -/

protected lemma mono (hC : is_exposed 𝕜 A C) (hBA : B ⊆ A) (hCB : C ⊆ B) :
  is_exposed 𝕜 B C :=
begin
  rintro ⟨w, hw⟩,
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩,
  exact ⟨l, subset.antisymm (λ x hx, ⟨hCB hx, λ y hy, hx.2 y (hBA hy)⟩)
    (λ x hx, ⟨hBA hx.1, λ y hy, (hw.2 y hy).trans (hx.2 w (hCB hw))⟩)⟩,
end

/-- If `B` is an exposed subset of `A`, then `B` is the intersection of `A` with some closed
halfspace. The converse is *not* true. It would require that the corresponding open halfspace
doesn't intersect `A`. -/
lemma eq_inter_halfspace (hAB : is_exposed 𝕜 A B) :
  ∃ l : E →L[𝕜] 𝕜, ∃ a, B = {x ∈ A | a ≤ l x} :=
begin
  obtain hB | hB := B.eq_empty_or_nonempty,
  { refine ⟨0, 1, _⟩,
    rw [hB, eq_comm, eq_empty_iff_forall_not_mem],
    rintro x ⟨-, h⟩,
    rw continuous_linear_map.zero_apply at h,
    linarith },
  obtain ⟨l, rfl⟩ := hAB hB,
  obtain ⟨w, hw⟩ := hB,
  exact ⟨l, l w, subset.antisymm (λ x hx, ⟨hx.1, hx.2 w hw.1⟩)
    (λ x hx, ⟨hx.1, λ y hy, (hw.2 y hy).trans hx.2⟩)⟩,
end

protected lemma inter (hB : is_exposed 𝕜 A B) (hC : is_exposed 𝕜 A C) :
  is_exposed 𝕜 A (B ∩ C) :=
begin
  rintro ⟨w, hwB, hwC⟩,
  obtain ⟨l₁, rfl⟩ := hB ⟨w, hwB⟩,
  obtain ⟨l₂, rfl⟩ := hC ⟨w, hwC⟩,
  refine ⟨l₁ + l₂, subset.antisymm _ _⟩,
  { rintro x ⟨⟨hxA, hxB⟩, ⟨-, hxC⟩⟩,
    exact ⟨hxA, λ z hz, add_le_add (hxB z hz) (hxC z hz)⟩ },
  rintro x ⟨hxA, hx⟩,
  refine ⟨⟨hxA, λ y hy, _⟩, hxA, λ y hy, _⟩,
  { exact (add_le_add_iff_right (l₂ x)).1 ((add_le_add (hwB.2 y hy) (hwC.2 x hxA)).trans
      (hx w hwB.1)) },
  { exact (add_le_add_iff_left (l₁ x)).1 (le_trans (add_le_add (hwB.2 x hxA) (hwC.2 y hy))
    (hx w hwB.1)) }
end

lemma sInter {F : finset (set E)} (hF : F.nonempty)
  (hAF : ∀ B ∈ F, is_exposed 𝕜 A B) :
  is_exposed 𝕜 A (⋂₀ F) :=
begin
  revert hF F,
  refine finset.induction _ _,
  { rintro h,
    exfalso,
    exact empty_not_nonempty h },
  rintro C F _ hF _ hCF,
  rw [finset.coe_insert, sInter_insert],
  obtain rfl | hFnemp := F.eq_empty_or_nonempty,
  { rw [finset.coe_empty, sInter_empty, inter_univ],
    exact hCF C (finset.mem_singleton_self C) },
  exact (hCF C (finset.mem_insert_self C F)).inter (hF hFnemp (λ B hB,
    hCF B(finset.mem_insert_of_mem hB))),
end

lemma inter_left (hC : is_exposed 𝕜 A C) (hCB : C ⊆ B) :
  is_exposed 𝕜 (A ∩ B) C :=
begin
  rintro ⟨w, hw⟩,
  obtain ⟨l, rfl⟩ := hC ⟨w, hw⟩,
  exact ⟨l, subset.antisymm (λ x hx, ⟨⟨hx.1, hCB hx⟩, λ y hy, hx.2 y hy.1⟩)
    (λ x ⟨⟨hxC, _⟩, hx⟩, ⟨hxC, λ y hy, (hw.2 y hy).trans (hx w ⟨hC.subset hw, hCB hw⟩)⟩)⟩,
end

lemma inter_right (hC : is_exposed 𝕜 B C) (hCA : C ⊆ A) :
  is_exposed 𝕜 (A ∩ B) C :=
begin
  rw inter_comm,
  exact hC.inter_left hCA,
end

protected lemma is_extreme (hAB : is_exposed 𝕜 A B) :
  is_extreme 𝕜 A B :=
begin
  refine ⟨hAB.subset, λ x₁ hx₁A x₂ hx₂A x hxB hx, _⟩,
  obtain ⟨l, rfl⟩ := hAB ⟨x, hxB⟩,
  have hl : convex_on 𝕜 univ l := l.to_linear_map.convex_on convex_univ,
  have hlx₁ := hxB.2 x₁ hx₁A,
  have hlx₂ := hxB.2 x₂ hx₂A,
  refine ⟨⟨hx₁A, λ y hy, _⟩, ⟨hx₂A, λ y hy, _⟩⟩,
  { rw hlx₁.antisymm (hl.le_left_of_right_le (mem_univ _) (mem_univ _) hx hlx₂),
    exact hxB.2 y hy },
  { rw hlx₂.antisymm (hl.le_right_of_left_le (mem_univ _) (mem_univ _) hx hlx₁),
    exact hxB.2 y hy }
end

protected lemma convex (hAB : is_exposed 𝕜 A B) (hA : convex 𝕜 A) :
  convex 𝕜 B :=
begin
  obtain rfl | hB := B.eq_empty_or_nonempty,
  { exact convex_empty },
  obtain ⟨l, rfl⟩ := hAB hB,
  exact λ x₁ x₂ hx₁ hx₂ a b ha hb hab, ⟨hA hx₁.1 hx₂.1 ha hb hab, λ y hy,
    ((l.to_linear_map.concave_on convex_univ).convex_ge _
    ⟨mem_univ _, hx₁.2 y hy⟩ ⟨mem_univ _, hx₂.2 y hy⟩ ha hb hab).2⟩,
end

protected lemma is_closed [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_closed A) :
  is_closed B :=
begin
  obtain ⟨l, a, rfl⟩ := hAB.eq_inter_halfspace,
  exact hA.is_closed_le continuous_on_const l.continuous.continuous_on,
end

protected lemma is_compact [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_compact A) :
  is_compact B :=
compact_of_is_closed_subset hA (hAB.is_closed hA.is_closed) hAB.subset

end is_exposed

variables (𝕜)

/-- A point is exposed with respect to `A` iff there exists an hyperplane whose intersection with
`A` is exactly that point. -/
def set.exposed_points (A : set E) :
  set E :=
{x ∈ A | ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x)}

variables {𝕜}

lemma exposed_point_def :
  x ∈ A.exposed_points 𝕜 ↔ x ∈ A ∧ ∃ l : E →L[𝕜] 𝕜, ∀ y ∈ A, l y ≤ l x ∧ (l x ≤ l y → y = x) :=
iff.rfl

lemma exposed_points_subset :
  A.exposed_points 𝕜 ⊆ A :=
λ x hx, hx.1

@[simp] lemma exposed_points_empty :
  (∅ : set E).exposed_points 𝕜 = ∅ :=
subset_empty_iff.1 exposed_points_subset

/-- Exposed points exactly correspond to exposed singletons. -/
lemma mem_exposed_points_iff_exposed_singleton :
  x ∈ A.exposed_points 𝕜 ↔ is_exposed 𝕜 A {x} :=
begin
  use λ ⟨hxA, l, hl⟩ h, ⟨l, eq.symm $ eq_singleton_iff_unique_mem.2 ⟨⟨hxA, λ y hy, (hl y hy).1⟩,
    λ z hz, (hl z hz.1).2 (hz.2 x hxA)⟩⟩,
  rintro h,
  obtain ⟨l, hl⟩ := h ⟨x, mem_singleton _⟩,
  rw [eq_comm, eq_singleton_iff_unique_mem] at hl,
  exact ⟨hl.1.1, l, λ y hy, ⟨hl.1.2 y hy, λ hxy, hl.2 y ⟨hy, λ z hz, (hl.1.2 z hz).trans hxy⟩⟩⟩,
end

lemma exposed_points_subset_extreme_points :
  A.exposed_points 𝕜 ⊆ A.extreme_points 𝕜 :=
λ x hx, mem_extreme_points_iff_extreme_singleton.2
  (mem_exposed_points_iff_exposed_singleton.1 hx).is_extreme


/-
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, Sébastien Gouëzel, Yury Kudryashov
-/
import dynamics.ergodic.measure_preserving
import linear_algebra.determinant
import linear_algebra.matrix.diagonal
import linear_algebra.matrix.transvection
import measure_theory.constructions.pi
import measure_theory.measure.stieltjes

/-!
# Lebesgue measure on the real line and on `ℝⁿ`

We construct Lebesgue measure on the real line, as a particular case of Stieltjes measure associated
to the function `x ↦ x`. We obtain as a consequence Lebesgue measure on `ℝⁿ`. We prove that they
are translation invariant.

We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.

More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
-/

noncomputable theory
open classical set filter measure_theory measure_theory.measure
open ennreal (of_real)
open_locale big_operators ennreal nnreal topological_space

/-!
### Definition of the Lebesgue measure and lengths of intervals
-/

/-- Lebesgue measure on the Borel sigma algebra, giving measure `b - a` to the interval `[a, b]`. -/
instance real.measure_space : measure_space ℝ :=
⟨stieltjes_function.id.measure⟩

namespace real

variables {ι : Type*} [fintype ι]

open_locale topological_space

theorem volume_val (s) : volume s = stieltjes_function.id.measure s := rfl

@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
by simp [volume_val]

@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
ennreal.eq_top_of_forall_nnreal_le $ λ r,
  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
              ... ≤ volume univ            : measure_mono (subset_univ _)

@[simp] lemma volume_ball (a r : ℝ) :
  volume (metric.ball a r) = of_real (2 * r) :=
by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_closed_ball (a r : ℝ) :
  volume (metric.closed_ball a r) = of_real (2 * r) :=
by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [metric.emetric_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.closed_ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [emetric.closed_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
⟨λ x, volume_singleton⟩

@[simp] lemma volume_interval {a b : ℝ} : volume (interval a b) = of_real (|b - a|) :=
by rw [interval, volume_Icc, max_sub_min_eq_abs]

@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self

@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
by simp [← measure_congr Ioi_ae_eq_Ici]

@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self

@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
by simp [← measure_congr Iio_ae_eq_Iic]

instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
⟨λ x, ⟨Ioo (x - 1) (x + 1),
  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩

instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
 ⟨by simp⟩

instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
⟨by simp⟩

/-!
### Volume of a box in `ℝⁿ`
-/

lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
begin
  rw [← pi_univ_Icc, volume_pi_pi],
  simp only [real.volume_Icc]
end

@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioo {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioc {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ico {a b : ι → ℝ} :
  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
end

@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
end

lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
begin
  by_cases hs : metric.bounded s,
  { rw [real.ediam_eq hs, ← volume_Icc],
    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
  { rw metric.ediam_of_unbounded hs, exact le_top }
end

lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
          ... = ∏ i, volume (closure $ function.eval i '' s) :
  volume_pi_pi _
          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)

lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
  volume s ≤ emetric.diam s ^ fintype.card ι :=
calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
          ... = emetric.diam s ^ fintype.card ι              :
  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]

/-!
### Images of the Lebesgue measure under translation/multiplication in ℝ
-/

instance is_add_left_invariant_real_volume :
  is_add_left_invariant (volume : measure ℝ) :=
⟨λ a, eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
  by simp [measure.map_apply (measurable_const_add a) measurable_set_Ioo, sub_sub_sub_cancel_right]⟩

lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
begin
  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
  cases lt_or_gt_of_ne h with h h,
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
      neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
      mul_div_cancel' _ (ne_of_lt h)] },
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul] }
end

lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
  one_smul] }

@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }

lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
by simpa only [mul_comm] using real.smul_map_volume_mul_left h

lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by simpa only [mul_comm] using real.map_volume_mul_left h

@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }

instance : is_neg_invariant (volume : measure ℝ) :=
⟨eq.symm $ real.measure_ext_Ioo_rat $ λ p q, by simp [show volume.neg (Ioo (p : ℝ) q) = _,
  from measure.map_apply measurable_neg measurable_set_Ioo]⟩

/-!
### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
-/

open matrix

/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
uses this particular case). -/
lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
  rw [measure.map_apply _ (measurable_set.univ_pi_fintype hs)],
  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
  { ext f,
    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
  { assume i,
    have A : D i ≠ 0,
    { simp only [det_diagonal, ne.def] at h,
      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
  rw [this, volume_pi_pi, finset.abs_prod,
    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
  simp only [B]
end

/-- A transvection preserves Lebesgue measure. -/
lemma volume_preserving_transvection_struct [decidable_eq ι] (t : transvection_struct ι ℝ) :
  measure_preserving (t.to_matrix.to_lin') :=
begin
  /- We separate the coordinate along which there is a shearing from the other ones, and apply
  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
  translation, and therefore preserves Lebesgue. -/
  let p : ι → Prop := λ i, i ≠ t.i,
  let α : Type* := {x // p x},
  let β : Type* := {x // ¬ (p x)},
  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
    λ p, (id p.1, g p.1 p.2),
  let e : (ι → ℝ) ≃ᵐ (α → ℝ) × (β → ℝ) := measurable_equiv.pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p,
  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
  { cases t,
    ext f k,
    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
      measurable_equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
      measurable_equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
    by_cases h : t_i = k,
    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
        one_apply, boole_mul, add_comm], },
    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
  rw this,
  have A : measure_preserving e,
  { convert volume_preserving_pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p },
  have B : measure_preserving F,
  { have g_meas : measurable (function.uncurry g),
    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
      refine (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)).add measurable_snd,
      exact this.comp measurable_fst },
    exact (measure_preserving.id _).skew_product g_meas
      (eventually_of_forall (λ a, map_add_left_eq_self _ _)) },
  exact ((A.symm e).comp B).comp A,
end

/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
  measure.map M.to_lin' volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
begin
  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
  -- as these matrices generate all invertible matrices.
  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
    (λ A B hA hB IHA IHB, _),
  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
      ennreal.of_real_one, one_smul] },
  { simp only [matrix.transvection_struct.det, ennreal.of_real_one,
      (volume_preserving_transvection_struct _).map_eq, one_smul, _root_.inv_one, abs_one] },
  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, measure.map_smul,
      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv],
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi },
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi } }
end

/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
begin
  -- this is deduced from the matrix case
  classical,
  let M := f.to_matrix',
  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
  rw [A, B],
  apply map_matrix_volume_pi_eq_smul_volume_pi,
  rwa A at hf
end

end real

open_locale topological_space

lemma filter.eventually.volume_pos_of_nhds_real {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
  (0 : ℝ≥0∞) < volume {x | p x} :=
begin
  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
  refine lt_of_lt_of_le _ (measure_mono hs),
  simpa [-mem_Ioo] using hx.1.trans hx.2
end

section region_between

open_locale classical

variable {α : Type*}

/-- The region between two real-valued functions on an arbitrary set. -/
def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}

lemma region_between_subset (f g : α → ℝ) (s : set α) :
  region_between f g s ⊆ s ×ˢ (univ : set ℝ) :=
by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left

variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}

/-- The region between two measurable functions on a measurable set is measurable. -/
lemma measurable_set_region_between
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set (region_between f g s) :=
begin
  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs
end

theorem volume_region_between_eq_lintegral'
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  rw measure.prod_apply,
  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
            = s.indicator (λ x, ennreal.of_real (g x - f x)),
    { funext x,
      rw indicator_apply,
      split_ifs,
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
        simp only [hx, real.volume_Ioo, sub_zero] },
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
        simp only [hx, measure_empty] } },
    dsimp only [region_between, preimage_set_of_eq],
    rw [h, lintegral_indicator];
    simp only [hs, pi.sub_apply] },
  { exact measurable_set_region_between hf hg hs },
end

/-- The volume of the region between two almost everywhere measurable functions on a measurable set
    can be represented as a Lebesgue integral. -/
theorem volume_region_between_eq_lintegral [sigma_finite μ]
  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
  (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  have h₁ : (λ y, ennreal.of_real ((g - f) y))
          =ᵐ[μ.restrict s]
              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
  { apply measure_congr,
    apply eventually_eq.rfl.inter,
    exact
      ((ae_eq_comp' measurable_fst.ae_measurable
        hf.ae_eq_mk measure.prod_fst_absolutely_continuous).comp₂ _ eventually_eq.rfl).inter
      (eventually_eq.rfl.comp₂ _ (ae_eq_comp' measurable_fst.ae_measurable
        hg.ae_eq_mk measure.prod_fst_absolutely_continuous)) },
  rw [lintegral_congr_ae h₁,
      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
  convert h₂ using 1,
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _ (region_between_subset f g s)).symm, },
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _
      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
end

theorem volume_region_between_eq_integral' [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
begin
  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
    integral_congr_ae h, lintegral_congr_ae,
    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
  simpa only,
end

/-- If two functions are integrable on a measurable set, and one function is less than
    or equal to the other on that set, then the volume of the region
    between the two functions can be represented as an integral. -/
theorem volume_region_between_eq_integral [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
volume_region_between_eq_integral' f_int g_int hs
  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))

end region_between


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 $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hneq : i ≠ j),
    assume hfracteq : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h2 : α * ↑i = α * ↑j, from by {
      rw int.fract_eq_of_eq hfracteq,
      ring, },
    have h3 : α = (↑i - ↑j)⁻¹ * (int.nat_abs (i - j)), from by {
      rw mul_comm α (↑i - ↑j),
      rw h2,
      ring, },
    have h4 : irrational (↑i - ↑j)⁻¹, from by {
      apply irrational_of_irrational_mul hα_irrat,
      apply irrational_of_int_nat_abs, },
    have h5 : irrational (↑i - ↑j), from by {
      apply irrational_of_irrational_inv h4, },
    have h6 : irrational (int.nat_abs (i - j)), from by {
      apply irrational_of_irrational_mul hα_irrat,
      apply irrational_of_int_nat_abs, },
    have h7 : irrational (↑i - ↑j) * (int.nat_abs (i - j)) = α, from by {
      rw mul_comm (↑i - ↑j) (int.nat_abs (i - j)),
      rw h3,
      ring, },
    have h8 : (↑i - ↑j) = 0, from by {
      apply irrational_iff_not_rat.1 h5 h7, },
    have h9 : i = j, from by {
      rw sub_eq_zero_iff_eq h8, },
    show false, from by {
      apply hneq h9, },
  },

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h2 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    apply infinite_of_injective_of_infinite (λ m n, int.fract_eq_of_eq),
    apply infinite_univ,
    apply h1, },

  -- 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$.
  have h3 : ∃ y ∈ set.Icc 0 1, ∀ ε > 0, ∃ x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), abs (x - y) < ε, from by {
    apply exists_limit_point_of_infinite h2, },

  -- 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$.
  have h4 : ∀ (y : ℝ) (h1 : y ∈ set.Icc 0 1) (ε > 0), ∃ (x : ℝ) (h2 : x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))), abs (x - y) < ε, from by {
    assume (y : ℝ) (h1 : y ∈ set.Icc 0 1) (ε : ℝ) (hε : ε > 0),
    cases h3 with (y0 : ℝ) (h2 : y0 ∈ set.Icc 0 1) (h3 : ∀ ε : ℝ, ε > 0 → ∃ (x : ℝ) (h4 : x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))), abs (x - y0) < ε),
    let ε0 := min ε (y0 / 2),
    have hε0 : ε0 > 0, from by {
      rw lt_min,
      split,
      exact hε,
      apply div_pos h2.1 (by norm_num), },
    cases h3 ε0 hε0 with (x0 : ℝ) (h4 : x0 ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))),
    let N := ⌈(y - x0) / ε0⌉,
    have h5 : N * ε0 ≤ y - x0, from by {
      rw le_div_iff_mul_le,
      norm_num,
      apply le_ceil, },
    have h6 : y - x0 < (N + 1) * ε0, from by {
      rw lt_div_iff_mul_lt,
      norm_num,
      apply lt_ceil, },
    have h7 : (N + 1) * ε0 ≤ y, from by {
      apply le_of_lt,
      apply lt_of_lt_of_le h6 h1.2, },
    have h8 : N * ε0 ≤ y, from by {
      apply le_trans h5 h7, },
    have h9 : N * ε0 - y < ε0, from by {
      apply lt_of_lt_of_le h6 h7, },
    have h10 : N * ε0 - y < y0 / 2, from by {
      apply lt_of_lt_of_le h9 h1.1, },
    have h11 : N * ε0 ≤ y + y0 / 2, from by {
      apply le_of_lt,
      apply lt_of_le_of_lt h8 h10, },
    have h12 : N * ε0 ≤ y + y0 / 2, from by {
      apply le_of_lt,
      apply lt_of_le_of_lt h8 h10, },
    have h13 : y + y0 / 2 ≤ (N + 1) * ε0, from by {
      apply le_of_lt,
      apply lt_of_lt_of_le h6 h7, },
    have h14 : y + y0 / 2 ≤ (N + 1) * ε0, from by {
      apply le_of_lt,
      apply lt_of_lt_of_le h6 h7, },
    have h15 : y + y0 / 2 - y < ε0, from by {
      apply lt_of_lt_of_le h6 h7, },
    have h16 : y0 / 2 < ε0, from by {
      apply lt_of_lt_of_le h10 h1.1, },
    have h17 : y0 / 2 < ε0, from by {
      apply lt_of_lt_of_le h10 h1.1, },
    have h18 : y0 / 2 < ε0, from by {
      apply lt_of_lt_
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
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume (i j : ℤ) (hij : i ≠ j),
    begin
      -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
      assume h : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h2 : α * ↑i - int.nat_abs (α * ↑i) = int.fract (α * ↑i), from by {rw ← int.fract_eq_of_nat_abs_lt, rw int.nat_abs_of_nonneg, rw ← int.coe_nat_lt, rw int.coe_nat_lt, apply int.coe_nat_pos, },
      have h3 : α * ↑j - int.nat_abs (α * ↑j) = int.fract (α * ↑j), from by {rw ← int.fract_eq_of_nat_abs_lt, rw int.nat_abs_of_nonneg, rw ← int.coe_nat_lt, rw int.coe_nat_lt, apply int.coe_nat_pos, },
      have h4 : α * ↑i - int.nat_abs (α * ↑i) = α * ↑j - int.nat_abs (α * ↑j), from by {rw h, rw h2, rw h3, },
      have h5 : (α * ↑i - int.nat_abs (α * ↑i)) / ↑(i - j) = (α * ↑j - int.nat_abs (α * ↑j)) / ↑(i - j), from by {rw h4, },
      have h6 : (α * ↑i - int.nat_abs (α * ↑i)) / ↑(i - j) = α / ↑(i - j), from by {rw ← int.mul_div_cancel, rw ← int.coe_nat_lt, rw int.coe_nat_lt, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw int.coe_nat_lt, apply int.coe_nat_pos, rw
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume i j : ℤ, assume h : i ≠ j, assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) + int.nat_abs (i - j) * α) / (i - j), from by {
      rw [h2, int.fract_add, int.fract_mul, int.fract_eq_of_nat_abs_lt_one],
      rw [← int.coe_nat_eq_coe_nat_iff, int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (int.fract_ne_zero _)))))), int.nat_abs_mul],
      rw [int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne h (ne.symm (int.fract_ne_zero _))))))), int.nat_abs_of_nonneg (int.coe_nat_le_coe_nat_iff.mp (int.le_of_lt (int.coe_nat_lt_coe_nat_iff.mpr (int.lt_of_ne_of_ne (ne.symm h) (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
  -- 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}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume (i j : ℤ) (hij : i ≠ j), by {
      have h2 : (α * ↑i) - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw int.fract_def},
      have h3 : (α * ↑j) - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw int.fract_def},
      have h4 : (α * ↑i) - ↑(int.floor (α * ↑i)) = (α * ↑j) - ↑(int.floor (α * ↑j)), from by {rw [h2,h3]},
      have h5 : α = (↑(int.floor (α * ↑i)) - ↑(int.floor (α * ↑j))) / ↑(i - j), from by {rw [← int.cast_mul,← int.cast_sub,← int.cast_sub,← int.cast_div,h4]},
      show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {rw [← int.cast_ne,← int.cast_irrational,hα_irrat,h5]},
    },

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  let S := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h2 : S ≠ ∅, from by {
    have h3 : ∀ i : ℤ, int.fract (α * ↑i) ∈ S, from by {
      assume i : ℤ,
      have h4 : int.fract (α * ↑i) = int.fract (α * ↑i), from rfl,
      show int.fract (α * ↑i) ∈ S, from by {rw ← h4, apply set.mem_image_of_mem (set.mem_univ i)},
    },
    have h5 : int.fract (α * ↑0) ∈ S, from h3 0,
    show S ≠ ∅, from by {assume h6 : S = ∅, apply h5, rw h6},
  },
  have h3 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h1,
  have h4 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from by {
    assume m : ℤ,
    have h5 : int.fract (α * ↑m) = int.fract (α * ↑m), from rfl,
    show int.fract (α * ↑m) ∈ S, from by {rw ← h5, apply set.mem_image_of_mem (set.mem_univ m)},
  },
  have h5 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h3,
  have h6 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h4,
  have h7 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h5,
  have h8 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h6,
  have h9 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h7,
  have h10 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h8,
  have h11 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h9,
  have h12 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h10,
  have h13 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h11,
  have h14 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h12,
  have h15 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h13,
  have h16 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h14,
  have h17 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h15,
  have h18 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h16,
  have h19 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h17,
  have h20 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h18,
  have h21 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h19,
  have h22 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h20,
  have h23 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h21,
  have h24 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h22,
  have h25 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h23,
  have h26 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h24,
  have h27 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h25,
  have h28 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h26,
  have h29 : ∀ m n : ℤ, m ≠ n → int.fract (α * ↑m) ≠ int.fract (α * ↑n), from h27,
  have h30 : ∀ m : ℤ, int.fract (α * ↑m) ∈ S, from h28,
  have h31 : ∀ m n : ℤ, m ≠ n →
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hij : i ≠ j),
    -- Then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
    have h2 : α * ↑i - int.nat_abs (α * ↑i) = int.fract (α * ↑i), from by {rw int.fract_eq_sub_nat_abs,ring},
    have h3 : α * ↑j - int.nat_abs (α * ↑j) = int.fract (α * ↑j), from by {rw int.fract_eq_sub_nat_abs,ring},
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have h4 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from by {rw [h2,h3,int.nat_abs_mul,int.nat_abs_mul],ring},
    have h5 : (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j) ∈ ℚ, from by {apply int.nat_abs_mul_self_pos_of_nonneg,exact hα_irrat,},
    have h6 : α ∈ ℚ, from eq.trans h4 h5,
    have h7 : irrational α, from hα_irrat,
    have h8 : α ∉ ℚ, from by {apply irrational_iff_not_rat,exact h7},
    show int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {apply not_iff_not_of_iff h8 h6,},
  },

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h9 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
    assume (i : ℤ),
    have h10 : 0 ≤ int.fract (α * ↑i), from by {rw int.fract_eq_sub_nat_abs,apply int.nat_abs_nonneg},
    have h11 : int.fract (α * ↑i) ≤ 1, from by {rw int.fract_eq_sub_nat_abs,apply int.nat_abs_sub_le_nat_abs,},
    show int.fract (α * ↑i) ∈ set.Icc 0 1, from by {apply set.mem_Icc,exact h10,exact h11,},
  },
  have h12 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by {apply set.subset_univ,exact h9,},
  have h13 : infinite ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {apply infinite_of_injective_of_infinite,exact h1,apply infinite_univ,},

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h14 : ∃ x ∈ set.Icc 0 1, x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {apply set.exists_mem_of_infinite_of_subset_of_limit_point h13 h12,},
  have h15 : ∃ x ∈ set.Icc 0 1, ∀ ε > 0, ∃ y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), abs (x - y) < ε, from by {apply set.exists_mem_of_infinite_of_subset_of_limit_point h13 h12,},

  -- 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$.
  have h16 : ∃ x ∈ set.Icc 0 1, ∀ ε > 0, ∃ y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), abs (x - y) < ε ∧ abs (x - y) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
    cases h15 with x h15,
    cases h15 with h16 h15,
    use x,
    split,exact h16,
    assume ε hε,
    cases h15 ε hε with y h15,
    cases h15 with h17 h18,
    use y,
    split,
    exact h17,
    have h19 : abs (x - y) = int.fract (α * ↑(int.nat_abs (x - y))), from by {rw int.fract_eq_sub_nat_abs,ring,},
    rw h19,
    have h20 : int.fract (α * ↑(int.nat_abs (x - y))) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      have h21 : int.nat_abs (x - y) ∈ @set.univ ℤ, from by {apply int.nat_abs_nonneg,},
      have h22 : int.fract (α * ↑(int.nat_abs (x - y))) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {apply set.mem_image_of_mem,exact h21,},
      exact h22,
    },
    exact h20,
  },

  -- 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$.
  have h17 : ∀ (y : ℝ), y ∈ set.Icc 0 1 → ∀ ε > 0, ∃ x ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), abs (y - x) < ε, from by {
    assume (y : ℝ) (hy : y ∈ set.Icc 0 1) (ε : ℝ) (hε : ε > 0),
    cases h16 with x h16,
    cases h16 with h18 h16,
    cases h16 ε hε with x h16,
    cases h16 with h19 h20,
    cases exists_nat_gt (int.fract x) with N hN,
    use int.fract (α *
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), (i ≠ j) → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
    assume i j : ℤ, assume h1 : i ≠ j,
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      assume h2 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h3 : (i - j) ≠ 0, from by {
        assume h3 : (i - j) = 0,
        have h4 : i = j, from by {
          rw h3,
          ring,
        },
        exact h1 h4,
      },
      have h4 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
        rw h2,
        ring,
      },
      have h5 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) * (i - j)⁻¹, from by {
        rw h4,
      },
      have h6 : α = ((int.fract (α * ↑i) - int.fract (α * ↑j)) * (i - j)⁻¹) * (i - j), from by {
        rw h5,
        ring,
      },
      have h7 : α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {
        rw h6,
        ring,
      },
      have h8 : α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {
        rw ← h7,
        rw ← int.fract_add,
        ring,
      },
      have h9 : α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {
        rw ← h8,
        rw ← int.fract_mul,
        ring,
      },
      have h10 : α = int.fract (α * ↑i) - int.fract (α * ↑j), from by {
        rw ← h9,
        rw int.fract_eq_of_lt,
        have h11 : 0 < α * ↑i, from by {
          rw ← int.fract_lt,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract_eq_of_lt,
          rw int.fract_zero,
          rw int.fract
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
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) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.real.irrational
import data.rat.encodable
import topology.metric_space.baire

/-!
# Topology of irrational numbers

In this file we prove the following theorems:

* `is_Gδ_irrational`, `dense_irrational`, `eventually_residual_irrational`: irrational numbers
  form a dense Gδ set;

* `irrational.eventually_forall_le_dist_cast_div`,
  `irrational.eventually_forall_le_dist_cast_div_of_denom_le`;
  `irrational.eventually_forall_le_dist_cast_rat_of_denom_le`: a sufficiently small neighborhood of
  an irrational number is disjoint with the set of rational numbers with bounded denominator.

We also provide `order_topology`, `no_min_order`, `no_max_order`, and `densely_ordered`
instances for `{x // irrational x}`.

## Tags

irrational, residual
-/

open set filter metric
open_locale filter topology

lemma is_Gδ_irrational : is_Gδ {x | irrational x} :=
(countable_range _).is_Gδ_compl

lemma dense_irrational : dense {x : ℝ | irrational x} :=
begin
  refine real.is_topological_basis_Ioo_rat.dense_iff.2 _,
  simp only [mem_Union, mem_singleton_iff],
  rintro _ ⟨a, b, hlt, rfl⟩ hne, rw inter_comm,
  exact exists_irrational_btwn (rat.cast_lt.2 hlt)
end

lemma eventually_residual_irrational : ∀ᶠ x in residual ℝ, irrational x :=
eventually_residual.2 ⟨_, is_Gδ_irrational, dense_irrational, λ _, id⟩

namespace irrational

variable {x : ℝ}

instance : order_topology {x // irrational x} :=
induced_order_topology _ (λ x y, iff.rfl) $ λ x y hlt,
  let ⟨a, ha, hxa, hay⟩ := exists_irrational_btwn hlt in ⟨⟨a, ha⟩, hxa, hay⟩

instance : no_max_order {x // irrational x} :=
⟨λ ⟨x, hx⟩, ⟨⟨x + (1 : ℕ), hx.add_nat 1⟩, by simp⟩⟩

instance : no_min_order {x // irrational x} :=
⟨λ ⟨x, hx⟩, ⟨⟨x - (1 : ℕ), hx.sub_nat 1⟩, by simp⟩⟩

instance : densely_ordered {x // irrational x} :=
⟨λ x y hlt, let ⟨z, hz, hxz, hzy⟩ := exists_irrational_btwn hlt in ⟨⟨z, hz⟩, hxz, hzy⟩⟩

lemma eventually_forall_le_dist_cast_div (hx : irrational x) (n : ℕ) :
  ∀ᶠ ε : ℝ in 𝓝 0, ∀ m : ℤ, ε ≤ dist x (m / n) :=
begin
  have A : is_closed (range (λ m, n⁻¹ * m : ℤ → ℝ)),
    from ((is_closed_map_smul₀ (n⁻¹ : ℝ)).comp
      int.closed_embedding_coe_real.is_closed_map).closed_range,
  have B : x ∉ range (λ m, n⁻¹ * m : ℤ → ℝ),
  { rintro ⟨m, rfl⟩, simpa using hx },
  rcases metric.mem_nhds_iff.1 (A.is_open_compl.mem_nhds B) with ⟨ε, ε0, hε⟩,
  refine (ge_mem_nhds ε0).mono (λ δ hδ m, not_lt.1 $ λ hlt, _),
  rw dist_comm at hlt,
  refine hε (ball_subset_ball hδ hlt) ⟨m, _⟩,
  simp [div_eq_inv_mul]
end

lemma eventually_forall_le_dist_cast_div_of_denom_le (hx : irrational x) (n : ℕ) :
  ∀ᶠ ε : ℝ in 𝓝 0, ∀ (k ≤ n) (m : ℤ), ε ≤ dist x (m / k) :=
(finite_le_nat n).eventually_all.2 $ λ k hk, hx.eventually_forall_le_dist_cast_div k

end irrational


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland

! This file was ported from Lean 3 source module algebra.ring.units
! leanprover-community/mathlib commit 2ed7e4aec72395b6a7c3ac4ac7873a7a43ead17c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Ring.InjSurj
import Mathlib.Algebra.Group.Units

/-!
# Units in semirings and rings

-/

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open Function

namespace Units

section HasDistribNeg

variable [Monoid α] [HasDistribNeg α] {a b : α}

/-- Each element of the group of units of a ring has an additive inverse. -/
instance : Neg αˣ :=
  ⟨fun u => ⟨-↑u, -↑u⁻¹, by simp, by simp⟩⟩

/-- Representing an element of a ring's unit group as an element of the ring commutes with
    mapping this element to its additive inverse. -/
@[simp, norm_cast]
protected theorem val_neg (u : αˣ) : (↑(-u) : α) = -u :=
  rfl
#align units.coe_neg Units.val_neg

@[simp, norm_cast]
protected theorem coe_neg_one : ((-1 : αˣ) : α) = -1 :=
  rfl
#align units.coe_neg_one Units.coe_neg_one

instance : HasDistribNeg αˣ :=
  Units.ext.hasDistribNeg _ Units.val_neg Units.val_mul

@[field_simps]
theorem neg_divp (a : α) (u : αˣ) : -(a /ₚ u) = -a /ₚ u := by simp only [divp, neg_mul]
#align units.neg_divp Units.neg_divp

end HasDistribNeg

section Ring

variable [Ring α] {a b : α}

-- Needs to have higher simp priority than divp_add_divp. 1000 is the default priority.
@[field_simps 1010]
theorem divp_add_divp_same (a b : α) (u : αˣ) : a /ₚ u + b /ₚ u = (a + b) /ₚ u := by
  simp only [divp, add_mul]
#align units.divp_add_divp_same Units.divp_add_divp_same

-- Needs to have higher simp priority than divp_sub_divp. 1000 is the default priority.
@[field_simps 1010]
theorem divp_sub_divp_same (a b : α) (u : αˣ) : a /ₚ u - b /ₚ u = (a - b) /ₚ u := by
  rw [sub_eq_add_neg, sub_eq_add_neg, neg_divp, divp_add_divp_same]
#align units.divp_sub_divp_same Units.divp_sub_divp_same

@[field_simps]
theorem add_divp (a b : α) (u : αˣ) : a + b /ₚ u = (a * u + b) /ₚ u := by
  simp only [divp, add_mul, Units.mul_inv_cancel_right]
#align units.add_divp Units.add_divp

@[field_simps]
theorem sub_divp (a b : α) (u : αˣ) : a - b /ₚ u = (a * u - b) /ₚ u := by
  simp only [divp, sub_mul, Units.mul_inv_cancel_right]
#align units.sub_divp Units.sub_divp

@[field_simps]
theorem divp_add (a b : α) (u : αˣ) : a /ₚ u + b = (a + b * u) /ₚ u := by
  simp only [divp, add_mul, Units.mul_inv_cancel_right]
#align units.divp_add Units.divp_add

@[field_simps]
theorem divp_sub (a b : α) (u : αˣ) : a /ₚ u - b = (a - b * u) /ₚ u := by
  simp only [divp, sub_mul, sub_right_inj]
  rw [mul_assoc, Units.mul_inv, mul_one]
#align units.divp_sub Units.divp_sub

end Ring

end Units

theorem IsUnit.neg [Monoid α] [HasDistribNeg α] {a : α} : IsUnit a → IsUnit (-a)
  | ⟨x, hx⟩ => hx ▸ (-x).isUnit
#align is_unit.neg IsUnit.neg

@[simp]
theorem IsUnit.neg_iff [Monoid α] [HasDistribNeg α] (a : α) : IsUnit (-a) ↔ IsUnit a :=
  ⟨fun h => neg_neg a ▸ h.neg, IsUnit.neg⟩
#align is_unit.neg_iff IsUnit.neg_iff

theorem IsUnit.sub_iff [Ring α] {x y : α} : IsUnit (x - y) ↔ IsUnit (y - x) :=
  (IsUnit.neg_iff _).symm.trans <| neg_sub x y ▸ Iff.rfl
#align is_unit.sub_iff IsUnit.sub_iff

namespace Units

@[field_simps]
theorem divp_add_divp [CommRing α] (a b : α) (u₁ u₂ : αˣ) :
    a /ₚ u₁ + b /ₚ u₂ = (a * u₂ + u₁ * b) /ₚ (u₁ * u₂) := by
  simp only [divp, add_mul, mul_inv_rev, val_mul]
  rw [mul_comm (↑u₁ * b), mul_comm b]
  rw [←mul_assoc, ←mul_assoc, mul_assoc a, mul_assoc (↑u₂⁻¹ : α), mul_inv, inv_mul, mul_one,
    mul_one]
  -- porting note: `assoc_rw` not ported: `assoc_rw [mul_inv, mul_inv, mul_one, mul_one]`
#align units.divp_add_divp Units.divp_add_divp

@[field_simps]
theorem divp_sub_divp [CommRing α] (a b : α) (u₁ u₂ : αˣ) :
    a /ₚ u₁ - b /ₚ u₂ = (a * u₂ - u₁ * b) /ₚ (u₁ * u₂) := by
  simp only [sub_eq_add_neg, neg_divp, divp_add_divp, mul_neg]
#align units.divp_sub_divp Units.divp_sub_divp

theorem add_eq_mul_one_add_div [Semiring R] {a : Rˣ} {b : R} : ↑a + b = a * (1 + ↑a⁻¹ * b) := by
  rw [mul_add, mul_one, ← mul_assoc, Units.mul_inv, one_mul]
#align units.add_eq_mul_one_add_div Units.add_eq_mul_one_add_div

end Units


/-
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, Kevin Buzzard, Yury Kudryashov

! This file was ported from Lean 3 source module algebra.module.submodule.lattice
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Module.Submodule.Basic
import Mathlib.Algebra.PUnitInstances

/-!
# The lattice structure on `Submodule`s

This file defines the lattice structure on submodules, `Submodule.CompleteLattice`, with `⊥`
defined as `{0}` and `⊓` defined as intersection of the underlying carrier.
If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`.

Many results about operations on this lattice structure are defined in `LinearAlgebra/Basic.lean`,
most notably those which use `span`.

## Implementation notes

This structure should match the `AddSubmonoid.CompleteLattice` structure, and we should try
to unify the APIs where possible.

-/

variable {R S M : Type _}

section AddCommMonoid

variable [Semiring R] [Semiring S] [AddCommMonoid M] [Module R M] [Module S M]

variable [SMul S R] [IsScalarTower S R M]

variable {p q : Submodule R M}

namespace Submodule

/-- The set `{0}` is the bottom element of the lattice of submodules. -/
instance : Bot (Submodule R M) :=
  ⟨{ (⊥ : AddSubmonoid M) with
      carrier := {0}
      smul_mem' := by simp }⟩

instance inhabited' : Inhabited (Submodule R M) :=
  ⟨⊥⟩
#align submodule.inhabited' Submodule.inhabited'

@[simp]
theorem bot_coe : ((⊥ : Submodule R M) : Set M) = {0} :=
  rfl
#align submodule.bot_coe Submodule.bot_coe

@[simp]
theorem bot_toAddSubmonoid : (⊥ : Submodule R M).toAddSubmonoid = ⊥ :=
  rfl
#align submodule.bot_to_add_submonoid Submodule.bot_toAddSubmonoid

section

variable (R)

@[simp]
theorem restrictScalars_bot : restrictScalars S (⊥ : Submodule R M) = ⊥ :=
  rfl
#align submodule.restrict_scalars_bot Submodule.restrictScalars_bot

@[simp]
theorem mem_bot {x : M} : x ∈ (⊥ : Submodule R M) ↔ x = 0 :=
  Set.mem_singleton_iff
#align submodule.mem_bot Submodule.mem_bot

end

@[simp]
theorem restrictScalars_eq_bot_iff {p : Submodule R M} : restrictScalars S p = ⊥ ↔ p = ⊥ := by
  simp [SetLike.ext_iff]
#align submodule.restrict_scalars_eq_bot_iff Submodule.restrictScalars_eq_bot_iff

instance uniqueBot : Unique (⊥ : Submodule R M) :=
  ⟨inferInstance, fun x ↦ Subtype.ext <| (mem_bot R).1 x.mem⟩
#align submodule.unique_bot Submodule.uniqueBot

instance : OrderBot (Submodule R M) where
  bot := ⊥
  bot_le p x := by simp (config := { contextual := true }) [zero_mem]

protected theorem eq_bot_iff (p : Submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) :=
  ⟨fun h ↦ h.symm ▸ fun _ hx ↦ (mem_bot R).mp hx,
    fun h ↦ eq_bot_iff.mpr fun x hx ↦ (mem_bot R).mpr (h x hx)⟩
#align submodule.eq_bot_iff Submodule.eq_bot_iff

@[ext]
protected theorem bot_ext (x y : (⊥ : Submodule R M)) : x = y := by
  rcases x with ⟨x, xm⟩; rcases y with ⟨y, ym⟩; congr
  rw [(Submodule.eq_bot_iff _).mp rfl x xm]
  rw [(Submodule.eq_bot_iff _).mp rfl y ym]
#align submodule.bot_ext Submodule.bot_ext

protected theorem ne_bot_iff (p : Submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) := by
  simp only [ne_eq, p.eq_bot_iff, not_forall, exists_prop]
#align submodule.ne_bot_iff Submodule.ne_bot_iff

theorem nonzero_mem_of_bot_lt {p : Submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 :=
  let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne'
  ⟨⟨b, hb₁⟩, hb₂ ∘ congr_arg Subtype.val⟩
#align submodule.nonzero_mem_of_bot_lt Submodule.nonzero_mem_of_bot_lt

theorem exists_mem_ne_zero_of_ne_bot {p : Submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 :=
  let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h
  ⟨b, hb₁, hb₂⟩
#align submodule.exists_mem_ne_zero_of_ne_bot Submodule.exists_mem_ne_zero_of_ne_bot

/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/
@[simps]
def botEquivPUnit : (⊥ : Submodule R M) ≃ₗ[R] PUnit where
  toFun _ := PUnit.unit
  invFun _ := 0
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  left_inv _ := Subsingleton.elim _ _
  right_inv _ := rfl
#align submodule.bot_equiv_punit Submodule.botEquivPUnit

theorem eq_bot_of_subsingleton (p : Submodule R M) [Subsingleton p] : p = ⊥ := by
  rw [eq_bot_iff]
  intro v hv
  exact congr_arg Subtype.val (Subsingleton.elim (⟨v, hv⟩ : p) 0)
#align submodule.eq_bot_of_subsingleton Submodule.eq_bot_of_subsingleton

/-- The universal set is the top element of the lattice of submodules. -/
instance : Top (Submodule R M) :=
  ⟨{ (⊤ : AddSubmonoid M) with
      carrier := Set.univ
      smul_mem' := fun _ _ _ ↦ trivial }⟩

@[simp]
theorem top_coe : ((⊤ : Submodule R M) : Set M) = Set.univ :=
  rfl
#align submodule.top_coe Submodule.top_coe

@[simp]
theorem top_toAddSubmonoid : (⊤ : Submodule R M).toAddSubmonoid = ⊤ :=
  rfl
#align submodule.top_to_add_submonoid Submodule.top_toAddSubmonoid

@[simp]
theorem mem_top {x : M} : x ∈ (⊤ : Submodule R M) :=
  trivial
#align submodule.mem_top Submodule.mem_top

section

variable (R)

@[simp]
theorem restrictScalars_top : restrictScalars S (⊤ : Submodule R M) = ⊤ :=
  rfl
#align submodule.restrict_scalars_top Submodule.restrictScalars_top

end

@[simp]
theorem restrictScalars_eq_top_iff {p : Submodule R M} : restrictScalars S p = ⊤ ↔ p = ⊤ := by
  simp [SetLike.ext_iff]
#align submodule.restrict_scalars_eq_top_iff Submodule.restrictScalars_eq_top_iff

instance : OrderTop (Submodule R M) where
  top := ⊤
  le_top _ _ _ := trivial

theorem eq_top_iff' {p : Submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p :=
  eq_top_iff.trans ⟨fun h _ ↦ h trivial, fun h x _ ↦ h x⟩
#align submodule.eq_top_iff' Submodule.eq_top_iff'

/-- The top submodule is linearly equivalent to the module.

This is the module version of `AddSubmonoid.topEquiv`. -/
@[simps]
def topEquiv : (⊤ : Submodule R M) ≃ₗ[R] M where
  toFun x := x
  invFun x := ⟨x, mem_top⟩
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
  left_inv _ := rfl
  right_inv _ := rfl
#align submodule.top_equiv Submodule.topEquiv

instance : InfSet (Submodule R M) :=
  ⟨fun S ↦
    { carrier := ⋂ s ∈ S, (s : Set M)
      zero_mem' := by simp [zero_mem]
      add_mem' := by simp (config := { contextual := true }) [add_mem]
      smul_mem' := by simp (config := { contextual := true }) [smul_mem] }⟩

private theorem infₛ_le' {S : Set (Submodule R M)} {p} : p ∈ S → infₛ S ≤ p :=
  Set.binterᵢ_subset_of_mem

private theorem le_infₛ' {S : Set (Submodule R M)} {p} : (∀ q ∈ S, p ≤ q) → p ≤ infₛ S :=
  Set.subset_interᵢ₂

instance : Inf (Submodule R M) :=
  ⟨fun p q ↦
    { carrier := p ∩ q
      zero_mem' := by simp [zero_mem]
      add_mem' := by simp (config := { contextual := true }) [add_mem]
      smul_mem' := by simp (config := { contextual := true }) [smul_mem] }⟩

instance completeLattice : CompleteLattice (Submodule R M) :=
  { (inferInstance : OrderTop (Submodule R M)),
    (inferInstance : OrderBot (Submodule R M)) with
    sup := fun a b ↦ infₛ { x | a ≤ x ∧ b ≤ x }
    le_sup_left := fun _ _ ↦ le_infₛ' fun _ ⟨h, _⟩ ↦ h
    le_sup_right := fun _ _ ↦ le_infₛ' fun _ ⟨_, h⟩ ↦ h
    sup_le := fun _ _ _ h₁ h₂ ↦ infₛ_le' ⟨h₁, h₂⟩
    inf := (· ⊓ ·)
    le_inf := fun _ _ _ ↦ Set.subset_inter
    inf_le_left := fun _ _ ↦ Set.inter_subset_left _ _
    inf_le_right := fun _ _ ↦ Set.inter_subset_right _ _
    le_supₛ := fun _ _ hs ↦ le_infₛ' fun _ hq ↦ by exact hq _ hs
    supₛ_le := fun _ _ hs ↦ infₛ_le' hs
    le_infₛ := fun _ _ ↦ le_infₛ'
    infₛ_le := fun _ _ ↦ infₛ_le' }
#align submodule.complete_lattice Submodule.completeLattice

@[simp]
theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : Set M) :=
  rfl
#align submodule.inf_coe Submodule.inf_coe

@[simp]
theorem mem_inf {p q : Submodule R M} {x : M} : x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q :=
  Iff.rfl
#align submodule.mem_inf Submodule.mem_inf

@[simp]
theorem infₛ_coe (P : Set (Submodule R M)) : (↑(infₛ P) : Set M) = ⋂ p ∈ P, ↑p :=
  rfl
#align submodule.Inf_coe Submodule.infₛ_coe

@[simp]
theorem finset_inf_coe {ι} (s : Finset ι) (p : ι → Submodule R M) :
    (↑(s.inf p) : Set M) = ⋂ i ∈ s, ↑(p i) := by
  letI := Classical.decEq ι
  refine' s.induction_on _ fun i s _ ih ↦ _
  · simp
  · rw [Finset.inf_insert, inf_coe, ih]
    simp
#align submodule.finset_inf_coe Submodule.finset_inf_coe

@[simp]
theorem infᵢ_coe {ι} (p : ι → Submodule R M) : (↑(⨅ i, p i) : Set M) = ⋂ i, ↑(p i) := by
  rw [infᵢ, infₛ_coe] ; simp only [Set.mem_range, Set.interᵢ_exists, Set.interᵢ_interᵢ_eq']
#align submodule.infi_coe Submodule.infᵢ_coe

@[simp]
theorem mem_infₛ {S : Set (Submodule R M)} {x : M} : x ∈ infₛ S ↔ ∀ p ∈ S, x ∈ p :=
  Set.mem_interᵢ₂
#align submodule.mem_Inf Submodule.mem_infₛ

@[simp]
theorem mem_infᵢ {ι} (p : ι → Submodule R M) {x} : (x ∈ ⨅ i, p i) ↔ ∀ i, x ∈ p i := by
  rw [← SetLike.mem_coe, infᵢ_coe, Set.mem_interᵢ] ; rfl
#align submodule.mem_infi Submodule.mem_infᵢ

@[simp]
theorem mem_finset_inf {ι} {s : Finset ι} {p : ι → Submodule R M} {x : M} :
    x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i := by
  simp only [← SetLike.mem_coe, finset_inf_coe, Set.mem_interᵢ]
#align submodule.mem_finset_inf Submodule.mem_finset_inf

theorem mem_sup_left {S T : Submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T := by
  have : S ≤ S ⊔ T := le_sup_left
  rw [LE.le] at this
  exact this
#align submodule.mem_sup_left Submodule.mem_sup_left

theorem mem_sup_right {S T : Submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T := by
  have : T ≤ S ⊔ T := le_sup_right
  rw [LE.le] at this
  exact this
#align submodule.mem_sup_right Submodule.mem_sup_right

theorem add_mem_sup {S T : Submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T :=
  add_mem (mem_sup_left hs) (mem_sup_right ht)
#align submodule.add_mem_sup Submodule.add_mem_sup

theorem sub_mem_sup {R' M' : Type _} [Ring R'] [AddCommGroup M'] [Module R' M']
    {S T : Submodule R' M'} {s t : M'} (hs : s ∈ S) (ht : t ∈ T) : s - t ∈ S ⊔ T := by
  rw [sub_eq_add_neg]
  exact add_mem_sup hs (neg_mem ht)
#align submodule.sub_mem_sup Submodule.sub_mem_sup

theorem mem_supᵢ_of_mem {ι : Sort _} {b : M} {p : ι → Submodule R M} (i : ι) (h : b ∈ p i) :
    b ∈ ⨆ i, p i :=
  (le_supᵢ p i) h
#align submodule.mem_supr_of_mem Submodule.mem_supᵢ_of_mem

open BigOperators

theorem sum_mem_supᵢ {ι : Type _} [Fintype ι] {f : ι → M} {p : ι → Submodule R M}
    (h : ∀ i, f i ∈ p i) : (∑ i, f i) ∈ ⨆ i, p i :=
  sum_mem fun i _ ↦ mem_supᵢ_of_mem i (h i)
#align submodule.sum_mem_supr Submodule.sum_mem_supᵢ

theorem sum_mem_bsupᵢ {ι : Type _} {s : Finset ι} {f : ι → M} {p : ι → Submodule R M}
    (h : ∀ i ∈ s, f i ∈ p i) : (∑ i in s, f i) ∈ ⨆ i ∈ s, p i :=
  sum_mem fun i hi ↦ mem_supᵢ_of_mem i <| mem_supᵢ_of_mem hi (h i hi)
#align submodule.sum_mem_bsupr Submodule.sum_mem_bsupᵢ

/-! Note that `Submodule.mem_supᵢ` is provided in `LinearAlgebra/Span.lean`. -/

theorem mem_supₛ_of_mem {S : Set (Submodule R M)} {s : Submodule R M} (hs : s ∈ S) :
    ∀ {x : M}, x ∈ s → x ∈ supₛ S := by
  have := le_supₛ hs
  rw [LE.le] at this
  exact this
#align submodule.mem_Sup_of_mem Submodule.mem_supₛ_of_mem

theorem disjoint_def {p p' : Submodule R M} : Disjoint p p' ↔ ∀ x ∈ p, x ∈ p' → x = (0 : M) :=
  disjoint_iff_inf_le.trans <| show (∀ x, x ∈ p ∧ x ∈ p' → x ∈ ({0} : Set M)) ↔ _ by simp
#align submodule.disjoint_def Submodule.disjoint_def

theorem eq_zero_of_coe_mem_of_disjoint (hpq : Disjoint p q) {a : p} (ha : (a : M) ∈ q) : a = 0 := by
  exact_mod_cast disjoint_def.mp hpq a (coe_mem a) ha
#align submodule.eq_zero_of_coe_mem_of_disjoint Submodule.eq_zero_of_coe_mem_of_disjoint

end Submodule

section NatSubmodule

-- Porting note: `S.toNatSubmodule` doesn't work. I used `AddSubmonoid.toNatSubmodule S` instead.
/-- An additive submonoid is equivalent to a ℕ-submodule. -/
def AddSubmonoid.toNatSubmodule : AddSubmonoid M ≃o Submodule ℕ M where
  toFun S := { S with smul_mem' := fun r s hs ↦ show r • s ∈ S from nsmul_mem hs _ }
  invFun := Submodule.toAddSubmonoid
  left_inv _ := rfl
  right_inv _ := rfl
  map_rel_iff' := Iff.rfl
#align add_submonoid.to_nat_submodule AddSubmonoid.toNatSubmodule

@[simp]
theorem AddSubmonoid.toNatSubmodule_symm :
    ⇑(AddSubmonoid.toNatSubmodule.symm : _ ≃o AddSubmonoid M) = Submodule.toAddSubmonoid :=
  rfl
#align add_submonoid.to_nat_submodule_symm AddSubmonoid.toNatSubmodule_symm

@[simp]
theorem AddSubmonoid.coe_toNatSubmodule (S : AddSubmonoid M) :
    (AddSubmonoid.toNatSubmodule S : Set M) = S :=
  rfl
#align add_submonoid.coe_to_nat_submodule AddSubmonoid.coe_toNatSubmodule

@[simp]
theorem AddSubmonoid.toNatSubmodule_toAddSubmonoid (S : AddSubmonoid M) :
    S.toNatSubmodule.toAddSubmonoid = S :=
  AddSubmonoid.toNatSubmodule.symm_apply_apply S
#align add_submonoid.to_nat_submodule_to_add_submonoid AddSubmonoid.toNatSubmodule_toAddSubmonoid

@[simp]
theorem Submodule.toAddSubmonoid_toNatSubmodule (S : Submodule ℕ M) :
    AddSubmonoid.toNatSubmodule S.toAddSubmonoid = S :=
  AddSubmonoid.toNatSubmodule.apply_symm_apply S
#align submodule.to_add_submonoid_to_nat_submodule Submodule.toAddSubmonoid_toNatSubmodule

end NatSubmodule

end AddCommMonoid

section IntSubmodule

variable [AddCommGroup M]

-- Porting note: `S.toIntSubmodule` doesn't work. I used `AddSubgroup.toIntSubmodule S` instead.
/-- An additive subgroup is equivalent to a ℤ-submodule. -/
def AddSubgroup.toIntSubmodule : AddSubgroup M ≃o Submodule ℤ M where
  toFun S := { S with smul_mem' := fun _ _ hs ↦ S.zsmul_mem hs _ }
  invFun := Submodule.toAddSubgroup
  left_inv _ := rfl
  right_inv _ := rfl
  map_rel_iff' := Iff.rfl
#align add_subgroup.to_int_submodule AddSubgroup.toIntSubmodule

@[simp]
theorem AddSubgroup.toIntSubmodule_symm :
    ⇑(AddSubgroup.toIntSubmodule.symm : _ ≃o AddSubgroup M) = Submodule.toAddSubgroup :=
  rfl
#align add_subgroup.to_int_submodule_symm AddSubgroup.toIntSubmodule_symm

@[simp]
theorem AddSubgroup.coe_toIntSubmodule (S : AddSubgroup M) :
    (AddSubgroup.toIntSubmodule S : Set M) = S :=
  rfl
#align add_subgroup.coe_to_int_submodule AddSubgroup.coe_toIntSubmodule

@[simp]
theorem AddSubgroup.toIntSubmodule_toAddSubgroup (S : AddSubgroup M) :
    S.toIntSubmodule.toAddSubgroup = S :=
  AddSubgroup.toIntSubmodule.symm_apply_apply S
#align add_subgroup.to_int_submodule_to_add_subgroup AddSubgroup.toIntSubmodule_toAddSubgroup

@[simp]
theorem Submodule.toAddSubgroup_toIntSubmodule (S : Submodule ℤ M) :
    AddSubgroup.toIntSubmodule S.toAddSubgroup = S :=
  AddSubgroup.toIntSubmodule.apply_symm_apply S
#align submodule.to_add_subgroup_to_int_submodule Submodule.toAddSubgroup_toIntSubmodule

end IntSubmodule


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau
-/
import logic.equiv.basic

/-!
# Opposites

In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the
identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. If `α` is a category, then `αᵒᵖ` is the opposite
category, with all arrows reversed.
-/

universes v u -- morphism levels before object levels. See note [category_theory universes].

variable (α : Sort u)

/-- The type of objects of the opposite of `α`; used to define the opposite category.

  In order to avoid confusion between `α` and its opposite type, we
  set up the type of objects `opposite α` using the following pattern,
  which will be repeated later for the morphisms.

  1. Define `opposite α := α`.
  2. Define the isomorphisms `op : α → opposite α`, `unop : opposite α → α`.
  3. Make the definition `opposite` irreducible.

  This has the following consequences.

  * `opposite α` and `α` are distinct types in the elaborator, so you
    must use `op` and `unop` explicitly to convert between them.
  * Both `unop (op X) = X` and `op (unop X) = X` are definitional
    equalities. Notably, every object of the opposite category is
    definitionally of the form `op X`, which greatly simplifies the
    definition of the structure of the opposite category, for example.

  (If Lean supported definitional eta equality for records, we could
  achieve the same goals using a structure with one field.)
-/
def opposite : Sort u := α

-- Use a high right binding power (like that of postfix ⁻¹) so that, for example,
-- `presheaf Cᵒᵖ` parses as `presheaf (Cᵒᵖ)` and not `(presheaf C)ᵒᵖ`.
notation α `ᵒᵖ`:std.prec.max_plus := opposite α

namespace opposite

variables {α}
/-- The canonical map `α → αᵒᵖ`. -/
@[pp_nodot]
def op : α → αᵒᵖ := id
/-- The canonical map `αᵒᵖ → α`. -/
@[pp_nodot]
def unop : αᵒᵖ → α := id

lemma op_injective : function.injective (op : α → αᵒᵖ) := λ _ _, id
lemma unop_injective : function.injective (unop : αᵒᵖ → α) := λ _ _, id

@[simp] lemma op_inj_iff (x y : α) : op x = op y ↔ x = y := iff.rfl
@[simp] lemma unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y := iff.rfl

@[simp] lemma op_unop (x : αᵒᵖ) : op (unop x) = x := rfl
@[simp] lemma unop_op (x : α) : unop (op x) = x := rfl

attribute [irreducible] opposite

/-- The type-level equivalence between a type and its opposite. -/
def equiv_to_opposite : α ≃ αᵒᵖ :=
{ to_fun := op,
  inv_fun := unop,
  left_inv := unop_op,
  right_inv := op_unop }

@[simp]

lemma op_eq_iff_eq_unop {x : α} {y} : op x = y ↔ x = unop y :=
equiv_to_opposite.apply_eq_iff_eq_symm_apply

lemma unop_eq_iff_eq_op {x} {y : α} : unop x = y ↔ x = op y :=
equiv_to_opposite.symm.apply_eq_iff_eq_symm_apply

instance [inhabited α] : inhabited αᵒᵖ := ⟨op default⟩

/-- A recursor for `opposite`. Use as `induction x using opposite.rec`. -/
@[simp]
protected def rec {F : Π (X : αᵒᵖ), Sort v} (h : Π X, F (op X)) : Π X, F X :=
λ X, h (unop X)

end opposite

namespace tactic

open opposite

namespace op_induction

/-- Test if `e : expr` is of type `opposite α` for some `α`. -/
meta def is_opposite (e : expr) : tactic bool :=
do t ← infer_type e,
   `(opposite _) ← whnf t | return ff,
   return tt

/-- Find the first hypothesis of type `opposite _`. Fail if no such hypothesis exist in the local
context. -/
meta def find_opposite_hyp : tactic name :=
do lc ← local_context,
   h :: _ ← lc.mfilter $ is_opposite | fail "No hypotheses of the form Xᵒᵖ",
   return h.local_pp_name

end op_induction

open op_induction

/-- A version of `induction x using opposite.rec` which finds the appropriate hypothesis
automatically, for use with `local attribute [tidy] op_induction'`. This is necessary because
`induction x` is not able to deduce that `opposite.rec` should be used. -/
meta def op_induction' : tactic unit :=
do h ← find_opposite_hyp,
   h' ← tactic.get_local h,
   tactic.induction' h' [] `opposite.rec

end tactic