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 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [hα_irrat, int.fract_eq_iff_eq, int.cast_inj],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h2 : ∃ s : ℝ, s ∈ (closure S), from by auto [bw],

  have h3 : ∀ x y : ℝ, x ∈ S → y ∈ S → abs (x - y) ∈ S, from by auto [abs_of_nonneg (sub_nonneg.2 (int.fract_nonneg _))],

  have h4 : ∀ x y : ℝ, x ∈ S → y ∈ S → abs (x - y) < 1, from by auto [int.fract_lt_one],

  have h5 : ∀ x : ℝ, x ∈ S → 0 ≤ x, from by auto [int.fract_nonneg],

  have h6 : ∀ x : ℝ, x ∈ S → x < 1, from by auto [int.fract_lt_one],

  have h7 : ∀ x y : ℝ, x ∈ S → y ∈ S → abs (x - y) < (1 : ℝ), from by auto [abs_of_nonneg (sub_nonneg.2 (int.fract_nonneg _))],

  show closure S = set.Icc 0 1, from by auto [closure_eq_of_is_closed, set.is_closed_Icc, h2, h3, h4, h5, h6, h7],
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $α$ be an irrational number. Then for distinct $i, j \in \Z$, we must have $\{i α\} \neq\{j α\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto using [hα_irrat, irrational_iff_not_rat],

  -- If this were not true, then
  have h2 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto [h1],

  -- $\{i \alpha\} \neq\{j \alpha\}$
  have h3 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto [h2],

  -- Hence,
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto [h3],

  -- $S:=\{\{i \alpha\} \mid i \in \Z\}$
  let S := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),

  -- is an infinite subset of $\left[0,1\right]$.
  have h5 : ∀ x : ℤ, x ∈ @set.univ ℤ → (int.fract (α * ↑x)) ∈ set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h6 : S ⊆  set.Icc 0 1, from by auto [h5],
  have h7 : set.Icc 0 1 ⊆ closure S, from by auto [closure_subset, h6],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h8 : ∃ x : ℝ, x ∈ closure S ∧ ∃ s : set ℝ, finite s ∧ x ∈ closure s, from by auto [closure_iff_nhds_ne_empty],
  have h9 : ∃ x : ℝ, x ∈ closure S ∧ ∃ s : set ℝ, finite s ∧ x ∈ closure s, from by auto [h8],

  -- There exists $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point)
  have h10 : ∃ (x : ℤ), x ∈ @set.univ ℤ ∧ (int.fract (α * ↑x)) < (1 : ℝ), from by auto [h9, set.mem_univ, int.fract_nonneg, int.fract_lt_one],
  have h11 : ∃ (x : ℤ), x ∈ @set.univ ℤ ∧ (int.fract (α * ↑x)) < (1 : ℝ), from by auto [h10],

  -- and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$
  have h12 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h11, int.fract_nonneg, int.fract_lt_one],
  have h13 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h12],

  -- we get: $|y-\{N x\}|<\epsilon$.
  have h14 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h13],

  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h15 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h14],

  -- Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point),
  have h16 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h15],

  -- and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$
  have h17 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h16],

  -- we get: $|y-\{N x\}|<\epsilon$.
  have h18 : ∃ N : ℤ, (int.fract (α * ↑N)) ≤ (1 : ℝ) ∧ (int.fract (α * ↑N)) < (1 : ℝ), from by auto [h17],
  have h19 : closure S = set.Icc 0 1, from by auto [closure_eq_of_is_closed, h7, h18],
  show closure S = set.Icc 0 1, from by auto [h19],
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- fractional part of integer multiples of $\alpha$ is a subset of $[0,1]$
  have h1 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ (set.Icc 0 1), from by auto [set.Icc_subset, int.fract_range],
  -- $\alpha$ is irrational
  have hα_irrat_1 : irrational (1 : ℝ), from by auto,
  have hα_irrat_2 : irrational (-1 : ℝ), from by auto,
  -- fractional part of integer multiples of $\alpha$ is an infinite set
  have h2 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [hα_irrat, hα_irrat_1, hα_irrat_2, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int],
  -- fractional part of integer multiples of $\alpha$ has zero as a limit point
  have h3 : limit_point ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) 0, from by auto [int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.fract_eq_of_int_eq_int, int.f
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 α be an irrational number
    assume hα_irrat : irrational α,
    -- for any distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$
    have h_distinct_ne : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)),
    begin
        -- assume i, j are distinct integers
        assume i j : ℤ,
        assume h_ne: i ≠ j,
        -- assume $\{i \alpha\} =\{j \alpha\}$
        assume h_eq : int.fract (α * ↑i) = int.fract (α * ↑j),
        -- then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$
        have h_eq1 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by auto [int.fract_def, int.floor_le],
        have h_eq2 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by auto [int.fract_def, int.floor_le],
        have h_eq3 : int.fract (α * ↑i) = int.fract (α * ↑j), from h_eq,
        have h_eq4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from eq.trans (eq.symm h_eq1) (eq.trans h_eq3 h_eq2),
        -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
        have h_eq5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by auto [int.div_eq_iff_mul_eq, eq.trans (eq.symm h_eq4) (eq.trans (eq.symm h_eq1) (eq.trans (eq.symm h_eq3) h_eq2)), eq.symm (int.div_mul_cancel (i - j))],
        have h_eq6 : α ∈ ℚ, from by auto [int.coe_nat_dvd, eq.symm h_eq5],
        -- contradiction
        contradiction,
    end,
    -- hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
    have h_S_finite : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [exists.intro 0],
    have h_S_infinite : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ set.finite_univ, from by auto [eq_self_iff_true, h_S_finite, h_distinct_ne],
    have h_S_infinite' : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc 0 1, from by auto [h_S_infinite],
    -- by Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
    have h_S_limit_point : ∃ x ∈ set.Icc 0 1, ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), dist x y < ε, from by auto [set.bounded_Icc, set.compact_Icc, set.closed_Icc, set.compact_Icc, set.bounded_Icc, set.Icc_subset_univ, set.eq_univ_of_univ_subset, set.eq_univ_of_univ_subset, set.Icc_subset_univ],
    -- 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 h_S_limit_point' : ∃ x ∈ set.Icc 0 1, ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), dist x y < ε, from by auto [set.bounded_Icc, set.compact_Icc, set.closed_Icc, set.compact_Icc, set.bounded_Icc, set.Icc_subset_univ, set.eq_univ_of_univ_subset, set.eq_univ_of_univ_subset, set.Icc_subset_univ],
    -- to show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
    have h_S_dense : ∀ y ∈ set.Icc 0 1, ∀ ε > 0, ∃ x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), dist x y < ε,
    begin
        -- assume y ∈ [0, 1]
        assume y : ℝ,
        assume h_le : 0 ≤ y,
        assume h_le' : y ≤ 1,
        -- assume ε > 0
        assume ε : ℝ,
        assume h_ε : 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 h_x : ∃ x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), dist x y < ε, from by auto [h_S_limit_point'],
        have h_x' : ∃ x : ℝ, ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), dist x y < ε, from by auto [h_x],
        have h_x'' : ∃ x : ℝ, ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), abs (x - y) < ε, from by auto [h_x'],
        have h_x''' : ∃ x : ℝ, ∀ ε > 0, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), abs (x - y) < ε, from by auto [h_x''],
        have h_x'''' : ∃ x : ℝ, ∃ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), abs (x - y) < ε, from by auto [h_x'''],
        have h_x'''''
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- by Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$
  have h1 : ∃ x : ℝ, x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ x ≠ 0, from by auto [compact_closure, compact_Icc, Icc_subset_closure, int.fract_ne_zero],
  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h2 : ∃ (x y : ℝ), x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ y ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ x ≠ y ∧ 0 < abs (x - y), from by auto [closure_iff, h1],
  -- 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 : 0 ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [closure_iff, h2],

  -- To show that $S$ is dense in $[0, 1]$,
  have h4 : ∀ y ∈ set.Icc 0 1, ∃ (x : ℝ), x ∈ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ y ∈ set.Ioo x (x + abs (x - y)), from by auto [closure_iff, h3],

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

--OUTPUT 6
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
    begin
      assume (i : ℤ) (j : ℤ) (hij : i ≠ j),
      assume hij_eq : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h1 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by auto using [int.fract_add],
      -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}
      have h2 : α ∈ ℚ, from by auto [h1],
      show false, from hα_irrat h2,
    end,

  -- 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
    begin
      show infinite ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto using [h1, set.finite_univ, set.infinite_iff_nonempty_of_injective],
    end,

  have h3 : ∀ n : ℤ, n ≠ 0 → int.fract (α * ↑n) ∈ ({(λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)}), from by auto using [set.mem_image],

  -- 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$.
  let S : set ℝ := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h4 : ∀ x ∈ S, ∃ y, y ∈ S ∧ dist x y < 1, from
    begin
      assume (x : ℝ) (hx : x ∈ S),
      have h1 : (∃ n : ℤ, x = int.fract (α * ↑n)), from by auto [set.mem_image],
      have h2 : (∃ n : ℤ, int.fract (α * ↑n) = x), from by auto [h1],
      have h3 : (∃ n : ℤ, int.fract (α * ↑n) = x ∧ n ≠ 0), from by auto using [h2, hx, h3],
      have h4 : (∃ n : ℤ, int.fract (α * ↑n) = x ∧ n ≠ 0 ∧ n ≠ 1), from by auto using [h3, h3],
      have h5 : ∃ y, y ∈ S ∧ dist x y < 1, from by auto using [h4, h3, h2, hx, h1, h3, exists_and_dist_lt_one],
      show ∃ y, y ∈ S ∧ dist x y < 1, from by auto [h5],
    end,
  have h5 : ∀ (x : ℝ) (hx : x ∈ S), limit_point S x, from by auto using [h4, limit_point_of_forall_dist_lt],
  have h6 : ∀ (n : ℤ) (hn : n ≠ 0), limit_point S (int.fract (α * ↑n)), from by auto using [h5, h3],
  have h7 : limit_point S 0, from by auto using [h6, limit_point_of_forall_dist_lt],
  have h8 : 0 ∈ closure S, from by auto using [h7],
  have h9 : 0 ∈ set.Icc 0 1, from by auto using [set.mem_Icc, set.mem_Icc],
  have h10 : S ⊆ set.Icc 0 1, from by auto using [h9, h8, subset_insert_of_mem],

  -- 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 h11 : ∀ (y : ℝ) (hy : y ∈ set.Icc 0 1) (ε : ℝ) (hε : ε > 0), ∃ (x : ℝ) (hx : x ∈ S), dist x y < ε, from
    begin
      assume (y : ℝ) (hy : y ∈ set.Icc 0 1) (ε : ℝ) (hε : ε > 0),
      have h1 : ∃ (x : ℝ) (hx : x ∈ S), dist x 0 < ε, from by auto using [h8, hε, h7, h11],
      have h2 : ∃ (n : ℤ), int.fract (α * ↑n) = x, from by auto [set.mem_image, h1],
      have h3 : ∃ (n : ℤ), int.fract (α * ↑n) = x ∧ n ≠ 0, from by auto using [h2, h3],
      have h4 : ∃ (n : ℤ), int.fract (α * ↑n) = x ∧ n ≠ 0 ∧ n ≠ 1, from by auto using [h3, h3],
      have h5 : ∃ (n : ℤ), int.fract (α * ↑n) = x ∧ n ≠ 0 ∧ n ≠ 1 ∧ 0 < ↑n * (int.fract (α * ↑n)) ∧ ↑n * (int.fract (α * ↑n)) ≤ y, from by auto using [h4, h3, h2, h1, h3, exists_and_dist_lt_one, exists_and_dist_lt_one, exists_and_dist_lt_one, exists_and_dist_lt_one],
      have h6 : ∃ (n : ℤ), int.fract (α * ↑n) = x ∧ n ≠ 0 ∧ n ≠ 1 ∧ 0 < ↑n * (int.fract (α * ↑n)) ∧ ↑n * (int.fract (α * ↑n)) ≤ y ∧ y < (↑n + 1) * (int.fract (α * ↑n)), from by auto using [h5, h5, h1, h3, h2, h3, exists_and_dist_lt_one, exists_and_dist_lt_one, exists_and_dist_lt_one, exists_and_dist_lt_one],
      have h7 : ∃ (n : ℤ), int.fract (α * ↑n) = x ∧ n ≠ 0 ∧ n ≠ 1 ∧ 0 < ↑n * (int.fract (α * ↑n)) ∧ ↑n * (int.fract (α * ↑n)) ≤ y ∧ y < (↑n + 1) * (int.fract (α
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
  -- ∀ x : ℤ, ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y')
  have h1 : ∀ x : ℤ, ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y'),
  {
    assume x : ℤ,
    -- ℤ → α ≠ 0
    have h1_1 : (ℤ → α) ≠ 0, from by auto [irrational.def, int.coe_nat_ne_zero, int.coe_int_ne_zero, not_false_iff],
    -- α ≠ 0
    have h1_2 : α ≠ 0, from by auto [h1_1, int.cast_ne_zero],
    -- by_contradiction
    by_contradiction,
    -- Suppose ∀ x : ℤ, ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y')
    assume h2 : ∀ x : ℤ, ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y'),
    -- ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y')
    have h3 : ∃ y : ℤ, ∀ y' : ℤ, y ≠ y' → int.fract (α * ↑y) ≠ int.fract (α * ↑y'), from by auto [h2],
    -- ∃ y : ℤ, int.fract (α * ↑y) = int.fract (α * ↑x)
    have h4 : ∃ y : ℤ, int.fract (α * ↑y) = int.fract (α * ↑x), from by auto [h3],
    -- int.fract (α * ↑y) = int.fract (α * ↑x)
    obtain ⟨y, h4_1⟩ : ∃ y : ℤ, int.fract (α * ↑y) = int.fract (α * ↑x), from h4,
    -- α * ↑y = α * ↑x
    have h5 : α * ↑y = α * ↑x, from by auto [int.fract_eq_iff, h4_1],
    -- α * ↑y = α * ↑x → α * ↑y - α * ↑x = 0
    have h6 : α * ↑y = α * ↑x → α * ↑y - α * ↑x = 0, from by auto [sub_eq_zero],
    -- α * ↑y - α * ↑x = 0
    have h7 : α * ↑y - α * ↑x = 0, from by auto [h5, h6],
    -- α * ↑y - α * ↑x = 0 → α * (↑y - ↑x) = 0
    have h8 : α * ↑y - α * ↑x = 0 → α * (↑y - ↑x) = 0, from by auto [sub_eq_zero],
    -- α * (↑y - ↑x) = 0
    have h9 : α * (↑y - ↑x) = 0, from by auto [h7, h8],
    -- α = 0
    have h10 : α = 0, from by auto [h9, h1_2, mul_eq_zero],
    -- α = 0 → α ≠ 0
    have h11 : α = 0 → α ≠ 0, from by auto [h1_2],
    -- α ≠ 0
    have h12 : α ≠ 0, from by auto [h10, h11],
    -- This is a contradiction
    have h13 : false, from by auto [h12],
    -- Contradiction
    contradiction,
  },

  -- The set of fractional parts of the multiples of α is infinite
  have h2 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [h1, exists_forall_of_infinite],

  -- The set of fractional parts of the multiples of α has a limit point
  have h3 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from by auto [h2, closure_iff_nhds_within_eq, set.finite_to_set],
  -- ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε
  obtain ⟨x, h3_1, h3_2⟩ : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from h3,

  -- The set of fractional parts of the multiples of α has 0 as a limit point
  have h4 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from by auto [h3, h3_1, h3_2],
  -- ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε
  obtain ⟨x, h4_1, h4_2⟩ : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from h4,
  -- ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε
  have h5 : ∀ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from by auto [h4_1, h4_2],
  -- ∃ ε > 0, ∃ y : ℝ, y ∈ ((λ m : ℤ, int.fract (
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number, Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$
  assume hα : irrational α,
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    by auto [int.fract_eq_iff, int.fract_ne_iff, hα, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],

  -- 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 h2 : (∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j)) → irrational α, from
    by auto [int.fract_eq_iff, int.fract_ne_iff, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],

  have h3 : irrational α, from by auto [h2, h1],

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$
  have h4 : ∀ i : ℤ, int.fract (α * ↑i) ∈ set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h5 : set.univ ℤ = (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h6 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = (λ (m : ℤ), int.fract (α * ↑m)) '' ((λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' set.Icc 0 1), from by auto [set.image_preimage_eq],
  have h7 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = (λ (m : ℤ), int.fract (α * ↑m)) '' set.Icc 0 1, from by auto [h5, h6],
  have h8 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' set.Icc 0 1, from by auto [h5, h6],
  have h9 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc 0 1, from by auto [h8, h4],

  have h10 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [h9],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$
  have h11 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ≠ ∅, from by auto [h10, closure_ne_empty],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close
  have h12 : ∀ (x₁ x₂ : ℤ), x₁ ≠ x₂ → int.fract (α * ↑x₁) ≠ int.fract (α * ↑x₂), from
    by auto [int.fract_eq_iff, int.fract_ne_iff, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],
  have h13 : ∀ (x₁ x₂ : ℤ), x₁ ≠ x₂ → (int.fract (α * ↑x₁) - int.fract (α * ↑x₂)) ≠ 0, from
    by auto [int.fract_eq_iff, int.fract_ne_iff, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],
  have h14 : ∀ (x₁ x₂ : ℤ), x₁ ≠ x₂ → int.fract (α * ↑x₁ - α * ↑x₂) ≠ 0, from
    by auto [int.fract_eq_iff, int.fract_ne_iff, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],
  have h15 : ∀ (x₁ x₂ : ℤ), x₁ ≠ x₂ → int.fract (α * ↑x₁) - int.fract (α * ↑x₂) ≠ 0, from
    by auto [int.fract_eq_iff, int.fract_ne_iff, exists_eq_mul_right_of_dvd, int.coe_nat_dvd_iff, int.coe_nat_eq_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_mul_coe_nat, int.coe_nat_dvd, int.coe_nat_lt, int.coe_nat_pos, int.coe_nat_one, int.coe_nat_zero],

  have h16 : ∀ (x₁ x₂ : ℤ), x₁ ≠ x₂ → ∃ (ε : ℝ), ε > 0 ∧ ∀ (y : ℝ), abs (int.fract (α * ↑x₁) -
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $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 auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

  -- 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 by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import Lbar.ses
import Lbar.finsupp_instance

universe u

noncomputable theory
open_locale big_operators nnreal
open pseudo_normed_group category_theory category_theory.limits aux_thm69 laurent_measures

local attribute [instance] type_pow

variables {r' : ℝ≥0} [fact (0 < r')] [fact (r' < 1)] {S : Fintype}
  (F : laurent_measures r' S) (s : S)

/--  Given `F : laurent_measures r' S`, for each `s : S`, `tail F s` is the restriction of `F s` to
the non-positive indices, with opposite sign, i.e. a finsupp `ℕ →₀ ℤ`.
Taken together `tail F` is a term of type `invpoly r' ⟨S⟩`. -/
def tail : invpoly' r' ⟨S⟩ :=
λ s, ⟨begin
    refine set.finite.to_finset (_ : {n : ℕ | ∃ m : ℤ, m = -n ∧ F s (m) ≠ 0}.finite),
    obtain ⟨d, h⟩ := exists_bdd_filtration (fact.out _ : 0 < r') (fact.out _ : r' < 1) F,
    refine ((finset.range (-d + 1).to_nat).finite_to_set).subset (λ n hn, _),
    rw [set.mem_set_of_eq, exists_eq_left] at hn,
    rw [finset.mem_coe, finset.mem_range, int.lt_to_nat],
    exact not_le.mp (λ nd, hn $ h s (- n) $ neg_lt.mp $ int.add_one_le_iff.mp nd)
  end,
 λ n, F s (-(n : ℤ)),
 by simp only [set.mem_set_of_eq, exists_eq_left, set.finite.mem_to_finset, iff_self, forall_const]⟩

lemma tail_of_nonneg {n : ℕ} : (tail F s n) = F s (- n) :=
by simp only [tail, finsupp.coe_mk]

lemma int.tail_of_nonneg {n : ℤ} (n0 : 0 ≤ n) : tail F s n.to_nat = F s (- n) :=
(tail_of_nonneg F s).trans $ congr_arg _ $ congr_arg _ $ int.to_nat_of_nonneg n0

lemma ite_to_Lbar_tail (n : ℤ) :
  ite (0 < n) ((to_Lbar r' S F).to_fun s n.to_nat) (tail F s (-n).to_nat) = F s n :=
begin
  by_cases n0 : 0 < n,
  { have : n.to_nat ≠ 0,
    { simpa using (lt_of_lt_of_le n0 (int.to_nat_of_nonneg n0.le).ge).ne' },
    simp only [n0, to_Lbar, if_true, this, int.to_nat_of_nonneg n0.le, if_false] },
  { rw [if_neg n0, int.tail_of_nonneg F s (neg_nonneg.mpr (not_lt.mp n0)), neg_neg] }
end


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.covering.vitali_family
import measure_theory.measure.regular
import measure_theory.function.ae_measurable_order
import measure_theory.integral.lebesgue
import measure_theory.decomposition.radon_nikodym

/-!
# Differentiation of measures

On a metric space with a measure `μ`, consider a Vitali family (i.e., for each `x` one has a family
of sets shrinking to `x`, with a good behavior with respect to covering theorems).
Consider also another measure `ρ`. Then, for almost every `x`, the ratio `ρ a / μ a` converges when
`a` shrinks to `x` along the Vitali family, towards the Radon-Nikodym derivative of `ρ` with
respect to `μ`. This is the main theorem on differentiation of measures.

This theorem is proved in this file, under the name `vitali_family.ae_tendsto_rn_deriv`. Note that,
almost surely, `μ a` is eventually positive and finite (see
`vitali_family.ae_eventually_measure_pos` and `vitali_family.eventually_measure_lt_top`), so the
ratio really makes sense.

For concrete applications, one needs concrete instances of Vitali families, as provided for instance
by `besicovitch.vitali_family` (for balls) or by `vitali.vitali_family` (for doubling measures).

## Sketch of proof

Let `v` be a Vitali family for `μ`. Assume for simplicity that `ρ` is absolutely continuous with
respect to `μ`, as the case of a singular measure is easier.

It is easy to see that a set `s` on which `liminf ρ a / μ a < q` satisfies `ρ s ≤ q * μ s`, by using
a disjoint subcovering provided by the definition of Vitali families. Similarly for the limsup.
It follows that a set on which `ρ a / μ a` oscillates has measure `0`, and therefore that
`ρ a / μ a` converges almost surely (`vitali_family.ae_tendsto_div`). Moreover, on a set where the
limit is close to a constant `c`, one gets `ρ s ∼ c μ s`, using again a covering lemma as above.
It follows that `ρ` is equal to `μ.with_density (v.lim_ratio ρ x)`, where `v.lim_ratio ρ x` is the
limit of `ρ a / μ a` at `x` (which is well defined almost everywhere). By uniqueness of the
Radon-Nikodym derivative, one gets `v.lim_ratio ρ x = ρ.rn_deriv μ x` almost everywhere, completing
the proof.

There is a difficulty in this sketch: this argument works well when `v.lim_ratio ρ` is measurable,
but there is no guarantee that this is the case, especially if one doesn't make further assumptions
on the Vitali family. We use an indirect argument to show that `v.lim_ratio ρ` is always
almost everywhere measurable, again based on the disjoint subcovering argument
(see `vitali_family.exists_measurable_supersets_lim_ratio`), and then proceed as sketched above
but replacing `v.lim_ratio ρ` by a measurable version called `v.lim_ratio_meas ρ`.

## References

* [Herbert Federer, Geometric Measure Theory, Chapter 2.9][Federer1996]
-/

open measure_theory metric set filter topological_space measure_theory.measure
open_locale filter ennreal measure_theory nnreal topological_space

local attribute [instance] emetric.second_countable_of_sigma_compact

variables {α : Type*} [metric_space α] {m0 : measurable_space α}
{μ : measure α} (v : vitali_family μ)
include v

namespace vitali_family

/-- The limit along a Vitali family of `ρ a / μ a` where it makes sense, and garbage otherwise.
Do *not* use this definition: it is only a temporary device to show that this ratio tends almost
everywhere to the Radon-Nikodym derivative. -/
noncomputable def lim_ratio (ρ : measure α) (x : α) : ℝ≥0∞ :=
lim (v.filter_at x) (λ a, ρ a / μ a)

/-- For almost every point `x`, sufficiently small sets in a Vitali family around `x` have positive
measure. (This is a nontrivial result, following from the covering property of Vitali families). -/
theorem ae_eventually_measure_pos [second_countable_topology α] :
  ∀ᵐ x ∂μ, ∀ᶠ a in v.filter_at x, 0 < μ a :=
begin
  set s := {x | ¬ (∀ᶠ a in v.filter_at x, 0 < μ a)} with hs,
  simp only [not_lt, not_eventually, nonpos_iff_eq_zero] at hs,
  change μ s = 0,
  let f : α → set (set α) := λ x, {a | μ a = 0},
  have h : v.fine_subfamily_on f s,
  { assume x hx ε εpos,
    rw hs at hx,
    simp only [frequently_filter_at_iff, exists_prop, gt_iff_lt, mem_set_of_eq] at hx,
    rcases hx ε εpos with ⟨a, a_sets, ax, μa⟩,
    exact ⟨a, ⟨a_sets, μa⟩, ax⟩ },
  refine le_antisymm _ bot_le,
  calc μ s ≤ ∑' (x : h.index), μ (h.covering x) : h.measure_le_tsum
  ... = ∑' (x : h.index), 0 : by { congr, ext1 x, exact h.covering_mem x.2 }
  ... = 0 : by simp only [tsum_zero, add_zero]
end

/-- For every point `x`, sufficiently small sets in a Vitali family around `x` have finite measure.
(This is a trivial result, following from the fact that the measure is locally finite). -/
theorem eventually_measure_lt_top [is_locally_finite_measure μ] (x : α) :
  ∀ᶠ a in v.filter_at x, μ a < ∞ :=
begin
  obtain ⟨ε, εpos, με⟩ : ∃ (ε : ℝ) (hi : 0 < ε), μ (closed_ball x ε) < ∞ :=
    (μ.finite_at_nhds x).exists_mem_basis nhds_basis_closed_ball,
  exact v.eventually_filter_at_iff.2 ⟨ε, εpos, λ a ha haε, (measure_mono haε).trans_lt με⟩,
end

/-- If two measures `ρ` and `ν` have, at every point of a set `s`, arbitrarily small sets in a
Vitali family satisfying `ρ a ≤ ν a`, then `ρ s ≤ ν s` if `ρ ≪ μ`.-/
theorem measure_le_of_frequently_le [sigma_compact_space α] [borel_space α]
  {ρ : measure α} (ν : measure α) [is_locally_finite_measure ν]
  (hρ : ρ ≪ μ) (s : set α) (hs : ∀ x ∈ s, ∃ᶠ a in v.filter_at x, ρ a ≤ ν a) :
  ρ s ≤ ν s :=
begin
  -- this follows from a covering argument using the sets satisfying `ρ a ≤ ν a`.
  apply ennreal.le_of_forall_pos_le_add (λ ε εpos hc, _),
  obtain ⟨U, sU, U_open, νU⟩ : ∃ (U : set α) (H : s ⊆ U), is_open U ∧ ν U ≤ ν s + ε :=
    exists_is_open_le_add s ν (ennreal.coe_pos.2 εpos).ne',
  let f : α → set (set α) := λ x, {a | ρ a ≤ ν a ∧ a ⊆ U},
  have h : v.fine_subfamily_on f s,
  { apply v.fine_subfamily_on_of_frequently f s (λ x hx, _),
    have := (hs x hx).and_eventually ((v.eventually_filter_at_mem_sets x).and
      (v.eventually_filter_at_subset_of_nhds (U_open.mem_nhds (sU hx)))),
    apply frequently.mono this,
    rintros a ⟨ρa, av, aU⟩,
    exact ⟨ρa, aU⟩ },
  haveI : encodable h.index := h.index_countable.to_encodable,
  calc ρ s ≤ ∑' (x : h.index), ρ (h.covering x) : h.measure_le_tsum_of_absolutely_continuous hρ
  ... ≤ ∑' (x : h.index), ν (h.covering x) : ennreal.tsum_le_tsum (λ x, (h.covering_mem x.2).1)
  ... = ν (⋃ (x : h.index), h.covering x) :
    by rw [measure_Union h.covering_disjoint_subtype (λ i, h.measurable_set_u i.2)]
  ... ≤ ν U : measure_mono (Union_subset (λ i, (h.covering_mem i.2).2))
  ... ≤ ν s + ε : νU
end

section

variables [sigma_compact_space α] [borel_space α] [is_locally_finite_measure μ]
  {ρ : measure α} [is_locally_finite_measure ρ]

/-- If a measure `ρ` is singular with respect to `μ`, then for `μ` almost every `x`, the ratio
`ρ a / μ a` tends to zero when `a` shrinks to `x` along the Vitali family. This makes sense
as `μ a` is eventually positive by `ae_eventually_measure_pos`. -/
lemma ae_eventually_measure_zero_of_singular (hρ : ρ ⊥ₘ μ) :
  ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 0) :=
begin
  have A : ∀ ε > (0 : ℝ≥0), ∀ᵐ x ∂μ, ∀ᶠ a in v.filter_at x, ρ a < ε * μ a,
  { assume ε εpos,
    set s := {x | ¬(∀ᶠ a in v.filter_at x, ρ a < ε * μ a) } with hs,
    change μ s = 0,
    obtain ⟨o, o_meas, ρo, μo⟩ : ∃ (o : set α), measurable_set o ∧ ρ o = 0 ∧ μ oᶜ = 0 := hρ,
    apply le_antisymm _ bot_le,
    calc μ s ≤ μ ((s ∩ o) ∪ oᶜ) : begin
      conv_lhs { rw ← inter_union_compl s o },
      exact measure_mono (union_subset_union_right _ (inter_subset_right _ _))
    end
    ... ≤ μ (s ∩ o) + μ (oᶜ) : measure_union_le _ _
    ... = μ (s ∩ o) : by rw [μo, add_zero]
    ... = ε⁻¹ * (ε • μ) (s ∩ o) : begin
      simp only [coe_nnreal_smul_apply, ← mul_assoc, mul_comm _ (ε : ℝ≥0∞)],
      rw [ennreal.mul_inv_cancel (ennreal.coe_pos.2 εpos).ne' ennreal.coe_ne_top, one_mul],
    end
    ... ≤ ε⁻¹ * ρ (s ∩ o) : begin
      apply ennreal.mul_le_mul le_rfl,
      refine v.measure_le_of_frequently_le ρ ((measure.absolutely_continuous.refl μ).smul ε) _ _,
      assume x hx,
      rw hs at hx,
      simp only [mem_inter_eq, not_lt, not_eventually, mem_set_of_eq] at hx,
      exact hx.1
    end
    ... ≤ ε⁻¹ * ρ o : ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_right _ _))
    ... = 0 : by rw [ρo, mul_zero] },
  obtain ⟨u, u_anti, u_pos, u_lim⟩ :
    ∃ (u : ℕ → ℝ≥0), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
      exists_seq_strict_anti_tendsto (0 : ℝ≥0),
  have B : ∀ᵐ x ∂μ, ∀ n, ∀ᶠ a in v.filter_at x, ρ a < u n * μ a :=
    ae_all_iff.2 (λ n, A (u n) (u_pos n)),
  filter_upwards [B, v.ae_eventually_measure_pos],
  assume x hx h'x,
  refine tendsto_order.2 ⟨λ z hz, (ennreal.not_lt_zero hz).elim, λ z hz, _⟩,
  obtain ⟨w, w_pos, w_lt⟩ : ∃ (w : ℝ≥0), (0 : ℝ≥0∞) < w ∧ (w : ℝ≥0∞) < z :=
    ennreal.lt_iff_exists_nnreal_btwn.1 hz,
  obtain ⟨n, hn⟩ : ∃ n, u n < w :=
    ((tendsto_order.1 u_lim).2 w (ennreal.coe_pos.1 w_pos)).exists,
  filter_upwards [hx n, h'x, v.eventually_measure_lt_top x],
  assume a ha μa_pos μa_lt_top,
  rw ennreal.div_lt_iff (or.inl μa_pos.ne') (or.inl μa_lt_top.ne),
  exact ha.trans_le (ennreal.mul_le_mul ((ennreal.coe_le_coe.2 hn.le).trans w_lt.le) le_rfl)
end

section absolutely_continuous

variable (hρ : ρ ≪ μ)
include hρ

/-- A set of points `s` satisfying both `ρ a ≤ c * μ a` and `ρ a ≥ d * μ a` at arbitrarily small
sets in a Vitali family has measure `0` if `c < d`. Indeed, the first inequality should imply
that `ρ s ≤ c * μ s`, and the second one that `ρ s ≥ d * μ s`, a contradiction if `0 < μ s`. -/
theorem null_of_frequently_le_of_frequently_ge {c d : ℝ≥0} (hcd : c < d) (s : set α)
  (hc : ∀ x ∈ s, ∃ᶠ a in v.filter_at x, ρ a ≤ c * μ a)
  (hd : ∀ x ∈ s, ∃ᶠ a in v.filter_at x, (d : ℝ≥0∞) * μ a ≤ ρ a) :
  μ s = 0 :=
begin
  apply null_of_locally_null s (λ x hx, _),
  obtain ⟨o, xo, o_open, μo⟩ : ∃ o : set α, x ∈ o ∧ is_open o ∧ μ o < ∞ :=
    measure.exists_is_open_measure_lt_top μ x,
  refine ⟨o, mem_nhds_within_of_mem_nhds (o_open.mem_nhds xo), _⟩,
  let s' := s ∩ o,
  by_contra,
  apply lt_irrefl (ρ s'),
  calc ρ s' ≤ c * μ s' : v.measure_le_of_frequently_le (c • μ) hρ s' (λ x hx, hc x hx.1)
  ... < d * μ s' : begin
    apply (ennreal.mul_lt_mul_right h _).2 (ennreal.coe_lt_coe.2 hcd),
    exact (lt_of_le_of_lt (measure_mono (inter_subset_right _ _)) μo).ne,
  end
  ... ≤ ρ s' : v.measure_le_of_frequently_le ρ
    ((measure.absolutely_continuous.refl μ).smul d) s' (λ x hx, hd x hx.1)
end

/-- If `ρ` is absolutely continuous with respect to `μ`, then for almost every `x`,
the ratio `ρ a / μ a` converges as `a` shrinks to `x` along a Vitali family for `μ`. -/
theorem ae_tendsto_div :
  ∀ᵐ x ∂μ, ∃ c, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 c) :=
begin
  obtain ⟨w, w_count, w_dense, w_zero, w_top⟩ : ∃ w : set ℝ≥0∞, countable w ∧ dense w ∧
    0 ∉ w ∧ ∞ ∉ w := ennreal.exists_countable_dense_no_zero_top,
  have I : ∀ x ∈ w, x ≠ ∞ := λ x xs hx, w_top (hx ▸ xs),
  have A : ∀ (c ∈ w) (d ∈ w), (c < d) → ∀ᵐ x ∂μ,
    ¬((∃ᶠ a in v.filter_at x, ρ a / μ a < c) ∧ (∃ᶠ a in v.filter_at x, d < ρ a / μ a)),
  { assume c hc d hd hcd,
    lift c to ℝ≥0 using I c hc,
    lift d to ℝ≥0 using I d hd,
    apply v.null_of_frequently_le_of_frequently_ge hρ (ennreal.coe_lt_coe.1 hcd),
    { simp only [and_imp, exists_prop, not_frequently, not_and, not_lt, not_le, not_eventually,
        mem_set_of_eq, mem_compl_eq, not_forall],
      assume x h1x h2x,
      apply h1x.mono (λ a ha, _),
      refine (ennreal.div_le_iff_le_mul _ (or.inr (bot_le.trans_lt ha).ne')).1 ha.le,
      simp only [ennreal.coe_ne_top, ne.def, or_true, not_false_iff] },
    { simp only [and_imp, exists_prop, not_frequently, not_and, not_lt, not_le, not_eventually,
        mem_set_of_eq, mem_compl_eq, not_forall],
      assume x h1x h2x,
      apply h2x.mono (λ a ha, _),
      exact ennreal.mul_le_of_le_div ha.le } },
  have B : ∀ᵐ x ∂μ, ∀ (c ∈ w) (d ∈ w), (c < d) →
    ¬((∃ᶠ a in v.filter_at x, ρ a / μ a < c) ∧ (∃ᶠ a in v.filter_at x, d < ρ a / μ a)),
    by simpa only [ae_ball_iff w_count, ae_imp_iff],
  filter_upwards [B],
  assume x hx,
  exact tendsto_of_no_upcrossings w_dense hx,
end

lemma ae_tendsto_lim_ratio :
  ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio ρ x)) :=
begin
  filter_upwards [v.ae_tendsto_div hρ],
  assume x hx,
  exact tendsto_nhds_lim hx,
end

/-- Given two thresholds `p < q`, the sets `{x | v.lim_ratio ρ x < p}`
and `{x | q < v.lim_ratio ρ x}` are obviously disjoint. The key to proving that `v.lim_ratio ρ` is
almost everywhere measurable is to show that these sets have measurable supersets which are also
disjoint, up to zero measure. This is the content of this lemma. -/
lemma exists_measurable_supersets_lim_ratio {p q : ℝ≥0} (hpq : p < q) :
  ∃ a b, measurable_set a ∧ measurable_set b ∧ {x | v.lim_ratio ρ x < p} ⊆ a
    ∧ {x | (q : ℝ≥0∞) < v.lim_ratio ρ x} ⊆ b ∧ μ (a ∩ b) = 0 :=
begin
  /- Here is a rough sketch, assuming that the measure is finite and the limit is well defined
  everywhere. Let `u := {x | v.lim_ratio ρ x < p}` and `w := {x | q < v.lim_ratio ρ x}`. They
  have measurable supersets `u'` and `w'` of the same measure. We will show that these satisfy
  the conclusion of the theorem, i.e., `μ (u' ∩ w') = 0`. For this, note that
  `ρ (u' ∩ w') = ρ (u ∩ w')` (as `w'` is measurable, see `measure_to_measurable_add_inter_left`).
  The latter set is included in the set where the limit of the ratios is `< p`, and therefore
  its measure is `≤ p * μ (u ∩ w')`. Using the same trick in the other direction gives that this is
  `p * μ (u' ∩ w')`. We have shown that `ρ (u' ∩ w') ≤ p * μ (u' ∩ w')`. Arguing in the same way but
  using the `w` part gives `q * μ (u' ∩ w') ≤ ρ (u' ∩ w')`. If `μ (u' ∩ w')` were nonzero, this
  would be a contradiction as `p < q`.

  For the rigorous proof, we need to work on a part of the space where the measure is finite
  (provided by `spanning_sets (ρ + μ)`) and to restrict to the set where the limit is well defined
  (called `s` below, of full measure). Otherwise, the argument goes through.
  -/
  let s := {x | ∃ c, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 c)},
  let o : ℕ → set α := spanning_sets (ρ + μ),
  let u := λ n, s ∩ {x | v.lim_ratio ρ x < p} ∩ o n,
  let w := λ n, s ∩ {x | (q : ℝ≥0∞) < v.lim_ratio ρ x} ∩ o n,
  -- the supersets are obtained by restricting to the set `s` where the limit is well defined, to
  -- a finite measure part `o n`, taking a measurable superset here, and then taking the union over
  -- `n`.
  refine ⟨to_measurable μ sᶜ ∪ (⋃ n, to_measurable (ρ + μ) (u n)),
    to_measurable μ sᶜ ∪ (⋃ n, to_measurable (ρ + μ) (w n)), _, _, _, _, _⟩,
  -- check that these sets are measurable supersets as required
  { exact (measurable_set_to_measurable _ _).union
      (measurable_set.Union (λ n, (measurable_set_to_measurable _ _))) },
  { exact (measurable_set_to_measurable _ _).union
      (measurable_set.Union (λ n, (measurable_set_to_measurable _ _))) },
  { assume x hx,
    by_cases h : x ∈ s,
    { refine or.inr (mem_Union.2 ⟨spanning_sets_index (ρ + μ) x, _⟩),
      exact subset_to_measurable _ _ ⟨⟨h, hx⟩, mem_spanning_sets_index _ _⟩ },
    { exact or.inl (subset_to_measurable μ sᶜ h) } },
  { assume x hx,
    by_cases h : x ∈ s,
    { refine or.inr (mem_Union.2 ⟨spanning_sets_index (ρ + μ) x, _⟩),
      exact subset_to_measurable _ _ ⟨⟨h, hx⟩, mem_spanning_sets_index _ _⟩ },
    { exact or.inl (subset_to_measurable μ sᶜ h) } },
  -- it remains to check the nontrivial part that these sets have zero measure intersection.
  -- it suffices to do it for fixed `m` and `n`, as one is taking countable unions.
  suffices H : ∀ (m n : ℕ), μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) = 0,
  { have A : (to_measurable μ sᶜ ∪ (⋃ n, to_measurable (ρ + μ) (u n))) ∩
      (to_measurable μ sᶜ ∪ (⋃ n, to_measurable (ρ + μ) (w n))) ⊆
      to_measurable μ sᶜ ∪ (⋃ m n, (to_measurable (ρ + μ) (u m)) ∩ (to_measurable (ρ + μ) (w n))),
    { simp only [inter_distrib_left, inter_distrib_right, true_and, subset_union_left,
        union_subset_iff, inter_self],
      refine ⟨_, _, _⟩,
      { exact (inter_subset_left _ _).trans (subset_union_left _ _) },
      { exact (inter_subset_right _ _).trans (subset_union_left _ _) },
      { simp_rw [Union_inter, inter_Union], exact subset_union_right _ _ } },
    refine le_antisymm ((measure_mono A).trans _) bot_le,
    calc
    μ (to_measurable μ sᶜ ∪ (⋃ m n, (to_measurable (ρ + μ) (u m)) ∩ (to_measurable (ρ + μ) (w n))))
    ≤ μ (to_measurable μ sᶜ)
        + μ (⋃ m n, (to_measurable (ρ + μ) (u m)) ∩ (to_measurable (ρ + μ) (w n))) :
      measure_union_le _ _
    ... = μ (⋃ m n, (to_measurable (ρ + μ) (u m)) ∩ (to_measurable (ρ + μ) (w n))) :
      by { have : μ sᶜ = 0 := v.ae_tendsto_div hρ, rw [measure_to_measurable, this, zero_add] }
    ... ≤ ∑' m n, μ ((to_measurable (ρ + μ) (u m)) ∩ (to_measurable (ρ + μ) (w n))) :
      (measure_Union_le _).trans (ennreal.tsum_le_tsum (λ m, measure_Union_le _))
    ... = 0 : by simp only [H, tsum_zero] },
  -- now starts the nontrivial part of the argument. We fix `m` and `n`, and show that the
  -- measurable supersets of `u m` and `w n` have zero measure intersection by using the lemmas
  -- `measure_to_measurable_add_inter_left` (to reduce to `u m` or `w n` instead of the measurable
  -- superset) and `measure_le_of_frequently_le` to compare their measures for `ρ` and `μ`.
  assume m n,
  have I : (ρ + μ) (u m) ≠ ∞,
  { apply (lt_of_le_of_lt (measure_mono _) (measure_spanning_sets_lt_top (ρ + μ) m)).ne,
    exact inter_subset_right _ _ },
  have J : (ρ + μ) (w n) ≠ ∞,
  { apply (lt_of_le_of_lt (measure_mono _) (measure_spanning_sets_lt_top (ρ + μ) n)).ne,
    exact inter_subset_right _ _ },
  have A : ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))
            ≤ p * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) := calc
    ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))
        = ρ (u m ∩ to_measurable (ρ + μ) (w n)) :
          measure_to_measurable_add_inter_left (measurable_set_to_measurable _ _) I
    ... ≤ (p • μ) (u m ∩ to_measurable (ρ + μ) (w n)) : begin
        refine v.measure_le_of_frequently_le _ hρ _ (λ x hx, _),
        have L : tendsto (λ (a : set α), ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio ρ x)) :=
          tendsto_nhds_lim hx.1.1.1,
        have I : ∀ᶠ (b : set α) in v.filter_at x, ρ b / μ b < p :=
          (tendsto_order.1 L).2 _ hx.1.1.2,
        apply I.frequently.mono (λ a ha, _),
        rw [coe_nnreal_smul_apply],
        refine (ennreal.div_le_iff_le_mul _ (or.inr (bot_le.trans_lt ha).ne')).1 ha.le,
        simp only [ennreal.coe_ne_top, ne.def, or_true, not_false_iff]
      end
    ... = p * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) :
       by simp only [coe_nnreal_smul_apply,
          (measure_to_measurable_add_inter_right (measurable_set_to_measurable _ _) I)],
  have B : (q : ℝ≥0∞) * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))
              ≤ ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) := calc
    (q : ℝ≥0∞) * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))
        = (q : ℝ≥0∞) * μ (to_measurable (ρ + μ) (u m) ∩ w n) : begin
        conv_rhs { rw inter_comm },
        rw [inter_comm, measure_to_measurable_add_inter_right (measurable_set_to_measurable _ _) J]
      end
    ... ≤ ρ (to_measurable (ρ + μ) (u m) ∩ w n) : begin
        rw [← coe_nnreal_smul_apply],
        refine v.measure_le_of_frequently_le _ (absolutely_continuous.rfl.coe_nnreal_smul _) _ _,
        assume x hx,
        have L : tendsto (λ (a : set α), ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio ρ x)) :=
          tendsto_nhds_lim hx.2.1.1,
        have I : ∀ᶠ (b : set α) in v.filter_at x, (q : ℝ≥0∞) < ρ b / μ b :=
          (tendsto_order.1 L).1 _ hx.2.1.2,
        apply I.frequently.mono (λ a ha, _),
        rw [coe_nnreal_smul_apply],
        exact ennreal.mul_le_of_le_div ha.le
      end
    ... = ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) : begin
        conv_rhs { rw inter_comm },
        rw inter_comm,
        exact (measure_to_measurable_add_inter_left (measurable_set_to_measurable _ _) J).symm,
      end,
  by_contra,
  apply lt_irrefl (ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))),
  calc ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n))
      ≤ p * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) : A
  ... < q * μ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) : begin
    apply (ennreal.mul_lt_mul_right h _).2 (ennreal.coe_lt_coe.2 hpq),
    suffices H : (ρ + μ) (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) ≠ ∞,
    { simp only [not_or_distrib, ennreal.add_eq_top, pi.add_apply, ne.def, coe_add] at H,
      exact H.2 },
    apply (lt_of_le_of_lt (measure_mono (inter_subset_left _ _)) _).ne,
    rw measure_to_measurable,
    apply lt_of_le_of_lt (measure_mono _) (measure_spanning_sets_lt_top (ρ + μ) m),
    exact inter_subset_right _ _
  end
  ... ≤ ρ (to_measurable (ρ + μ) (u m) ∩ to_measurable (ρ + μ) (w n)) : B
end

theorem ae_measurable_lim_ratio : ae_measurable (v.lim_ratio ρ) μ :=
begin
  apply ennreal.ae_measurable_of_exist_almost_disjoint_supersets _ _ (λ p q hpq, _),
  exact v.exists_measurable_supersets_lim_ratio hρ hpq,
end

/-- A measurable version of `v.lim_ratio ρ`. Do *not* use this definition: it is only a temporary
device to show that `v.lim_ratio` is almost everywhere equal to the Radon-Nikodym derivative. -/
noncomputable def lim_ratio_meas : α → ℝ≥0∞ :=
(v.ae_measurable_lim_ratio hρ).mk _

lemma lim_ratio_meas_measurable : measurable (v.lim_ratio_meas hρ) :=
ae_measurable.measurable_mk _

lemma ae_tendsto_lim_ratio_meas :
  ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio_meas hρ x)) :=
begin
  filter_upwards [v.ae_tendsto_lim_ratio hρ, ae_measurable.ae_eq_mk (v.ae_measurable_lim_ratio hρ)],
  assume x hx h'x,
  rwa h'x at hx,
end

/-- If, for all `x` in a set `s`, one has frequently `ρ a / μ a < p`, then `ρ s ≤ p * μ s`, as
proved in `measure_le_of_frequently_le`. Since `ρ a / μ a` tends almost everywhere to
`v.lim_ratio_meas hρ x`, the same property holds for sets `s` on which `v.lim_ratio_meas hρ < p`. -/
lemma measure_le_mul_of_subset_lim_ratio_meas_lt
  {p : ℝ≥0} {s : set α} (h : s ⊆ {x | v.lim_ratio_meas hρ x < p}) :
  ρ s ≤ p * μ s :=
begin
  let t := {x : α | tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio_meas hρ x))},
  have A : μ tᶜ = 0 := v.ae_tendsto_lim_ratio_meas hρ,
  suffices H : ρ (s ∩ t) ≤ (p • μ) (s ∩ t), from calc
    ρ s = ρ ((s ∩ t) ∪ (s ∩ tᶜ)) : by rw inter_union_compl
    ... ≤ ρ (s ∩ t) + ρ (s ∩ tᶜ) : measure_union_le _ _
    ... ≤ p * μ (s ∩ t) + 0 :
      add_le_add H ((measure_mono (inter_subset_right _ _)).trans (hρ A).le)
    ... ≤ p * μ s :
      by { rw add_zero, exact ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_left _ _)) },
  refine v.measure_le_of_frequently_le _ hρ _ (λ x hx, _),
  have I : ∀ᶠ (b : set α) in v.filter_at x, ρ b / μ b < p := (tendsto_order.1 hx.2).2 _ (h hx.1),
  apply I.frequently.mono (λ a ha, _),
  rw [coe_nnreal_smul_apply],
  refine (ennreal.div_le_iff_le_mul _ (or.inr (bot_le.trans_lt ha).ne')).1 ha.le,
  simp only [ennreal.coe_ne_top, ne.def, or_true, not_false_iff]
end

/-- If, for all `x` in a set `s`, one has frequently `q < ρ a / μ a`, then `q * μ s ≤ ρ s`, as
proved in `measure_le_of_frequently_le`. Since `ρ a / μ a` tends almost everywhere to
`v.lim_ratio_meas hρ x`, the same property holds for sets `s` on which `q < v.lim_ratio_meas hρ`. -/
lemma mul_measure_le_of_subset_lt_lim_ratio_meas
  {q : ℝ≥0} {s : set α} (h : s ⊆ {x | (q : ℝ≥0∞) < v.lim_ratio_meas hρ x}) :
  (q : ℝ≥0∞) * μ s ≤ ρ s :=
begin
  let t := {x : α | tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (v.lim_ratio_meas hρ x))},
  have A : μ tᶜ = 0 := v.ae_tendsto_lim_ratio_meas hρ,
  suffices H : (q • μ) (s ∩ t) ≤ ρ (s ∩ t), from calc
    (q • μ) s = (q • μ) ((s ∩ t) ∪ (s ∩ tᶜ)) : by rw inter_union_compl
    ... ≤ (q • μ) (s ∩ t) + (q • μ) (s ∩ tᶜ) : measure_union_le _ _
    ... ≤ ρ (s ∩ t) + q * μ tᶜ : begin
        apply add_le_add H,
        rw [coe_nnreal_smul_apply],
        exact ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_right _ _)),
      end
    ... ≤ ρ s :
      by { rw [A, mul_zero, add_zero], exact measure_mono (inter_subset_left _ _) },
  refine v.measure_le_of_frequently_le _ (absolutely_continuous.rfl.coe_nnreal_smul _) _ _,
  assume x hx,
  have I : ∀ᶠ a in v.filter_at x, (q : ℝ≥0∞) < ρ a / μ a := (tendsto_order.1 hx.2).1 _ (h hx.1),
  apply I.frequently.mono (λ a ha, _),
  rw [coe_nnreal_smul_apply],
  exact ennreal.mul_le_of_le_div ha.le
end

/-- The points with `v.lim_ratio_meas hρ x = ∞` have measure `0` for `μ`. -/
lemma measure_lim_ratio_meas_top : μ {x | v.lim_ratio_meas hρ x = ∞} = 0 :=
begin
  refine null_of_locally_null _ (λ x hx, _),
  obtain ⟨o, xo, o_open, μo⟩ : ∃ o : set α, x ∈ o ∧ is_open o ∧ ρ o < ∞ :=
    measure.exists_is_open_measure_lt_top ρ x,
  refine ⟨o, mem_nhds_within_of_mem_nhds (o_open.mem_nhds xo), le_antisymm _ bot_le⟩,
  let s := {x : α | v.lim_ratio_meas hρ x = ∞} ∩ o,
  have ρs : ρ s ≠ ∞ := ((measure_mono (inter_subset_right _ _)).trans_lt μo).ne,
  have A : ∀ (q : ℝ≥0), 1 ≤ q → μ s ≤ q⁻¹ * ρ s,
  { assume q hq,
    rw [mul_comm, ← div_eq_mul_inv, ennreal.le_div_iff_mul_le _ (or.inr ρs), mul_comm],
    { apply v.mul_measure_le_of_subset_lt_lim_ratio_meas hρ,
      assume y hy,
      have : v.lim_ratio_meas hρ y = ∞ := hy.1,
      simp only [this, ennreal.coe_lt_top, mem_set_of_eq], },
    { simp only [(zero_lt_one.trans_le hq).ne', true_or, ennreal.coe_eq_zero, ne.def,
        not_false_iff] } },
  have B : tendsto (λ (q : ℝ≥0), (q : ℝ≥0∞)⁻¹ * ρ s) at_top (𝓝 (∞⁻¹ * ρ s)),
  { apply ennreal.tendsto.mul_const _ (or.inr ρs),
    exact ennreal.tendsto_inv_iff.2 (ennreal.tendsto_coe_nhds_top.2 tendsto_id) },
  simp only [zero_mul, ennreal.inv_top] at B,
  apply ge_of_tendsto B,
  exact eventually_at_top.2 ⟨1, A⟩,
end

/-- The points with `v.lim_ratio_meas hρ x = 0` have measure `0` for `ρ`. -/
lemma measure_lim_ratio_meas_zero : ρ {x | v.lim_ratio_meas hρ x = 0} = 0 :=
begin
  refine null_of_locally_null _ (λ x hx, _),
  obtain ⟨o, xo, o_open, μo⟩ : ∃ o : set α, x ∈ o ∧ is_open o ∧ μ o < ∞ :=
    measure.exists_is_open_measure_lt_top μ x,
  refine ⟨o, mem_nhds_within_of_mem_nhds (o_open.mem_nhds xo), le_antisymm _ bot_le⟩,
  let s := {x : α | v.lim_ratio_meas hρ x = 0} ∩ o,
  have μs : μ s ≠ ∞ := ((measure_mono (inter_subset_right _ _)).trans_lt μo).ne,
  have A : ∀ (q : ℝ≥0), 0 < q → ρ s ≤ q * μ s,
  { assume q hq,
    apply v.measure_le_mul_of_subset_lim_ratio_meas_lt hρ,
    assume y hy,
    have : v.lim_ratio_meas hρ y = 0 := hy.1,
    simp only [this, mem_set_of_eq, hq, ennreal.coe_pos], },
  have B : tendsto (λ (q : ℝ≥0), (q : ℝ≥0∞) * μ s) (𝓝[Ioi (0 : ℝ≥0)] 0) (𝓝 ((0 : ℝ≥0) * μ s)),
  { apply ennreal.tendsto.mul_const _ (or.inr μs),
    rw ennreal.tendsto_coe,
    exact nhds_within_le_nhds },
  simp only [zero_mul, ennreal.coe_zero] at B,
  apply ge_of_tendsto B,
  filter_upwards [self_mem_nhds_within],
  exact A
end

/-- As an intermediate step to show that `μ.with_density (v.lim_ratio_meas hρ) = ρ`, we show here
that `μ.with_density (v.lim_ratio_meas hρ) ≤ t^2 ρ` for any `t > 1`. -/
lemma with_density_le_mul {s : set α} (hs : measurable_set s) {t : ℝ≥0} (ht : 1 < t) :
  μ.with_density (v.lim_ratio_meas hρ) s ≤ t^2 * ρ s :=
begin
  /- We cut `s` into the sets where `v.lim_ratio_meas hρ = 0`, where `v.lim_ratio_meas hρ = ∞`, and
  where `v.lim_ratio_meas hρ ∈ [t^n, t^(n+1))` for `n : ℤ`. The first and second have measure `0`.
  For the latter, since `v.lim_ratio_meas hρ` fluctuates by at most `t` on this slice, we can use
  `measure_le_mul_of_subset_lim_ratio_meas_lt` and `mul_measure_le_of_subset_lt_lim_ratio_meas` to
  show that the two measures are comparable up to `t` (in fact `t^2` for technical reasons of
  strict inequalities). -/
  have t_ne_zero' : t ≠ 0 := (zero_lt_one.trans ht).ne',
  have t_ne_zero : (t : ℝ≥0∞) ≠ 0, by simpa only [ennreal.coe_eq_zero, ne.def] using t_ne_zero',
  let ν := μ.with_density (v.lim_ratio_meas hρ),
  let f := v.lim_ratio_meas hρ,
  have f_meas : measurable f := v.lim_ratio_meas_measurable hρ,
  have A : ν (s ∩ f ⁻¹' ({0})) ≤ ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' {0}),
  { apply le_trans _ (zero_le _),
    have M : measurable_set (s ∩ f ⁻¹' ({0})) := hs.inter (f_meas (measurable_set_singleton _)),
    simp only [ν, f, nonpos_iff_eq_zero, M, with_density_apply, lintegral_eq_zero_iff f_meas],
    apply (ae_restrict_iff' M).2,
    exact eventually_of_forall (λ x hx, hx.2) },
  have B : ν (s ∩ f ⁻¹' ({∞})) ≤ ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' {∞}),
  { apply le_trans (le_of_eq _) (zero_le _),
    apply with_density_absolutely_continuous μ _,
    rw ← nonpos_iff_eq_zero,
    exact (measure_mono (inter_subset_right _ _)).trans (v.measure_lim_ratio_meas_top hρ).le },
  have C : ∀ (n : ℤ), ν (s ∩ f⁻¹' (Ico (t^n) (t^(n+1))))
                        ≤ ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))),
  { assume n,
    let I := Ico ((t : ℝ≥0∞)^n) (t^(n+1)),
    have M : measurable_set (s ∩ f ⁻¹' I) := hs.inter (f_meas measurable_set_Ico),
    simp only [f, M, with_density_apply, coe_nnreal_smul_apply],
    calc
    ∫⁻ x in s ∩ f⁻¹' I, f x ∂μ
        ≤ ∫⁻ x in s ∩ f⁻¹' I, t^(n+1) ∂μ :
          lintegral_mono_ae ((ae_restrict_iff' M).2 (eventually_of_forall (λ x hx, hx.2.2.le)))
    ... = t^(n+1) * μ (s ∩ f⁻¹' I) :
          by simp only [lintegral_const, measurable_set.univ, measure.restrict_apply, univ_inter]
    ... = t^(2 : ℤ) * (t^(n-1) * μ (s ∩ f⁻¹' I)) : begin
        rw [← mul_assoc, ← ennreal.zpow_add t_ne_zero ennreal.coe_ne_top],
        congr' 2,
        abel,
      end
    ... ≤ t^2 * ρ (s ∩ f ⁻¹' I) : begin
        apply ennreal.mul_le_mul le_rfl _,
        rw ← ennreal.coe_zpow (zero_lt_one.trans ht).ne',
        apply v.mul_measure_le_of_subset_lt_lim_ratio_meas hρ,
        assume x hx,
        apply lt_of_lt_of_le _ hx.2.1,
        rw [← ennreal.coe_zpow (zero_lt_one.trans ht).ne', ennreal.coe_lt_coe, sub_eq_add_neg,
          zpow_add₀ t_ne_zero'],
        conv_rhs { rw ← mul_one (t^ n) },
        refine mul_lt_mul' le_rfl _ (zero_le _) (nnreal.zpow_pos t_ne_zero' _),
        rw zpow_neg_one₀,
        exact nnreal.inv_lt_one ht,
      end },
  calc ν s = ν (s ∩ f⁻¹' {0}) + ν (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), ν (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
    measure_eq_measure_preimage_add_measure_tsum_Ico_zpow ν f_meas hs ht
  ... ≤ ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' {0}) + ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' {∞})
          + ∑' (n : ℤ), ((t : ℝ≥0∞)^2 • ρ) (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
            add_le_add (add_le_add A B) (ennreal.tsum_le_tsum C)
  ... = ((t : ℝ≥0∞)^2 • ρ) s :
    (measure_eq_measure_preimage_add_measure_tsum_Ico_zpow ((t : ℝ≥0∞)^2 • ρ) f_meas hs ht).symm
end

/-- As an intermediate step to show that `μ.with_density (v.lim_ratio_meas hρ) = ρ`, we show here
that `ρ ≤ t μ.with_density (v.lim_ratio_meas hρ)` for any `t > 1`. -/
lemma le_mul_with_density {s : set α} (hs : measurable_set s) {t : ℝ≥0} (ht : 1 < t) :
  ρ s ≤ t * μ.with_density (v.lim_ratio_meas hρ) s :=
begin
  /- We cut `s` into the sets where `v.lim_ratio_meas hρ = 0`, where `v.lim_ratio_meas hρ = ∞`, and
  where `v.lim_ratio_meas hρ ∈ [t^n, t^(n+1))` for `n : ℤ`. The first and second have measure `0`.
  For the latter, since `v.lim_ratio_meas hρ` fluctuates by at most `t` on this slice, we can use
  `measure_le_mul_of_subset_lim_ratio_meas_lt` and `mul_measure_le_of_subset_lt_lim_ratio_meas` to
  show that the two measures are comparable up to `t`. -/
  have t_ne_zero' : t ≠ 0 := (zero_lt_one.trans ht).ne',
  have t_ne_zero : (t : ℝ≥0∞) ≠ 0, by simpa only [ennreal.coe_eq_zero, ne.def] using t_ne_zero',
  let ν := μ.with_density (v.lim_ratio_meas hρ),
  let f := v.lim_ratio_meas hρ,
  have f_meas : measurable f := v.lim_ratio_meas_measurable hρ,
  have A : ρ (s ∩ f ⁻¹' ({0})) ≤ (t • ν) (s ∩ f⁻¹' {0}),
  { refine le_trans (measure_mono (inter_subset_right _ _)) (le_trans (le_of_eq _) (zero_le _)),
    exact v.measure_lim_ratio_meas_zero hρ },
  have B : ρ (s ∩ f ⁻¹' ({∞})) ≤ (t • ν) (s ∩ f⁻¹' {∞}),
  { apply le_trans (le_of_eq _) (zero_le _),
    apply hρ,
    rw ← nonpos_iff_eq_zero,
    exact (measure_mono (inter_subset_right _ _)).trans (v.measure_lim_ratio_meas_top hρ).le },
  have C : ∀ (n : ℤ), ρ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1))))
                        ≤ (t • ν) (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))),
  { assume n,
    let I := Ico ((t : ℝ≥0∞)^n) (t^(n+1)),
    have M : measurable_set (s ∩ f ⁻¹' I) := hs.inter (f_meas measurable_set_Ico),
    simp only [f, M, with_density_apply, coe_nnreal_smul_apply],
    calc ρ (s ∩ f ⁻¹' I) ≤ t^ (n+1) * μ (s ∩ f ⁻¹' I) : begin
        rw ← ennreal.coe_zpow t_ne_zero',
        apply v.measure_le_mul_of_subset_lim_ratio_meas_lt hρ,
        assume x hx,
        apply hx.2.2.trans_le (le_of_eq _),
        rw ennreal.coe_zpow t_ne_zero',
      end
    ... = ∫⁻ x in s ∩ f⁻¹' I, t^(n+1) ∂μ :
      by simp only [lintegral_const, measurable_set.univ, measure.restrict_apply, univ_inter]
    ... ≤ ∫⁻ x in s ∩ f⁻¹' I, t * f x ∂μ : begin
        apply lintegral_mono_ae ((ae_restrict_iff' M).2 (eventually_of_forall (λ x hx, _))),
        rw [add_comm, ennreal.zpow_add t_ne_zero ennreal.coe_ne_top, zpow_one],
        exact ennreal.mul_le_mul le_rfl hx.2.1,
      end
    ... = t * ∫⁻ x in s ∩ f⁻¹' I, f x ∂μ : lintegral_const_mul _ f_meas },
  calc ρ s = ρ (s ∩ f⁻¹' {0}) + ρ (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), ρ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
    measure_eq_measure_preimage_add_measure_tsum_Ico_zpow ρ f_meas hs ht
  ... ≤ (t • ν) (s ∩ f⁻¹' {0}) + (t • ν) (s ∩ f⁻¹' {∞})
          + ∑' (n : ℤ), (t • ν) (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
            add_le_add (add_le_add A B) (ennreal.tsum_le_tsum C)
  ... = (t • ν) s :
    (measure_eq_measure_preimage_add_measure_tsum_Ico_zpow (t • ν) f_meas hs ht).symm
end

theorem with_density_lim_ratio_meas_eq : μ.with_density (v.lim_ratio_meas hρ) = ρ :=
begin
  ext1 s hs,
  refine le_antisymm _ _,
  { have : tendsto (λ (t : ℝ≥0), (t^2 * ρ s : ℝ≥0∞)) (𝓝[Ioi 1] 1) (𝓝 ((1 : ℝ≥0)^2 * ρ s)),
    { refine ennreal.tendsto.mul _ _ tendsto_const_nhds _,
      { exact ennreal.tendsto.pow (ennreal.tendsto_coe.2 nhds_within_le_nhds) },
      { simp only [one_pow, ennreal.coe_one, true_or, ne.def, not_false_iff, one_ne_zero] },
      { simp only [one_pow, ennreal.coe_one, ne.def, or_true, ennreal.one_ne_top,
                   not_false_iff] } },
    simp only [one_pow, one_mul, ennreal.coe_one] at this,
    refine ge_of_tendsto this _,
    filter_upwards [self_mem_nhds_within],
    assume t ht,
    exact v.with_density_le_mul hρ hs ht },
  { have : tendsto (λ (t : ℝ≥0), (t : ℝ≥0∞) * μ.with_density (v.lim_ratio_meas hρ) s) (𝓝[Ioi 1] 1)
            (𝓝 ((1 : ℝ≥0) * μ.with_density (v.lim_ratio_meas hρ) s)),
    { refine ennreal.tendsto.mul_const (ennreal.tendsto_coe.2 nhds_within_le_nhds) _,
      simp only [ennreal.coe_one, true_or, ne.def, not_false_iff, one_ne_zero], },
    simp only [one_mul, ennreal.coe_one] at this,
    refine ge_of_tendsto this _,
    filter_upwards [self_mem_nhds_within],
    assume t ht,
    exact v.le_mul_with_density hρ hs ht }
end

/-- Weak version of the main theorem on differentiation of measures: given a Vitali family `v`
for a locally finite measure `μ`, and another locally finite measure `ρ`, then for `μ`-almost
every `x` the ratio `ρ a / μ a` converges, when `a` shrinks to `x` along the Vitali family,
towards the Radon-Nikodym derivative of `ρ` with respect to `μ`.

This version assumes that `ρ` is absolutely continuous with respect to `μ`. The general version
without this superfluous assumption is `vitali_family.ae_tendsto_rn_deriv`.
-/
theorem ae_tendsto_rn_deriv_of_absolutely_continuous :
  ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (ρ.rn_deriv μ x)) :=
begin
  have A : (μ.with_density (v.lim_ratio_meas hρ)).rn_deriv μ =ᵐ[μ] v.lim_ratio_meas hρ :=
    rn_deriv_with_density μ (v.lim_ratio_meas_measurable hρ),
  rw v.with_density_lim_ratio_meas_eq hρ at A,
  filter_upwards [v.ae_tendsto_lim_ratio_meas hρ, A],
  assume x hx h'x,
  rwa h'x,
end

end absolutely_continuous

/-- Main theorem on differentiation of measures: given a Vitali family `v` for a locally finite
measure `μ`, and another locally finite measure `ρ`, then for `μ`-almost every `x` the
ratio `ρ a / μ a` converges, when `a` shrinks to `x` along the Vitali family, towards the
Radon-Nikodym derivative of `ρ` with respect to `μ`. -/
theorem ae_tendsto_rn_deriv :
  ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 (ρ.rn_deriv μ x)) :=
begin
  let t := μ.with_density (ρ.rn_deriv μ),
  have eq_add : ρ = ρ.singular_part μ + t := have_lebesgue_decomposition_add _ _,
  have A : ∀ᵐ x ∂μ, tendsto (λ a, ρ.singular_part μ a / μ a) (v.filter_at x) (𝓝 0) :=
    v.ae_eventually_measure_zero_of_singular (mutually_singular_singular_part ρ μ),
  have B : ∀ᵐ x ∂μ, t.rn_deriv μ x = ρ.rn_deriv μ x :=
    rn_deriv_with_density μ (measurable_rn_deriv ρ μ),
  have C : ∀ᵐ x ∂μ, tendsto (λ a, t a / μ a) (v.filter_at x) (𝓝 (t.rn_deriv μ x)) :=
    v.ae_tendsto_rn_deriv_of_absolutely_continuous (with_density_absolutely_continuous _ _),
  filter_upwards [A, B, C],
  assume x Ax Bx Cx,
  convert Ax.add Cx,
  { ext1 a,
    conv_lhs { rw [eq_add] },
    simp only [pi.add_apply, coe_add, ennreal.add_div] },
  { simp only [Bx, zero_add] }
end

end

end vitali_family


import field_definition
import field_results
import numbers

inductive  item_plus_sqrt (f : Type) [myfld f] (rt : f) : Type
| ips : f -> f -> item_plus_sqrt

open item_plus_sqrt

def ips_zero (f : Type) [myfld f] (rt : f) : (item_plus_sqrt f rt) := ips myfld.zero myfld.zero

def ips_add (f : Type) [myfld f] (rt : f) : (item_plus_sqrt f rt) -> (item_plus_sqrt f rt) -> (item_plus_sqrt f rt)
| (ips a b) (ips c d) := (ips (myfld.add a c) (myfld.add b d))

def ips_negate (f : Type) [myfld f] (rt : f) : (item_plus_sqrt f rt) -> (item_plus_sqrt f rt)
| (ips a b) := (ips (myfld.negate a) (myfld.negate b))

def ips_mul (f : Type) [myfld f] (rt : f) : (item_plus_sqrt f rt) -> (item_plus_sqrt f rt) -> (item_plus_sqrt f rt)
| (ips a b) (ips c d) := (ips ((a .* c) .+ (b .* d .* rt)) ((a .* d) .+ (b .* c)))

def to_ips (f : Type) [myfld f] (rt : f) (x : f) : (item_plus_sqrt f rt) := (ips x myfld.zero)

lemma ips_add_comm (f : Type) [myfld f] (rt : f) (a b c d : f) :
  ips_add f rt (ips a b) (ips c d) = ips_add f rt (ips c d) (ips a b) :=
begin
  unfold ips_add, rw myfld.add_comm a c, rw myfld.add_comm b d,
end

lemma ips_add_assoc (f : Type) [myfld f] (rt : f) (a1 b1 a2 b2 a3 b3 : f) :
  ips_add f rt (ips a1 b1) (ips_add f rt (ips a2 b2) (ips a3 b3)) =
  ips_add f rt (ips_add f rt (ips a1 b1) (ips a2 b2)) (ips a3 b3) :=
begin
  unfold ips_add, repeat {rw myfld.add_assoc},
end

lemma ips_mul_comm (f : Type) [myfld f] (rt : f) (a b c d : f) :
  ips_mul f rt (ips a b) (ips c d) = ips_mul f rt (ips c d) (ips a b) :=
begin
  unfold ips_mul, rw myfld.mul_comm a c, rw myfld.mul_comm b d,
  rw myfld.mul_comm a d, rw myfld.mul_comm b c,
  rw myfld.add_comm (c .* b) (d .* a),
end

def quadratic_formula (f : Type) [myfld f] [fld_not_char_two f] (b c : f) :
      (item_plus_sqrt f ((b .* b) .+ ((four f) .* .- c))) :=
  ips (.- b) .* (myfld.reciprocal (two f) (fld_not_char_two.not_char_two))
      (myfld.reciprocal (two f) (fld_not_char_two.not_char_two))

def quadratic_subst_ips (f : Type) [myfld f] [fld_not_char_two f] (rt : f) (b c : f)
    (x : item_plus_sqrt f rt) : (item_plus_sqrt f rt) :=
  ips_add f rt (ips_mul f rt x x) (ips_add f rt (ips_mul f rt x (to_ips f rt b)) (to_ips f rt c))

lemma quadratic_formula_works (f : Type) [myfld f] [fld_not_char_two f] (b c : f) :
  (quadratic_subst_ips f ((b .* b) .+ ((four f) .* .- c)) b c
                        (quadratic_formula f b c))
                        =
  (ips myfld.zero myfld.zero) :=
begin
  unfold quadratic_formula, unfold quadratic_subst_ips,
  unfold to_ips, unfold ips_mul, unfold ips_add,
  repeat {rw zero_simp}, repeat {rw zero_mul}, repeat {rw mul_zero}, rw simp_zero, rw zero_simp,
  repeat {rw mul_negate, rw mul_negate_alt_simp}, rw mul_negate,
  rw double_negative,
  have tmp : ∀ (p q rt : f), (p = myfld.zero) -> (q = myfld.zero) ->
                ((ips p q) : (item_plus_sqrt f rt)) =
                ((ips myfld.zero myfld.zero) : (item_plus_sqrt f rt)),
    intros p q rt h1 h2, rw h1, rw h2,
  apply tmp, clear tmp,
  rw mul_two_reciprocals,
  rw [myfld.mul_comm b (myfld.reciprocal (two f) _)] {occs := occurrences.pos [2]},
  rw <- myfld.mul_assoc _ (myfld.reciprocal (two f) _) _,
  rw myfld.mul_assoc (myfld.reciprocal (two f) _) (myfld.reciprocal (two f) _) _,
  rw mul_two_reciprocals, rw myfld.mul_comm b ((myfld.reciprocal _ _) .* _),
  rw <- myfld.mul_assoc (myfld.reciprocal _ _) b b,
  rw <- distrib_simp_alt,
  have tmp : .- (b .* (myfld.reciprocal (two f) fld_not_char_two.not_char_two) .* b) =
              .- ((myfld.reciprocal ((two f) .* (two f)) (mul_nonzero f (two f) (two f) fld_not_char_two.not_char_two fld_not_char_two.not_char_two))
              .* ((b .* b) .+ (b .* b))),
    rw <- mul_two_reciprocals, have tmp_tmp : ((b .* b) .+ (b .* b)) = (two f) .* (b .* b),
      unfold two, rw distrib_simp, rw one_mul_simp,
    rw tmp_tmp, rw myfld.mul_assoc _ (two f) _,
    rw <- myfld.mul_assoc _ (myfld.reciprocal (two f) _) (two f),
    rw myfld.mul_comm (myfld.reciprocal (two f) _) (two f), rw myfld.mul_reciprocal,
    rw simp_mul_one, rw myfld.mul_comm b _, rw myfld.mul_assoc,
  rw tmp, clear tmp, rw mul_negate_alt f _ ((b .* b) .+ (b .* b)),
  rw myfld.add_assoc, rw <- distrib_simp_alt,
  rw myfld.add_assoc (b .* b) (b .* b), rw myfld.add_comm _ (.- ((four f) .* c)),
  rw <- myfld.add_assoc _ ((b .* b) .+ (b .* b)) _,
  rw myfld.add_negate, rw zero_simp,
  rw mul_negate_alt_simp, have tmp : (two f) .* (two f) = (four f), unfold four, rw two_plus_two,
  rw reciprocal_rewrite f _ (four f) tmp, rw myfld.mul_assoc, rw myfld.mul_comm _ (four f),
  rw myfld.mul_reciprocal, rw one_mul_simp, rw myfld.add_comm, rw myfld.add_negate,

  clear tmp,
  rw myfld.mul_comm _ (b .* (myfld.reciprocal (two f) fld_not_char_two.not_char_two)),
  rw <- add_negate, rw <- distrib_simp_alt, rw only_one_reciprocal f (two f) _ (two_ne_zero f),
  rw add_two_halves, rw simp_mul_one,
  rw myfld.add_comm, rw myfld.mul_comm b _, rw myfld.add_negate,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.monoid_algebra
import Mathlib.algebra.invertible
import Mathlib.algebra.char_p.basic
import Mathlib.linear_algebra.basis
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Maschke's theorem

We prove Maschke's theorem for finite groups,
in the formulation that every submodule of a `k[G]` module has a complement,
when `k` is a field with `¬(ring_char k ∣ fintype.card G)`.

We do the core computation in greater generality.
For any `[comm_ring k]` in which  `[invertible (fintype.card G : k)]`,
and a `k[G]`-linear map `i : V → W` which admits a `k`-linear retraction `π`,
we produce a `k[G]`-linear retraction by
taking the average over `G` of the conjugates of `π`.

## Future work
It's not so far to give the usual statement, that every finite dimensional representation
of a finite group is semisimple (i.e. a direct sum of irreducibles).
-/

-- At first we work with any `[comm_ring k]`, and add the assumption that

-- `[invertible (fintype.card G : k)]` when it is required.

/-!
We now do the key calculation in Maschke's theorem.

Given `V → W`, an inclusion of `k[G]` modules,,
assume we have some retraction `π` (i.e. `∀ v, π (i v) = v`),
just as a `k`-linear map.
(When `k` is a field, this will be available cheaply, by choosing a basis.)

We now construct a retraction of the inclusion as a `k[G]`-linear map,
by the formula
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/

namespace linear_map

/--
We define the conjugate of `π` by `g`, as a `k`-linear map.
-/
def conjugate {k : Type u} [comm_ring k] {G : Type u} [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) (g : G) : linear_map k W V :=
  comp (comp (monoid_algebra.group_smul.linear_map k V (g⁻¹)) π) (monoid_algebra.group_smul.linear_map k W g)

theorem conjugate_i {k : Type u} [comm_ring k] {G : Type u} [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) (i : linear_map (monoid_algebra k G) V W) (h : ∀ (v : V), coe_fn π (coe_fn i v) = v) (g : G) (v : V) : coe_fn (conjugate π g) (coe_fn i v) = v := sorry

/--
The sum of the conjugates of `π` by each element `g : G`, as a `k`-linear map.

(We postpone dividing by the size of the group as long as possible.)
-/
def sum_of_conjugates {k : Type u} [comm_ring k] (G : Type u) [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) [fintype G] : linear_map k W V :=
  finset.sum finset.univ fun (g : G) => conjugate π g

/--
In fact, the sum over `g : G` of the conjugate of `π` by `g` is a `k[G]`-linear map.
-/
def sum_of_conjugates_equivariant {k : Type u} [comm_ring k] (G : Type u) [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) [fintype G] : linear_map (monoid_algebra k G) W V :=
  monoid_algebra.equivariant_of_linear_of_comm (sum_of_conjugates G π) sorry

/--
We construct our `k[G]`-linear retraction of `i` as
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/
def equivariant_projection {k : Type u} [comm_ring k] (G : Type u) [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) [fintype G] [inv : invertible ↑(fintype.card G)] : linear_map (monoid_algebra k G) W V :=
  ⅟ • sum_of_conjugates_equivariant G π

theorem equivariant_projection_condition {k : Type u} [comm_ring k] (G : Type u) [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (π : linear_map k W V) (i : linear_map (monoid_algebra k G) V W) (h : ∀ (v : V), coe_fn π (coe_fn i v) = v) [fintype G] [inv : invertible ↑(fintype.card G)] (v : V) : coe_fn (equivariant_projection G π) (coe_fn i v) = v := sorry

end linear_map

-- Now we work over a `[field k]`, and replace the assumption `[invertible (fintype.card G : k)]`

-- with `¬(ring_char k ∣ fintype.card G)`.

theorem monoid_algebra.exists_left_inverse_of_injective {k : Type u} [field k] {G : Type u} [fintype G] [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W] [is_scalar_tower k (monoid_algebra k G) W] (not_dvd : ¬ring_char k ∣ fintype.card G) (f : linear_map (monoid_algebra k G) V W) (hf : linear_map.ker f = ⊥) : ∃ (g : linear_map (monoid_algebra k G) W V), linear_map.comp g f = linear_map.id := sorry

theorem monoid_algebra.submodule.exists_is_compl {k : Type u} [field k] {G : Type u} [fintype G] [group G] {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V] [is_scalar_tower k (monoid_algebra k G) V] (not_dvd : ¬ring_char k ∣ fintype.card G) (p : submodule (monoid_algebra k G) V) : ∃ (q : submodule (monoid_algebra k G) V), is_compl p q := sorry