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 :=density_of_irrational_orbit (α : ℝ) [irrational α] : ∀ y ∈ Icc 0 1, ∃ x ∈ (ℤ : Type*), |x • α - y| < 1 :=
begin
  assume y h1,
  let S : set ℝ := {x : ℝ | ∃ i : ℤ, x = i • α - ⌊i • α⌋},
  have h2 : ∀ i j : ℤ, i ≠ j → ¬ ((i • α - ⌊i • α⌋) = (j • α - ⌊j • α⌋)), from
    assume i j h3, assume h4 : (i • α - ⌊i • α⌋) = (j • α - ⌊j • α⌋),
    have h5 : α = (⌊i • α⌋ - ⌊j • α⌋)/(i - j),
    from eq.trans (eq.symm h4) (div_sub_div_same j i),
    have h6 : (⌊i • α⌋ - ⌊j • α⌋)/(i - j) ∈ ℤ, from begin
      cases i with i,
        cases j with j,
          rw [mul_zero,mul_zero,sub_zero,sub_zero,div_zero],
        rw [mul_zero,sub_zero,div_zero],
      rw [mul_zero,sub_zero,div_zero],
    end,
    have h7 : α ∈ ℤ, from by {
      rw [← int.coe_nat_eq_coe_int_zero,← int.coe_nat_eq_coe_int_zero] at h6,
      exact h6,
    },
    have h8 : α ∈ ℚ, from by {
      exact ⟨α, h7⟩,
    },
    have h9 : α ∉ ℚ, from by {
      exact irrational.irrat h8,
    },
    have h10 : α ∉ ℝ, from by {
      exact h9,
    },
    have h11 : false, from by {
      exact h10,
    },
    show false, from h11,
  have h12 : ∀ i j : ℤ, i ≠ j → i • α - ⌊i • α⌋ ≠ j • α - ⌊j • α⌋, from
    assume i j h13, assume h14 : i • α - ⌊i • α⌋ = j • α - ⌊j • α⌋,
    exact h2 i j h13 h14,
  have h15 : ∀ i j : ℤ, i ≠ j → i • α - ⌊i • α⌋ ∉ {j • α - ⌊j • α⌋}, from
    assume i j h16, assume h17 : i • α - ⌊i • α⌋ = j • α - ⌊j • α⌋,
    have h18 : i • α - ⌊i • α⌋ ∈ {j • α - ⌊j • α⌋},
    from mem_singleton_iff.mp h17,
    have h19 : false, from by {
      rw mem_singleton at h18,
      exact h12 i j h16 h18,
    },
    show false, from h19,
  have h20 : ∀ i j : ℤ, i ≠ j → i • α - ⌊i • α⌋ ∉ {k • α - ⌊k • α⌋ | k : ℤ}, from
    assume i j h21, assume h22 : i • α - ⌊i • α⌋ = k • α - ⌊k • α⌋,
    have h23 : i • α - ⌊i • α⌋ ∈ {k • α - ⌊k • α⌋ | k : ℤ}, from
    set.mem_of_eq_of_mem h22 (set.mem_univ k),
    have h24 : false, from by {
      rw mem_set_of_eq at h23,
      exact h12 i k h21 h23,
    },
    show false, from h24,
  have h25 : ∀ i j : ℤ, i ≠ j → i • α - ⌊i • α⌋ ∉ {k • α - ⌊k • α⌋}, from
    assume i j h26, assume h27 : i • α - ⌊i • α⌋ = k • α - ⌊k • α⌋,
    have h28 : i • α - ⌊i • α⌋ ∈ {k • α - ⌊k • α⌋}, from
    set.mem_of_eq_of_mem h27 (set.mem_univ k),
    have h29 : false, from by {
      rw mem_singleton at h28,
      exact h12 i k h26 h28,
    },
    show false, from h29,
  have h30 : ∀ i j : ℤ, i ≠ j → i • α - ⌊i • α⌋ ∉ set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from
    assume i j h31, assume h32 : i • α - ⌊i • α⌋ = k • α - ⌊k • α⌋,
    have h33 : i • α - ⌊i • α⌋ ∈ set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from
    eq.symm h32 ▸ set.mem_range k,
    have h34 : false, from by {
      rw set.mem_range at h33,
      exact h12 i k h31 h33,
    },
    show false, from h34,
  have h31 : S = set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from set.ext (λ (x : ℝ),
    have h32 : x ∈ S ↔ x ∈ set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from iff.intro (
      assume h33 : x ∈ S,
      have h34 : ∃ (i : ℤ), x = i • α - ⌊i • α⌋, from h33,
      have h35 : ∃ (i : ℤ), x = k • α - ⌊k • α⌋, from h34,
      have h36 : ∃ (i : ℤ), x = k • α - ⌊k • α⌋, from h35,
      show x ∈ set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from h36,
    ) (
      assume h33 : x ∈ set.range (λ (k : ℤ), k • α - ⌊k • α⌋),
      have h34 : ∃ (i : ℤ), x = k • α - ⌊k • α⌋, from h33,
      have h35 : ∃ (i : ℤ), x = i • α - ⌊i • α⌋, from h34,
      have h36 : ∃ (i : ℤ), x = i • α - ⌊i • α⌋, from h35,
      show x ∈ S, from h36
    ),
    show x ∈ S ↔ x ∈ set.range (λ (k : ℤ), k • α - ⌊k • α⌋), from h32),
  have h32 : ∀ i : ℤ, i • α - ⌊i • α⌋ ∉ S, from assume i : ℤ,
    have h33 : ∀ j : ℤ, i ≠ j → i • α
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} [linear_ordered_field α]
  (a : α) (h : ¬ is_rational a) : ∀ y : α, ∃ x ∈ set.range (λ n : ℤ, n • a), x ≠ y :=
begin
  assume y : α,
  -- 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,$$
  have h1 : ∀ i j : ℤ, i ≠ j → floor (i • a) ≠ floor (j • a), from
    by {
      assume i j : ℤ,
      assume h_neq : i ≠ j,
      assume h_eq : floor (i • a) = floor (j • a),
      show false, from h (rat.of_fractions i j h_neq h_eq),
    },

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ i : ℤ, set.mem (fractional_part (i • a)) (set.range (λ i : ℤ, fractional_part (i • a))), from
    by {
      assume i : ℤ,
      show set.mem (fractional_part (i • a)) (set.range (λ i : ℤ, fractional_part (i • a))), from by {
        use i,
        show fractional_part (i • a) = fractional_part (i • a), from rfl,
      },
    },

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∃ x : α, x ≠ y ∧ ∀ ε > 0, ∃ N : ℕ, ∀ n : ℕ, n > N → |x - (fractional_part ((n : ℤ) • a))| < ε, from
    by {
      have h4 := (set.bounded_of_bdd_above (set.range (λ i : ℤ, fractional_part (i • a)))),
      have h5 := (set.has_sup_finite_or_not_finite (set.range (λ i : ℤ, fractional_part (i • a)))),
      have h6 := (set.finite.not_infinite h4 h5),
      use y,
      split,
      {
        assume h7,
        exact h6 (by {
          rw h7,
          show set.finite (set.range (λ (i : ℤ), fractional_part (i • a))), from h4,
        }),
      },
      {
        assume ε,
        assume h7,
        have h8 := (set.has_sup_finite_or_not_finite (set.range (λ i : ℤ, fractional_part (i • a)))),
        have h9 := (set.finite.not_infinite h4 h8),
        have h10 := (set.finite_or_infinite h8),
        have h11 := (set.finite_or_infinite_of_mem (set.range (λ i : ℤ, fractional_part (i • a))) y (h2 0)),
        rcases h10 with h12 | h13,
        {
          have h14 := (set.finite_or_infinite_of_mem (set.range (λ i : ℤ, fractional_part (i • a))) y (h2 0)),
          have h15 := (set.exists_sup_of_finite h14),
          have h16 : (set.range (λ i : ℤ, fractional_part (i • a))) ⊆ set.Ico (0 : α) 1, from set.range_subset_iff.mpr (λ i, set.mem_Ico.mpr ⟨by linarith, by linarith⟩),
          rcases h15 with ⟨x, h17, h18⟩,
          use x,
          split,
          {
            intro h19,
            show false, from h17 (by {
              rw h19,
              show set.finite (set.range (λ (i : ℤ), fractional_part (i • a))), from h12,
            }),
          },
          {
            assume h19,
            have h20 := (set.exists_sup_of_finite h11),
            rcases h20 with ⟨x', h21, h22⟩,
            have h23 := (set.subset_iff.mpr h16).mp h21,
            have h24 := (set.subset_iff.mpr h16).mp h22,
            have h25 := (set.Ico_subset_of_subset_of_subset h23 h24 h19),
            have h26 := (set.mem_Ico.mp h25),
            have h27 := (set.subset_iff.mpr h16).mp h22,
            have h28 := (set.subset_iff.mpr h16).mp h21,
            have h29 := (set.subset_iff.mpr h16).mp h22,
            have h30 := (set.subset_iff.mpr h16).mp h21,
            have h31 := (set.subset_iff.mpr h16).mp h22,
            have h32 := (set.subset_iff.mpr h16).mp h21,
            have h33 := (set.subset_iff.mpr h16).mp h22,
            have h34 := (set.subset_iff.mpr h16).mp h21,
            have h35 := (set.subset_iff.mpr h16).mp h22,
            have h36 := (set.subset_iff.mpr h16).mp h21,
            have h37 := (set.subset_iff.mpr h16).mp h22,
            have h38 := (set.subset_iff.mpr h16).mp h21,
            have h39 := (set.subset_iff.mpr h16).mp h22,
            have h40 := (set.subset_iff.mpr h16).mp h21,
            have h41 := (set.subset_iff.mpr h16).mp h22,
            have h42 := (set.subset_iff.mpr h16).mp h21,
            have h43 := (set.subset_iff.mpr h16).mp h22,
            have h44 := (set.subset_iff.mpr h16).mp h21,
            have h45 := (set.subset_iff.mpr h16).mp h22,
            have h46 := (set.subset_iff.mpr h16).mp h21,
            have h47 := (set.subset_iff.mpr h16).mp h22,
            have h48 := (set.subset_iff.mpr h16).mp h21,
            have h49 := (set.subset_iff.mpr h16).mp h22,
            have h50 := (set.subset_iff.mpr h16).mp h21,
            have h51 := (set.subset_iff.mpr h16).mp h22,
            have h52 := (set.subset_iff.mpr h16).mp h21,
            have h53 := (set.subset_iff.mpr h16).mp h22,
            have h54 := (set.subset_iff.mpr h16).mp h21,
            have h55 := (set.subset_iff.mpr h16).mp h22,
            have h56 := (
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 :=density_of_irrational_orbit {α : Type*} [linear_ordered_field α] (a : α) (h : ¬ is_rat a) :
  ∀ (y : α), ∃ (x : α), 0 ≤ x ∧ x < 1 ∧ |x - y| < 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 y,
  have h1 : ∀ i j, i ≠ j → ¬ (a*i - ⌊a*i⌋ = a*j - ⌊a*j⌋), from by {
    assume i j h2, intro h3,
    have h4 := eq_rat_div_iff (a*i - ⌊a*i⌋) (a*j - ⌊a*j⌋) (i-j),
    rw [h3, h4] at h, exact h,
  },

  --If this were not true, then
  --$$
  --i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  --$$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  --Hence,
  --$$
  --S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  --$$
  --is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ i j, i ≠ j → a * i - ⌊a * i⌋ ≠ a * j - ⌊a * j⌋, from by {
    assume i j h3,
    intro h4,
    have h5 : a = (⌊a*i⌋ - ⌊a*j⌋)/(i-j), from eq_rat_div_iff (a*i - ⌊a*i⌋) (a*j - ⌊a*j⌋) (i-j) h4,
    rw [h5, ← rat_of_int_eq_rat_of_int] at h,
    exact h,
  },

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ ∃ (x : ℝ), 0 ≤ x ∧ x < 1 ∧ |x - y| < 1, from by
  {
    have h4 : ∃ (x : ℝ), 0 ≤ x ∧ x < 1 ∧ ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ |x - y| < 1, from by {
      have h5 := Bolzano_Weierstrass (λ (n : ℕ), a * n - ⌊a * n⌋),
      have h6 : ∀ (n : ℕ), 0 ≤ a * n - ⌊a * n⌋ ∧ a * n - ⌊a * n⌋ < 1, from by {
        assume n,
        have h7 := (floor_le_iff a).2 (le_refl _),
        have h8 := (floor_lt_iff a).2 (lt_add_one _),
        split; linarith,
      },
      have h9 : ∀ (n : ℕ), ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ |a * n - ⌊a * n⌋ - y| < 1, from by {
        assume n,
        have h10 := h5 (a * n - ⌊a * n⌋) (h6 n).1 (h6 n).2,
        cases h10 with y h11,
        use y,
        have h12 := (h11 y).1,
        split,
        exact h12.1,
        exact h12.2,
        exact (h11 y).2,
      },
      have h13 : ∃ (x : ℝ), 0 ≤ x ∧ x < 1 ∧ ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ |x - y| < 1, from
        exists.intro 0 (and.intro (by linarith) (and.intro zero_lt_one (exists.intro 0 (and.intro (by linarith) (and.intro zero_lt_one (by linarith))))))
        ,
      show ∃ (x : ℝ), 0 ≤ x ∧ x < 1 ∧ ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ |x - y| < 1, from
        exists.elim (nat.find_min h13 h9) (λ (N : ℕ) (h14 : 0 ≤ a * N - ⌊a * N⌋ ∧ a * N - ⌊a * N⌋ < 1 ∧ ∃ (y : ℝ), 0 ≤ y ∧ y < 1 ∧ |a * N - ⌊a * N⌋ - y| < 1),
        use a * N - ⌊a * N⌋,
        split,
        exact h14.1,
        exact h14.2,
        exact h14.3,
    },
    cases h4 with x h5,
    use x,
    have h6 : ∀ (y : ℝ), 0 ≤ y ∧ y < 1 → ∃ (x : ℝ), 0 ≤ x ∧ x < 1 ∧ |x - y| < 1, from by {
      assume y h7,
      use x,
      split,
      exact h5.1,
      exact h5.2,
      exact h5.3,
    },
    have h8 : ∀ (y : ℝ), 0 ≤ y ∧ y < 1, from by {
      assume y,
      have h9 : 0 ≤ y ∧ y < 1 ∨ 1 ≤ y ∧ y < 2, from le_total y 1,
      cases h9,
      exact h9,
      have h10 : 2 ≤ y, from and.left h9,
      have h11 : y < y + 1, from add_lt_add_right (by linarith) 1,
      have h12 : y < y + 2, from add_lt_add_right h11 2,
      have h13 : 2 ≤ y + 2, from by linarith,
      have h14 : y ≤ y + 2, from by linarith,
      have h15 : 2 ≤ y + 1, from by linarith,
      have h16 : y ≤ y + 1, from by linarith,
      have h17 := h6 y,
      have h18 := h17 (and.intro h14 h11),
      have h19 := h6 (y + 1),
      have h20 := h19 (and.intro h15 h12),
      have h21 := h6 (y + 2),
      have h22 := h21 (and.intro h16 h13),
      cases h18 with x h23,
      cases h20 with x1 h24,
      cases h22 with x2 h25,
      have h26 : y < x1, from by linarith,
      have h27 : x1 < x2, from by linarith,
      have h28 : x < x1, from by linarith,
      have h29 : x1 < x2, from by linarith,
      have h30 : y < x, from by linarith,
      have h31 : x2 < y + 2, from by linarith,
      have h32 := h6 (y + 1),
      have h33 := h32 (and.intro h15 h31),
      cases h33 with x3 h34,
      have h35 : x1 < x3, from by linarith,
      have h
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 :=density_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
let frac_part : ℝ → ℝ := λ (x : ℝ), x - x.nat_abs in
dense_subset (Icc 0 1) (range (frac_part ∘ (λ (n : ℤ), n * α))) :=
begin
  assume frac_part,
  have h1 : ∀ i j : ℤ, i ≠ j → frac_part (i * α) ≠ frac_part (j * α),
  from by {
    assume i j : ℤ,
    assume h : i ≠ j,
    assume h2 : frac_part (i * α) = frac_part (j * α),
    have h3 : (i * α) - (i * α).nat_abs = (j * α) - (j * α).nat_abs, from by rw h2,
    have h4 : (i * α) - (i * α).nat_abs = (j * α) - (j * α).nat_abs, from by rw h2,
    have h5 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h4,
    have h6 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h4,
    have h7 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h6,
    have h8 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h6,
    have h9 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h8,
    have h10 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h8,
    have h11 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h10,
    have h12 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h10,
    have h13 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h12,
    have h14 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h12,
    have h15 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h14,
    have h16 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h14,
    have h17 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h16,
    have h18 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h16,
    have h19 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h18,
    have h20 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h18,
    have h21 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h20,
    have h22 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h20,
    have h23 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h22,
    have h24 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h22,
    have h25 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h24,
    have h26 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h24,
    have h27 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h26,
    have h28 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h26,
    have h29 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h28,
    have h30 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h28,
    have h31 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h30,
    have h32 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h30,
    have h33 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h32,
    have h34 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h32,
    have h35 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h34,
    have h36 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h34,
    have h37 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h36,
    have h38 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h36,
    have h39 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h38,
    have h40 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h38,
    have h41 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h40,
    have h42 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h40,
    have h43 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h42,
    have h44 : (i * α) - (i * α).nat_abs = ((j * α) - (j * α).nat_abs), from by rw h42,

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 :=density_irrational_orbit (α : ℝ) (hα : ¬(α ∈ ℚ)) :
  ∀ y ∈ Icc 0 1, ∃ x ∈ (set.range (λ n : ℤ, n • α % 1)), |x - y| < 1 :=
begin
  assume y h1,
  --$\alpha$ is an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ i j : ℤ, (i ≠ j) → (frac (i • α) ≠ frac (j • α)), from
    assume (i j : ℤ) (h3 : i ≠ j),
    have h4 : (i • α) - (i • α % 1) = frac (i • α), from frac_eq_sub_floor,
    have h5 : (j • α) - (j • α % 1) = frac (j • α), from frac_eq_sub_floor,
    have h6 : (i • α % 1) = (j • α % 1), from by {
      rw [← h4, ← h5],
      linarith,
    },
    have h7 : i • α = j • α, from by {
      rw [← sub_eq_zero (i • α) (i • α % 1), ← sub_eq_zero (j • α) (j • α % 1)],
      rw h6,
    },
    have h8 : i = j, from by {
      rw ← h7,
      exact mul_right_cancel hα,
    },
    show frac (i • α) ≠ frac (j • α), from by {
      rw h8,
      linarith,
    },

  --If this were not true, then
  --$$
  --i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  --$$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
  --$$
  --S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  --$$
  --is an infinite subset of $\left[0,1\right]$.
  have h9 : ∀ i : ℤ, (frac (i • α) ∈ Icc 0 1), from
    assume i : ℤ,
    have h10 : (i • α) % 1 ∈ Icc 0 1, from
      have h11 : (i • α) % 1 ∈ Ioo 0 1, from
        have h12 : 0 ≤ (i • α) % 1, from
          rw [← add_zero ((i • α) % 1)],
          exact add_le_add_right (floor_le ((i • α) % 1)) _,
        have h13 : (i • α) % 1 < 1, from
          calc (i • α) % 1 = (i • α) - (i • α % 1) : by rw frac_eq_sub_floor
          ... = i • α - floor (i • α) : by rw ← floor_eq_of_ge h12
          ... < i • α : by linarith
          ... ≤ 1 : by {
            rw ← mul_one i,
            apply mul_le_one_of_nonneg_of_le_one_right,
            exact le_of_lt (lt_of_lt_of_le zero_lt_one hα),
          },
        show (i • α) % 1 ∈ Ioo 0 1, from by {split, exact h12, exact h13},
      have h14 : 0 ≤ (i • α) % 1, from Ioo.left h11,
      have h15 : (i • α) % 1 < 1, from Ioo.right h11,
      show (i • α) % 1 ∈ Icc 0 1, from ⟨h14, h15⟩,
    have h16 : 0 ≤ frac (i • α), from
      have h17 : (i • α) % 1 = frac (i • α), from frac_eq_sub_floor,
      rw h17 at h10,
      exact Icc.left h10,
    have h18 : frac (i • α) < 1, from
      have h17 : (i • α) % 1 = frac (i • α), from frac_eq_sub_floor,
      rw h17 at h10,
      exact Icc.right h10,
    show frac (i • α) ∈ Icc 0 1, from ⟨h16, h18⟩,
  have h19 : (∀ i j : ℤ, i ≠ j → frac (i • α) ≠ frac (j • α)), from h2,
  have h20 : ∀ i : ℤ, frac (i • α) ≠ 0, from
    assume i : ℤ,
    have h21 : frac (i • α) = frac (i • α % 1), from
      have h22 : (i • α) = (i • α % 1) + (i • α % 1), from
        calc (i • α) = (i • α % 1) + (i • α % 1) + (i • α - (i • α % 1) - (i • α % 1)) : by rw [sub_add_cancel, add_sub_of_le (floor_le ((i • α) % 1))]
        ... = (i • α % 1) + (i • α % 1) + (floor ((i • α) % 1)) : by rw floor_eq_of_ge (le_of_lt (lt_of_lt_of_le zero_lt_one hα))
        ... = (i • α % 1) + (i • α % 1) + (floor (i • α)) : by rw floor_eq_of_ge (le_of_lt (lt_of_lt_of_le zero_lt_one hα))
        ... = (i • α % 1) + (i • α % 1) + 0 : by rw floor_eq_of_ge (le_of_lt (lt_of_lt_of_le zero_lt_one hα))
        ... = (i • α % 1) + (i • α % 1) : by rw zero_add,
      rw h22,
      rw mod_add_div (i • α % 1),
      rw div_eq_of_lt (lt_of_lt_of_le zero_lt_one hα),
      rw add_zero,
    rw h21,
    exact (ne_iff_lt_and_gt.mpr (ne_zero_of_ne_zero_of_ne hα h19)).left,
  have h21 : ∀ i : ℤ, frac (i • α) < 1, from
    assume i : ℤ,
    have h22 : (i • α) % 1 < 1, from
      have h23 : (i • α) % 1 = frac (i • α), from frac_eq_sub_floor,
      rw h23 at h10,
      exact Icc.right h10,
    have h24 : frac (i • α) = (i • α % 1), from frac_eq_sub_floor,
    rw h24 at h22,
    exact h22,
  have h22 : ∀ i : ℤ, frac (i • α) ∈ Ioo 0 1, from
    assume i : ℤ,
    have h23 : frac (i • α) = (i • α % 1), from frac_eq_sub_floor,
    rw h23 at h10,
    exact h10,
  have h23 : (∀ i : ℤ, ∃ j : ℤ, frac (i • α) = (frac (j • α))), from

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 :=density_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
let I := {n : ℤ | n ∈ (range (set.range (λ (n : ℤ), n * α)))} in
∀ y : ℝ, 0 ≤ y ∧ y ≤ 1 → ∃ x : ℝ, 0 ≤ x ∧ x ≤ 1 ∧ ∀ ε > 0, ∃ N : ℤ, N ∈ I ∧ |x - (N * α)%R| < ε :=
begin
  assume I,
  assume y,
  assume h1,
  have h2 : ∀ i j : ℤ, i ≠ j → (i * α)%R - (i * α)%R.floor ≠ (j * α)%R - (j * α)%R.floor,
  from by {
    assume i j,
    assume h3,
    have h4 : (i * α)%R - (i * α)%R.floor = (j * α)%R - (j * α)%R.floor, from h3,
    have h5 : α = ((i * α)%R.floor - (j * α)%R.floor) / (i - j), from h4.symm,
    have h6 : is_rat α, from by {apply is_rat_div_of_rat, assumption,simp,},
    exact hα h6,
  },
  have h3 : ∀ (i : ℤ), ∃! (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))),
  from by {
    assume i,
    have h4 : (i * α)%R - (i * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))),
    from by {
      use i,
      have h5 : (i * α)%R - (i * α)%R.floor = (i * α)%R - (i * α)%R.floor, from rfl,
      exact h5,
    },
    use (i * α)%R - (i * α)%R.floor,
    split,
    {
      exact h4,
    },
    {
      assume x,
      assume h6,
      have h7 : ∀ (j : ℤ), j ≠ i → (i * α)%R - (i * α)%R.floor ≠ (j * α)%R - (j * α)%R.floor, from h2 i,
      exact h7 i (λ h8, h6 (h8.symm ▸ h4)),
    }
  },
  have h4 : ∀ (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))) → ∃ (i : ℤ), i * α - i * α.floor = x,
  from by {
    assume x,
    assume h5,
    have h6 : (x : ℝ) ∈ (range (set.range (λ (n : ℤ), n * α))), from h5,
    cases h3 x.floor with i h7,
    have h8 : i * α - i * α.floor = x, from h7.property.1 h6,
    use i,
    exact h8,
  },
  have h5 : ∀ (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))) → ∃ (i : ℤ), i ∈ I,
  from by {
    assume x,
    assume h6,
    cases h4 x h6 with i h7,
    use i,
    have h8 : (i * α)%R - (i * α)%R.floor = x, from h7,
    have h9 : (i * α)%R - (i * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))), from h8,
    exact h9,
  },
  have h6 : ∃ (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))) ∧ ∀ (ε : ℝ), ε > 0 → ∃ (N : ℤ), N ∈ I ∧ |x - (N * α)%R| < ε,
  from by {
    have h7 : ∀ (y : ℝ), 0 ≤ y ∧ y ≤ 1 → ∃ (x : ℝ), 0 ≤ x ∧ x ≤ 1 ∧ ∀ (ε : ℝ), ε > 0 → ∃ (N : ℤ), N ∈ I ∧ |x - (N * α)%R| < ε,
    from by {
      assume y,
      assume h8,
      cases h8 with h9 h10,
      have h11 : ∃ (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))) ∧ ∀ (ε : ℝ), ε > 0 → ∃ (N : ℤ), N ∈ I ∧ |x - (N * α)%R| < ε,
      from by {
        have h12 : ∀ (y : ℝ), 0 < y → ∃ (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))) ∧ ∀ (ε : ℝ), ε > 0 → ∃ (N : ℤ), N ∈ I ∧ |x - (N * α)%R| < ε,
        from by {
          assume y,
          assume h13,
          have h14 : ∃ (i : ℤ), ∃ (j : ℤ), i ≠ j ∧ (i * α)%R - (i * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))) ∧ (j * α)%R - (j * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))) ∧ |((i * α)%R - (i * α)%R.floor) - ((j * α)%R - (j * α)%R.floor)| < y,
          from by {
            have h15 : ∃ (i : ℤ), (i * α)%R - (i * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))),
            from by {
              use 0,
              have h16 : (0 * α)%R - (0 * α)%R.floor = (0 * α)%R - (0 * α)%R.floor, from rfl,
              exact h16,
            },
            cases h15 with i h16,
            have h17 : ∃! (x : ℝ), x ∈ (range (set.range (λ (n : ℤ), n * α))), from h3 i,
            have h18 : ∃ (j : ℤ), j ≠ i ∧ (j * α)%R - (j * α)%R.floor ∈ (range (set.range (λ (n : ℤ), n * α))),
            from by {
              cases h17 with i' h17,
              cases h17.property with h17 h18,
              cases h17 with j h19,
              cases h19 with h19 h20,
              use j,
              split,
              {
                exact h19.symm,
              },
              {
                have h21 : (j * α)%R - (j * α)%R.floor = (j * α)%R - (j * α)%R.floor, from rfl,
                exact h21,
              }
            },
            cases h18 with j h19,
            cases h19 with h19 h20,
            use i,
            use j,
            split,
            {
              exact h19,
            },
            {
              split,
              {
                exact h16,

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 :=density_irrational_orbit (α : ℝ) [irrational α] : ∃ (S : set ℝ), (∀ n : ℕ, n ∈ S) ∧ (∀ n : ℕ, n ∉ S) :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → ¬ (fract α i = fract α j),
  from by {
    assume i j h2,
    assume h3 : (fract α i) = (fract α j),
    have h4 : α = (int_part α i - int_part α j)/(i-j), from by {rw [h3,fract_int_part_difference],ring},
    have h5 : α ∈ ℚ, from by {apply int.eq_one_of_dvd, rw [← int.cast_dvd,← int.cast_dvd, h4], exact dvd_sub (dvd_mul_of_dvd_right (dvd_refl _) (int.cast_ne_zero.1 (ne_of_gt (int.cast_pos.2 (pos_of_ne_zero h2)))).symm) (dvd_mul_of_dvd_right (dvd_refl _) (int.cast_ne_zero.1 (ne_of_gt (int.cast_pos.2 (pos_of_ne_zero h2)))).symm)},
    exact absurd h5 irrational.irrational_is_not_rational,
  },

  --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 h6 : ∀ i j : ℤ, i ≠ j → (int_part α i - int_part α j)/(i-j) ∉ ℚ,
  from by {
    assume i j h7,
    assume h8 : (int_part α i - int_part α j)/(i-j) ∈ ℚ,
    have h9 : (int_part α i - int_part α j)%Z = 0, from by {rw ← int.cast_inj, rw ← int.cast_inj, rw [← int.cast_dvd,← int.cast_dvd, h8], exact dvd_sub (dvd_mul_of_dvd_right (dvd_refl _) (int.cast_ne_zero.1 (ne_of_gt (int.cast_pos.2 (pos_of_ne_zero h7)))).symm) (dvd_mul_of_dvd_right (dvd_refl _) (int.cast_ne_zero.1 (ne_of_gt (int.cast_pos.2 (pos_of_ne_zero h7)))).symm)},
    have h10 : (int_part α i - int_part α j) = 0, from by {rw h9, exact int.coe_nat_zero},
    have h11 : (fract α i) = (fract α j), from by {rw [h10,fract_int_part_difference],ring},
    exact absurd h11 (h1 i j h7),
  },

  --Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h12 : ∃ S : set ℤ, (∀ n : ℕ, n ∈ S) ∧ (∀ n : ℕ, n ∉ S),
  from by {exact exists_infinite_set_of_distinct_fractional_parts α h1},

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h13 : ∃ (S : set ℝ), (∀ n : ℕ, n ∈ S) ∧ (∀ n : ℕ, n ∉ S) := by {
    cases h12 with S h14,
    use (fract α '' S),
    split,
    {
      intros n h15,
      have h16 := set.mem_image_of_mem _ h15,
      exact h16.right,
    },
    {
      intros n h17,
      have h18 := set.mem_image_of_mem _ h17,
      exact h18.left,
    },
  },

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  cases h13 with S h19,
  have h20 : ∃ (δ : ℝ), (0 < δ) ∧ (∀ x y : ℝ, (x ∈ S) ∧ (y ∈ S) ∧ (x ≠ y) → (|x - y| < δ)), from by {apply set.has_limit_point_iff.mp h19,},

  --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 h21 : set.has_limit_point (λ (x : ℝ), (|x| : ℝ)) S 0, from by {
    cases h20 with δ h20,
    rw [set.has_limit_point_iff],
    use δ,
    split,
    {exact h20.left},
    {
      assume ε h22,
      cases h20.right (ε/2) h22 with x h23,
      cases h23 with y h23,
      use x,
      use y,
      split,
      {
        intros h24,
        have h25 := h23.left h24,
        have h26 := h23.right h24,
        have h27 := h23.right h24,
        have h28 := h23.left h24,
        have h29 := h23.left h24,
        split,
        {
          have h30 : |x| < ε/2, from by {rw ← h25, rw ← abs_of_nonneg, exact le_of_lt h20.left},
          have h31 : (ε/2) ≤ ε, from by {apply div_le_self, exact h20.left},
          exact le_trans h30 h31,
        },
        {
          have h32 : |y| < ε/2, from by {rw ← h26, rw ← abs_of_nonneg, exact le_of_lt h20.left},
          have h33 : (ε/2) ≤ ε, from by {apply div_le_self, exact h20.left},
          exact le_trans h32 h33,
        },
        {
          have h34 : |x - y| < ε/2, from by {rw ← h27, exact h28},
          have h35 : (ε/2) ≤ ε, from by {apply div_le_self, exact h20.left},
          exact le_trans h34 h35,
        },
        {
          have h36 : |y - x| < ε/2, from by {rw ← h28, exact h29},
          have h37 : (ε/2) ≤ ε, from by {apply div_le_self, exact h20.left},
          exact le_trans h36 h37,
        },
      },
      {
        rintros h38,
        have h39 : |x| < ε/2, from by {rw ← h25, rw ← abs_of_nonneg, exact le_of_lt h20.left},
        have h40 : (ε/2)
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 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) :
  (∀ (i j : ℤ), i ≠ j → ¬ ((i : ℝ) * α) = ((j : ℝ) * α)) ∧ dense ((λ i : ℤ, i * α) '' univ) :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  -- $$
  -- i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  -- $$
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h1 : ∀ (i j : ℤ), i ≠ j → ¬ ((i : ℝ) * α) = ((j : ℝ) * α), from by {
    assume (i j : ℤ) (hij : i ≠ j),
    assume h2 : (i : ℝ) * α = (j : ℝ) * α,
    have h3 : (i : ℝ) * α = ((j : ℝ) * α - (i : ℝ) * α), from by {
      rw h2, ring, },
    have h4 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h5 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h6 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h7 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h8 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h9 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h10 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h11 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h12 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h13 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h14 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h15 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h16 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h17 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h18 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h19 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h20 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h21 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h22 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h23 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h24 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h25 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h26 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h27 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h28 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h29 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h30 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h31 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h32 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h33 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h34 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h35 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from by {
      rw h2, ring, },
    have h36 : (i : ℝ) * α = (j : ℝ) * α - (i : ℝ) * α, from
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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

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

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

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

Let $\epsilon > 0$.

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

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

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

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

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

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

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

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

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

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

Hence the result.
{{qed}}

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

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

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

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

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

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

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

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

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

  },

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

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

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

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

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

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Patrick Massot, Scott Morrison, Mario Carneiro

import category_theory.concrete_category
import category_theory.full_subcategory
import category_theory.functor_category
import category_theory.adjunction
import category_theory.limits.types
import category_theory.natural_isomorphism
import category_theory.eq_to_hom
import topology.basic
import topology.opens
import order.galois_connection

open category_theory
open category_theory.nat_iso
open topological_space

universe u

namespace category_theory.instances

/-- The category of topological spaces and continuous maps. -/
@[reducible] def Top : Type (u+1) := bundled topological_space

instance (x : Top) : topological_space x := x.str

namespace Top
instance : concrete_category @continuous := ⟨@continuous_id, @continuous.comp⟩

-- local attribute [class] continuous
-- instance {R S : Top} (f : R ⟶ S) : continuous (f : R → S) := f.2

section
open category_theory.limits

variables {J : Type u} [small_category J]

def limit (F : J ⥤ Top.{u}) : cone F :=
{ X := ⟨limit (F ⋙ forget), ⨆ j, (F.obj j).str.induced (limit.π (F ⋙ forget) j)⟩,
  π :=
  { app := λ j, ⟨limit.π (F ⋙ forget) j, continuous_iff_induced_le.mpr (lattice.le_supr _ j)⟩,
    naturality' := λ j j' f, subtype.eq ((limit.cone (F ⋙ forget)).π.naturality f) } }

def limit_is_limit (F : J ⥤ Top.{u}) : is_limit (limit F) :=
by refine is_limit.of_faithful forget (limit.is_limit _) (λ s, ⟨_, _⟩) (λ s, rfl);
   exact continuous_iff_le_coinduced.mpr (lattice.supr_le $ λ j,
     induced_le_iff_le_coinduced.mpr $ continuous_iff_le_coinduced.mp (s.π.app j).property)

instance : has_limits.{u} Top.{u} :=
λ J 𝒥 F, by exactI { cone := limit F, is_limit := limit_is_limit F }

instance : preserves_limits (forget : Top.{u} ⥤ Type u) :=
λ J 𝒥 F, by exactI preserves_limit_of_preserves_limit_cone
  (limit.is_limit F) (limit.is_limit (F ⋙ forget))

def colimit (F : J ⥤ Top.{u}) : cocone F :=
{ X := ⟨colimit (F ⋙ forget), ⨅ j, (F.obj j).str.coinduced (colimit.ι (F ⋙ forget) j)⟩,
  ι :=
  { app := λ j, ⟨colimit.ι (F ⋙ forget) j, continuous_iff_le_coinduced.mpr (lattice.infi_le _ j)⟩,
    naturality' := λ j j' f, subtype.eq ((colimit.cocone (F ⋙ forget)).ι.naturality f) } }

def colimit_is_colimit (F : J ⥤ Top.{u}) : is_colimit (colimit F) :=
by refine is_colimit.of_faithful forget (colimit.is_colimit _) (λ s, ⟨_, _⟩) (λ s, rfl);
   exact continuous_iff_induced_le.mpr (lattice.le_infi $ λ j,
     induced_le_iff_le_coinduced.mpr $ continuous_iff_le_coinduced.mp (s.ι.app j).property)

instance : has_colimits.{u} Top.{u} :=
λ J 𝒥 F, by exactI { cocone := colimit F, is_colimit := colimit_is_colimit F }

instance : preserves_colimits (forget : Top.{u} ⥤ Type u) :=
λ J 𝒥 F, by exactI preserves_colimit_of_preserves_colimit_cocone
  (colimit.is_colimit F) (colimit.is_colimit (F ⋙ forget))

end

def discrete : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊤⟩,
  map := λ X Y f, ⟨f, continuous_top⟩ }

def trivial : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊥⟩,
  map := λ X Y f, ⟨f, continuous_bot⟩ }

def adj₁ : adjunction discrete forget :=
{ hom_equiv := λ X Y,
  { to_fun := λ f, f,
    inv_fun := λ f, ⟨f, continuous_top⟩,
    left_inv := by tidy,
    right_inv := by tidy },
  unit := { app := λ X, id },
  counit := { app := λ X, ⟨id, continuous_top⟩ } }

def adj₂ : adjunction forget trivial :=
{ hom_equiv := λ X Y,
  { to_fun := λ f, ⟨f, continuous_bot⟩,
    inv_fun := λ f, f,
    left_inv := by tidy,
    right_inv := by tidy },
  unit := { app := λ X, ⟨id, continuous_bot⟩ },
  counit := { app := λ X, id } }

end Top

variables {X : Top.{u}}

instance : small_category (opens X) := by apply_instance

def nbhd (x : X.α) := { U : opens X // x ∈ U }
def nbhds (x : X.α) : small_category (nbhd x) := begin unfold nbhd, apply_instance end

end category_theory.instances

open category_theory.instances

namespace topological_space.opens

/-- `opens.map f` gives the functor from open sets in Y to open set in X,
    given by taking preimages under f. -/
def map
  {X Y : Top.{u}} (f : X ⟶ Y) : opens Y ⥤ opens X :=
{ obj := λ U, ⟨ f.val ⁻¹' U, f.property _ U.property ⟩,
  map := λ U V i, ⟨ ⟨ λ a b, i.down.down b ⟩ ⟩ }.

@[simp] lemma map_id_obj (X : Top.{u}) (U : opens X) : (map (𝟙 X)).obj U = U := by tidy

@[simp] def map_id (X : Top.{u}) : map (𝟙 X) ≅ functor.id (opens X) :=
{ hom := { app := λ U, 𝟙 U },
  inv := { app := λ U, 𝟙 U } }

-- We could make f g implicit here, but it's nice to be able to see when
-- they are the identity (often!)
def map_iso {X Y : Top.{u}} (f g : X ⟶ Y) (h : f = g) : map f ≅ map g :=
nat_iso.of_components (λ U, eq_to_iso (congr_fun (congr_arg _ (congr_arg _ h)) _) ) (by obviously)

@[simp] def map_iso_id {X : Top.{u}} (h) : map_iso (𝟙 X) (𝟙 X) h = iso.refl (map _) := rfl

end topological_space.opens


import category_theory.limits.shapes.finite_products
import category_theory.preadditive.additive_functor
import category_theory.limits.preserves.shapes.binary_products

noncomputable theory

namespace category_theory

open category

namespace limits

variables {C : Type*} [category C] [preadditive C]

variables (X Y : C) [has_binary_coproduct X Y] [has_binary_product X Y]

def coprod_iso_prod :
  X ⨿ Y ≅ X ⨯ Y :=
{ hom := prod.lift (coprod.desc (𝟙 X) 0) (coprod.desc 0 (𝟙 Y)),
  inv := limits.prod.fst ≫ coprod.inl + limits.prod.snd ≫ coprod.inr, }

@[simp, reassoc]
lemma coprod_inl_coprod_iso_prod_hom :
  coprod.inl ≫ (coprod_iso_prod X Y).hom = prod.lift (𝟙 X) 0 :=
begin
  dsimp [coprod_iso_prod],
  simp only [prod.comp_lift, coprod.inl_desc],
end

@[simp, reassoc]
lemma coprod_inr_coprod_iso_prod_hom :
  coprod.inr ≫ (coprod_iso_prod X Y).hom = prod.lift 0 (𝟙 Y) :=
begin
  dsimp [coprod_iso_prod],
  simp only [prod.comp_lift, coprod.inr_desc],
end

end limits

open limits

variables (C : Type*) [category C] [has_finite_products C]

structure add_comm_group_object :=
(X : C)
(zero : ⊤_ C ⟶ X)
(add : prod X X ⟶ X)
(neg : X ⟶ X)
(add_assoc' : prod.lift (limits.prod.map (𝟙 X) limits.prod.fst ≫ add) (limits.prod.snd ≫ limits.prod.snd) ≫ add =
  (limits.prod.map (𝟙 X) add) ≫ add)
(add_zero' : (prod.lift (terminal.from X ≫ zero) (𝟙 X)) ≫ add = 𝟙 X)
(comm' : prod.lift limits.prod.snd limits.prod.fst ≫ add = add)
(add_left_neg' : prod.lift neg (𝟙 X) ≫ add = terminal.from X ≫ zero)

variable {C}

def add_comm_group_object.add_comm_group_hom
  (A : C) (G : add_comm_group_object C) : add_comm_group (A ⟶ G.X) :=
begin
  let zero : A ⟶ G.X := terminal.from A ≫ G.zero,
  let add := λ (g₁ g₂ : A ⟶ G.X), prod.lift g₁ g₂ ≫ G.add,
  have zero_add : ∀ (g : A ⟶ G.X), add zero g = g,
  { intro g,
    dsimp [add, zero],
    have h := g ≫= G.add_zero',
    simp only [← assoc, comp_id] at h,
    convert h,
    ext,
    { simp only [prod.comp_lift, prod.lift_fst, ← assoc],
      congr' 1, },
    { tidy, }, },
  have comm : ∀ (g₁ g₂ : A ⟶ G.X), add g₁ g₂ = add g₂ g₁,
  { intros g₁ g₂,
    dsimp [add],
    have h := prod.lift g₁ g₂ ≫= G.comm',
    simp only [← assoc] at h,
    convert h.symm,
    tidy, },
  exact
  { add := add,
    add_assoc := λ g₁ g₂ g₃, begin
      dsimp,
      have h := prod.lift g₁ (prod.lift g₂ g₃) ≫= G.add_assoc',
      simp only [← assoc] at h,
      convert h,
      tidy,
    end,
    add_comm := comm,
    zero := zero,
    neg := λ g, g ≫ G.neg,
    zero_add := zero_add,
    add_zero := λ g, begin
      change add g zero = g,
      rw [comm, zero_add],
    end,
    add_left_neg := λ g, begin
      change prod.lift (g ≫ G.neg) g ≫ G.add = terminal.from A ≫ G.zero,
      have h := g ≫= G.add_left_neg',
      simp only [← assoc] at h,
      convert h,
      tidy,
    end, },
end

namespace add_comm_group_object

lemma add_comm_group_object_add [preadditive C] (G : add_comm_group_object C) :
  G.add = limits.prod.fst + limits.prod.snd :=
begin
  haveI : has_finite_biproducts C := limits.has_finite_biproducts.of_has_finite_products,
  let s₀ := terminal.from G.X ≫ G.zero,
  let s₁ := coprod.inl ≫ (coprod_iso_prod G.X G.X).hom ≫ G.add,
  let s₂ := coprod.inr ≫ (coprod_iso_prod G.X G.X).hom ≫ G.add,
  have hs₀ : ∃ t₀, t₀ = s₀ := ⟨s₀, rfl⟩,
  have hs₁ : ∃ t₁, t₁ = s₁ := ⟨s₁, rfl⟩,
  have hs₂ : ∃ t₂, t₂ = s₂ := ⟨s₂, rfl⟩,
  rcases hs₀ with ⟨t₀, ht₀⟩,
  rcases hs₁ with ⟨t₁, ht₁⟩,
  rcases hs₂ with ⟨t₂, ht₂⟩,
  have Gadd : G.add = limits.prod.fst ≫ t₁ + limits.prod.snd ≫ t₂,
  { rw [ht₁, ht₂],
    rw ← cancel_epi (coprod_iso_prod G.X G.X).hom,
    ext,
    { simp only [s₁, coprod_inl_coprod_iso_prod_hom_assoc, preadditive.comp_add,
        prod.lift_fst_assoc, id_comp, prod.lift_snd_assoc, zero_comp, add_zero], },
    { simp only [s₂, coprod_inr_coprod_iso_prod_hom_assoc, preadditive.comp_add,
        prod.lift_fst_assoc, zero_comp, prod.lift_snd_assoc, id_comp, zero_add], }, },
  have h₀ : t₁ ≫ t₁ = t₁ := by simpa only [Gadd, preadditive.comp_add, prod.map_fst_assoc,
    id_comp, prod.map_snd_assoc, prod.lift_fst_assoc, preadditive.add_comp, assoc,
    prod.lift_snd_assoc, zero_comp, add_zero]
      using prod.lift (𝟙 G.X) (prod.lift 0 0) ≫= G.add_assoc',
  have h₁ : t₁ = t₂ := by simpa only [Gadd, preadditive.comp_add,
    prod.lift_fst_assoc, prod.lift_snd_assoc, id_comp, zero_comp,
    add_zero, zero_add] using prod.lift 0 (𝟙 G.X) ≫= G.comm',
  subst h₁,
  have h₂ : t₀ ≫ t₁ + t₁ = 𝟙 G.X := by simpa only [ht₀, ← assoc, Gadd,
    preadditive.comp_add, prod.lift_fst_assoc, prod.lift_snd_assoc, id_comp] using G.add_zero',
  have h₃ : G.neg ≫ t₁ + t₁ = t₀ := by simpa only [ht₀, Gadd, preadditive.comp_add,
    prod.lift_fst_assoc, prod.lift_snd_assoc, id_comp] using G.add_left_neg',
  have h₄ : t₀ + t₁ = 𝟙 G.X,
  { rw [← h₃, preadditive.add_comp, h₀, assoc, h₀, h₃] at h₂,
    exact h₂, },
  have h₅ : t₀ = 𝟙 G.X -t₁ := by simp only [← h₄, add_sub_cancel],
  have h₆ : t₁ = 𝟙 G.X := by simpa only [h₀, h₅, preadditive.sub_comp,
    id_comp, sub_self, zero_add] using h₂,
  subst h₆,
  simpa only [comp_id] using Gadd,
end

local attribute [instance] add_comm_group_object.add_comm_group_hom

lemma add_eq {A : C} {G : add_comm_group_object C} (g₁ g₂ : A ⟶ G.X) :
  g₁ + g₂ = prod.lift g₁ g₂ ≫ G.add := rfl

lemma comp_add {A A': C} (f : A ⟶ A') {G : add_comm_group_object C}
  (g₁ g₂ : A' ⟶ G.X) : f ≫ (g₁ + g₂) = f ≫ g₁ + f ≫ g₂ :=
by simp only [add_eq, prod.comp_lift_assoc]

variable {C}

def hom (G₁ G₂ : add_comm_group_object C) :=
{ f : G₁.X ⟶ G₂.X // G₁.add ≫ f = limits.prod.map f f ≫ G₂.add }

@[simps]
def hom.id (G : add_comm_group_object C) : hom G G :=
⟨𝟙 G.X, by tidy⟩

@[simps]
def hom.comp {G₁ G₂ G₃ : add_comm_group_object C} (f : hom G₁ G₂) (g : hom G₂ G₃) :
  hom G₁ G₃ :=
⟨ f.1 ≫ g.1, begin
  slice_lhs 1 2 { rw f.2,},
  rw [assoc, g.2, prod.map_map_assoc],
end⟩

instance : category (add_comm_group_object C) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z, hom.comp, }

@[simp]
lemma id_val (G : add_comm_group_object C) : subtype.val (𝟙 G) = 𝟙 G.X := rfl

@[simp]
lemma comp_val {G₁ G₂ G₃ : add_comm_group_object C} (f : G₁ ⟶ G₂) (g : G₂ ⟶ G₃) :
  (f ≫ g).1 = f.1 ≫ g.1 := rfl

@[ext]
lemma hom_ext {G₁ G₂ : add_comm_group_object C} (f g : G₁ ⟶ G₂) (h : f.1 = g.1) : f = g := by tidy

variable (C)

@[simps]
def forget : add_comm_group_object C ⥤ C :=
{ obj := λ G, G.X,
  map := λ G₁ G₂ f, f.1, }

variables {C} (F : C ⥤ add_comm_group_object C) (e : F ⋙ forget C ≅ 𝟭 C)

lemma add_comp {A : C} {G G' : add_comm_group_object C} (f₁ f₂ : A ⟶ G.X) (g : G ⟶ G') :
  (f₁ + f₂) ≫ g.1 = f₁ ≫ g.1 + f₂ ≫ g.1 :=
by simp only [add_eq, assoc, g.2, prod.lift_map_assoc]

namespace preadditive_of

include e

def hom_group (X Y : C) : add_comm_group (X ⟶ Y) :=
begin
  let add : (X ⟶ Y) → (X ⟶ Y) → (X ⟶ Y) :=
    λ f₁ f₂, ((f₁ ≫ e.inv.app Y : X ⟶ (F.obj Y).X) + (f₂ ≫ e.inv.app Y : X ⟶ (F.obj Y).X)) ≫ e.hom.app Y,
  have add_comm : ∀ (f₁ f₂), add f₁ f₂ = add f₂ f₁ := λ f₁ f₂, begin
    dsimp [add],
    rw add_comm,
  end,
  let neg : (X ⟶ Y) → (X ⟶ Y) :=
    λ f, (-(f ≫ e.inv.app Y : X ⟶ (F.obj Y).X)) ≫ e.hom.app Y,
  exact
  { add := add,
    add_comm := add_comm,
    add_assoc := λ f₁ f₂ f₃, begin
      change add (add _ _ ) _ = add _ (add _ _ ),
      dsimp [add],
      simp only [assoc, iso.hom_inv_id_app],
      dsimp,
      rw [comp_id, comp_id, add_assoc],
    end,
    zero := (0 : X ⟶ (F.obj Y).X) ≫ e.hom.app Y,
    zero_add := λ f, begin
      change add _ _ = _,
      dsimp [add],
      simp only [assoc, iso.hom_inv_id_app],
      dsimp,
      rw [comp_id, zero_add, assoc, iso.inv_hom_id_app],
      dsimp,
      rw comp_id,
    end,
    add_zero := λ f, begin
      change add _ _ = _,
      dsimp [add],
      simp only [assoc, iso.hom_inv_id_app],
      dsimp,
      rw [comp_id, add_zero, assoc, iso.inv_hom_id_app],
      dsimp,
      rw comp_id,
    end,
    neg := neg,
    add_left_neg := λ f, begin
      change add (neg f) f = _,
      dsimp [add, neg],
      simp only [assoc, iso.hom_inv_id_app],
      dsimp,
      simpa only [comp_id, add_left_neg],
    end, },
end

lemma add_comp_inv_app {X Y : C} (f₁ f₂ : X ⟶ Y) :
  (hom_group F e X Y).add f₁ f₂ ≫ e.inv.app Y =
    (f₁ ≫ e.inv.app Y + f₂ ≫ e.inv.app Y : X ⟶ (F.obj Y).X) :=
begin
  rw [← cancel_mono (e.hom.app Y), assoc, iso.inv_hom_id_app],
  dsimp,
  simpa only [comp_id],
end

end preadditive_of

def preadditive_of : preadditive C :=
{ hom_group := λ X Y, preadditive_of.hom_group F e X Y,
  comp_add' := λ X₁ X₂ X₃ f g₁ g₂, begin
    change f ≫ (preadditive_of.hom_group F e _ _).add _ _ =
      (preadditive_of.hom_group F e _ _).add _ _,
    rw ← cancel_mono (e.inv.app X₃),
    dsimp,
    simp only [preadditive_of.add_comp_inv_app, comp_add, assoc],
  end,
  add_comp' := λ X₁ X₂ X₃ f₁ f₂ g, begin
    change (preadditive_of.hom_group F e _ _).add _ _ ≫ g =
      (preadditive_of.hom_group F e _ _).add _ _,
    rw ← cancel_mono (e.inv.app X₃),
    dsimp,
    have hg := e.inv.naturality g,
    simp only [functor.id_map, functor.comp_map, forget_map] at hg,
    simp only [preadditive_of.add_comp_inv_app, assoc, hg,
      reassoc_of (preadditive_of.add_comp_inv_app F e f₁ f₂)],
    simp only [← assoc],
    apply add_comp,
  end, }

end add_comm_group_object

namespace preadditive

variable (C)

@[simps]
def to_add_comm_group_object [preadditive C] : C ⥤ add_comm_group_object C :=
{ obj := λ X,
  { X := X,
    zero := 0,
    add := limits.prod.fst + limits.prod.snd,
    neg := -𝟙 X,
    add_assoc' := begin
      simp only [comp_add, limits.prod.map_fst, comp_id, limits.prod.map_snd, prod.lift_fst, prod.lift_snd],
      apply add_assoc,
    end,
    add_zero' := by tidy,
    comm' := by simpa only [comp_add, prod.lift_fst, prod.lift_snd] using add_comm _ _,
    add_left_neg' := by simp, },
  map := λ X Y f, ⟨f, by simp⟩, }

@[simps]
def to_add_comm_group_object_comp_forget_iso [preadditive C] :
  (to_add_comm_group_object C) ⋙ add_comm_group_object.forget C ≅ 𝟭 C := iso.refl _

instance : reflects_isomorphisms (add_comm_group_object.forget C) :=
⟨λ G₁ G₂ f hf, begin
  haveI : is_iso f.1 := hf,
  refine ⟨⟨⟨inv f.1, _⟩, _, _⟩⟩,
  { simp only [← cancel_mono f.1, ← cancel_epi (limits.prod.map f.1 f.1), f.2, assoc,
    is_iso.inv_hom_id, comp_id, prod.map_map_assoc, is_iso.hom_inv_id, prod.map_id_id, id_comp], },
  { apply add_comm_group_object.hom_ext,
    exact is_iso.hom_inv_id f.1, },
  { apply add_comm_group_object.hom_ext,
    exact is_iso.inv_hom_id f.1, },
end⟩

variable {C}

lemma add_eq_of_add_comm_group [hC : preadditive C] {X Y : C} {G : add_comm_group_object C} (e : G.X ≅ Y)
  (f₁ f₂ : X ⟶ Y) : f₁ + f₂ = prod.lift (f₁ ≫ e.inv) (f₂ ≫ e.inv) ≫ G.add ≫ e.hom :=
by simp only [G.add_comm_group_object_add, add_comp, comp_add, prod.lift_fst_assoc, assoc,
    iso.inv_hom_id, comp_id, prod.lift_snd_assoc]

end preadditive

namespace functor

variables {C} {D : Type*} [category D]
  [has_finite_products D] (F : C ⥤ D)
  [hF₀ : preserves_limit (functor.empty.{0} C) F]
  [hF₂ : preserves_limits_of_shape (discrete (walking_pair)) F]

include F hF₀ hF₂

lemma preserves_limit_pair_compatibility₁ {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) :
  limits.prod.map (F.map f₁) (F.map f₂) = (preserves_limit_pair.iso F X₁ X₂).inv ≫
    F.map (limits.prod.map f₁ f₂) ≫ (preserves_limit_pair.iso F Y₁ Y₂).hom :=
begin
  rw [← cancel_epi ((preserves_limit_pair.iso F X₁ X₂).hom), iso.hom_inv_id_assoc],
  ext,
  { simp only [preserves_limit_pair.iso_hom, assoc, limits.prod.map_fst, prod_comparison_fst_assoc,
      prod_comparison_fst, ← F.map_comp], },
  { simp only [preserves_limit_pair.iso_hom, assoc, limits.prod.map_snd, prod_comparison_snd_assoc,
      prod_comparison_snd, ← F.map_comp], },
end

lemma preserves_limit_pair_compatibility₂ {X₁ X₂ : C} :
  limits.prod.lift (limits.prod.snd : F.obj X₁ ⨯ F.obj X₂ ⟶ F.obj X₂) (limits.prod.fst : F.obj X₁ ⨯ F.obj X₂ ⟶ F.obj X₁)
  = (preserves_limit_pair.iso F X₁ X₂).inv ≫
  F.map (limits.prod.lift (limits.prod.snd : X₁ ⨯ X₂ ⟶ X₂) (limits.prod.fst : X₁ ⨯ X₂ ⟶ X₁)) ≫
    (preserves_limit_pair.iso F X₂ X₁).hom :=
begin
  rw [← cancel_epi ((preserves_limit_pair.iso F X₁ X₂).hom), iso.hom_inv_id_assoc],
  ext,
  { simp only [preserves_limit_pair.iso_hom, prod_comparison_snd, prod_comparison_fst,
      prod.lift_fst, assoc, ← F.map_comp], },
  { simp only [preserves_limit_pair.iso_hom, prod_comparison_snd, prod_comparison_fst,
      prod.lift_snd, assoc, ← F.map_comp], },
end

lemma preserves_limit_pair_compatibility₃ {X Y₁ Y₂ : C} (f₁ : X ⟶ Y₁) (f₂ : X ⟶ Y₂) :
  limits.prod.lift (F.map f₁) (F.map f₂) =
    F.map (limits.prod.lift f₁ f₂) ≫ (preserves_limit_pair.iso F Y₁ Y₂).hom :=
begin
  ext,
  { simp only [prod.lift_fst, preserves_limit_pair.iso_hom, assoc, prod_comparison_fst,
      ← F.map_comp], },
  { simp only [prod.lift_snd, preserves_limit_pair.iso_hom, assoc, prod_comparison_snd,
      ← F.map_comp], },
end

lemma preserves_limit_pair_compatibility_fst (X₁ X₂ : C) :
  limits.prod.fst = (preserves_limit_pair.iso F X₁ X₂).inv ≫ F.map limits.prod.fst  :=
by rw [← cancel_epi (preserves_limit_pair.iso F X₁ X₂).hom,
    iso.hom_inv_id_assoc, preserves_limit_pair.iso_hom, prod_comparison_fst]

lemma preserves_limit_pair_compatibility_snd (X₁ X₂ : C) :
  limits.prod.snd = (preserves_limit_pair.iso F X₁ X₂).inv ≫ F.map limits.prod.snd  :=
by rw [← cancel_epi (preserves_limit_pair.iso F X₁ X₂).hom,
    iso.hom_inv_id_assoc, preserves_limit_pair.iso_hom, prod_comparison_snd]

lemma preserves_terminal_compatibility (X : C) :
  terminal.from (F.obj X) = F.map (terminal.from X) ≫ (preserves_terminal.iso F).hom :=
subsingleton.elim _ _

@[simps]
def map_add_comm_group_object.obj (G : add_comm_group_object C) : add_comm_group_object D :=
{ X := F.obj G.X,
  zero := (preserves_terminal.iso F).inv ≫ F.map G.zero,
  add := (preserves_limit_pair.iso F G.X G.X).inv ≫ F.map G.add,
  neg := F.map G.neg,
  add_assoc' := begin
    rw ← cancel_epi (limits.prod.map (𝟙 (F.obj G.X)) (preserves_limit_pair.iso F G.X G.X).hom),
    rw ← cancel_epi (preserves_limit_pair.iso F G.X (G.X ⨯ G.X)).hom,
    convert F.congr_map G.add_assoc',
    { simp only [F.map_comp, ← assoc],
      congr' 1,
      simp only [assoc, ← cancel_mono (preserves_limit_pair.iso F G.X G.X).hom,
        iso.inv_hom_id, comp_id],
      ext,
      { rw [assoc, assoc, assoc, prod.lift_fst, prod.map_map_assoc, comp_id,
          preserves_limit_pair_compatibility_fst, iso.hom_inv_id_assoc,
          ← F.map_id, preserves_limit_pair_compatibility₁, assoc, assoc,
          iso.hom_inv_id_assoc, iso.hom_inv_id_assoc, ← F.map_comp,
          ← F.map_comp, prod.lift_fst], },
      { rw [assoc, assoc, assoc, prod.lift_snd, prod.map_snd_assoc,
          preserves_limit_pair_compatibility_snd, assoc, iso.hom_inv_id_assoc,
          preserves_limit_pair_compatibility_snd, iso.hom_inv_id_assoc,
          ← F.map_comp, ← F.map_comp, prod.lift_snd], }, },
    { rw [prod.map_map_assoc, id_comp, iso.hom_inv_id_assoc, F.map_comp, ← assoc, ← assoc],
      conv_lhs { rw ← F.map_id, },
      simp only [preserves_limit_pair_compatibility₁, assoc, iso.hom_inv_id_assoc], },
  end,
  add_zero' := begin
    simp only [preserves_terminal_compatibility, assoc, iso.hom_inv_id_assoc, ← F.map_comp],
    nth_rewrite 0 ← F.map_id,
    rw [preserves_limit_pair_compatibility₃, assoc, iso.hom_inv_id_assoc, ← F.map_comp,
      G.add_zero', F.map_id],
  end,
  comm' := by simp only [preserves_limit_pair_compatibility₂, assoc,
    iso.hom_inv_id_assoc, ← F.map_comp, G.comm'],
  add_left_neg' := begin
    rw [← F.map_id, preserves_limit_pair_compatibility₃, assoc, iso.hom_inv_id_assoc,
      ← F.map_comp, G.add_left_neg', preserves_terminal_compatibility, assoc,
      iso.hom_inv_id_assoc, F.map_comp],
  end, }

@[simps]
def map_add_comm_group_object :
  add_comm_group_object C ⥤ add_comm_group_object D :=
{ obj := λ G, map_add_comm_group_object.obj F G,
  map := λ G₁ G₂ f, ⟨F.map f.1, by simp only [map_add_comm_group_object.obj_add, assoc,
    ← F.map_comp, f.2, preserves_limit_pair_compatibility₁, assoc, iso.hom_inv_id_assoc]⟩, }

lemma map_add_comm_group_object_add_compatibility {X : C} (G : add_comm_group_object C)
  (f₁ f₂ : X ⟶ G.X) : F.map (prod.lift f₁ f₂ ≫ G.add) =
  prod.lift (F.map f₁) (F.map f₂) ≫ (F.map_add_comm_group_object.obj G).add :=
begin
  dsimp [map_add_comm_group_object.obj],
  simp only [assoc, preserves_limit_pair_compatibility₃, iso.hom_inv_id_assoc, ← F.map_comp],
end

lemma additive_of_preserves_binary_products [hC : preadditive C] [hD : preadditive D] : F.additive :=
⟨λ X Y f₁ f₂, begin
  let G := (preadditive.to_add_comm_group_object C).obj Y,
  let e : G.X ≅ Y := iso.refl _,
  let G' := F.map_add_comm_group_object.obj G,
  let e' : G'.X ≅ F.obj Y := iso.refl _,
  rw preadditive.add_eq_of_add_comm_group e,
  rw preadditive.add_eq_of_add_comm_group e',
  dsimp [e, e'],
  repeat { erw comp_id, },
  exact map_add_comm_group_object_add_compatibility F G f₁ f₂,
end⟩

end functor

end category_theory


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finsupp.basic
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_2 u_4 u_3 u_5 u_6

namespace Mathlib

/-!
# Properties of the semimodule `α →₀ M`

Given an `R`-semimodule `M`, the `R`-semimodule structure on `α →₀ M` is defined in
`data.finsupp.basic`.

In this file we define `finsupp.supported s` to be the set `{f : α →₀ M | f.support ⊆ s}`
interpreted as a submodule of `α →₀ M`. We also define `linear_map` versions of various maps:

* `finsupp.lsingle a : M →ₗ[R] ι →₀ M`: `finsupp.single a` as a linear map;

* `finsupp.lapply a : (ι →₀ M) →ₗ[R] M`: the map `λ f, f a` as a linear map;

* `finsupp.lsubtype_domain (s : set α) : (α →₀ M) →ₗ[R] (s →₀ M)`: restriction to a subtype as a
  linear map;

* `finsupp.restrict_dom`: `finsupp.filter` as a linear map to `finsupp.supported s`;

* `finsupp.lsum`: `finsupp.sum` or `finsupp.lift_add_hom` as a `linear_map`;

* `finsupp.total α M R (v : ι → M)`: sends `l : ι → R` to the linear combination of `v i` with
  coefficients `l i`;

* `finsupp.total_on`: a restricted version of `finsupp.total` with domain `finsupp.supported R R s`
  and codomain `submodule.span R (v '' s)`;

* `finsupp.supported_equiv_finsupp`: a linear equivalence between the functions `α →₀ M` supported
  on `s` and the functions `s →₀ M`;

* `finsupp.lmap_domain`: a linear map version of `finsupp.map_domain`;

* `finsupp.dom_lcongr`: a `linear_equiv` version of `finsupp.dom_congr`;

* `finsupp.congr`: if the sets `s` and `t` are equivalent, then `supported M R s` is equivalent to
  `supported M R t`;

* `finsupp.lcongr`: a `linear_equiv`alence between `α →₀ M` and `β →₀ N` constructed using `e : α ≃
  β` and `e' : M ≃ₗ[R] N`.

## Tags

function with finite support, semimodule, linear algebra
-/

namespace finsupp

/-- Interpret `finsupp.single a` as a linear map. -/
def lsingle {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] (a : α) : linear_map R M (α →₀ M) :=
  linear_map.mk (add_monoid_hom.to_fun (single_add_hom a)) sorry sorry

/-- Two `R`-linear maps from `finsupp X M` which agree on each `single x y` agree everywhere. -/
theorem lhom_ext {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    {φ : linear_map R (α →₀ M) N} {ψ : linear_map R (α →₀ M) N}
    (h : ∀ (a : α) (b : M), coe_fn φ (single a b) = coe_fn ψ (single a b)) : φ = ψ :=
  linear_map.to_add_monoid_hom_injective (add_hom_ext h)

/-- Two `R`-linear maps from `finsupp X M` which agree on each `single x y` agree everywhere.

We formulate this fact using equality of linear maps `φ.comp (lsingle a)` and `ψ.comp (lsingle a)`
so that the `ext` tactic can apply a type-specific extensionality lemma to prove equality of these
maps. E.g., if `M = R`, then it suffices to verify `φ (single a 1) = ψ (single a 1)`. -/
theorem lhom_ext' {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    {φ : linear_map R (α →₀ M) N} {ψ : linear_map R (α →₀ M) N}
    (h : ∀ (a : α), linear_map.comp φ (lsingle a) = linear_map.comp ψ (lsingle a)) : φ = ψ :=
  lhom_ext fun (a : α) => linear_map.congr_fun (h a)

/-- Interpret `λ (f : α →₀ M), f a` as a linear map. -/
def lapply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] (a : α) : linear_map R (α →₀ M) M :=
  linear_map.mk (add_monoid_hom.to_fun (apply_add_hom a)) sorry sorry

/-- Interpret `finsupp.subtype_domain s` as a linear map. -/
def lsubtype_domain {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] (s : set α) : linear_map R (α →₀ M) (↥s →₀ M) :=
  linear_map.mk (subtype_domain fun (x : α) => x ∈ s) sorry sorry

theorem lsubtype_domain_apply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (f : α →₀ M) :
    coe_fn (lsubtype_domain s) f = subtype_domain (fun (x : α) => x ∈ s) f :=
  rfl

@[simp] theorem lsingle_apply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (a : α) (b : M) : coe_fn (lsingle a) b = single a b :=
  rfl

@[simp] theorem lapply_apply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (a : α) (f : α →₀ M) : coe_fn (lapply a) f = coe_fn f a :=
  rfl

@[simp] theorem ker_lsingle {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (a : α) : linear_map.ker (lsingle a) = ⊥ :=
  linear_map.ker_eq_bot_of_injective (single_injective a)

theorem lsingle_range_le_ker_lapply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (t : set α) (h : disjoint s t) :
    (supr fun (a : α) => supr fun (H : a ∈ s) => linear_map.range (lsingle a)) ≤
        infi fun (a : α) => infi fun (H : a ∈ t) => linear_map.ker (lapply a) :=
  sorry

theorem infi_ker_lapply_le_bot {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] : (infi fun (a : α) => linear_map.ker (lapply a)) ≤ ⊥ :=
  sorry

theorem supr_lsingle_range {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] : (supr fun (a : α) => linear_map.range (lsingle a)) = ⊤ :=
  sorry

theorem disjoint_lsingle_lsingle {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (t : set α) (hs : disjoint s t) :
    disjoint (supr fun (a : α) => supr fun (H : a ∈ s) => linear_map.range (lsingle a))
        (supr fun (a : α) => supr fun (H : a ∈ t) => linear_map.range (lsingle a)) :=
  sorry

theorem span_single_image {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set M) (a : α) :
    submodule.span R (single a '' s) = submodule.map (lsingle a) (submodule.span R s) :=
  sorry

/-- `finsupp.supported M R s` is the `R`-submodule of all `p : α →₀ M` such that `p.support ⊆ s`. -/
def supported {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] (s : set α) : submodule R (α →₀ M) :=
  submodule.mk (set_of fun (p : α →₀ M) => ↑(support p) ⊆ s) sorry sorry sorry

theorem mem_supported {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {s : set α} (p : α →₀ M) : p ∈ supported M R s ↔ ↑(support p) ⊆ s :=
  iff.rfl

theorem mem_supported' {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {s : set α} (p : α →₀ M) :
    p ∈ supported M R s ↔ ∀ (x : α), ¬x ∈ s → coe_fn p x = 0 :=
  sorry

theorem single_mem_supported {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {s : set α} {a : α} (b : M) (h : a ∈ s) :
    single a b ∈ supported M R s :=
  set.subset.trans support_single_subset (iff.mpr finset.singleton_subset_set_iff h)

theorem supported_eq_span_single {α : Type u_1} (R : Type u_4) [semiring R] (s : set α) :
    supported R R s = submodule.span R ((fun (i : α) => single i 1) '' s) :=
  sorry

/-- Interpret `finsupp.filter s` as a linear map from `α →₀ M` to `supported M R s`. -/
def restrict_dom {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] (s : set α) : linear_map R (α →₀ M) ↥(supported M R s) :=
  linear_map.cod_restrict (supported M R s)
    (linear_map.mk (filter fun (_x : α) => _x ∈ s) sorry sorry) sorry

@[simp] theorem restrict_dom_apply {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (l : α →₀ M) :
    ↑(coe_fn (restrict_dom M R s) l) = filter (fun (_x : α) => _x ∈ s) l :=
  rfl

theorem restrict_dom_comp_subtype {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) :
    linear_map.comp (restrict_dom M R s) (submodule.subtype (supported M R s)) = linear_map.id :=
  sorry

theorem range_restrict_dom {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) : linear_map.range (restrict_dom M R s) = ⊤ :=
  sorry

theorem supported_mono {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] {s : set α} {t : set α} (st : s ⊆ t) : supported M R s ≤ supported M R t :=
  fun (l : α →₀ M) (h : l ∈ supported M R s) => set.subset.trans h st

@[simp] theorem supported_empty {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] : supported M R ∅ = ⊥ :=
  sorry

@[simp] theorem supported_univ {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] : supported M R set.univ = ⊤ :=
  iff.mpr eq_top_iff fun (l : α →₀ M) (_x : l ∈ ⊤) => set.subset_univ ↑(support l)

theorem supported_Union {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] {δ : Type u_3} (s : δ → set α) :
    supported M R (set.Union fun (i : δ) => s i) = supr fun (i : δ) => supported M R (s i) :=
  sorry

theorem supported_union {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (t : set α) :
    supported M R (s ∪ t) = supported M R s ⊔ supported M R t :=
  sorry

theorem supported_Inter {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] {ι : Type u_3} (s : ι → set α) :
    supported M R (set.Inter fun (i : ι) => s i) = infi fun (i : ι) => supported M R (s i) :=
  sorry

theorem supported_inter {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) (t : set α) :
    supported M R (s ∩ t) = supported M R s ⊓ supported M R t :=
  sorry

theorem disjoint_supported_supported {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] {s : set α} {t : set α} (h : disjoint s t) :
    disjoint (supported M R s) (supported M R t) :=
  sorry

theorem disjoint_supported_supported_iff {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [nontrivial M] {s : set α} {t : set α} :
    disjoint (supported M R s) (supported M R t) ↔ disjoint s t :=
  sorry

/-- Interpret `finsupp.restrict_support_equiv` as a linear equivalence between
`supported M R s` and `s →₀ M`. -/
def supported_equiv_finsupp {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] (s : set α) :
    linear_equiv R (↥(supported M R s)) (↥s →₀ M) :=
  let F : ↥(supported M R s) ≃ (↥s →₀ M) := restrict_support_equiv s M;
  equiv.to_linear_equiv F sorry

/-- Lift a family of linear maps `M →ₗ[R] N` indexed by `x : α` to a linear map from `α →₀ M` to
`N` using `finsupp.sum`. This is an upgraded version of `finsupp.lift_add_hom`.
We define this as an additive equivalence. For a commutative `R`, this equivalence can be
upgraded further to a linear equivalence. -/
def lsum {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N] :
    (α → linear_map R M N) ≃+ linear_map R (α →₀ M) N :=
  add_equiv.mk
    (fun (F : α → linear_map R M N) =>
      linear_map.mk (fun (d : α →₀ M) => sum d fun (i : α) => ⇑(F i)) sorry sorry)
    (fun (F : linear_map R (α →₀ M) N) (x : α) => linear_map.comp F (lsingle x)) sorry sorry sorry

@[simp] theorem coe_lsum {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    (f : α → linear_map R M N) :
    ⇑(coe_fn lsum f) = fun (d : α →₀ M) => sum d fun (i : α) => ⇑(f i) :=
  rfl

theorem lsum_apply {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    (f : α → linear_map R M N) (l : α →₀ M) :
    coe_fn (coe_fn lsum f) l = sum l fun (b : α) => ⇑(f b) :=
  rfl

theorem lsum_single {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    (f : α → linear_map R M N) (i : α) (m : M) :
    coe_fn (coe_fn lsum f) (single i m) = coe_fn (f i) m :=
  sum_single_index (linear_map.map_zero (f i))

theorem lsum_symm_apply {α : Type u_1} {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N]
    (f : linear_map R (α →₀ M) N) (x : α) :
    coe_fn (add_equiv.symm lsum) f x = linear_map.comp f (lsingle x) :=
  rfl

/-- Interpret `finsupp.lmap_domain` as a linear map. -/
def lmap_domain {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {α' : Type u_5} (f : α → α') : linear_map R (α →₀ M) (α' →₀ M) :=
  linear_map.mk (map_domain f) sorry map_domain_smul

@[simp] theorem lmap_domain_apply {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} (f : α → α') (l : α →₀ M) :
    coe_fn (lmap_domain M R f) l = map_domain f l :=
  rfl

@[simp] theorem lmap_domain_id {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] : lmap_domain M R id = linear_map.id :=
  linear_map.ext fun (l : α →₀ M) => map_domain_id

theorem lmap_domain_comp {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} {α'' : Type u_6} (f : α → α')
    (g : α' → α'') :
    lmap_domain M R (g ∘ f) = linear_map.comp (lmap_domain M R g) (lmap_domain M R f) :=
  linear_map.ext fun (l : α →₀ M) => map_domain_comp

theorem supported_comap_lmap_domain {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} (f : α → α') (s : set α') :
    supported M R (f ⁻¹' s) ≤ submodule.comap (lmap_domain M R f) (supported M R s) :=
  sorry

theorem lmap_domain_supported {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} [Nonempty α] (f : α → α') (s : set α) :
    submodule.map (lmap_domain M R f) (supported M R s) = supported M R (f '' s) :=
  sorry

theorem lmap_domain_disjoint_ker {α : Type u_1} (M : Type u_2) (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} (f : α → α') {s : set α}
    (H : ∀ (a b : α), a ∈ s → b ∈ s → f a = f b → a = b) :
    disjoint (supported M R s) (linear_map.ker (lmap_domain M R f)) :=
  sorry

/-- Interprets (l : α →₀ R) as linear combination of the elements in the family (v : α → M) and
    evaluates this linear combination. -/
protected def total (α : Type u_1) (M : Type u_2) (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] (v : α → M) : linear_map R (α →₀ R) M :=
  coe_fn lsum fun (i : α) => linear_map.smul_right linear_map.id (v i)

theorem total_apply {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {v : α → M} (l : α →₀ R) :
    coe_fn (finsupp.total α M R v) l = sum l fun (i : α) (a : R) => a • v i :=
  rfl

theorem total_apply_of_mem_supported {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {v : α → M} {l : α →₀ R} {s : finset α}
    (hs : l ∈ supported R R ↑s) :
    coe_fn (finsupp.total α M R v) l = finset.sum s fun (i : α) => coe_fn l i • v i :=
  sorry

@[simp] theorem total_single {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {v : α → M} (c : R) (a : α) :
    coe_fn (finsupp.total α M R v) (single a c) = c • v a :=
  sorry

theorem total_unique {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] [unique α] (l : α →₀ R) (v : α → M) :
    coe_fn (finsupp.total α M R v) l = coe_fn l Inhabited.default • v Inhabited.default :=
  sorry

theorem total_range {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {v : α → M} (h : function.surjective v) :
    linear_map.range (finsupp.total α M R v) = ⊤ :=
  sorry

theorem range_total {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {v : α → M} :
    linear_map.range (finsupp.total α M R v) = submodule.span R (set.range v) :=
  sorry

theorem lmap_domain_total {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} {M' : Type u_6} [add_comm_monoid M']
    [semimodule R M'] {v : α → M} {v' : α' → M'} (f : α → α') (g : linear_map R M M')
    (h : ∀ (i : α), coe_fn g (v i) = v' (f i)) :
    linear_map.comp (finsupp.total α' M' R v') (lmap_domain R R f) =
        linear_map.comp g (finsupp.total α M R v) :=
  sorry

theorem total_emb_domain {α : Type u_1} (R : Type u_4) [semiring R] {α' : Type u_5} {M' : Type u_6}
    [add_comm_monoid M'] [semimodule R M'] {v' : α' → M'} (f : α ↪ α') (l : α →₀ R) :
    coe_fn (finsupp.total α' M' R v') (emb_domain f l) =
        coe_fn (finsupp.total α M' R (v' ∘ ⇑f)) l :=
  sorry

theorem total_map_domain {α : Type u_1} (R : Type u_4) [semiring R] {α' : Type u_5} {M' : Type u_6}
    [add_comm_monoid M'] [semimodule R M'] {v' : α' → M'} (f : α → α') (hf : function.injective f)
    (l : α →₀ R) :
    coe_fn (finsupp.total α' M' R v') (map_domain f l) = coe_fn (finsupp.total α M' R (v' ∘ f)) l :=
  sorry

theorem span_eq_map_total {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {v : α → M} (s : set α) :
    submodule.span R (v '' s) = submodule.map (finsupp.total α M R v) (supported R R s) :=
  sorry

theorem mem_span_iff_total {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {v : α → M} {s : set α} {x : M} :
    x ∈ submodule.span R (v '' s) ↔
        ∃ (l : α →₀ R), ∃ (H : l ∈ supported R R s), coe_fn (finsupp.total α M R v) l = x :=
  sorry

/-- `finsupp.total_on M v s` interprets `p : α →₀ R` as a linear combination of a
subset of the vectors in `v`, mapping it to the span of those vectors.

The subset is indicated by a set `s : set α` of indices.
-/
protected def total_on (α : Type u_1) (M : Type u_2) (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] (v : α → M) (s : set α) :
    linear_map R ↥(supported R R s) ↥(submodule.span R (v '' s)) :=
  linear_map.cod_restrict (submodule.span R (v '' s))
    (linear_map.comp (finsupp.total α M R v) (submodule.subtype (supported R R s))) sorry

theorem total_on_range {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {v : α → M} (s : set α) : linear_map.range (finsupp.total_on α M R v s) = ⊤ :=
  sorry

theorem total_comp {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R] [add_comm_monoid M]
    [semimodule R M] {α' : Type u_5} {v : α → M} (f : α' → α) :
    finsupp.total α' M R (v ∘ f) = linear_map.comp (finsupp.total α M R v) (lmap_domain R R f) :=
  sorry

theorem total_comap_domain {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {α' : Type u_5} {v : α → M} (f : α → α') (l : α' →₀ R)
    (hf : set.inj_on f (f ⁻¹' ↑(support l))) :
    coe_fn (finsupp.total α M R v) (comap_domain f l hf) =
        finset.sum (finset.preimage (support l) f hf) fun (i : α) => coe_fn l (f i) • v i :=
  sorry

theorem total_on_finset {α : Type u_1} {M : Type u_2} (R : Type u_4) [semiring R]
    [add_comm_monoid M] [semimodule R M] {s : finset α} {f : α → R} (g : α → M)
    (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) :
    coe_fn (finsupp.total α M R g) (on_finset s f hf) = finset.sum s fun (x : α) => f x • g x :=
  sorry

/-- An equivalence of domains induces a linear equivalence of finitely supported functions. -/
protected def dom_lcongr {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] {α₁ : Type u_1} {α₂ : Type u_3} (e : α₁ ≃ α₂) :
    linear_equiv R (α₁ →₀ M) (α₂ →₀ M) :=
  add_equiv.to_linear_equiv (finsupp.dom_congr e) sorry

@[simp] theorem dom_lcongr_single {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] {α₁ : Type u_1} {α₂ : Type u_3} (e : α₁ ≃ α₂) (i : α₁) (m : M) :
    coe_fn (finsupp.dom_lcongr e) (single i m) = single (coe_fn e i) m :=
  sorry

/-- An equivalence of sets induces a linear equivalence of `finsupp`s supported on those sets. -/
def congr {α : Type u_1} {M : Type u_2} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] {α' : Type u_3} (s : set α) (t : set α') (e : ↥s ≃ ↥t) :
    linear_equiv R ↥(supported M R s) ↥(supported M R t) :=
  linear_equiv.trans (supported_equiv_finsupp s)
    (linear_equiv.trans (finsupp.dom_lcongr e) (linear_equiv.symm (supported_equiv_finsupp t)))

/-- An equivalence of domain and a linear equivalence of codomain induce a linear equivalence of the
corresponding finitely supported functions. -/
def lcongr {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R] [add_comm_monoid M]
    [semimodule R M] [add_comm_monoid N] [semimodule R N] {ι : Type u_1} {κ : Type u_5} (e₁ : ι ≃ κ)
    (e₂ : linear_equiv R M N) : linear_equiv R (ι →₀ M) (κ →₀ N) :=
  linear_equiv.trans (finsupp.dom_lcongr e₁)
    (linear_equiv.mk (map_range (⇑e₂) (linear_equiv.map_zero e₂)) sorry sorry
      (map_range ⇑(linear_equiv.symm e₂) sorry) sorry sorry)

@[simp] theorem lcongr_single {M : Type u_2} {N : Type u_3} {R : Type u_4} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N] {ι : Type u_1}
    {κ : Type u_5} (e₁ : ι ≃ κ) (e₂ : linear_equiv R M N) (i : ι) (m : M) :
    coe_fn (lcongr e₁ e₂) (single i m) = single (coe_fn e₁ i) (coe_fn e₂ m) :=
  sorry

end finsupp

theorem linear_map.map_finsupp_total {R : Type u_1} {M : Type u_2} {N : Type u_3} [semiring R]
    [add_comm_monoid M] [semimodule R M] [add_comm_monoid N] [semimodule R N] (f : linear_map R M N)
    {ι : Type u_4} {g : ι → M} (l : ι →₀ R) :
    coe_fn f (coe_fn (finsupp.total ι M R g) l) = coe_fn (finsupp.total ι N R (⇑f ∘ g)) l :=
  sorry

theorem submodule.exists_finset_of_mem_supr {R : Type u_1} {M : Type u_2} [semiring R]
    [add_comm_monoid M] [semimodule R M] {ι : Type u_3} (p : ι → submodule R M) {m : M}
    (hm : m ∈ supr fun (i : ι) => p i) :
    ∃ (s : finset ι), m ∈ supr fun (i : ι) => supr fun (H : i ∈ s) => p i :=
  sorry

theorem mem_span_finset {R : Type u_1} {M : Type u_2} [semiring R] [add_comm_monoid M]
    [semimodule R M] {s : finset M} {x : M} :
    x ∈ submodule.span R ↑s ↔ ∃ (f : M → R), (finset.sum s fun (i : M) => f i • i) = x :=
  sorry

end Mathlib