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
  rw closure_eq,
  split; rintros ⟨x, h₁, h₂⟩; split,
  rwa [← coe_nat_cast_on_nat_cast (nat.succ_pos _), ← coe_nat_cast_add, coe_int_nat, nat.cast_add, nat.add_one,
        nat_cast_lt_coe_nat, int.coe_nat_succ, int.add_mul_div_left_fract, int.fract_coe_nat, int.add_zero,
        ← int.to_rat_mul],
  {
    assume h,
    have h' : ↑(x - α) ∈ (@set.univ ℤ),
    {
      rw [← int.to_rat_mul, ← rat.cast_coe_int, @rat.cast_lt _ _ _ x,
          rat.cast_lt_rat, rat.fract_lt_iff, rat.mul_eq_one, int.coe_nat_one] at h,
      rwa [← rat.cast_coe_int, ← int.to_rat_mul],
    },
    rw ← h₂ at h',
    cases h',
  },
  {
    assume h,
    cases (classical.em (x = 1)),
    {
      rw h_1,
    },
    {
      let N : ℕ := ⌊x⌋,
      have h' : x - int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α)) < 1,
      {
        rw [← rat.cast_coe_int, rat.cast_lt_rat, int.fract_eq_of_nonneg_of_lt, int.nat_abs_of_nonneg, int.coe_nat_nonneg,
            ← rat.cast_coe_int, int.coe_nat_lt_coe_nat_of_lt, int.lt_nat_abs, rat.cast_lt_rat] at h,
        rw [← int.nat_abs_of_nonneg (int.coe_nat_nonneg _), ← int.coe_nat_lt_coe_nat_of_lt, int.lt_nat_abs] at h,
        exact h,
      },
      have h' : x - rat.cast (int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α))) < 1,
      {
        rw rat.cast_lt_rat,
        exact h',
      },
      have h'' : 0 < x * rat.cast α - int.nat_abs (N * rat.cast α),
      {
        have h'' : 0 < x - ((1 : ℝ) - rat.cast (int.nat_abs (x * rat.cast α))) := by linarith,
        rw [← int.to_rat_mul, ← rat.cast_coe_int, ← int.to_rat_mul],
        simpa only [rat.cast_sub, int.coe_nat_add, rat.cast_le, rat.cast_coe_nat, rat.sub_eq_add_neg],
      },
      have h''' : 0 < (x * rat.cast α - int.nat_abs (N * rat.cast α)) * int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α)),
      {
        exact rat.mul_pos h'' (int.nat_abs_pos _),
      },
      have h''' : 0 < (x * rat.cast α - int.nat_abs (N * rat.cast α)) * rat.cast (int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α))),
      {
        rw rat.cast_lt_rat,
        exact h''',
      },
      have h'''' : x * rat.cast α - int.nat_abs (N * rat.cast α) < rat.cast (int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α))),
      {
        rw [int.nat_abs_of_nonneg (int.le_of_lt h''), ← sub_eq_add_neg],
        exact rat.sub_lt_sub_right h''' _,
      },
      have h'''' : x * rat.cast α - int.nat_abs (N * rat.cast α) - rat.cast (int.nat_abs (x * rat.cast α - int.nat_abs (N * rat.cast α))) < 0,
      {
        rw [← rat.cast_sub, ← rat.cast_sub],
        exact rat.sub_lt_sub_left h'''' _,
      },
      have h''''' : 0 < x * rat.cast α - int.nat_abs (N * rat.cast α) - (x * rat.cast α - int.nat_abs (N * rat.cast α)),
      {
        rw [← int.coe_nat_zero, ← int.coe_nat_sub, ← rat.cast_sub],
        exact rat.sub_pos.2 h'''',
      },
      have h''''' : (x * rat.cast α - int.nat_abs (N * rat.cast α)) * 0 < 0,
      {
        exact rat.mul_lt_mul_of_pos_left h''''' (int.coe_nat_pos _),
      },
      have h''''' : 0 < 0,
      {
        rw [int.nat_abs_zero, rat.cast_zero, rat.cast_sub, rat.sub_eq_zero_iff_eq] at h''''',
        exact h''''',
      },
      exact int.lt_irrefl _ h''''',
    },

    {
      rw [← int.to_rat_mul, ← rat.cast_coe_int, ← int.to_rat_mul] at h,
      apply int.lt_of_add_one_le_iff.2,
      apply int.le_of_lt_add_one,
      intros a ha,
      have h' : a * rat.cast α < 0,
      {
        have : a * rat.cast α ≤ x * rat.cast α := rat.mul_le_mul_of_nonneg_left (le_of_lt ha) (rat.cast_nonneg _),
        linarith,
      },
      have h'' : int.nat_abs (a * rat.cast α) = 0,
      {
        have h''' : 0 < int.nat_abs (a * rat.cast α),
        {
          rw int.nat_abs_of_nonneg (le_of_lt h'),
          exact h',
        },
        linarith,
      },
      rw [int.nat_abs_of_nonneg (le_of_lt ha), sub_eq_zero, ← int.to_rat_mul, ← rat.cast_coe_int, ← int.to_rat_mul] at h'',
      rw [← int.to_rat_mul, ← rat.cast_coe_int, ← int.to_rat_mul] at h'',

      have h''' := int.lt_of_add_one_le_iff.1 (int.coe_nat_le_coe_nat.2 ha),
      rw [← int.coe_nat_add, sub_eq_zero, int.coe_nat_sub, sub_eq_zero, ← int.to_rat_mul, ← rat.cast_coe_int,
          ← int.to_rat_mul] at h''',
      rw [← int.to_rat_mul, ← rat.cast_coe_int, ← int.to_rat_mul, rat.cast_lt_rat] at h''',
      linarith,
    },
  },
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h_nonempty : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    begin
      assume (i j : ℤ) h_neq,
      have h_1 : (α * ↑i - (int.fract (α * ↑i))) = int.fract (α * ↑i),
      {
        have h_2 := int.fract_val (α * ↑i),
        rw h_2,
        rw int.fract_val,
        ring,
      },
      have h_3 : (α * ↑j - (int.fract (α * ↑j))) = int.fract (α * ↑j),
      {
        have h_4 := int.fract_val (α * ↑j),
        rw h_4,
        rw int.fract_val,
        ring,
      },
      have h_5 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from rat.eq_iff_mul_eq_mul_left_iff.mp (int.eq_iff_modeq_nat_int.mp h_neq),
      have h_6 : (i - j) ≠ (0 : ℤ), from assume h_absurd, h_neq (one_mul i - one_mul j),
      have h_7 : (i - j) ≠ (0 : ℕ), from int.coe_nat_ne_zero_iff_ne_zero.mp h_6,
      have h_8 : (i - j) ≠ (0 : ℚ), from
        begin
          have h_9 : (0 : ℤ) ≠ (i - j), from assume h_absurd, h_neq (i - j),
          rw int.eq_zero_iff_nat_abs_eq_zero,
          rw nat.eq_zero_iff_zero at h_9,
          rw nat.eq_zero_iff_zero at h_9,
          exact h_9,
        end,
      rw rat.div_eq_iff_mul_eq h_8 at h_5,
      rw ← h_1 at h_5,
      rw ← h_3 at h_5,
      rw ← rat.cast_val at h_5,
      have h_10 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ≠ (0 : ℤ), from assume h_absurd, h_neq (int.fract (α * ↑i) - int.fract (α * ↑j)),
      have h_11 :
        (int.fract (α * ↑i) - int.fract (α * ↑j)) ≠ (0 : ℤ),
        from nat.cast_ne_zero.mp h_10,
      have h_12 : (int.fract (α * ↑i) - int.fract (α * ↑j)) ≠ (0 : ℚ), from
        begin
          have h_13 : (0 : ℤ) ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)), from assume h_absurd, h_neq (int.fract (α * ↑i) - int.fract (α * ↑j)),
          rw int.eq_zero_iff_nat_abs_eq_zero,
          rw nat.eq_zero_iff_zero at h_13,
          rw nat.eq_zero_iff_zero at h_13,
          exact h_13,
        end,
      rw rat.cast_ne_zero_iff at h_12,
      exact h_12 h_5,
    end,

  have h_seq_limit : ∀ (i : ℤ), seq_limit (λ (n : ℕ), int.fract (α * ↑(i + n))) 0, from
    begin
      assume i,
      assume ε : ℝ,
      assume h1 : (ε > 0),
      have h2 : (2 * ε) > 0, from
        begin
          have h3 := rat.coe_lt_coe,
          have h4 := h3 ℝ ℚ ε (2 : ℝ) (rat.cast_lt.mp h1),
          rw rat.cast_one at h4,
          linarith,
        end,
      have h5 : ∃ (N : ℤ), (∀ (n : ℕ), (int.fract (α * ↑(i + n))) ≤ ((-1 : ℤ) + (1 + (2 * ε))) ∧ ((-1 : ℤ) + (1 + (2 * ε))) ≤ (int.fract (α * ↑(i + n)))), from
        begin
          use int.nat_abs ((1 + ε) / (2 * α)),
          assume n h_absurd,
          have h6 : (int.fract (α * ↑(i + n)) - (int.fract (α * ↑i))) = (int.fract (α * ↑n)), from
            begin
              rw nat.add_comm (i : ℕ),
              rw int.fract_add,
              rw int.fract_val,
              ring,
            end,
          have h7 : (α * ↑n - (int.fract (α * ↑n))) = int.fract (α * ↑n), from
            begin
              rw int.fract_val,
              ring,
            end,
          have h8 : α = (α * ↑n - (int.fract (α * ↑n))) / (n : ℕ) ,from
            begin
              have h9 : (n : ℤ) ≠ (0 : ℤ), by {linarith,},
              have h10 : (n : ℤ) ≠ (0 : ℝ), by {rw rat.cast_ne_zero_iff, exact h9,},
              rw rat.div_eq_iff_mul_eq h10,
              ring,
            end,
          have h11 : ((n : ℝ) : ℚ) ≠ (0 : ℚ), from
            begin
              have h12 : (n : ℤ) ≠ (0 : ℤ), by {linarith},
              rw rat.cast_ne_zero_iff,
              exact h12,
            end,
          rw rat.div_eq_iff_mul_eq h11 at h8,
          rw h7 at h8,
          rw ← h6 at h8,
          have h13 : (α * ↑(i + n) - (int.fract (α * ↑i))) = (int.fract (α * ↑n)), from
            begin
              rw nat.add_comm (i : ℕ),
              rw int.fract_add,
              rw int.fract_val,
              ring,
            end,
          rw h7 at h13,
          rw ← h13 at h8,
          have h14 : (int.fract (α * ↑n) < ((1 + (2 * ε)) : ℝ)), from
            begin
              have h15 : (int.fract (α * ↑n) - (1 + (2 * ε))) < (0 : ℝ), from by {linarith},
              have h16 : (0 : ℝ) - (0 : ℝ) < (int.fract (α * ↑n) - (1 + (2 * ε))), from by {linarith},
              rw zero_sub at h16,
              exact h16,
            end,
          have h17 : ((-1) : ℤ) ≤ (int.fract (α * ↑n)), from by {linarith},
          have h18 : (int.fract (α * ↑n)) ≤ ((1 + (2 * ε)) : ℝ), from by {linarith,},
          split, exact h17, exact h
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
  split,

  {
    show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ) ⊆ Icc 0 1,
    by {
      assume y (h1 : (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' {y} ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) ⁻¹' {y}),
      have h2_exists : ∃ m : ℤ, (λ (m : ℤ), int.fract (α * ↑m)) m = y, from
        exists_mem_of_ne_empty h1,
      cases h2_exists with m h2, rw h2,
      rw int.fract_mul,
      rw int.fract_eq_iff_mod_one,
      simp, exacts [and.intro (by rw int.div_lt_iff;exacts[lt_iff_le_and_ne,zero_lt_one,hα_irrat]) (by rw int.mod_lt;exact one_pos)],
    },
  },

  {
    show Icc 0 1 ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ),
    by {
      assume y (h : y ∈ Icc 0 1),
      cases h with h1 h2,
      have h1_pos : (0 : ℤ) < 1, from zero_lt_one,

      have h2_dense : ∀ ε : ℝ, 0 < ε → ∃ (m : ℤ), ((int.fract (α * ↑m)) - y)^2 < ε,
      from begin
        assume ε h2,
        have h3 : 0 < ε^2, from by {rw pow, linarith},
        have h4 : (ε^2) / 2 = ε / 2 * ε, from by {rw ← pow, linarith},
        have h4_pos : 0 < ε / 2, from by {rw ← h4, linarith},
        have h5 : 2 < ε^2, from by {rw pow, linarith},

        have h6 : 0 < y, from by {contradiction, linarith},
        have h7 : 0 < 1 - y, from by {rw sub_pos_iff, linarith},
        have h8 : 0 < min y (1 - y), from by {apply min_pos, exacts [h6,h7]},

        have h9 : ∃ a : ℤ, 1 - y < (α * ↑a - y)^2 ∧ (α * ↑a - y)^2 < ε,
        from begin
          have h10 : ∃ a : ℤ, (α * ↑a - y)^2 < ε, by {
            apply limit_theorem_irrational_squared_distance,
            exact hα_irrat,
            exact h5,
          },
          cases h10 with a h10,
          have h10_pos : 0 < (α * ↑a - y)^2, from by {rw pow, linarith},
          have h11 : ∃ a : ℤ, 1 - y < (α * ↑a - y)^2, from by {
            apply limit_theorem_irrational_squared_distance,
            exact hα_irrat,
            exact h3,
          },
          cases h11 with a1 h11,

          existsi max a a1,
          split,
          {
            apply lt_of_le_of_lt,
            apply lt_of_lt_of_le,
            apply int.cast_lt,
            exact le_max_left _ _,
            exact h11,
          },
          {
            apply lt_of_lt_of_le,
            apply lt_of_lt_of_le,
            apply int.cast_lt,
            exact le_max_right _ _,
            exact h10,
          },
        end,

        cases h9 with a h9,

        existsi a,
        rw pow_two,
        rw pow_two,
        rw sub_sub,
        rw ← subsingleton.elim (int.cast_inj.mp (le_antisymm (int.cast_lt.mp (by linarith)) (int.cast_lt.mp (le_max_left _ _)))),
        rw ← subsingleton.elim (int.cast_inj.mp (le_antisymm (int.cast_lt.mp (by linarith)) (int.cast_lt.mp (le_max_right _ _)))),
        rw int.fract_mul,
        rw int.fract_eq_iff_mod_one,
        rw int.mod_lt,
        rw pow_two,
        rw pow_two,
        rw sub_sub,
        linarith,
        linarith,
        exact one_pos,
        exact one_pos,
        exact hα_irrat,
        exact hα_irrat,
        rw pow,
        linarith,
      end,

      have h3 : ∃ (m : ℤ), ((int.fract (α * ↑m)) - y)^2 < (ε / 2)^2, from
        @squeeze_theorem_real_numbers ℤ ((λ (m : ℤ), int.fract (α * ↑m)) - y) 0 ((ε / 2)^2)
        (by rw sub_zero),
      cases h3 with m h3,
      have h4 : 0 < (ε / 2)^2, from by {rw pow, linarith},
      have h5 : ((int.fract (α * ↑m)) - y)^2 < ε / 2, from by {rw ← pow, linarith},
      have h6 : y < int.fract (α * ↑m) + ε / 2, by {linarith},
      existsi m,
      split,
      {
        have h7 : int.fract (α * ↑m) - ε / 2 ≤ int.fract (α * ↑m), from by {linarith},
        rw ← sub_sub,
        rw ← sub_sub,
        rw ← sub_sub,
        rw sub_sub_self,
        apply lt_of_le_of_lt,
        exact h7,
        exact h6,
      },
      {
        have h7 : int.fract (α * ↑m) + ε / 2 < 1, from int.fract_lt_one_of_ne_zero (by linarith),
        rw ← sub_sub,
        apply lt_of_lt_of_le,
        exact h6,
        exact h7,
      },
    },
  },
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    by {
      intros i j hi,
      rw int.fract_eq_iff.1,
      intro h2,
      have h2_rat := @rat.cast_inj ℤ _ _ _ _,
      rw [int.cast_inj, int.cast_inj] at h2_rat,
      have h3 := h2_rat
        ((int.cast α)/(int.cast i))
        ((int.cast α)/(int.cast j)),
      rw [h2,h2] at h3,
      have h4 := h1,
      apply hi h4,
    },

  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    by {
      intros i j hi,
      rw int.fract_eq_iff.1,
      intro h2,
      have h2_rat := @rat.cast_inj ℤ _ _ _ _,
      rw [int.cast_inj, int.cast_inj] at h2_rat,
      have h3 := h2_rat
        ((int.cast α)/(int.cast i))
        ((int.cast α)/(int.cast j)),
      rw [h2,h2] at h3,
      have h4 := h3.trans (by {ring at h3, exact h3}),
      have h5 : int.cast i = 0, from h4.right.right,
      have h6 : int.cast j = 0, from h4.left.right,
      have h7 : i = 0, from congr_arg int.fract h5,
      have h8 : j = 0, from congr_arg int.fract h6,
      have h9 : i = j, by {rw [h7,h8]},
      apply hi h9,
    },

  have h2 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m)) * (int.fract (α * ↑n)) ≠ 0, from
    by {
      intros m n h,
      rw int.fract_eq_iff.1,
      intro h2,
      have h3 := int.cast_inj α,
      rw h3,
      have h4 := int.cast_inj m,
      have h5 := int.cast_inj n,
      have h6 := int.cast_mul m n,
      have h7 := int.cast_mul α α,
      rw [h4,h5,h6,h7,mul_assoc,h2] at h3,
      have h8 := @rat.cast_inj ℤ _ _ _ _,
      have h9 := h8 _ _ h3,
      have h10 := rat.mul_self_inj (int.cast α),
      rw [←rat.mul_div_assoc,h2,rat.one_mul,rat.div_one,rat.one_mul,rat.div_one,rat.mul_one] at h10,
      apply h10 h9,
    },

  have h2 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m)) * (int.fract (α * ↑n)) ≠ 0, from
    by {
      intros m n hn,
      rw int.fract_eq_iff.1,
      intro h,
      have h1 := int.cast_inj α,
      have h2 := int.cast_inj m,
      have h3 := int.cast_inj n,
      have h4 := int.cast_mul m n,
      have h5 := int.cast_mul α α,
      rw [h2,h3,h4,h5,mul_assoc,h,mul_assoc] at h1,
      have h6 : (int.cast α) * ((int.cast m) * (int.cast n)) = ((int.cast α) * (int.cast α)) * (int.cast m), from by {
        rw h1, ring,
      },
      have h7 := @rat.cast_inj ℤ _ _ _ _,
      have h8 := h7 _ _ h6,
      have h9 := rat.mul_self_inj (int.cast α),
      rw [←rat.mul_div_assoc,h,rat.one_mul,rat.div_one,rat.one_mul,rat.div_one,rat.mul_one] at h9,
      apply h9 h8,
    },

  have h3 : ∀ n : ℤ, n ≠ 0 → rat.mk n 1 ≠ (int.cast α) * ((int.cast n) * (int.cast n)),
  begin
    assume (n : ℤ) (hn : n ≠ 0),
    rw rat.mk_eq_div,
    rw int.cast_inj,
    have h1 := int.cast_inj α,
    have h2 := int.cast_inj n,
    have h3 := int.cast_mul n n,
    have h4 := int.cast_mul α n,
    rw [h2,h3,h4,mul_assoc,mul_assoc,mul_assoc,h1] at hn,
    rw [mul_comm,mul_comm] at hn,
    intro h,
    cases h with h1 h2,
    rw [h1,h2,rat.mul_div_cancel] at hn,
    have h5 : int.cast n = 0, from hn,
    rw h5 at h1,
    have h6 : n = 0, from congr_arg int.fract h1,
    have h7 : n ≠ n, from h6.symm ▸ hn,
    apply h7,
    end,

  have h3 : ∀ n : ℤ, n ≠ 0 → rat.mk n 1 ≠ (int.cast α) * ((int.cast n) * (int.cast n)), from
    by {
      assume (n : ℤ) (hn : n ≠ 0),
      rw rat.mk_eq_div,
      rw int.cast_inj,
      have h1 := int.cast_inj α,
      have h2 := int.cast_inj n,
      have h3 := int.cast_mul n n,
      have h4 := int.cast_mul α n,
      rw [h2,h3,h4,mul_assoc,mul_assoc,mul_assoc,h1] at hn,
      rw [mul_comm,mul_comm] at hn,
      intro h,
      cases h with h1 h2,
      rw [h1,h2,rat.mul_div_cancel] at hn,
      have h5 : int.cast n = 0, from hn,
      rw h5 at h1,
      have h6 : n = 0, from congr_arg int.fract h1,
      have h7 : n ≠ n, from h6.symm ▸ hn,
      apply h7,
    },

  have h4 : ∀ m n : ℤ, m ≠ n → (int.fract (α * ↑m)) * (int.fract (α * ↑n)) ≠ 0, from
    by {
      assume (m n : ℤ) (hm : m ≠ n),
      cases m with m,
      exfalso,
      apply hm (int.coe_nat_zero),
      cases n with n,
      exfalso, rw eq_comm at hm, apply hm (int.coe_nat_zero).symm,

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
  unfold irrational at hα_irrat,
  assume ε : ℝ,
  assume (h1 : 0 ≤ ε) (h2 : ε < 1),
  have εpos : ε > 0, from lt_of_lt_of_le h2 h1,

  have h3 : ∃ q ∈ ℚ, ε < q, from
  begin
    apply exists_lt_rat,
    exact ε,
  end,
  rcases h3 with ⟨q1, h4, h5⟩,
  note h6 := hα_irrat q1 h4,
  let q2 := min q1 1,
  have h7 : q1 ≥ q2, from min_le_left,
  let N := ceil ((q2 - ε) / α),
  have h7 : N ∈ ℕ, from nat.mem_coe.2 (le_ceil ((q2 - ε) / α)),
  let m : ℤ := N,
  have h8 : α * ↑m = α * (↑N : ℝ), from by rw mul_comm,
  have h9 : 0 ≤ α * ↑N, from zero_le_mul (nat.cast_nonneg.2 h7) (irrational.nonneg hα_irrat),
  have h10 : α * ↑N ≤ (q1 - ε), from le_of_lt (sub_lt_iff_lt_add'.2 h5),
  let αNε : ℝ := (α * ↑N) + ε,
  have h11 : (αNε : ℝ) ∈ set.univ, from
  begin
    change ((αNε : ℝ) ∈ set.univ),
    suffices h12 : αNε ∈ ℝ,
      from ⟨h12, rfl⟩,
    split,
    exact h9,
    exact h10,
  end,
  have h12 : (αNε : ℝ) = α * ↑N + ε, from rfl,
  have h13 : (0 : ℝ) ≤ α * ↑N + ε, from calc
    0 ≤ α * ↑N : add_nonneg h9 (by {linarith; from trivial})
    ... ≤ α * ↑N + ε : add_le_add_left h10 (by {linarith; from trivial}),
  have h14 : α * ↑N + ε ≤ 1, from calc
    α * ↑N + ε ≤ q2 : add_le_add_right h10 (by {linarith; from trivial})
    ... ≤ 1 : add_le_add_right (by {linarith; from trivial}) (by {linarith; from trivial}),
  have h15 : (αNε : ℝ) ∈ set.Icc 0 1, from ⟨h13, h14⟩,
  have h16 : (αNε : ℝ) ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
    from set.mem_closure_of_mem (set.mem_image_of_mem αNε h11) (by {linarith; from trivial}),
  have h17 : ∃ x ∈ set.Icc 0 1, ∀ y : ℝ, y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) → ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ abs (x - y) < b,
  from set.mem_of_closure_of_mem h16 (by {linarith; from trivial}),
  have h18 : ∃ x : ℝ, x ∈ set.Icc 0 1 ∧ ∀ y : ℝ, y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) → ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ abs (x - y) < b, from exists_prop h17,
  have h19 : ∃ x : ℝ, x ∈ set.Icc 0 1 ∧
    ∀ y : ℝ, ∃ b : ℝ, (y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ (b > 0 ∧ b < ε) ∧ abs (x - y) < b, from exists_prop h18,
  have h20 : ∃ x : ℝ, x ∈ set.Icc 0 1 ∧
    ∀ y : ℝ, ∃ b : ℝ, (y ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ (b > 0 ∧ b < ε) ∧ abs (x - y) < b, from exists_prop h19,
  have h21 : (αNε : ℝ) ∈ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from
  begin
    change ((αNε : ℝ) ∈ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ))),
    apply exists.intro m,
    split,
    exact h11,
    rw ← h12,
    rw ← h8,
    exact rfl,
  end,
  have h22 : ∃ b : ℝ, ((αNε : ℝ) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ (b > 0 ∧ b < ε) ∧ abs (αNε - αNε) < b, from h20 αNε h15 h21,
  have h23 : ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ abs (αNε - αNε) < b, from exists_prop h22,
  have h24 : ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ (abs (αNε - αNε) < b), from exists_prop h23,
  have h25 : ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ (abs (αNε - αNε) < b), from exists_prop h24,
  have h26 : ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ (abs (αNε - αNε) < b), from exists_prop h25,
  have h27 : αNε - αNε = 0, from calc
    αNε - αNε = α* ↑N + ε - α* ↑N - ε : by rw [h12, h12]
    ... = 0 : by ring,
  have h28 : abs (0 : ℝ) = 0, from dec_trivial,
  have h29 : ∃ b : ℝ, (b > 0 ∧ b < ε) ∧ (abs (αNε - αNε) < b),
    from eq.symm (h28 (αNε - αNε)) ▸ h26,
  have h30 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h29,
  have h31 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h30,
  have h32 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h31,
  have h33 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h32,
  have h34 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h33,
  have h35 : ∃ b : ℝ, b > 0 ∧ b < ε, from exists_prop h34,
  have h36 :
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 : ∀ (m n : ℤ), m ≠ n → (α * ↑ m) % 1 ≠ (α * ↑ n) % 1 := by
  {
    assume (m n : ℤ) (hne : m ≠ n),
    have h2 : (α * ↑ m) % 1 = (α * ↑ n) % 1 ↔ (α * ↑ m - (α * ↑ m) % 1) = (α * ↑ n - (α * ↑ n) % 1), from
    by {
      rw [←int.fract_eq_iff_eq_or_lt α, ←int.fract_eq_iff_eq_or_lt (α * ↑ m), ←int.fract_eq_iff_eq_or_lt (α * ↑ n),
      int.fract_add_int_eq_add_int_fract (α * ↑ m) (α * ↑ n)] },

    have h3 : (α * ↑ m) % 1 = (α * ↑ n) % 1 ↔ (α * ↑ m) = (α * ↑ n), from
    by {
      rw [h2, int.fract_eq_iff_eq_or_lt (α * ↑ m), int.fract_eq_iff_eq_or_lt (α * ↑ n)],
      rw [←int.fract_add_int_eq_add_int_fract (α * ↑ m) (α * ↑ n), int.fract_add_int_eq_add_int_fract (α * ↑ m) (α * ↑ n)],
      split,
      rintro ⟨rfl,rfl⟩,
      rintro rfl,
      split; linarith,
    },
    have hn : (α * ↑ m) = (α * ↑ n) → m = n, from
    by {
      assume h4 : (α * ↑ m) = (α * ↑ n) ,
      rw [(left_distrib α ↑ m ↑ n), (left_distrib α ↑ m ↑ n)] at h4,
      rw (zero_add α) at h4,
      rw (zero_add α) at h4, linarith,
    },

    exact or.resolve_left (hne) (hn (h3.mp (h2.mp h4))),
  },

  have h2 : ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1 :=
  by {
    rintro x (mx : x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))),
    have h3 : x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) := mx,
    rw[set.mem_image] at h3,
    cases h3 with m h4,
    cases h4 with h4 h4,
    rw h4,
    exact int.fract_lt_one (α * ↑m),
  },

  have h3 : ∀ x : ℝ, x ∈ set.Icc 0 1 → ∃ (N : ℕ) (y : ℤ), (N : ℝ) * x ≤ (y : ℝ) ∧ (y + 1) * x ≥ 1 := by
  {
    assume (x : ℝ) (hx : x ∈ set.Icc 0 1),
    have h4 : ∃ (N : ℕ), (N : ℝ) * x > 1 :=
    begin
      have h5 : (1 : ℝ) > ((1 : ℕ) : ℝ) * x ∨ (1 : ℝ) = ((1 : ℕ) : ℝ) * x, from classical.em (((1 : ℕ) : ℝ) * x < (1 : ℝ)),
      cases h5 with h6 h7,
      {
        use 1,
        linarith,
      },
      {
        have h8 : ((1 : ℕ) : ℝ) * x < 1 ∨ ((1 : ℕ) : ℝ) * x = 1, from (not_lt.mp h6),
        cases h8 with h9 h10,
        have h11 : (1 : ℕ) + 1 > (1 : ℝ) * x, from nat.cast_add (1 : ℕ) ▸ h9,
        use 2, linarith,
      },
    end,

    cases h4 with N h5,
    use N,

    cases x with x hx_spec,
    rw set.mem_Icc at hx, cases hx with hx1 hx2,
    have h6 : 0 ≤ x ∧ x < 1 := hx,
    have h7 : x ≤ 1 := le_of_lt h6.right,
    have h8 : ((N : ℕ) : ℝ) * x > 1, from h5,
    have h9 : ((N : ℕ) : ℝ) * x ≤ 1, from le_of_not_gt h8,
    have h10 : ((N : ℕ) : ℝ) * x < 1 + 1, from lt_of_lt_of_le h8 h7,
    have h11 : (N : ℝ) * x < ↑(nat.succ N), from lt_of_lt_of_le h10 (le_refl (1 + 1)),
    have h12 : (N : ℝ) * x ≤ ↑N := le_of_lt_succ h11,
    have h13 : (N : ℝ) * x ≤ nat.succ ↑N := nat.succ_le_succ (le_of_lt_succ h11),
    have h14 : ((N : ℕ) : ℝ) * x < ↑(nat.succ ↑N), from h13,
    have h15 : (N : ℝ) * x ≤ ↑(↑N + 1), from h13,
    have h16 : (N : ℝ) * x < ↑(↑N + 1) := lt_of_le_of_lt h15 h14,
    have h17 : (N : ℝ) * x < ↑(↑N + 1), from h16,
    have h18 : (N : ℝ) * x ≤ ↑N := le_of_not_gt h5,

    have h19 : (↑N + 1 : ℝ) > 0, from nat.cast_add (1 : ℕ) ▸ h6.left,
    have h20 : (↑N + 1 : ℝ) ≥ 0, from zero_le (↑N + 1),

    have h21 : nat.succ N > 0, from nat.cast_lt.mp h19,
    have h22 : nat.succ N ≥ 0, from zero_le (nat.succ N),

    have h23 : (↑N : ℝ) + 1 > ↑N, from nat.cast_add 1 ▸ h21,

    have h24 : (↑N : ℝ) ≤ ↑N + 1, from le_of_not_gt (not_lt_of_ge h22 (nat.succ_pos N)),

    have h25 : (N : ℝ) * x < ↑N + 1, from lt_of_le_of_lt h18 h23,
    have h26 : (N : ℝ) * x < ↑(↑N + 1), from h25,
    have h27 : (N : ℝ) * x < ↑(nat.succ ↑N), from h26,
    have h28 : (N : ℕ) * x < nat.succ ↑N, from nat.cast_lt.mpr h27,
    have h29 : (N : ℕ) * x < nat.succ ↑N, from h28,
    have h30 : (N : ℕ) * x ≤ nat.succ ↑N, from le_of_not_gt (not_lt_of_ge h22 (nat.succ_pos N)),
    have h31 :
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, (int.fract ((α * ↑i))) ≠ (int.fract ((α * ↑j))), from begin
    assume i j : ℤ,
    have h2 := hα_irrat,
    have h3 : irrational (α * ↑i), from by {rintro rfl,exact h2},
    have h4 : irrational (α * ↑j), from by {rintro rfl,exact h2},
    have h5 : (α * ↑i) = (α * ↑j) → ¬ irrational α,
    from by {
      assume h6 : (α * ↑i) = (α * ↑j),
      have h7 := eq_of_mul_eq_mul_left (α * ↑i),
      have h8 := eq_of_mul_eq_mul_left (α * ↑j),
      have h9 := @add_left_cancel ℝ (α * ↑i) (↑i) α,
      have h10 := @add_left_cancel ℝ (α * ↑j) (↑j) α,
      have h11 := calc
                    ↑i = (α * ↑i) - α : by rw [sub_eq_add_neg,sub_eq_add_neg,sub_self]
                   ... = (α * ↑j) - α : by rw [h6,sub_self]
                   ... = ↑j : by simp,

      have h12 := calc
                    ↑i - ↑j = (α * ↑i) - (α * ↑j) : by simp
                   ... = ↥α * (↑i - ↑j) : by ring,

      rw ↥α at h12,
      rw ↥α at h11,
      have h13 := eq_rat_of_mul_eq_mul_of_ne_zero h12 hα_irrat,
      rwa ↥α at h13,
    },
    have h11 :=
      calc
      (int.fract ((α * ↑i))) = (int.fract ((α * ↑i) - ↑i))
      : by rw [sub_eq_add_neg,sub_eq_add_neg,sub_self]
      ... = (int.fract ((α * ↑j) - ↑j)) : by rw [add_right_cancel (↑i) (α * ↑i) (α * ↑j),h5 h11],
    exact h11,
  end,

  have h2 : ∀ i : ℤ, (int.fract (α * ↑i)) ∈ set.Icc 0 1, from begin
    assume i : ℤ,
    have h3 := int.fract_within_Icc _ _,
    rw int.fract at h3,
    exact h3,
  end,

  have h3 : ∀ x ∈ (int.fract '' (@set.univ ℤ)), x ∈ (set.Icc 0 1), from by {
    assume (x : ℝ) (h : x ∈ (int.fract '' (@set.univ ℤ))),
    apply h2,
    exact (h.right),
  },

  have h4 : ∀ x : ℝ,  x ∈ (set.Icc 0 1) → x ∈ (int.fract '' (@set.univ ℤ)), from begin
    assume (x : ℝ) (h : x ∈ (set.Icc 0 1)),
    cases (hx : ∃ i : ℤ, x ∈ (int.fract '' (@set.range i))) with (i : ℤ) h0,
    have h1 := h0.left,
    have h2 := set.mem_range.mp h1,
    have h3 : int.fract ↑i ∈ (int.fract '' (@set.range i)), from by {exact set.mem_range.mpr ⟨i,rfl⟩,},
    have h4 := @add_left_cancel ℝ ↑i x (int.fract ↑i),
    have h5 : x = int.fract ((↑i + x) - ↑i), from by {rw [h4,sub_eq_add_neg,sub_eq_add_neg,sub_self],},
    rw ↥ℤ at h2,
    have h6 := int.fract_nonneg (↑i + x),
    have h7 := int.lt_add_one_of_fract_lt_one (↑x),
    have h8 := int.fract_lt_one (↑i + x),
    have h9 := @add_left_cancel ℝ (↑i + x) ↑i (int.fract (↑i + x)),
    have h10 := calc
                   ↑i + x = ↥(↑i + x) : by rw ↥ℤ
                  ... = ↥(↑i) + x : by simp
                  ... = (int.fract (↑i + x)) + x : by rw [↥ℤ,h9,↥ℤ,int.fract_add_int,int.fract_neg_int,int.fract_zero]
                  ... = int.fract (↑i + x) : by simp,
    cases (eq_or_lt_of_le h8) with h10 h11,
    cases h10 with h12 h13,
    have h11 : x < (1 : ℝ), from by {linarith,},
    cases h11 with h12 h13,
    have h14 : int.fract (↑i + x) = (1 : ℝ), from by {rw [↥ℤ,add_comm,h5,↥ℤ] at h10,exact h10,},
    have h15 := int.fract_add_int (↑i + x),
    have h16 := calc
                  int.fract (↑i + x) = int.fract (↑i + (int.fract (↑i + x) + x - int.fract (↑i + x))) : by rw [↥ℤ,int.fract_add_int,int.fract_add_int,h14,int.fract_int,int.fract_neg_int,int.fract_zero]
                 ... = int.fract (↑i + (1 + x - 1)) : by rw ↥ℤ

    have h17 := int.fract_lt_one (↑i + 1 + x - 1),
    have h18 := calc
                  (1 : ℝ) = int.fract (↑i + 1 + x - 1) - (0 : ℝ)  : by rw [↥ℤ,add_comm,int.fract_add_int,int.fract_add_int,h14,int.fract_int,int.fract_neg_int,int.fract_zero]
                 ... < int.fract (↑i + 1 + x - 1) : by linarith,
    have h19 := int.fract_nonneg (↑i + 1 + x - 1),
    cases (eq_or_lt_of_le h19) with h20 h21,
    cases h20 with h22 h23,
    have h24 := @add_left_cancel ℝ ↑i (1 + x - 1)
    have h25 : int.fract (↑i + 1 + x - 1) = (1 : ℝ), from by {rw [↥ℤ,add_comm,int.fract_add_int,int.fract_add_int,h14,int.fract_int,int.fract_neg_int,int.fract_zero] at h14,exact h14,},
    exact (1 : ℝ),
    have h20 : int.fract (↑i + 1 + x - 1) < (1 : ℝ), from by {rw [↥ℤ,int.fract_add_int,int.fract_neg_int,int.fract_zero] at h18, exact h18,},
    exact (1 : ℝ),
    have h20 : (1 : ℝ
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  let S : set ℝ := {x | ∃ m : ℤ, x = int.fract (α * ↑m)},

  obtain ⟨δ, hδ⟩ : ∃ δ > 0, ∀ x ∈ S.Ico 0 1, ∃ y ∈ S.Ico 0 1, |x - y| < δ :=
  begin
    have hS_infinite : infinite S, from
    begin
      intros h1,
      obtain ⟨m, hm⟩ := nat.find_min h1,

      have h1 : ∀ m : ℤ, ∃ n : ℤ, α * ↑m = n, from
        by {intros m, use (m * α), simp [mul_comm],},
      obtain ⟨n, hn⟩ := h1 m,
      have h3 : (α * ↑m) = (α * ↑n), from hn,
      rw [h3, mul_left_inj hα_irrat] at hm,
      rw [hm, nat.find_min_eq_zero] at hm, simp at hm,
      exact absurd hm dec_trivial
    end,
    have hS_closed : is_closed S, from is_closed_finite_inter_Ico ⊤,
    obtain ⟨N, hN⟩ : ∃ N : ℕ, ¬ is_open (finite_inter_Ico ⊤ (insert 0 ((int.fract (α * ↑N)) : finset ℝ))),
    from mt (is_open_finite_inter_Ico ⊤) hS_infinite,
    obtain ⟨N, hN⟩ : ∃ N : ℕ, ¬ is_open (Ico 0 1 ∩ S), from (hN ⊤).elim,
    let S' : finset ℝ := insert 0 ((int.fract (α * ↑N)) : finset ℝ),
    have hS' : S ∩ Ico 0 1 ⊆ ↑S', from
    begin
      assume x hx,
      have h1 : x ∈ Ico 0 1 ∧ x ∈ S, from hx,
      have h2 : x ∈ Ico 0 1, from (h1.left),
      have h3 : x ∈ S, from (h1.right),
      have h3 : x = int.fract (α * ↑N), from (h3.elim N),
      have h4 : x = 0 ∨ x = int.fract (α * ↑N), from (eq_or_mem_insert_of_mem h3),
      simp at h4,
      exact (or.elim h4 (λ h5, (or.inl h5)) (λ h6, (or.inr h6))),
    end,
    have hS'_set : ↑S' = {x : ℝ | ∃ (t : ℤ), x = int.fract (α * ↑t) ∧ (x = 0 ∨ x = int.fract (α * ↑N))}, from
    begin
      rw [finset.coe_insert, finset.coe_singleton, finset.coe_union],
      simp,
    end,

    have hS': S' ⊆ S, from
    begin
      assume x hx,
      obtain ⟨t, ht⟩ := hx,
      have h2 : ∃ (s : ℤ), x = int.fract (α * ↑s), {
        cases ht with h3 ht,
        obtain ⟨s, hs⟩ := h3,
        use s,
        assume h, simp [h] at hs,
        exact absurd hs dec_trivial,
      },
      obtain ⟨s, hs⟩ := h2,
      use s,
      simp [hs, ht],
    end,
    obtain ⟨y, hy⟩ : ∃ y ∈ S, y ∈ (Icc 0 1), from exists_mem_of_ne_empty (ne_empty_of_mem (mem_Icc.2 ⟨zero_lt_one, dec_trivial⟩) S') (mt (is_open_Icc 0 1) hS'),
    obtain ⟨δ, hδ⟩ : ∃ δ > 0, ∀ x ∈ (Icc (y - δ) (y + δ)), x ∈ (Icc 0 1), from exists_is_open_of_mem_nhds (mem_nhds_Icc (y - δ) (y + δ)) (y - δ) (y + δ) (mem_Icc_self 0 1) (hy.right),
    use δ,
    split, exact δ,
    assume x hx, cases (hδ x), split, exact hδ_left, exact hδ_right,
  end,

  have h1 : closure S ⊆ S, from by {

    assume x h1,
    have h2 : ∀ ε > 0, ∃ y ∈ S, |x - y| < ε, from h1,
    show x ∈ S, from
    begin
      assume h3,
      have h4 : ∀ ε > 0, ∃ y ∈ S, |x - y| < ε, from h2,
      have h5 : ∃ y ∈ S, |x - y| < δ, from h4 δ,
      obtain ⟨y, hy⟩ := h5,
      have h6 : δ > 0, exact (hδ).left,
      have h6 : |x - y| < δ, from h6,
      obtain ⟨z, hz⟩ := hδ y hx,
      have h7 : (y - δ) < y, from sub_lt_self y δ,
      have h8 : (y + δ) > y, from add_lt_self y δ,
      have h9 : (y - δ) < z, from lt_of_le_of_lt (hz.left) h7,
      have h10 : z < (y + δ), from lt_of_lt_of_le h8 (hz.right),
      have h11 : z ∈ Icc (y - δ) (y + δ), from mem_Icc.2 ⟨h9, h10⟩,
      have h12 : x = z, simp [h6, h11] at hz, exact hz,
      have h13 : (x - δ) < x, from sub_lt_self x δ,
      have h14 : (x + δ) > x, from add_lt_self x δ,

      have h15 : (x - δ) < y, from lt_of_lt_of_le h13 ((mem_Ico.1 hy).left),
      have h16 : y < (x + δ), from lt_of_le_of_lt ((mem_Ico.1 hy).right) h14,
      have h17 : y ∈ Icc (x - δ) (x + δ), from mem_Icc.2 ⟨h15, h16⟩,
      have h18 := hδ x (h1 h17),
      have h19 : (x - δ) < z, from lt_of_lt_of_le (h18.left) h13,
      have h20 : z < (x + δ), from lt_of_le_of_lt h14 (h18.right),
      have h21 : z ∈ Icc (x - δ) (x + δ), from mem_Icc.2 ⟨h19, h20⟩,
      have h22 : x = z, simp [h6, h21] at hz, exact hz,
      rw h12 at h13, rw h22 at h13,
      exact absurd h13 dec_trivial,
    end
  },

  have h2 : ∀ n : ℤ, 0 ≤
end --Needs more than 2000 tokens!

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

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    rw closure_univ_eq,
    show (λ (i : ℤ), int.fract (α * i)) '' set.univ ⊆ set.Icc 0 1,
    from by {
      assume z hz,
      cases hz with x hx,
      rw ← hx,
      show int.fract (α * x) ∈ set.Icc 0 1,
      from by
      {
        have h1 : int.fract (α * x) < 1, rw [← @add_zero_dt ℤ _ _ _,mul_add,int.fract_eq_int_add_fract,add_assoc],
        exact lt_of_lt_of_le zero_lt_one h1,
        have h2 : 0 ≤ int.fract (α * x), rw [← @zero_add_dt ℤ _ _ _,add_mul,int.fract_eq_int_add_fract,add_assoc],
        exact le_of_lt h2 zero_lt_one,
      },
    },
    show set.Icc 0 1 ⊆ (λ (i : ℤ), int.fract (α * i)) '' set.univ,
    from by {
      assume z hz,
      rw ← @set.mem_univ_iff ℤ _ z,
      use z,
      split,
      swap,
      show int.fract (α * z) = z,
      rw int.fract_eq_int_add_fract, ring,
      cases hz,
      exact hz.left,
    },
end

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

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

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

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

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

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

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

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

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

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

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

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

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

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

Let $\epsilon > 0$.

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

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

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

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

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

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

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

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

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

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

Hence the result.
{{qed}}

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

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,

  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

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

  },

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

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

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

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

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

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


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.matrix.basic
import Mathlib.data.pequiv
import Mathlib.PostPort

universes u_3 u_4 v u_2 u_1

namespace Mathlib

/-
# partial equivalences for matrices

Using partial equivalences to represent matrices.
This file introduces the function `pequiv.to_matrix`, which returns a matrix containing ones and
zeros. For any partial equivalence `f`, `f.to_matrix i j = 1 ↔ f i = some j`.

The following important properties of this function are proved
`to_matrix_trans : (f.trans g).to_matrix = f.to_matrix ⬝ g.to_matrix`
`to_matrix_symm  : f.symm.to_matrix = f.to_matrixᵀ`
`to_matrix_refl : (pequiv.refl n).to_matrix = 1`
`to_matrix_bot : ⊥.to_matrix = 0`

This theory gives the matrix representation of projection linear maps, and their right inverses.
For example, the matrix `(single (0 : fin 1) (i : fin n)).to_matrix` corresponds to the the ith
projection map from R^n to R.

Any injective function `fin m → fin n` gives rise to a `pequiv`, whose matrix is the projection
map from R^m → R^n represented by the same function. The transpose of this matrix is the right
inverse of this map, sending anything not in the image to zero.

## notations

This file uses the notation ` ⬝ ` for `matrix.mul` and `ᵀ` for `matrix.transpose`.
-/

namespace pequiv

/-- `to_matrix` returns a matrix containing ones and zeros. `f.to_matrix i j` is `1` if
  `f i = some j` and `0` otherwise -/
def to_matrix {m : Type u_3} {n : Type u_4} [fintype m] [fintype n] {α : Type v} [DecidableEq n] [HasZero α] [HasOne α] (f : m ≃. n) : matrix m n α :=
  sorry

theorem mul_matrix_apply {l : Type u_2} {m : Type u_3} {n : Type u_4} [fintype l] [fintype m] [fintype n] {α : Type v} [DecidableEq m] [semiring α] (f : l ≃. m) (M : matrix m n α) (i : l) (j : n) : matrix.mul (to_matrix f) M i j = option.cases_on (coe_fn f i) 0 fun (fi : m) => M fi j := sorry

theorem to_matrix_symm {m : Type u_3} {n : Type u_4} [fintype m] [fintype n] {α : Type v} [DecidableEq m] [DecidableEq n] [HasZero α] [HasOne α] (f : m ≃. n) : to_matrix (pequiv.symm f) = matrix.transpose (to_matrix f) := sorry

@[simp] theorem to_matrix_refl {n : Type u_4} [fintype n] {α : Type v} [DecidableEq n] [HasZero α] [HasOne α] : to_matrix (pequiv.refl n) = 1 := sorry

theorem matrix_mul_apply {l : Type u_2} {m : Type u_3} {n : Type u_4} [fintype l] [fintype m] [fintype n] {α : Type v} [semiring α] [DecidableEq n] (M : matrix l m α) (f : m ≃. n) (i : l) (j : n) : matrix.mul M (to_matrix f) i j = option.cases_on (coe_fn (pequiv.symm f) j) 0 fun (fj : m) => M i fj := sorry

theorem to_pequiv_mul_matrix {m : Type u_3} {n : Type u_4} [fintype m] [fintype n] {α : Type v} [DecidableEq m] [semiring α] (f : m ≃ m) (M : matrix m n α) : matrix.mul (to_matrix (equiv.to_pequiv f)) M = fun (i : m) => M (coe_fn f i) := sorry

theorem to_matrix_trans {l : Type u_2} {m : Type u_3} {n : Type u_4} [fintype l] [fintype m] [fintype n] {α : Type v} [DecidableEq m] [DecidableEq n] [semiring α] (f : l ≃. m) (g : m ≃. n) : to_matrix (pequiv.trans f g) = matrix.mul (to_matrix f) (to_matrix g) := sorry

@[simp] theorem to_matrix_bot {m : Type u_3} {n : Type u_4} [fintype m] [fintype n] {α : Type v} [DecidableEq n] [HasZero α] [HasOne α] : to_matrix ⊥ = 0 :=
  rfl

theorem to_matrix_injective {m : Type u_3} {n : Type u_4} [fintype m] [fintype n] {α : Type v} [DecidableEq n] [monoid_with_zero α] [nontrivial α] : function.injective to_matrix := sorry

theorem to_matrix_swap {n : Type u_4} [fintype n] {α : Type v} [DecidableEq n] [ring α] (i : n) (j : n) : to_matrix (equiv.to_pequiv (equiv.swap i j)) =
  1 - to_matrix (single i i) - to_matrix (single j j) + to_matrix (single i j) + to_matrix (single j i) := sorry

@[simp] theorem single_mul_single {k : Type u_1} {m : Type u_3} {n : Type u_4} [fintype k] [fintype m] [fintype n] {α : Type v} [DecidableEq k] [DecidableEq m] [DecidableEq n] [semiring α] (a : m) (b : n) (c : k) : matrix.mul (to_matrix (single a b)) (to_matrix (single b c)) = to_matrix (single a c) := sorry

theorem single_mul_single_of_ne {k : Type u_1} {m : Type u_3} {n : Type u_4} [fintype k] [fintype m] [fintype n] {α : Type v} [DecidableEq k] [DecidableEq m] [DecidableEq n] [semiring α] {b₁ : n} {b₂ : n} (hb : b₁ ≠ b₂) (a : m) (c : k) : matrix.mul (to_matrix (single a b₁)) (to_matrix (single b₂ c)) = 0 := sorry

/-- Restatement of `single_mul_single`, which will simplify expressions in `simp` normal form,
  when associativity may otherwise need to be carefully applied. -/
@[simp] theorem single_mul_single_right {k : Type u_1} {l : Type u_2} {m : Type u_3} {n : Type u_4} [fintype k] [fintype l] [fintype m] [fintype n] {α : Type v} [DecidableEq k] [DecidableEq m] [DecidableEq n] [semiring α] (a : m) (b : n) (c : k) (M : matrix k l α) : matrix.mul (to_matrix (single a b)) (matrix.mul (to_matrix (single b c)) M) = matrix.mul (to_matrix (single a c)) M := sorry

/-- We can also define permutation matrices by permuting the rows of the identity matrix. -/
theorem equiv_to_pequiv_to_matrix {n : Type u_4} [fintype n] {α : Type v} [DecidableEq n] [HasZero α] [HasOne α] (σ : n ≃ n) (i : n) (j : n) : to_matrix (equiv.to_pequiv σ) i j = HasOne.one (coe_fn σ i) j :=
  if_congr option.some_inj rfl rfl


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.normed_space.basic

/-!
# Extended norm

In this file we define a structure `enorm 𝕜 V` representing an extended norm (i.e., a norm that can
take the value `∞`) on a vector space `V` over a normed field `𝕜`. We do not use `class` for
an `enorm` because the same space can have more than one extended norm. For example, the space of
measurable functions `f : α → ℝ` has a family of `L_p` extended norms.

We prove some basic inequalities, then define

* `emetric_space` structure on `V` corresponding to `e : enorm 𝕜 V`;
* the subspace of vectors with finite norm, called `e.finite_subspace`;
* a `normed_space` structure on this space.

The last definition is an instance because the type involves `e`.

## Implementation notes

We do not define extended normed groups. They can be added to the chain once someone will need them.

## Tags

normed space, extended norm
-/

noncomputable theory
local attribute [instance, priority 1001] classical.prop_decidable
open_locale ennreal

/-- Extended norm on a vector space. As in the case of normed spaces, we require only
`∥c • x∥ ≤ ∥c∥ * ∥x∥` in the definition, then prove an equality in `map_smul`. -/
structure enorm (𝕜 : Type*) (V : Type*) [normed_field 𝕜] [add_comm_group V] [module 𝕜 V] :=
(to_fun : V → ℝ≥0∞)
(eq_zero' : ∀ x, to_fun x = 0 → x = 0)
(map_add_le' : ∀ x y : V, to_fun (x + y) ≤ to_fun x + to_fun y)
(map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ ∥c∥₊ * to_fun x)

namespace enorm

variables {𝕜 : Type*} {V : Type*} [normed_field 𝕜] [add_comm_group V] [module 𝕜 V]
  (e : enorm 𝕜 V)

instance : has_coe_to_fun (enorm 𝕜 V) (λ _, V → ℝ≥0∞) := ⟨enorm.to_fun⟩

lemma coe_fn_injective : function.injective (coe_fn : enorm 𝕜 V → (V → ℝ≥0∞)) :=
λ e₁ e₂ h, by cases e₁; cases e₂; congr; exact h

@[ext] lemma ext {e₁ e₂ : enorm 𝕜 V} (h : ∀ x, e₁ x = e₂ x) : e₁ = e₂ :=
coe_fn_injective $ funext h

lemma ext_iff {e₁ e₂ : enorm 𝕜 V} : e₁ = e₂ ↔ ∀ x, e₁ x = e₂ x :=
⟨λ h x, h ▸ rfl, ext⟩

@[simp, norm_cast] lemma coe_inj {e₁ e₂ : enorm 𝕜 V} : (e₁ : V → ℝ≥0∞) = e₂ ↔ e₁ = e₂ :=
coe_fn_injective.eq_iff

@[simp] lemma map_smul (c : 𝕜) (x : V) : e (c • x) = ∥c∥₊ * e x :=
le_antisymm (e.map_smul_le' c x) $
begin
  by_cases hc : c = 0, { simp [hc] },
  calc (∥c∥₊ : ℝ≥0∞) * e x = ∥c∥₊ * e (c⁻¹ • c • x) : by rw [inv_smul_smul₀ hc]
  ... ≤ ∥c∥₊ * (∥c⁻¹∥₊ * e (c • x)) : _
  ... = e (c • x) : _,
  { exact ennreal.mul_le_mul le_rfl (e.map_smul_le' _ _) },
  { rw [← mul_assoc, nnnorm_inv, ennreal.coe_inv,
     ennreal.mul_inv_cancel _ ennreal.coe_ne_top, one_mul]; simp [hc] }
end

@[simp] lemma map_zero : e 0 = 0 :=
by { rw [← zero_smul 𝕜 (0:V), e.map_smul], norm_num }

@[simp] lemma eq_zero_iff {x : V} : e x = 0 ↔ x = 0 :=
⟨e.eq_zero' x, λ h, h.symm ▸ e.map_zero⟩

@[simp] lemma map_neg (x : V) : e (-x) = e x :=
calc e (-x) = ∥(-1 : 𝕜)∥₊ * e x : by rw [← map_smul, neg_one_smul]
        ... = e x               : by simp

lemma map_sub_rev (x y : V) : e (x - y) = e (y - x) :=
by rw [← neg_sub, e.map_neg]

lemma map_add_le (x y : V) : e (x + y) ≤ e x + e y := e.map_add_le' x y

lemma map_sub_le (x y : V) : e (x - y) ≤ e x + e y :=
calc e (x - y) = e (x + -y)   : by rw sub_eq_add_neg
           ... ≤ e x + e (-y) : e.map_add_le x (-y)
           ... = e x + e y    : by rw [e.map_neg]

instance : partial_order (enorm 𝕜 V) :=
{ le := λ e₁ e₂, ∀ x, e₁ x ≤ e₂ x,
  le_refl := λ e x, le_rfl,
  le_trans := λ e₁ e₂ e₃ h₁₂ h₂₃ x, le_trans (h₁₂ x) (h₂₃ x),
  le_antisymm := λ e₁ e₂ h₁₂ h₂₁, ext $ λ x, le_antisymm (h₁₂ x) (h₂₁ x) }

/-- The `enorm` sending each non-zero vector to infinity. -/
noncomputable instance : has_top (enorm 𝕜 V) :=
⟨{ to_fun := λ x, if x = 0 then 0 else ⊤,
   eq_zero' := λ x, by { split_ifs; simp [*] },
   map_add_le' := λ x y,
     begin
       split_ifs with hxy hx hy hy hx hy hy; try { simp [*] },
       simpa [hx, hy] using hxy
     end,
   map_smul_le' := λ c x,
     begin
       split_ifs with hcx hx hx; simp only [smul_eq_zero, not_or_distrib] at hcx,
       { simp only [mul_zero, le_refl] },
       { have : c = 0, by tauto,
         simp [this] },
       { tauto },
       { simp [hcx.1] }
     end }⟩

noncomputable instance : inhabited (enorm 𝕜 V) := ⟨⊤⟩

lemma top_map {x : V} (hx : x ≠ 0) : (⊤ : enorm 𝕜 V) x = ⊤ := if_neg hx

noncomputable instance : order_top (enorm 𝕜 V) :=
{ top := ⊤,
  le_top := λ e x, if h : x = 0 then by simp [h] else by simp [top_map h] }

noncomputable instance : semilattice_sup (enorm 𝕜 V) :=
{ le := (≤),
  lt := (<),
  sup := λ e₁ e₂,
  { to_fun := λ x, max (e₁ x) (e₂ x),
    eq_zero' := λ x h, e₁.eq_zero_iff.1 (ennreal.max_eq_zero_iff.1 h).1,
    map_add_le' := λ x y, max_le
      (le_trans (e₁.map_add_le _ _) $ add_le_add (le_max_left _ _) (le_max_left _ _))
      (le_trans (e₂.map_add_le _ _) $ add_le_add (le_max_right _ _) (le_max_right _ _)),
    map_smul_le' := λ c x, le_of_eq $ by simp only [map_smul, ennreal.mul_max] },
  le_sup_left := λ e₁ e₂ x, le_max_left _ _,
  le_sup_right := λ e₁ e₂ x, le_max_right _ _,
  sup_le := λ e₁ e₂ e₃ h₁ h₂ x, max_le (h₁ x) (h₂ x),
  .. enorm.partial_order }

@[simp, norm_cast]

@[norm_cast]
lemma max_map (e₁ e₂ : enorm 𝕜 V) (x : V) : (e₁ ⊔ e₂) x = max (e₁ x) (e₂ x) := rfl

/-- Structure of an `emetric_space` defined by an extended norm. -/
@[reducible] def emetric_space : emetric_space V :=
{ edist := λ x y, e (x - y),
  edist_self := λ x, by simp,
  eq_of_edist_eq_zero := λ x y, by simp [sub_eq_zero],
  edist_comm := e.map_sub_rev,
  edist_triangle := λ x y z,
    calc e (x - z) = e ((x - y) + (y - z)) : by rw [sub_add_sub_cancel]
               ... ≤ e (x - y) + e (y - z) : e.map_add_le (x - y) (y - z) }

/-- The subspace of vectors with finite enorm. -/
def finite_subspace : subspace 𝕜 V :=
{ carrier   := {x | e x < ⊤},
  zero_mem' := by simp,
  add_mem'  := λ x y hx hy, lt_of_le_of_lt (e.map_add_le x y) (ennreal.add_lt_top.2 ⟨hx, hy⟩),
  smul_mem' := λ c x (hx : _ < _),
    calc e (c • x) = ∥c∥₊ * e x : e.map_smul c x
               ... < ⊤              : ennreal.mul_lt_top ennreal.coe_ne_top hx.ne }

/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space`
to ensure that this definition agrees with `e.emetric_space`. -/
instance : metric_space e.finite_subspace :=
begin
  letI := e.emetric_space,
  refine emetric_space.to_metric_space (λ x y, _),
  change e (x - y) ≠ ⊤,
  exact ne_top_of_le_ne_top (ennreal.add_lt_top.2 ⟨x.2, y.2⟩).ne (e.map_sub_le x y)
end

lemma finite_dist_eq (x y : e.finite_subspace) : dist x y = (e (x - y)).to_real := rfl

lemma finite_edist_eq (x y : e.finite_subspace) : edist x y = e (x - y) := rfl

/-- Normed group instance on `e.finite_subspace`. -/
instance : normed_group e.finite_subspace :=
{ norm := λ x, (e x).to_real,
  dist_eq := λ x y, rfl,
  .. finite_subspace.metric_space e, .. submodule.add_comm_group _ }

lemma finite_norm_eq (x : e.finite_subspace) : ∥x∥ = (e x).to_real := rfl

/-- Normed space instance on `e.finite_subspace`. -/
instance : normed_space 𝕜 e.finite_subspace :=
{ norm_smul_le := λ c x, le_of_eq $ by simp [finite_norm_eq, ennreal.to_real_mul] }

end enorm


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.category.Frame

/-!
# The category of locales

This file defines `Locale`, the category of locales. This is the opposite of the category of frames.
-/

universes u

open category_theory opposite order topological_space

/-- The category of locales. -/
@[derive large_category] def Locale := Frameᵒᵖ

namespace Locale

instance : has_coe_to_sort Locale Type* := ⟨λ X, X.unop⟩
instance (X : Locale) : frame X := X.unop.str

/-- Construct a bundled `Locale` from a `frame`. -/
def of (α : Type*) [frame α] : Locale := op $ Frame.of α

@[simp] lemma coe_of (α : Type*) [frame α] : ↥(of α) = α := rfl

instance : inhabited Locale := ⟨of punit⟩

end Locale

/-- The forgetful functor from `Top` to `Locale` which forgets that the space has "enough points".
-/
@[simps] def Top_to_Locale : Top ⥤ Locale := Top_op_to_Frame.right_op

-- Note, `CompHaus` is too strong. We only need `t0_space`.
instance CompHaus_to_Locale.faithful : faithful (CompHaus_to_Top ⋙ Top_to_Locale.{u}) :=
⟨λ X Y f g h, by { dsimp at h, exact opens.comap_injective (quiver.hom.op_inj h) }⟩


/- This defines init and last on vectors. -/
import ..list.init
import .simplify_eq

universe variables u

namespace vector

variable {α : Type u}
variable {n : ℕ}

local infix `++`:65 := vector.append

-- Generate proof list non-null from proof length is sucessor some number
private
lemma eq_succ_implies_non_nil {l : list α} {n : ℕ} (pr : l^.length = nat.succ n) : l ≠ list.nil :=
begin
   cases l,
   all_goals {contradiction}
end

-- Return all but the last element of a vector
def init : vector α n → vector α (n-1)
| ⟨l,p⟩ := ⟨list.init l, eq.trans (list.length_init l) (congr_arg (λx, x - 1) p)⟩

-- Return last element in a non-empty vector.
def last : vector α (nat.succ n) → α
| ⟨l,p⟩ := list.last l (eq_succ_implies_non_nil p)

theorem init_append_last_self {n : ℕ} (x : vector α (nat.succ n))
: init x ++ vector.cons (last x) vector.nil = x :=
begin
  cases x with v p,
  simp [init, last, cons, nil, append, list.init_append_last_self v (eq_succ_implies_non_nil p)],
end

end vector


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

import category_theory.sites.spaces
import topology.sheaves.sheaf
import category_theory.sites.dense_subsite

/-!

# Coverings and sieves; from sheaves on sites and sheaves on spaces

In this file, we connect coverings in a topological space to sieves in the associated Grothendieck
topology, in preparation of connecting the sheaf condition on sites to the various sheaf conditions
on spaces.

We also specialize results about sheaves on sites to sheaves on spaces; we show that the inclusion
functor from a topological basis to `topological_space.opens` is cover_dense, that open maps
induce cover_preserving functors, and that open embeddings induce compatible_preserving functors.

-/

noncomputable theory

universes w v u

open category_theory topological_space

namespace Top.presheaf

variables {X : Top.{w}}

/--
Given a presieve `R` on `U`, we obtain a covering family of open sets in `X`, by taking as index
type the type of dependent pairs `(V, f)`, where `f : V ⟶ U` is in `R`.
-/
def covering_of_presieve (U : opens X) (R : presieve U) : (Σ V, {f : V ⟶ U // R f}) → opens X :=
λ f, f.1

@[simp]
lemma covering_of_presieve_apply (U : opens X) (R : presieve U) (f : Σ V, {f : V ⟶ U // R f}) :
  covering_of_presieve U R f = f.1 := rfl

namespace covering_of_presieve

variables (U : opens X) (R : presieve U)

/--
If `R` is a presieve in the grothendieck topology on `opens X`, the covering family associated to
`R` really is _covering_, i.e. the union of all open sets equals `U`.
-/
lemma supr_eq_of_mem_grothendieck (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
  supr (covering_of_presieve U R) = U :=
begin
  apply le_antisymm,
  { refine supr_le _,
    intro f,
    exact f.2.1.le, },
  intros x hxU,
  rw [opens.mem_supr],
  obtain ⟨V, iVU, ⟨W, iVW, iWU, hiWU, -⟩, hxV⟩ := hR x hxU,
  exact ⟨⟨W, ⟨iWU, hiWU⟩⟩, iVW.le hxV⟩,
end

end covering_of_presieve

/--
Given a family of opens `U : ι → opens X` and any open `Y : opens X`, we obtain a presieve
on `Y` by declaring that a morphism `f : V ⟶ Y` is a member of the presieve if and only if
there exists an index `i : ι` such that `V = U i`.
-/
def presieve_of_covering_aux {ι : Type v} (U : ι → opens X) (Y : opens X) : presieve Y :=
λ V f, ∃ i, V = U i

/-- Take `Y` to be `supr U` and obtain a presieve over `supr U`. -/
def presieve_of_covering {ι : Type v} (U : ι → opens X) : presieve (supr U) :=
presieve_of_covering_aux U (supr U)

/-- Given a presieve `R` on `Y`, if we take its associated family of opens via
    `covering_of_presieve` (which may not cover `Y` if `R` is not covering), and take
    the presieve on `Y` associated to the family of opens via `presieve_of_covering_aux`,
    then we get back the original presieve `R`. -/
@[simp] lemma covering_presieve_eq_self {Y : opens X} (R : presieve Y) :
  presieve_of_covering_aux (covering_of_presieve Y R) Y = R :=
by { ext Z f, exact ⟨λ ⟨⟨_,_,h⟩,rfl⟩, by convert h, λ h, ⟨⟨Z,f,h⟩,rfl⟩⟩ }

namespace presieve_of_covering

variables {ι : Type v} (U : ι → opens X)

/--
The sieve generated by `presieve_of_covering U` is a member of the grothendieck topology.
-/
lemma mem_grothendieck_topology :
  sieve.generate (presieve_of_covering U) ∈ opens.grothendieck_topology X (supr U) :=
begin
  intros x hx,
  obtain ⟨i, hxi⟩ := opens.mem_supr.mp hx,
  exact ⟨U i, opens.le_supr U i, ⟨U i, 𝟙 _, opens.le_supr U i, ⟨i, rfl⟩, category.id_comp _⟩, hxi⟩,
end

/--
An index `i : ι` can be turned into a dependent pair `(V, f)`, where `V` is an open set and
`f : V ⟶ supr U` is a member of `presieve_of_covering U f`.
-/
def hom_of_index (i : ι) : Σ V, {f : V ⟶ supr U // presieve_of_covering U f} :=
⟨U i, opens.le_supr U i, i, rfl⟩

/--
By using the axiom of choice, a dependent pair `(V, f)` where `f : V ⟶ supr U` is a member of
`presieve_of_covering U f` can be turned into an index `i : ι`, such that `V = U i`.
-/
def index_of_hom (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) : ι := f.2.2.some

lemma index_of_hom_spec (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) :
  f.1 = U (index_of_hom U f) := f.2.2.some_spec

end presieve_of_covering

end Top.presheaf

namespace Top.opens

variables {X : Top} {ι : Type*}

lemma cover_dense_iff_is_basis [category ι] (B : ι ⥤ opens X) :
  cover_dense (opens.grothendieck_topology X) B ↔ opens.is_basis (set.range B.obj) :=
begin
  rw opens.is_basis_iff_nbhd,
  split, intros hd U x hx, rcases hd.1 U x hx with ⟨V,f,⟨i,f₁,f₂,hc⟩,hV⟩,
  exact ⟨B.obj i, ⟨i,rfl⟩, f₁.le hV, f₂.le⟩,
  intro hb, split, intros U x hx, rcases hb hx with ⟨_,⟨i,rfl⟩,hx,hi⟩,
  exact ⟨B.obj i, ⟨⟨hi⟩⟩, ⟨⟨i, 𝟙 _, ⟨⟨hi⟩⟩, rfl⟩⟩, hx⟩,
end

lemma cover_dense_induced_functor {B : ι → opens X} (h : opens.is_basis (set.range B)) :
  cover_dense (opens.grothendieck_topology X) (induced_functor B) :=
(cover_dense_iff_is_basis _).2 h

end Top.opens

section open_embedding

open Top.presheaf opposite

variables {C : Type u} [category.{v} C]
variables {X Y : Top.{w}} {f : X ⟶ Y} {F : Y.presheaf C}

lemma open_embedding.compatible_preserving (hf : open_embedding f) :
  compatible_preserving (opens.grothendieck_topology Y) hf.is_open_map.functor :=
begin
  haveI : mono f := (Top.mono_iff_injective f).mpr hf.inj,
  apply compatible_preserving_of_downwards_closed,
  intros U V i,
  refine ⟨(opens.map f).obj V, eq_to_iso $ opens.ext $ set.image_preimage_eq_of_subset $ λ x h, _⟩,
  obtain ⟨_, _, rfl⟩ := i.le h,
  exact ⟨_, rfl⟩
end

lemma is_open_map.cover_preserving (hf : is_open_map f) :
  cover_preserving (opens.grothendieck_topology X) (opens.grothendieck_topology Y) hf.functor :=
begin
  constructor,
  rintros U S hU _ ⟨x, hx, rfl⟩,
  obtain ⟨V, i, hV, hxV⟩ := hU x hx,
  exact ⟨_, hf.functor.map i, ⟨_, i, 𝟙 _, hV, rfl⟩, set.mem_image_of_mem f hxV⟩
end

lemma Top.presheaf.is_sheaf_of_open_embedding (h : open_embedding f)
  (hF : F.is_sheaf) : is_sheaf (h.is_open_map.functor.op ⋙ F) :=
pullback_is_sheaf_of_cover_preserving h.compatible_preserving h.is_open_map.cover_preserving ⟨_, hF⟩

end open_embedding

namespace Top.sheaf

open Top opposite

variables {C : Type u} [category.{v} C]
variables {X : Top.{w}} {ι : Type*} {B : ι → opens X}
variables (F : X.presheaf C) (F' : sheaf C X) (h : opens.is_basis (set.range B))

/-- The empty component of a sheaf is terminal -/
def is_terminal_of_empty (F : sheaf C X) : limits.is_terminal (F.val.obj (op ⊥)) :=
F.is_terminal_of_bot_cover ⊥ (by tidy)

/-- A variant of `is_terminal_of_empty` that is easier to `apply`. -/
def is_terminal_of_eq_empty (F : X.sheaf C) {U : opens X} (h : U = ⊥) :
  limits.is_terminal (F.val.obj (op U)) :=
by convert F.is_terminal_of_empty

/-- If a family `B` of open sets forms a basis of the topology on `X`, and if `F'`
    is a sheaf on `X`, then a homomorphism between a presheaf `F` on `X` and `F'`
    is equivalent to a homomorphism between their restrictions to the indexing type
    `ι` of `B`, with the induced category structure on `ι`. -/
def restrict_hom_equiv_hom :
  ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1) ≃ (F ⟶ F'.1) :=
@cover_dense.restrict_hom_equiv_hom _ _ _ _ _ _ _ _ (opens.cover_dense_induced_functor h)
  _ F F'

@[simp] lemma extend_hom_app (α : ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1))
  (i : ι) : (restrict_hom_equiv_hom F F' h α).app (op (B i)) = α.app (op i) :=
by { nth_rewrite 1 ← (restrict_hom_equiv_hom F F' h).left_inv α, refl }

include h
lemma hom_ext {α β : F ⟶ F'.1} (he : ∀ i, α.app (op (B i)) = β.app (op (B i))) : α = β :=
by { apply (restrict_hom_equiv_hom F F' h).symm.injective, ext i, exact he i.unop }

end Top.sheaf


import measure_theory.integral_eq_improper
import analysis.special_functions.exp_log
import analysis.special_functions.trigonometric
import analysis.calculus.parametric_integral
import topology.uniform_space.compact_separated

noncomputable theory

open interval_integral set filter measure_theory
open_locale topological_space

def f : ℝ → ℝ := λ x, ∫ t in 0..x, real.exp (-t^2)

def g : ℝ → ℝ := λ x, ∫ t in 0..1, (real.exp (-(1+t^2)*x^2))/(1+t^2)

def h : ℝ → ℝ := λ x, g x + (f^2) x

lemma is_const_of_deriv_eq_zero {F : Type*}
  [normed_group F] [normed_space ℝ F] {f : ℝ → F} (hf : differentiable ℝ f)
  (hz : ∀ x, deriv f x = 0) : ∀ x y, f x = f y :=
begin
  apply is_const_of_fderiv_eq_zero hf (λ x, _),
  rw [← deriv_fderiv, hz x],
  ext u,
  simp
end

lemma exists_has_deriv_at_eq_slope_interval (f f' : ℝ → ℝ) {a b : ℝ}
  (hab : a ≠ b) (hf : continuous_on f (interval a b))
  (hff' : ∀ (x : ℝ), x ∈ Ioo (min a b) (max a b) → has_deriv_at f (f' x) x) :
  (∃ (c : ℝ) (H : c ∈ Ioo (min a b) (max a b)), f' c = (f b - f a) / (b - a)) :=
begin
  by_cases hlt : a < b;
  [skip, have hlt : b < a := lt_of_le_of_ne (le_of_not_lt hlt) hab.symm];
  rw interval at *;
  [rw min_eq_left_of_lt hlt at *, rw min_eq_right_of_lt hlt at *];
  [rw max_eq_right_of_lt hlt at *, rw max_eq_left_of_lt hlt at *];
  convert exists_has_deriv_at_eq_slope f f' hlt hf hff',
  conv in (_ / _) { rw [← neg_div_neg_eq, neg_sub, neg_sub] }
end

lemma has_deriv_at_parametric {a b : ℝ} (hab : a < b) (f f' : ℝ → ℝ → ℝ)
  (hff' : ∀ x t, has_deriv_at (λ u, f u t) (f' x t) x)
  (hf : continuous ↿f) (hf' : continuous ↿f') (x₀ : ℝ) :
has_deriv_at (λ x, ∫ t in a..b, f x t) (∫ t in a..b, f' x₀ t) x₀ :=
begin
  refine has_deriv_within_at.has_deriv_at _ (Icc_mem_nhds (sub_one_lt x₀) (lt_add_one x₀)),
  have compact_ab : is_compact (interval a b) := is_compact_Icc,
  have compact_cd : is_compact (Icc (x₀-1) (x₀+1)) := is_compact_Icc,
  have := (compact_cd.prod compact_ab).uniform_continuous_on_of_continuous hf'.continuous_on,
  rw [has_deriv_within_at_iff_tendsto_slope, metric.tendsto_nhds_within_nhds],
  intros ε hε,
  rw metric.uniform_continuous_on_iff at this,
  specialize this ((ε/2)/(b-a)) (div_pos (by linarith) (by linarith)),
  rcases this with ⟨δ, hδ, this⟩,
  use [δ, hδ],
  rintros y₀ ⟨⟨hy₁, hy₂⟩, hy₃ : y₀ ≠ x₀⟩ hy₀x₀,
  have key₁ := λ (t : ℝ), exists_has_deriv_at_eq_slope_interval (λ x, f x t) (λ x, f' x t) hy₃.symm
    (@continuous_uncurry_right _ _ _ _ _ _ f t hf).continuous_on (λ x hx, hff' x t),
  choose u hu using key₁,
  have key₂ : ∀ t, dist (u t) x₀ < δ,
  { intro t,
    rw [real.dist_eq, abs, max_lt_iff] at ⊢ hy₀x₀,
    rcases hu t with ⟨⟨ht₁, ht₂⟩, _⟩,
    by_cases hl : x₀ < y₀;
    [skip, push_neg at hl];
    [rw min_eq_left_of_lt hl at ht₁, rw min_eq_right hl at ht₁];
    [rw max_eq_right_of_lt hl at ht₂, rw max_eq_left hl at ht₂];
    split;
    linarith },
  have key₃ : Ioo (min x₀ y₀) (max x₀ y₀) ⊆ Icc (x₀-1) (x₀+1),
  { by_cases hl : x₀ < y₀;
    [skip, push_neg at hl];
    [rw min_eq_left_of_lt hl, rw min_eq_right hl];
    [rw max_eq_right_of_lt hl, rw max_eq_left hl];
    rintros a ⟨ha₁, ha₂⟩;
    split;
    linarith },
  have key₄ : ∀ x, continuous (f x) := λ x, @continuous_uncurry_left _ _ _ _ _ _ f x hf,
  have key₅ : continuous (λ (t : ℝ), (y₀ - x₀)⁻¹ * (f y₀ t - f x₀ t)) :=
    continuous_const.mul ((key₄ y₀).sub (key₄ x₀)),
  have key₅' : continuous (λ (t : ℝ), (y₀ - x₀)⁻¹ • (f y₀ t - f x₀ t)) := key₅,
  have key₆ : continuous (λ (t : ℝ), f' (u t) t),
  { convert key₅,
    ext t,
    rw [(hu t).2, div_eq_mul_inv, mul_comm] },
  rw [← integral_sub ((key₄ y₀).interval_integrable _ _) ((key₄ x₀).interval_integrable _ _),
      ← interval_integral.integral_smul, real.dist_eq,
      ← integral_sub (key₅'.interval_integrable _ _)
        ((@continuous_uncurry_left _ _ _ _ _ _ f' x₀ hf').interval_integrable _ _)],
  conv in (_ • _)
  { dsimp, rw ← div_eq_inv_mul, rw ← (hu _).2 },
  calc abs (∫ (t : ℝ) in a..b, f' (u t) t - f' x₀ t)
      ≤ abs (∫ (t : ℝ) in a..b, abs (f' (u t) t - f' x₀ t)) :
        by rw ← real.norm_eq_abs; exact norm_integral_le_abs_integral_norm
  ... = abs (∫ (t : ℝ) in Ioc a b, abs (f' (u t) t - f' x₀ t)) :
        by repeat {conv in (interval_integral _ _ _ _) { rw integral_of_le hab.le }}
  ... = (∫ (t : ℝ) in Ioc a b, abs (f' (u t) t - f' x₀ t)) :
        by rw abs_eq_self; exact integral_nonneg (λ x, abs_nonneg _)
  ... ≤ (∫ (t : ℝ) in Ioc a b, (ε/2)/(b-a)) :
        begin
          have meas_ab : measurable_set (Ioc a b) := measurable_set_Ioc,
          rw ← integral_indicator meas_ab,
          rw ← integral_indicator meas_ab,
          refine integral_mono _ _ (λ t, _),
          { rw integrable_indicator_iff meas_ab,
            refine ((continuous_abs.comp _).integrable_on_compact is_compact_Icc).mono_set Ioc_subset_Icc_self,
            refine key₆.sub (@continuous_uncurry_left _ _ _ _ _ _ f' x₀ hf') },
          { rw integrable_indicator_iff meas_ab,
            refine (continuous.integrable_on_compact compact_Icc _).mono_set Ioc_subset_Icc_self,
            simp only [continuous_const]},
          by_cases ht : t ∈ Ioc a b,
          { have := le_of_lt (this (u t, t) (x₀, t) _ _ _),
            { simpa only [ht, indicator_of_mem] using this},
            { refine ⟨key₃ (hu t).1, Icc_subset_interval $ Ioc_subset_Icc_self ht⟩, },
            { exact ⟨⟨(sub_one_lt x₀).le, (lt_add_one x₀).le⟩,
                Icc_subset_interval $ Ioc_subset_Icc_self ht⟩ },
            { rw [prod.dist_eq, max_lt_iff],
              refine ⟨key₂ t, (dist_self t).symm ▸ hδ⟩ } },
          { simp only [ht, indicator_of_not_mem, not_false_iff]},
        end
  ... = (b-a) * (ε/2/(b-a)) :
        by rw [set_integral_const, real.volume_Ioc,
               ennreal.to_real_of_real (show 0 ≤ b - a, by linarith),
               smul_eq_mul]
  ... = ε/2 : mul_div_cancel' (ε/2) (show b - a ≠ 0, by linarith)
  ... < ε : by linarith [hε],
  all_goals {apply_instance}
end

lemma continuous_gauss : continuous (λ x, real.exp (-x^2)) := by continuity; exact complex.continuous_exp

lemma has_deriv_at_f (x : ℝ) : has_deriv_at f (real.exp (-x^2)) x :=
integral_has_deriv_at_right (continuous_gauss.interval_integrable _ _)
  continuous_gauss.measurable.measurable_at_filter continuous_gauss.continuous_at

lemma has_deriv_at_f_square (x : ℝ) : has_deriv_at (f^2) (2 * real.exp (-x^2) * ∫ t in 0..x, real.exp (-t^2)) x :=
begin
  convert has_deriv_at.comp x (has_deriv_at_pow 2 _) (has_deriv_at_f x) using 1,
  norm_cast,
  ring
end

lemma has_deriv_at_g (x₀ : ℝ) : has_deriv_at g (∫ t in 0..1, -2 * x₀ * real.exp (-(1+t^2)*x₀^2)) x₀ :=
begin
  have key₁ : continuous (λ (t : ℝ), 1 + t^2) := by continuity,
  have key₂ : continuous ↿(λ x t, real.exp (-(1+t^2) * x^2)) :=
    real.continuous_exp.comp ((key₁.comp continuous_snd).neg.mul
      ((continuous_pow 2).comp continuous_fst)),
  apply has_deriv_at_parametric (zero_lt_one),
  { intros x t,
    have step₁ : has_deriv_at (λ u, -(1 + t^2) * u^2) (-(1 + t^2) * 2 * x) x,
    { convert (has_deriv_at_pow 2 x).const_mul (-(1 + t ^ 2)) using 1,
      norm_cast,
      ring },
    have step₂ : has_deriv_at (λ u, real.exp (-(1 + t^2) * u^2))
      (-(1 + t^2) * 2 * x * real.exp (-(1 + t^2) * x^2)) x,
    { rw mul_comm,
      exact has_deriv_at.comp x (real.has_deriv_at_exp _) step₁ },
    conv in (_ / _) { rw div_eq_mul_inv },
    convert step₂.mul_const _ using 1,
    conv_rhs {rw mul_comm, rw ← mul_assoc, rw ← mul_assoc, rw ← mul_assoc,
              rw mul_neg_eq_neg_mul_symm,
              rw inv_mul_cancel (show 1 + t^2 ≠ 0, by linarith [pow_two_nonneg t]) },
    ring },
  { exact key₂.div (key₁.comp continuous_snd) (λ ⟨x, t⟩, by linarith [pow_two_nonneg t]) },
  { exact (continuous_const.mul continuous_fst).mul key₂, },
end

lemma key1 : ∀ x : ℝ, ∀ t ∈ (set.interval 0 1 : set ℝ),
  has_deriv_at ((λ (u : ℝ), ∫ (t : ℝ) in 0..u, real.exp (-t ^ 2)) ∘ λ (u : ℝ), u * x) (real.exp (-(t * x) ^ 2) * x) t :=
begin
  intros x t ht,
  apply has_deriv_at.comp _ (has_deriv_at_f _),
  convert (has_deriv_at_id t).mul_const x,
  ring
end

lemma has_deriv_at_h : ∀ x, has_deriv_at h 0 x :=
begin
  intros x,
  rw h,
  convert ← (has_deriv_at_g x).add (has_deriv_at_f_square x),
  rw add_eq_zero_iff_eq_neg,
  calc  ∫ (t : ℝ) in 0..1, (-2) * x * real.exp (-(1 + t ^ 2) * x ^ 2)
      = ∫ (t : ℝ) in 0..1, (-2) * x * real.exp (-(t * x) ^ 2 + -x ^ 2) :
        by conv in (-(1+_^2)*x^2) { ring_nf, rw [← mul_pow, mul_comm, sub_eq_add_neg] }
  ... = ∫ t in 0..1, (-2) * x * (real.exp (-x ^ 2) * real.exp (-(t * x) ^ 2)) :
        by conv in (real.exp _) { rw real.exp_add, rw mul_comm }
  ... = ∫ t in 0..1, (-2 * real.exp (-x ^ 2)) * (real.exp (-(t * x) ^ 2) * x) :
        by congr; ext t; ring
  ... = ∫ t in 0..1, (-2 * real.exp (-x ^ 2)) • (real.exp (-(t * x) ^ 2) * x) :
        by congr; ext t; rw smul_eq_mul
  ... = (-2 * real.exp (-x ^ 2)) • ∫ t in 0..1, (real.exp (-(t * x) ^ 2) * x) :
        integral_smul _
  ... = (-2 * real.exp (-x ^ 2)) * ∫ t in 0..1, (real.exp (-(t * x) ^ 2) * x) :
        by rw smul_eq_mul
  ... = (-2 * real.exp (-x ^ 2)) *
          ( ((λ u, ∫ t in 0..u, real.exp (-t ^ 2)) ∘ (λ u, u * x)) 1
          - ((λ u, ∫ t in 0..u, real.exp (-t ^ 2)) ∘ (λ u, u * x)) 0 ) :
        begin
          congr,
          refine integral_eq_sub_of_has_deriv_at (key1 x) (continuous.continuous_on _),
          continuity
        end
  ... = (-2 * real.exp (-x ^ 2)) * ∫ t in 0..x, real.exp (-t ^ 2) : by simp
  ... = -(2 * real.exp (-x ^ 2) * ∫ t in 0..x, real.exp (-t ^ 2)) : by ring
end

lemma h_zero : h 0 = real.pi / 4 :=
begin
  change (∫ t in 0..1, real.exp (-(1 + t^2) * 0^2) / (1 + t^2)) +
    (∫ (t : ℝ) in 0..0, real.exp (-t^2))^2 = real.pi / 4,
  rw [integral_same, zero_pow zero_lt_two, add_zero],
  conv_lhs {congr, funext, rw mul_zero, rw real.exp_zero},
  convert integral_eq_sub_of_has_deriv_at (λ t _, t.has_deriv_at_arctan)
    (continuous_const.div _ _).continuous_on,
  { rw [real.arctan_one, real.arctan_zero, sub_zero] },
  { continuity },
  { intro t,
    linarith [pow_two_nonneg t] }
end

lemma h_eq : h = (λ x, real.pi / 4) :=
funext $ λ x, h_zero ▸ (is_const_of_deriv_eq_zero (λ t, (has_deriv_at_h t).differentiable_at)
  (λ t, (has_deriv_at_h t).deriv) x 0)

lemma g_le_key (x : ℝ) (hx : 1 ≤ x) :
  (λ t, (real.exp (-(1+t^2)*x^2))/(1+t^2)) ≤ (λ t, real.exp (-x)) :=
assume t,
have key₁ : 1 ≤ 1 + t^2,
  from (le_add_iff_nonneg_right 1).mpr (pow_two_nonneg t),
calc (real.exp (-(1+t^2)*x^2))/(1+t^2)
      ≤ (real.exp (-(1+t^2)*x^2))/1 : div_le_div_of_le_left
          (real.exp_pos _).le zero_lt_one key₁
  ... = real.exp (-(1+t^2)*x^2) : div_one _
  ... = real.exp ((1+t^2)*(-x^2)) : congr_arg real.exp (by ring)
  ... ≤ real.exp (1*(-x^2)) : real.exp_monotone
          (mul_mono_nonpos (neg_nonpos.mpr $ pow_two_nonneg x) key₁)
  ... = real.exp (-x^2) : by rw one_mul
  ... = real.exp (x*(-x)) : by ring_nf
  ... ≤ real.exp (1*(-x)) : real.exp_monotone
          (mul_mono_nonpos (neg_nonpos.mpr $ zero_le_one.trans hx) hx)
  ... = real.exp (-x) : by rw one_mul

lemma g_le : g ≤ᶠ[at_top] (λ x, real.exp (-x)) :=
begin
  dsimp [g],
  refine ((eventually_ge_at_top 1).mono $ λ x hx, _),
  convert interval_integral.integral_mono (zero_le_one : (0 : ℝ) ≤ 1) _ _ (g_le_key x hx),
  { rw interval_integral.integral_const,
    simp },
  { refine (continuous.div _ _ _).interval_integrable 0 1,
    { continuity },
    { continuity },
    { intro x, linarith [pow_two_nonneg x] } },
  { exact continuous.interval_integrable (by continuity) 0 1 },
end

lemma g_tendsto : tendsto g at_top (𝓝 0) :=
begin
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds
    (real.tendsto_exp_at_bot.comp tendsto_neg_at_top_at_bot)
    (eventually_of_forall $ λ x, _) g_le,
  dsimp [g],
  rw integral_of_le,
  { refine integral_nonneg (λ t, _),
    exact div_nonneg (real.exp_pos _).le
      (zero_le_one.trans $ (le_add_iff_nonneg_right 1).mpr (pow_two_nonneg t)) },
  { exact zero_le_one }
end

lemma f_square_tendsto : tendsto (f^2) at_top (𝓝 $ real.pi/4) :=
begin
  have : f^2 = h - g,
  { ext, simp [h] },
  rw [this, ← sub_zero (real.pi/4), h_eq],
  exact tendsto_const_nhds.sub g_tendsto
end

lemma f_tendsto : tendsto f at_top (𝓝 $ real.pi.sqrt / 2) :=
begin
  rw [← real.sqrt_sq zero_le_two, ← real.sqrt_div real.pi_pos.le],
  norm_num,
  refine f_square_tendsto.sqrt.congr' _,
  refine (eventually_ge_at_top 0).mono (λ x hx, real.sqrt_sq _),
  dsimp [f],
  rw integral_of_le hx,
  refine integral_nonneg (λ t, (real.exp_pos _).le),
end

lemma tendsto_gauss_integral_symm_interval :
  tendsto (λ x, ∫ t in (-x)..x, real.exp (-t^2)) at_top (𝓝 real.pi.sqrt) :=
begin
  convert ← tendsto.const_mul 2 f_tendsto,
  { ext x,
    rw [two_mul, ← integral_add_adjacent_intervals
      (continuous_gauss.interval_integrable (-x) 0)
      (continuous_gauss.interval_integrable 0 x)],
    refine congr_arg2 (+) _ rfl,
    conv in (real.exp _) {rw ← neg_sq, change (λ t, real.exp (-t^2)) (-t)},
    rw [integral_comp_neg (λ t, real.exp (-t^2)), neg_zero],
    all_goals {apply_instance} },
  { linarith }
end

lemma gauss_integrable : integrable (λ x, real.exp (-x^2)) :=
begin
  refine integrable_of_interval_integral_norm_tendsto at_top_countably_generated_of_archimedean
    (continuous_gauss.ae_measurable _) real.pi.sqrt
    (λ i, continuous_gauss.integrable_on_Icc.mono_set Ioc_subset_Icc_self)
    tendsto_neg_at_top_at_bot tendsto_id _,
  conv in (norm _) {rw real.norm_of_nonneg (-x^2).exp_pos.le},
  exact tendsto_gauss_integral_symm_interval
end

lemma gauss_integral : ∫ x : ℝ, real.exp (-x^2) = real.pi.sqrt :=
begin
  have := interval_integral_tendsto_integral at_top_countably_generated_of_archimedean
    (continuous_gauss.ae_measurable _) gauss_integrable tendsto_neg_at_top_at_bot tendsto_id,
  exact tendsto_nhds_unique this tendsto_gauss_integral_symm_interval,
end


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Mario Carneiro, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.modeq
import Mathlib.data.zmod.basic
import Mathlib.linear_algebra.adic_completion
import Mathlib.data.padics.padic_numbers
import Mathlib.ring_theory.discrete_valuation_ring
import Mathlib.topology.metric_space.cau_seq_filter
import Mathlib.PostPort

namespace Mathlib

/-!
# p-adic integers

This file defines the p-adic integers `ℤ_p` as the subtype of `ℚ_p` with norm `≤ 1`.
We show that `ℤ_p`
* is complete
* is nonarchimedean
* is a normed ring
* is a local ring
* is a discrete valuation ring

The relation between `ℤ_[p]` and `zmod p` is established in another file.

## Important definitions

* `padic_int` : the type of p-adic numbers

## Notation

We introduce the notation `ℤ_[p]` for the p-adic integers.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (nat.prime p)] as a type class argument.

Coercions into `ℤ_p` are set up to work with the `norm_cast` tactic.

## References

* [F. Q. Gouêva, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, p-adic integer
-/

/-- The p-adic integers ℤ_p are the p-adic numbers with norm ≤ 1. -/
def padic_int (p : ℕ) [fact (nat.prime p)] := Subtype fun (x : padic p) => norm x ≤ 1

namespace padic_int

/-! ### Ring structure and coercion to `ℚ_[p]` -/

protected instance padic.has_coe {p : ℕ} [fact (nat.prime p)] : has_coe (padic_int p) (padic p) :=
  has_coe.mk subtype.val

theorem ext {p : ℕ} [fact (nat.prime p)] {x : padic_int p} {y : padic_int p} : ↑x = ↑y → x = y :=
  iff.mpr subtype.ext_iff_val

/-- Addition on ℤ_p is inherited from ℚ_p. -/
protected instance has_add {p : ℕ} [fact (nat.prime p)] : Add (padic_int p) :=
  { add := fun (_x : padic_int p) => sorry }

/-- Multiplication on ℤ_p is inherited from ℚ_p. -/
protected instance has_mul {p : ℕ} [fact (nat.prime p)] : Mul (padic_int p) :=
  { mul := fun (_x : padic_int p) => sorry }

/-- Negation on ℤ_p is inherited from ℚ_p. -/
protected instance has_neg {p : ℕ} [fact (nat.prime p)] : Neg (padic_int p) :=
  { neg := fun (_x : padic_int p) => sorry }

/-- Subtraction on ℤ_p is inherited from ℚ_p. -/
protected instance has_sub {p : ℕ} [fact (nat.prime p)] : Sub (padic_int p) :=
  { sub := fun (_x : padic_int p) => sorry }

/-- Zero on ℤ_p is inherited from ℚ_p. -/
protected instance has_zero {p : ℕ} [fact (nat.prime p)] : HasZero (padic_int p) :=
  { zero := { val := 0, property := sorry } }

protected instance inhabited {p : ℕ} [fact (nat.prime p)] : Inhabited (padic_int p) :=
  { default := 0 }

/-- One on ℤ_p is inherited from ℚ_p. -/
protected instance has_one {p : ℕ} [fact (nat.prime p)] : HasOne (padic_int p) :=
  { one := { val := 1, property := sorry } }

@[simp] theorem mk_zero {p : ℕ} [fact (nat.prime p)] {h : norm 0 ≤ 1} :
    { val := 0, property := h } = 0 :=
  rfl

@[simp] theorem val_eq_coe {p : ℕ} [fact (nat.prime p)] (z : padic_int p) : subtype.val z = ↑z :=
  rfl

@[simp] theorem coe_add {p : ℕ} [fact (nat.prime p)] (z1 : padic_int p) (z2 : padic_int p) :
    ↑(z1 + z2) = ↑z1 + ↑z2 :=
  sorry

@[simp] theorem coe_mul {p : ℕ} [fact (nat.prime p)] (z1 : padic_int p) (z2 : padic_int p) :
    ↑(z1 * z2) = ↑z1 * ↑z2 :=
  sorry

@[simp] theorem coe_neg {p : ℕ} [fact (nat.prime p)] (z1 : padic_int p) : ↑(-z1) = -↑z1 :=
  subtype.cases_on z1
    fun (z1_val : padic p) (z1_property : norm z1_val ≤ 1) =>
      idRhs
        (↑(-{ val := z1_val, property := z1_property }) =
          ↑(-{ val := z1_val, property := z1_property }))
        rfl

@[simp] theorem coe_sub {p : ℕ} [fact (nat.prime p)] (z1 : padic_int p) (z2 : padic_int p) :
    ↑(z1 - z2) = ↑z1 - ↑z2 :=
  sorry

@[simp] theorem coe_one {p : ℕ} [fact (nat.prime p)] : ↑1 = 1 := rfl

@[simp] theorem coe_coe {p : ℕ} [fact (nat.prime p)] (n : ℕ) : ↑↑n = ↑n := sorry

@[simp] theorem coe_coe_int {p : ℕ} [fact (nat.prime p)] (z : ℤ) : ↑↑z = ↑z := sorry

@[simp] theorem coe_zero {p : ℕ} [fact (nat.prime p)] : ↑0 = 0 := rfl

protected instance ring {p : ℕ} [fact (nat.prime p)] : ring (padic_int p) :=
  ring.mk Add.add sorry 0 sorry sorry Neg.neg Sub.sub sorry sorry Mul.mul sorry 1 sorry sorry sorry
    sorry

/-- The coercion from ℤ[p] to ℚ[p] as a ring homomorphism. -/
def coe.ring_hom {p : ℕ} [fact (nat.prime p)] : padic_int p →+* padic p :=
  ring_hom.mk coe sorry coe_mul sorry coe_add

@[simp] theorem coe_pow {p : ℕ} [fact (nat.prime p)] (x : padic_int p) (n : ℕ) :
    ↑(x ^ n) = ↑x ^ n :=
  ring_hom.map_pow coe.ring_hom x n

@[simp] theorem mk_coe {p : ℕ} [fact (nat.prime p)] (k : padic_int p) :
    { val := ↑k, property := subtype.property k } = k :=
  sorry

/-- The inverse of a p-adic integer with norm equal to 1 is also a p-adic integer. Otherwise, the
inverse is defined to be 0. -/
def inv {p : ℕ} [fact (nat.prime p)] : padic_int p → padic_int p := sorry

protected instance char_zero {p : ℕ} [fact (nat.prime p)] : char_zero (padic_int p) :=
  char_zero.mk
    fun (m n : ℕ) (h : ↑m = ↑n) =>
      nat.cast_injective
        ((fun (this : ↑m = ↑n) => this)
          (eq.mp
            ((fun (a a_1 : padic p) (e_1 : a = a_1) (ᾰ ᾰ_1 : padic p) (e_2 : ᾰ = ᾰ_1) =>
                congr (congr_arg Eq e_1) e_2)
              (↑↑m) (↑m) (coe_coe m) (↑↑n) (↑n) (coe_coe n))
            (eq.mp (Eq._oldrec (Eq.refl (↑m = ↑n)) (propext subtype.ext_iff)) h)))

@[simp] theorem coe_int_eq {p : ℕ} [fact (nat.prime p)] (z1 : ℤ) (z2 : ℤ) : ↑z1 = ↑z2 ↔ z1 = z2 :=
  sorry

/--
A sequence of integers that is Cauchy with respect to the `p`-adic norm
converges to a `p`-adic integer.
-/
def of_int_seq {p : ℕ} [fact (nat.prime p)] (seq : ℕ → ℤ)
    (h : is_cau_seq (padic_norm p) fun (n : ℕ) => ↑(seq n)) : padic_int p :=
  { val := quotient.mk { val := fun (n : ℕ) => ↑(seq n), property := h }, property := sorry }

end padic_int

namespace padic_int

/-!
### Instances

We now show that `ℤ_[p]` is a
* complete metric space
* normed ring
* integral domain
-/

protected instance metric_space (p : ℕ) [fact (nat.prime p)] : metric_space (padic_int p) :=
  subtype.metric_space

protected instance complete_space (p : ℕ) [fact (nat.prime p)] : complete_space (padic_int p) :=
  sorry

protected instance has_norm (p : ℕ) [fact (nat.prime p)] : has_norm (padic_int p) :=
  has_norm.mk fun (z : padic_int p) => norm ↑z

protected theorem mul_comm {p : ℕ} [fact (nat.prime p)] (z1 : padic_int p) (z2 : padic_int p) :
    z1 * z2 = z2 * z1 :=
  sorry

protected theorem zero_ne_one {p : ℕ} [fact (nat.prime p)] : 0 ≠ 1 :=
  (fun
      (this :
      { val := 0, property := has_zero._proof_1 } ≠ { val := 1, property := has_one._proof_1 }) =>
      this)
    (mt (iff.mp subtype.ext_iff_val) zero_ne_one)

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {p : ℕ} [fact (nat.prime p)] (a : padic_int p)
    (b : padic_int p) : a * b = 0 → a = 0 ∨ b = 0 :=
  sorry

theorem norm_def {p : ℕ} [fact (nat.prime p)] {z : padic_int p} : norm z = norm ↑z := rfl

protected instance normed_comm_ring (p : ℕ) [fact (nat.prime p)] : normed_comm_ring (padic_int p) :=
  normed_comm_ring.mk padic_int.mul_comm

protected instance norm_one_class (p : ℕ) [fact (nat.prime p)] : norm_one_class (padic_int p) :=
  norm_one_class.mk (Eq.trans norm_def norm_one)

protected instance is_absolute_value (p : ℕ) [fact (nat.prime p)] :
    is_absolute_value fun (z : padic_int p) => norm z :=
  is_absolute_value.mk norm_nonneg (fun (_x : padic_int p) => sorry)
    (fun (_x : padic_int p) => sorry)
    fun (_x _x_1 : padic_int p) =>
      eq.mpr
        (id
          ((fun (a a_1 : ℝ) (e_1 : a = a_1) (ᾰ ᾰ_1