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
  have h1 : ∀ (i j : ℤ), i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : α * ↑i - ↑(int.floor (α * ↑i)) = int.fract (α * ↑i), from by {
      rw int.fract_def,
      ring,
    },
    have h3 : α * ↑j - ↑(int.floor (α * ↑j)) = int.fract (α * ↑j), from by {
      rw int.fract_def,
      ring,
    },
    have h4 : α * ↑i - ↑(int.floor (α * ↑i)) = α * ↑j - ↑(int.floor (α * ↑j)), from by {
      rw h2, rw h3,
    },
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {
      rw ← int.fract_add_floor_eq_of_lt (α * ↑i) (by {norm_num}),
      rw ← int.fract_add_floor_eq_of_lt (α * ↑j) (by {norm_num}),
      rw h4,
      rw int.fract_add_floor_eq_of_lt (α * ↑i) (by {norm_num}),
      rw int.fract_add_floor_eq_of_lt (α * ↑j) (by {norm_num}),
      rw ← int.fract_add_floor_eq_of_lt (α * ↑i) (by {norm_num}),
      rw ← int.fract_add_floor_eq_of_lt (α * ↑j) (by {norm_num}),
      rw int.fract_add_floor_eq_of_lt (α * ↑i) (by {norm_num}),
      rw int.fract_add_floor_eq_of_lt (α * ↑j) (by {norm_num}),
      ring,
    },
    have h6 : α ∈ ℚ, from by {
      rw ← h5,
      apply int.cast_ne_zero.1 hij,
    },
    have h7 : irrational α, from hα_irrat,
    have h8 : ¬(α ∈ ℚ), from h7,
    have h9 : false, from by {
      apply h8 h6,
    },
    show (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
      apply h9,
    },

  have h2 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ set.Icc 0 1, from
    assume (i : ℤ),
    have h3 : 0 ≤ int.fract (α * ↑i), from by {
      rw int.fract_def,
      apply int.cast_nonneg,
    },
    have h4 : int.fract (α * ↑i) < 1, from by {
      rw int.fract_def,
      have h5 : α * ↑i - ↑(int.floor (α * ↑i)) < 1, from by {
        apply int.cast_lt.2,
        rw ← int.coe_nat_lt_coe_nat_iff,
        apply int.fract_lt_one,
      },
      have h6 : 0 < α * ↑i - ↑(int.floor (α * ↑i)), from by {
        apply int.cast_pos,
        rw ← int.coe_nat_lt_coe_nat_iff,
        apply int.fract_pos,
        norm_num,
      },
      have h7 : 0 ≤ ↑(int.floor (α * ↑i)), from by {
        apply int.cast_nonneg,
      },
      linarith,
    },
    show int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
      apply set.mem_Icc.2,
      split,
      exact h3,
      exact h4,
    },

  have h3 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1,
  have h4 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ∉ set.range (λ (m : ℤ), int.fract (α * ↑m)), from
    assume (i j : ℤ) (hij : i ≠ j),
    have h5 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h3 i j hij,
    show int.fract (α * ↑i) ∉ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
      rw set.mem_range,
      rw set.mem_range at h5,
      exact h5,
    },

  have h5 : ∀ (i : ℤ), int.fract (α * ↑i) ∉ set.range (λ (m : ℤ), int.fract (α * ↑m)), from
    assume (i : ℤ),
    have h6 : ∃ (j : ℤ), i ≠ j, from by {
      have h7 : ∀ (j : ℤ), i ≠ j → ∃ (k : ℤ), i ≠ k, from by {
        assume (j : ℤ) (hij : i ≠ j),
        have h8 : ∃ (k : ℤ), k ≠ j, from by {
          use j,
          norm_num,
        },
        cases h8 with k hk,
        use k,
        exact hk,
      },
      have h9 : ∃ (j : ℤ), ∀ (k : ℤ), i ≠ k → i ≠ j, from by {
        use i,
        assume (k : ℤ) (hik : i ≠ k),
        exact hik,
      },
      cases h9 with j hj,
      use j,
      exact hj j (hj j),
    },
    cases h6 with j hj,
    h4 i j hj,

  have h6 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ closure (set.range (λ (m : ℤ), int.fract (α * ↑m))), from
    assume (i : ℤ),
    have h7 : ∀ (j : ℤ), i ≠ j → int.fract (α * ↑i) ∈ closure (set.range (λ (m : ℤ), int.fract (α * ↑m))), from by {
      assume (j : ℤ) (hij : i ≠ j),
      have h8 : int.fract (α * ↑i) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
        rw set.mem_range,
        use i,
        refl,
      },
      have h9 : int.fract (α * ↑i) ∉ closure (set.range (λ (m : ℤ), int.fract (α * ↑m))), from by {
        rw set.mem_closure_iff,
        rw set.mem_range at h8,
        cases h8 with k hk,
        rw hk,
        use int.fract (α * ↑k),
        assume h10,
        have h11 : int.fract (α * ↑i) ∉ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
          rw set.mem_range at h10,
          cases h10 with l hl,
          rw hl,

end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : (α * ↑i) - (int.floor (α * ↑i)) = (int.floor (α * ↑j)) - (int.floor (α * ↑j)),
    from by {rw h2, ring},
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)),
    from by {rw h3, ring},
    have h5 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)),
    from by {rw h3, ring},
    have h6 : α = (int.floor (α * ↑i)) - (int.floor (α * ↑j)) / (i - j),
    from by {rw h4, ring},
    have h7 : (int.floor (α * ↑i)) - (int.floor (α * ↑j)) / (i - j) ∈ ℚ,
    from by {apply int.cast_div,},
    have h8 : α ∈ ℚ, from by {rw h6, exact h7,},
    have h9 : irrational α, from hα_irrat,
    contradiction,
  },
  have h2 : set.finite (set.range (λ (m : ℤ), int.fract (α * ↑m))), from by {
    apply set.finite_range,
  },
  have h3 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ≠ 0, from by {
    assume x h,
    assume h2 : int.fract (α * ↑x) = 0,
    have h3 : (α * ↑x) - (int.floor (α * ↑x)) = 0,
    from by {rw h2, ring},
    have h4 : (α * ↑x) - (int.floor (α * ↑x)) = 0,
    from by {rw h3, ring},
    have h5 : α = (int.floor (α * ↑x)) / x,
    from by {rw h4, ring},
    have h6 : (int.floor (α * ↑x)) / x ∈ ℚ,
    from by {apply int.cast_div,},
    have h7 : α ∈ ℚ, from by {rw h5, exact h6,},
    have h8 : irrational α, from hα_irrat,
    contradiction,
  },
  have h4 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ≠ 1, from by {
    assume x h,
    assume h2 : int.fract (α * ↑x) = 1,
    have h3 : (α * ↑x) - (int.floor (α * ↑x)) = 1,
    from by {rw h2, ring},
    have h4 : (α * ↑x) - (int.floor (α * ↑x)) = 1,
    from by {rw h3, ring},
    have h5 : α = (int.floor (α * ↑x) + 1) / x,
    from by {rw h4, ring},
    have h6 : (int.floor (α * ↑x) + 1) / x ∈ ℚ,
    from by {apply int.cast_div,},
    have h7 : α ∈ ℚ, from by {rw h5, exact h6,},
    have h8 : irrational α, from hα_irrat,
    contradiction,
  },
  have h5 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ set.Icc 0 1, from by {
    assume x h,
    have h2 : int.fract (α * ↑x) ≠ 0, from h3 x h,
    have h3 : int.fract (α * ↑x) ≠ 1, from h4 x h,
    rw set.mem_Icc,
    split,
    exact h2,
    exact h3,
  },
  have h6 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
    assume x h,
    use x,
    simp [h],
  },
  have h7 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.Icc 0 1, from by {
    assume x h,
    split,
    exact h6 x h,
    exact h5 x h,
  },
  have h8 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    assume x h,
    have h2 : int.fract (α * ↑x) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.Icc 0 1, from h7 x h,
    have h3 : (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.Icc 0 1 ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
      assume x h,
      have h2 : x ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.Icc 0 1, from h,
      have h3 : x ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)), from h2.left,
      have h4 : x ∈ set.Icc 0 1, from h2.right,
      rw set.mem_closure,
      use (set.range (λ (m : ℤ), int.fract (α * ↑m))),
      split,
      exact h3,
      use set.univ,
      split,
      exact set.mem_univ x,
      exact h4,
    },
    exact h3 h2,
  },
  have h9 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from h8,
  have h10 : ∀ x : ℤ, x ≠ 0 → int.fract (α * ↑x) ∈ set.Icc 0 1, from by {
    assume x h,
    have h2 : int.fract (α * ↑x) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from h9 x h,
    have h3 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from by {
      assume x h,
      have h2 : x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from h,
      rw set.mem_Icc,
      rw set.mem_closure at h2,
      cases h2 with (h2_1 : x ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) (h2_2 : ∀ ε > 0, ∃ (y : ℤ), y
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
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    assume (i j : ℤ) (h : i ≠ j),
    have h1 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)) → α = (i - j)⁻¹ * (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) ∈ ℚ, from by {
      assume h2 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)),
      rw [h2,int.fract_mul,int.fract_mul] at h2,
      rw [int.fract_eq_iff_nat_abs_sub_lt_one,int.fract_eq_iff_nat_abs_sub_lt_one] at h2,
      have h3 : α = (i - j)⁻¹ * (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)), from by {
        rw [int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.mul_sub,int.
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hne : i ≠ j),
    have h2 : α ∉ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
      assume h3 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)),
      cases h3 with i0 h4,
      have h5 : α = ↑i0 / ↑(i0 - j), from by {rw ← h4, refl},
      have h6 : ↑i0 / ↑(i0 - j) ∈ ℚ, from by {
        have h7 : ↑i0 / ↑(i0 - j) = ↑i0 / ↑(i0 - j), from by refl,
        have h8 : ↑i0 / ↑(i0 - j) ∈ ℝ, from by {rw h7, apply_instance},
        have h9 : ↑i0 / ↑(i0 - j) ∈ ℚ, from by {rw h7, apply_instance},
        exact h9,
      },
      have h10 : ↑i0 / ↑(i0 - j) = ↑i / ↑(i - j), from by rw h5,
      have h11 : ↑i0 / ↑(i0 - j) = α, from by {rw h10, refl},
      have h12 : α ∈ ℚ, from by {rw h11, exact h6},
      have h13 : α ∉ ℚ, from by {exact hα_irrat},
      contradiction,
    },
    have h3 : ∀ (i : ℤ), i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume (i : ℤ) (hne : i ≠ j),
      have h4 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h5 : ¬(↑i / ↑(i - j) = α), from by {
        assume h6 : ↑i / ↑(i - j) = α,
        have h7 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h6, exact h4},
        contradiction,
      },
      exact h5,
    },
    have h4 : ∀ (i : ℤ), i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume (i : ℤ) (hne : i ≠ j),
      have h5 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h6 : ¬(↑i / ↑(i - j) = α), from by {
        assume h7 : ↑i / ↑(i - j) = α,
        have h8 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h7, exact h5},
        contradiction,
      },
      exact h6,
    },
    have h5 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h6 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h7 : ¬(↑i / ↑(i - j) = α), from by {
        assume h8 : ↑i / ↑(i - j) = α,
        have h9 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h8, exact h6},
        contradiction,
      },
      exact h7,
    },
    have h6 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h7 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h8 : ¬(↑i / ↑(i - j) = α), from by {
        assume h9 : ↑i / ↑(i - j) = α,
        have h10 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h9, exact h7},
        contradiction,
      },
      exact h8,
    },
    have h7 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h8 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h9 : ¬(↑i / ↑(i - j) = α), from by {
        assume h10 : ↑i / ↑(i - j) = α,
        have h11 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h10, exact h8},
        contradiction,
      },
      exact h9,
    },
    have h8 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h9 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h10 : ¬(↑i / ↑(i - j) = α), from by {
        assume h11 : ↑i / ↑(i - j) = α,
        have h12 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h11, exact h9},
        contradiction,
      },
      exact h10,
    },
    have h9 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h10 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h11 : ¬(↑i / ↑(i - j) = α), from by {
        assume h12 : ↑i / ↑(i - j) = α,
        have h13 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h12, exact h10},
        contradiction,
      },
      exact h11,
    },
    have h10 : i ≠ j → α ≠ ↑i / ↑(i - j), from by {
      assume hne : i ≠ j,
      have h11 : ↑i / ↑(i - j) ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {
        use i,
        refl,
      },
      have h12 : ¬(↑i / ↑(i - j) = α), from by {
        assume h13 : ↑i / ↑(i - j) = α,
        have h14 : α ∈ set.range (λ (i : ℤ), ↑i / ↑(i - j)), from by {rw ← h13, exact h11},
        contradiction,
      },
      exact h12,
    },

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
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from begin
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw int.fract_def, ring},
    have h3 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw int.fract_def, ring},
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by {rw [h2, h3]},
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h4, div_sub_div_same, div_self hij], ring},
    have h6 : α ∈ ℚ, from by {apply q_of_rat, exact h5},
    have h7 : irrational α, from hα_irrat,
    have h8 : ¬ (α ∈ ℚ), from h7,
    have h9 : ¬ (α ∈ ℚ), from h8,
    exact absurd h6 h9,
  end,

  have h2 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1,

  have h3 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) - int.fract (α * ↑j) ≠ 0, from begin
    assume (i j : ℤ) (hij : i ≠ j),
    have h4 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * ↑i) + - int.fract (α * ↑j), from by ring,
    have h5 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * ↑i) + - (int.fract (α * ↑j)), from by {rw h4},
    have h6 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * ↑i) + int.fract (-(α * ↑j)), from by {rw ← int.fract_neg, rw h5},
    have h7 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * ↑i - (α * ↑j)), from by {rw h6},
    have h8 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (↑i - ↑j)), from by {rw h7},
    have h9 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h8},
    have h10 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h9},
    have h11 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract ((α * i) - (α * j)), from by {rw h10},
    have h12 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract ((α * i) - (α * j)), from by {rw h11},
    have h13 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * i - α * j), from by {rw h12},
    have h14 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * i - α * j), from by {rw h13},
    have h15 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h14},
    have h16 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h15},
    have h17 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h16},
    have h18 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h17},
    have h19 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h18},
    have h20 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h19},
    have h21 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h20},
    have h22 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h21},
    have h23 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h22},
    have h24 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h23},
    have h25 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h24},
    have h26 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h25},
    have h27 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h26},
    have h28 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h27},
    have h29 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h28},
    have h30 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h29},
    have h31 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h30},
    have h32 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h31},
    have h33 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h32},
    have h34 : int.fract (α * ↑i) - int.fract (α * ↑j) = int.fract (α * (i - j)), from by {rw h33},
    have h35 : int.
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    assume i j hne,
    have h2 : (α * ↑i) - ↑(int.floor (α * ↑i)) = (int.fract (α * ↑i)), from by {rw int.fract_eq_sub_floor},
    have h3 : (α * ↑j) - ↑(int.floor (α * ↑j)) = (int.fract (α * ↑j)), from by {rw int.fract_eq_sub_floor},
    have h4 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)), from by {rw h2, rw h3, linarith},
    have h5 : (α * ↑i) - ↑(int.floor (α * ↑i)) = (α * ↑j) - ↑(int.floor (α * ↑j)), from by {rw h4},
    have h6 : (α * ↑i) - (α * ↑j) = ↑(int.floor (α * ↑i)) - ↑(int.floor (α * ↑j)), from by {linarith},
    have h7 : α = (↑(int.floor (α * ↑i)) - ↑(int.floor (α * ↑j))) / ↑(i - j), from by {rw h6, rw mul_comm α i, rw mul_comm α j, rw mul_sub, rw mul_sub, rw mul_comm, rw mul_assoc, rw mul_comm, rw mul_assoc, rw mul_comm, rw mul_comm, rw div_eq_mul_inv, rw mul_comm, rw mul_assoc, rw mul_comm, rw mul_assoc, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm, rw mul_comm
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
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) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison

Defines a functor between categories.

(As it is a 'bundled' object rather than the `is_functorial` typeclass parametrised
by the underlying function on objects, the name is capitalised.)

Introduces notations
  `C ⥤ D` for the type of all functors from `C` to `D`.
    (I would like a better arrow here, unfortunately ⇒ (`\functor`) is taken by core.)
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.reassoc_axiom
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

namespace category_theory

/--
`functor C D` represents a functor between categories `C` and `D`.

To apply a functor `F` to an object use `F.obj X`, and to a morphism use `F.map f`.

The axiom `map_id` expresses preservation of identities, and
`map_comp` expresses functoriality.

See https://stacks.math.columbia.edu/tag/001B.
-/
structure functor (C : Type u₁) [category C] (D : Type u₂) [category D]
where
  obj : C → D
  map : {X Y : C} → (X ⟶ Y) → (obj X ⟶ obj Y)
  map_id' : autoParam (C → map 𝟙 = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  map_comp' : autoParam (∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

infixr:26 " ⥤ " => Mathlib.category_theory.functor

-- A functor is basically a function, so give ⥤ a similar precedence to → (25).

-- For example, `C × D ⥤ E` should parse as `(C × D) ⥤ E` not `C × (D ⥤ E)`.

@[simp] theorem functor.map_id {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D) (X : C) : functor.map c 𝟙 = 𝟙 := sorry

@[simp] theorem functor.map_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D) {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : functor.map c (f ≫ g) = functor.map c f ≫ functor.map c g := sorry

theorem functor.map_comp_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (c : C ⥤ D) {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) {X' : D} (f' : functor.obj c Z ⟶ X') : functor.map c (f ≫ g) ≫ f' = functor.map c f ≫ functor.map c g ≫ f' := sorry

namespace functor

/-- `𝟭 C` is the identity functor on a category `C`. -/
protected def id (C : Type u₁) [category C] : C ⥤ C :=
  mk (fun (X : C) => X) fun (_x _x_1 : C) (f : _x ⟶ _x_1) => f

notation:1024 "𝟭" => Mathlib.category_theory.functor.id

protected instance inhabited (C : Type u₁) [category C] : Inhabited (C ⥤ C) :=
  { default := 𝟭 }

@[simp] theorem id_obj {C : Type u₁} [category C] (X : C) : obj 𝟭 X = X :=
  rfl

@[simp] theorem id_map {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) : map 𝟭 f = f :=
  rfl

/--
`F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`).
-/
def comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E :=
  mk (fun (X : C) => obj G (obj F X)) fun (_x _x_1 : C) (f : _x ⟶ _x_1) => map G (map F f)

infixr:80 " ⋙ " => Mathlib.category_theory.functor.comp

@[simp] theorem comp_obj {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D) (G : D ⥤ E) (X : C) : obj (F ⋙ G) X = obj G (obj F X) :=
  rfl

@[simp] theorem comp_map {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C ⥤ D) (G : D ⥤ E) {X : C} {Y : C} (f : X ⟶ Y) : map (F ⋙ G) f = map G (map F f) :=
  rfl

-- These are not simp lemmas because rewriting along equalities between functors

-- is not necessarily a good idea.

-- Natural isomorphisms are also provided in `whiskering.lean`.

protected theorem comp_id {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) : F ⋙ 𝟭 = F := sorry

protected theorem id_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) : 𝟭 ⋙ F = F := sorry


/-
Copyright (c) 2022 Ian Wood. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ian Wood
-/
import tactic.basic
import tactic.expand_exists

@[expand_exists nat_greater nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ⟨n + 1, by fconstructor⟩

noncomputable def nat_greater_res : ℕ → ℕ := nat_greater
lemma nat_greater_spec_res : ∀ (n : ℕ), n < nat_greater n := nat_greater_spec

@[expand_exists dependent_type dependent_type_val dependent_type_spec]
lemma dependent_type_exists {α : Type*} (a : α) : ∃ {β : Type} (b : β), (a, b) = (a, b) :=
⟨unit, (), rfl⟩

def dependent_type_res {α : Type*} (a : α) : Type := dependent_type a
noncomputable def dependent_type_val_res {α : Type*} (a : α) : dependent_type a :=
dependent_type_val a
lemma dependent_type_spec_res
{α : Type*} (a : α) : (a, dependent_type_val a) = (a, dependent_type_val a) := dependent_type_spec a

@[expand_exists nat_greater_nosplit nat_greater_nosplit_spec,
  expand_exists nat_greater_split nat_greater_split_lt nat_greater_split_neq]
lemma nat_greater_exists₂ (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := begin
  use n + 1,
  split,
  fconstructor,
  finish,
end

noncomputable def nat_greater_nosplit_res : ℕ → ℕ := nat_greater_nosplit
noncomputable def nat_greater_split_res : ℕ → ℕ := nat_greater_split

lemma nat_greater_nosplit_spec_res :
∀ (n : ℕ), n < nat_greater_nosplit n ∧ nat_greater_nosplit n ≠ 0 := nat_greater_nosplit_spec

lemma nat_greater_split_spec_lt_res : ∀ (n : ℕ), n < nat_greater_nosplit n := nat_greater_split_lt
lemma nat_greater_split_spec_neq_res : ∀ (n : ℕ), nat_greater_nosplit n ≠ 0 := nat_greater_split_neq


import tactic.transport
import order.bounded_lattice
import algebra.lie.basic

-- We verify that `transport` can move a `semiring` across an equivalence.
-- Note that we've never even mentioned the idea of addition or multiplication to `transport`.
def semiring.map {α : Type} [semiring α] {β : Type} (e : α ≃ β) : semiring β :=
by transport using e

-- Indeed, it can equally well move a `semilattice_sup_top`.
def sup_top.map {α : Type} [semilattice_sup_top α] {β : Type} (e : α ≃ β) : semilattice_sup_top β :=
by transport using e

-- Verify definitional equality of the new structure data.
example {α : Type} [semilattice_sup_top α] {β : Type} (e : α ≃ β) (x y : β) :
begin
  haveI := sup_top.map e,
  exact (x ≤ y) = (e.symm x ≤ e.symm y),
end :=
rfl

-- Below we verify in more detail that the transported structure for `semiring`
-- is definitionally what you would hope for.

inductive mynat : Type
| zero : mynat
| succ : mynat → mynat

def mynat_equiv : ℕ ≃ mynat :=
{ to_fun := λ n, nat.rec_on n mynat.zero (λ n, mynat.succ),
  inv_fun := λ n, mynat.rec_on n nat.zero (λ n, nat.succ),
  left_inv := λ n, begin induction n, refl, exact congr_arg nat.succ n_ih, end,
  right_inv := λ n, begin induction n, refl, exact congr_arg mynat.succ n_ih, end }

@[simp] lemma mynat_equiv_apply_zero : mynat_equiv 0 = mynat.zero := rfl
@[simp] lemma mynat_equiv_apply_succ (n : ℕ) :
  mynat_equiv (n + 1) = mynat.succ (mynat_equiv n) := rfl
@[simp] lemma mynat_equiv_symm_apply_zero : mynat_equiv.symm mynat.zero = 0:= rfl
@[simp] lemma mynat_equiv_symm_apply_succ (n : mynat) :
  mynat_equiv.symm (mynat.succ n) = (mynat_equiv.symm n) + 1 := rfl

instance semiring_mynat : semiring mynat :=
semiring.map mynat_equiv

lemma mynat_add_def (a b : mynat) : a + b = mynat_equiv (mynat_equiv.symm a + mynat_equiv.symm b) :=
rfl

-- Verify that we can do computations with the transported structure.
example :
  (mynat.succ (mynat.succ mynat.zero)) + (mynat.succ mynat.zero) =
    (mynat.succ (mynat.succ (mynat.succ mynat.zero))) :=
rfl

lemma mynat_zero_def : (0 : mynat) = mynat_equiv 0 :=
rfl

lemma mynat_one_def : (1 : mynat) = mynat_equiv 1 :=
rfl

lemma mynat_mul_def (a b : mynat) : a * b = mynat_equiv (mynat_equiv.symm a * mynat_equiv.symm b) :=
rfl

example : (3 : mynat) + (7 : mynat) = (10 : mynat) :=
rfl

example : (2 : mynat) * (2 : mynat) = (4 : mynat) :=
rfl

example : (3 : mynat) + (7 : mynat) * (2 : mynat) = (17 : mynat) :=
rfl

example : (2 : ℕ) • (3 : mynat) = (6 : mynat) :=
rfl

example : (3 : mynat) ^ 2 = (9 : mynat) :=
rfl


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.eq_to_hom
import data.ulift

/-!
# Discrete categories

We define `discrete α := α` for any type `α`, and use this type alias
to provide a `small_category` instance whose only morphisms are the identities.

There is an annoying technical difficulty that it has turned out to be inconvenient
to allow categories with morphisms living in `Prop`,
so instead of defining `X ⟶ Y` in `discrete α` as `X = Y`,
one might define it as `plift (X = Y)`.
In fact, to allow `discrete α` to be a `small_category`
(i.e. with morphisms in the same universe as the objects),
we actually define the hom type `X ⟶ Y` as `ulift (plift (X = Y))`.

`discrete.functor` promotes a function `f : I → C` (for any category `C`) to a functor
`discrete.functor f : discrete I ⥤ C`.

Similarly, `discrete.nat_trans` and `discrete.nat_iso` promote `I`-indexed families of morphisms,
or `I`-indexed families of isomorphisms to natural transformations or natural isomorphism.

We show equivalences of types are the same as (categorical) equivalences of the corresponding
discrete categories.
-/

namespace category_theory

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

/--
A type synonym for promoting any type to a category,
with the only morphisms being equalities.
-/
def discrete (α : Type u₁) := α

/--
The "discrete" category on a type, whose morphisms are equalities.

Because we do not allow morphisms in `Prop` (only in `Type`),
somewhat annoyingly we have to define `X ⟶ Y` as `ulift (plift (X = Y))`.

See https://stacks.math.columbia.edu/tag/001A
-/
instance discrete_category (α : Type u₁) : small_category (discrete α) :=
{ hom  := λ X Y, ulift (plift (X = Y)),
  id   := λ X, ulift.up (plift.up rfl),
  comp := λ X Y Z g f, by { rcases f with ⟨⟨rfl⟩⟩, exact g } }

namespace discrete

variables {α : Type u₁}

instance [inhabited α] : inhabited (discrete α) :=
by { dsimp [discrete], apply_instance }

instance [subsingleton α] : subsingleton (discrete α) :=
by { dsimp [discrete], apply_instance }

/-- Extract the equation from a morphism in a discrete category. -/

@[simp] lemma id_def (X : discrete α) : ulift.up (plift.up (eq.refl X)) = 𝟙 X := rfl

variables {C : Type u₂} [category.{v₂} C]

instance {I : Type u₁} {i j : discrete I} (f : i ⟶ j) : is_iso f :=
⟨⟨eq_to_hom (eq_of_hom f).symm, by tidy⟩⟩

/--
Any function `I → C` gives a functor `discrete I ⥤ C`.
-/
def functor {I : Type u₁} (F : I → C) : discrete I ⥤ C :=
{ obj := F,
  map := λ X Y f, begin cases f, cases f, cases f, exact 𝟙 (F X) end }

@[simp] lemma functor_obj  {I : Type u₁} (F : I → C) (i : I) :
  (discrete.functor F).obj i = F i := rfl

lemma functor_map  {I : Type u₁} (F : I → C) {i : discrete I} (f : i ⟶ i) :
  (discrete.functor F).map f = 𝟙 (F i) :=
by { cases f, cases f, cases f, refl }

/--
For functors out of a discrete category,
a natural transformation is just a collection of maps,
as the naturality squares are trivial.
-/
def nat_trans {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ⟶ G.obj i) : F ⟶ G :=
{ app := f }

@[simp] lemma nat_trans_app  {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ⟶ G.obj i) (i) : (discrete.nat_trans f).app i = f i :=
rfl

/--
For functors out of a discrete category,
a natural isomorphism is just a collection of isomorphisms,
as the naturality squares are trivial.
-/
def nat_iso {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) : F ≅ G :=
nat_iso.of_components f (by tidy)

@[simp]
lemma nat_iso_hom_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).hom.app i = (f i).hom :=
rfl

@[simp]
lemma nat_iso_inv_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).inv.app i = (f i).inv :=
rfl

@[simp]
lemma nat_iso_app {I : Type u₁} {F G : discrete I ⥤ C}
  (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) :
  (discrete.nat_iso f).app i = f i :=
by tidy

/-- Every functor `F` from a discrete category is naturally isomorphic (actually, equal) to
  `discrete.functor (F.obj)`. -/
def nat_iso_functor {I : Type u₁} {F : discrete I ⥤ C} : F ≅ discrete.functor (F.obj) :=
nat_iso $ λ i, iso.refl _

/--
We can promote a type-level `equiv` to
an equivalence between the corresponding `discrete` categories.
-/
@[simps]
def equivalence {I : Type u₁} {J : Type u₂} (e : I ≃ J) : discrete I ≌ discrete J :=
{ functor := discrete.functor (e : I → J),
  inverse := discrete.functor (e.symm : J → I),
  unit_iso := discrete.nat_iso (λ i, eq_to_iso (by simp)),
  counit_iso := discrete.nat_iso (λ j, eq_to_iso (by simp)), }

/-- We can convert an equivalence of `discrete` categories to a type-level `equiv`. -/
@[simps]
def equiv_of_equivalence {α : Type u₁} {β : Type u₂} (h : discrete α ≌ discrete β) : α ≃ β :=
{ to_fun := h.functor.obj,
  inv_fun := h.inverse.obj,
  left_inv := λ a, eq_of_hom (h.unit_iso.app a).2,
  right_inv := λ a, eq_of_hom (h.counit_iso.app a).1 }

end discrete

namespace discrete
variables {J : Type v₁}

open opposite

/-- A discrete category is equivalent to its opposite category. -/
protected def opposite (α : Type u₁) : (discrete α)ᵒᵖ ≌ discrete α :=
let F : discrete α ⥤ (discrete α)ᵒᵖ := discrete.functor (λ x, op x) in
begin
  refine equivalence.mk (functor.left_op F) F _ (discrete.nat_iso $ λ X, by simp [F]),
  refine nat_iso.of_components (λ X, by simp [F]) _,
  tidy
end

variables {C : Type u₂} [category.{v₂} C]

@[simp] lemma functor_map_id
  (F : discrete J ⥤ C) {j : discrete J} (f : j ⟶ j) : F.map f = 𝟙 (F.obj j) :=
begin
  have h : f = 𝟙 j, { cases f, cases f, ext, },
  rw h,
  simp,
end

end discrete

end category_theory