import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let α 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 : ℤ) (hij : i ≠ j), int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    intros i j hij,
    assume h2,
    have h4 : α * ↑i - int.floor (α * ↑i) = int.fract (α * ↑i), from by rw int.fract_eq_sub_floor,
    have h3 : (α * ↑i) - int.floor ((α * ↑i)) = (α * ↑j) - int.floor ((α * ↑j)), by {rw [h4,h2],},
    have h5 : α = ((int.floor ((α * ↑i)) - int.floor (α * ↑j))/(i - j)), from by {rw [div_eq_iff_mul_eq,mul_comm,h3],},
    have h6 : α ∈ ℚ, from by {rw h5,from hα_irrat.irrational_iff hij,},
    show false, from hα_irrat h6,
  },

  --Hence,
  --$$S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$$
  --is an infinite subset of $\left[0,1\right]$.
  have h2 : (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from λ x h, begin
    --Assume (h : x ∈ (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)),
    have h : x ∈ (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ), from h,
    --As (λ (m : ℤ), int.fract (m * α)) is a continuous function and (int.fract) maps into the unit interval,
    --we have $f(x) = int.fract(x) \in [0,1]$
    have h3 : x = int.fract(x) ∈ [0,1], from set.mem_image_of_mem h,
    --Hence the result.
    exact h3,
  end,
  have h3 : (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ) ≠ ∅, from begin
    --As (λ (m : ℤ), int.fract (m * α)) is a continuous function and (int.fract) maps into the unit interval,
    --we have $f(x) = int.fract(x) \in [0,1]$
    have h4 : (λ (m : ℤ), int.fract (m * α)) 0 = 0 ∈ [0,1], from by {rw [set.univ_def],norm_num,},
    exact h4,
  end,

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h4 : ∃ x, x ∈ closure ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)), from by {
    apply closure_of_discrete_subset_of_univ h2 h3,
    assume (m : ℤ) (n : ℤ) (hmn : m ≠ n),
    suffices h5 : int.fract (m * α) ≠ int.fract (n * α), from h5,
    apply h1 m n hmn,
  },
  have h5 : ∃ x, x ∈ closure ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)) ∧ x ∈ set.Icc 0 1, from by {
    cases h4 with x h4,
    have h6 : x ∈ {x : ℝ | ∃ m : ℤ, x = int.fract (m * α)}, from h4,
    have h7 : x ∈ {x : ℝ | ∃ m : ℤ, x = int.fract (m * α)} ∧ x ∈ set.Icc 0 1, from by {apply set.mem_inter_iff, split; exact h6, exact h2 h6,},
    exact h7,
  },

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h6 : ∃ x y, x ∈ closure ((λ (m : ℤ), @int.fract ℝ _ (m * α)) '' (@set.univ ℤ)) ∧ y ∈ closure ((λ (m : ℤ), @int.fract ℝ _ (m * α)) '' (@set.univ ℤ)) ∧ x ≠ y ∧  |x - y| < (1: ℝ), from by {
    cases h5 with x hx,
    cases hx with hx,
    cases hx with hx hx,
    cases hx with hx hx,
    cases hx with hx hx,
    rcases hx with ⟨m, rfl⟩,
    rw ← sub_eq_add_neg at hx,
    have h7 : |(m:ℝ)*α - (x:ℝ)| < 1, from by exact hx,
    rcases h7 with ⟨N, rfl⟩,
    have h8 : (N : ℝ) ≠ (m:ℝ), from by
    {
      assume h8,
      have h9 : (m:ℝ) - (m:ℝ) = (N:ℝ) - (m:ℝ), by rw h8,
      rw zero_sub at h9,
      rw zero_sub at hx,
      rw h9 at hx,
      apply absurd hx,
      norm_num,
    },
    have h9 : (↑N : ℝ) - (m:ℝ) < 1, from by linarith,
    use int.fract(N * α),
    use int.fract(m * α),
    use N,
    use m,
    have h10 : int.fract(N * α) ∈ closure ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)), from begin
      have h11 : int.fract(N * α) ∈ (λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ), from begin
        -- TODO
        have h12 : N ∈ univ, from set.mem_univ N,
        exact mem_image_of_mem (λ (m : ℤ), int.fract (m * α)) h12,
      end,
      exact subset_closure h11,
    end,
    split,
    exact h10,
    split,
    exact hx,
    split,
    exact h8,
    rw abs_of_pos (sub_pos_of_lt h9),
  },

  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$,
  have h7 : ∀ x y, x ∈ closure ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)) ∧ y ∈ closure ((λ (m : ℤ), int.fract (m * α)) '' (@set.univ ℤ)) → int.fract (y * α
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 h_fract_zero : ∀ (a : ℤ), ∃ m : ℤ, int.fract (a * ↑α) < ↑m * (int.fract α), from
  begin
    assume a,
    have h1 : (a * ↑α) - a * (int.floor (a * ↑α)) < a * (int.fract α), begin
      lin
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from by {
    apply closure_subset,
    intros m h2,
    rw set.mem_Icc_eq,
    split; linarith,
  },

  have h2 : ∀ x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), ∃ (m : ℤ), x = int.fract (α * ↑m), from by {
    assume (x : ℝ) (h2 : x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ))),
    cases h2 with U h3,
    assume h4,
    cases h3 with a h5,
    use a,
    rw set.mem_image_eq at h5,
    cases h5 with b h6,
    rw h6,
    symmetry,
    apply int.fract_mul,
  },

  have h6 : ∀ (x : ℝ), x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ↔ ∃ (m : ℤ), x = int.fract (α * ↑m), from by {
    intros x,
    split;
    assume hx,
    {
      apply h2, assumption,
    },
    {
      assume h7,
      cases h7 with m hx,
      use {m},
      rw set.mem_singleton_iff,
      rw set.mem_image_eq,
      use m,
      rw set.mem_univ,
      exact hx,
    },
  },

  have h7 : ∀ y ∈ set.Icc 0 1, ∃ (m : ℤ), int.fract (α * ↑m) = y, from by {
    assume y,
    assume h7,
    rw set.mem_Icc_eq at h7,
    use ↑nat.floor (α * y),
    calc int.fract (α * ↑nat.floor (α * y)) = int.fract(α * y) : by rw [hz_nat_floor, mul_comm],
    show int.fract (α * y) = y, from by {rw hx_int_fract, linarith,},
  },

  have h8 : ∀ y ∈ set.Icc 0 1, ∃ x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), x = y, from by {
    assume (y : ℝ),
    assume h7,
    have h8 : ∃ (m : ℤ), int.fract (α * ↑m) = y, from by {apply h7,},
    cases h8 with m hm,
    use int.fract (α * ↑m),
    rw h6,
    use m,
    exact hm,
  },

  have h9 : ∀ x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), ∃ y ∈ set.Icc 0 1, y = x, from by {
    assume x,
    assume hx,
    use x,
    have h8 : ∃ (m : ℤ), int.fract (α * ↑m) = x, from by {apply h6, assumption,},
    cases h8 with m hm,
    apply set.mem_Icc_eq,
    split,
    have h9 : 0 ≤ int.fract(α * ↑m), from by {rw hm, linarith},
    exact h9,
    have h10 : int.fract(α * ↑m) < 1, from by {rw hm, linarith,},
    exact h10,
  },

  exact subset.antisymm h1 set.subset_Icc,
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, (int.fract (α *↑i)) = (int.fract (α * ↑j)) → i = j,
  from by {intros i j h, rw int.floor_eq_iff at h, rw int.floor_eq_iff at h,
          rw [int.coe_nat_eq_coe_int_iff, int.coe_nat_eq_coe_int_iff] at h,
          exact quotient.sound (by exact_mod_cast _ _) (by exact_mod_cast _ _) h,
          },

  have h2 : ∀ {i j : ℤ}, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from by {intros i j hi, rw int.fract_eq_iff, rw int.fract_eq_iff, rw int.fract_eq_iff, rw [int.coe_nat_eq_coe_int_iff, int.coe_nat_eq_coe_int_iff],
          rw int.nat_abs_of_nonneg (int.coe_nat_nonneg _),
          rw int.nat_abs_of_nonneg (int.coe_nat_nonneg _),
          rw int.nat_abs_of_nonneg (int.coe_nat_nonneg _),
          rw mul_comm (int.nat_abs _) (int.nat_abs _),
          intro h, rw ← h at hi, rw [← int.coe_nat_eq_coe_int_iff, ← int.coe_nat_eq_coe_int_iff] at hi,
          have htemp := show ∀ (i : ℕ), (i : ℤ) * (1 : ℤ) = i * 1, from by {intros, ring},
          rw htemp at hi, rw htemp at hi, rw htemp at hi,
          have htemp2 := show ∀ (i : ℕ), (i : ℝ) = ↑i, from by {intros, rw ← int.coe_nat_eq_coe_int_iff},
          rw htemp2 at hi, rw htemp2 at hi, rw htemp2 at hi,
          exact hα_irrat (hi.symm),
          },

  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$
  have h3 : ∀ {i j : ℤ}, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from h2,
  have h3.r : nonempty.intro (int.fract (α * 1)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' set.univ :=
  by {use (1 : ℤ),simp [h3],rw ← int.coe_nat_eq_coe_int_iff,},
  rw ← set.nonempty_iff_ne_empty at h3.r,

  have h4 : ∀ {i j : ℤ}, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from h3,

  have h5 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∉ {(int.fract (α * ↑j))},
  from by {intros i j hi, assume (h5 : int.fract (α * ↑i) = int.fract (α * ↑j)), contradiction},

  have h6 : ∀ i : ℤ, (int.fract (α * ↑i)) ∉ {(int.fract (α * ↑i))}, by {intros i, assume h1, assumption},
  have h7 : ∀ i : ℤ, (int.fract (α * ↑i)) ∉ {(int.fract (α * ↑i))}, from h6,

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$
  have hb : closure (λ m : ℤ, int.fract (α * ↑m)) ∩ set.Icc 0 1 ≠ ∅,
  from by {rw ← h3.r, apply set.inter_nonempty_iff_ne_empty, apply set.is_closed_Icc, apply set.is_closed_closure,},

  have h8 : ∀ (S : set (ℤ → ℝ)) {l : ℝ}, (closure S) ∩ set.Icc 0 1 ≠ ∅ → l ∈ S → ∃ (ε : ℝ),  ε > 0, ∃ (x : ℤ → ℝ), x ∈ S ∧ |x - l| < ε,
  from by {
           assume S l hb hl, cases hl with i hi,
           let iα := (int.fract (α * ↑i)),
           let htemp := show iα ∈ closure S ∩ set.Icc 0 1, from by {apply set.mem_inter,
                                                                   apply set.mem_closure_iff.mp,
                                                                   use i,
                                                                   simp [hi, h7],
                                                                   apply set.mem_Icc,
                                                                   split,
                                                                   rw ← int.fract_zero,
                                                                   apply int.fract_lt,
                                                                   rw ← int.fract_one,
                                                                   apply int.fract_lt,
                                                                  },
           have htemp2 : ∃ (ε : ℝ), ε > 0,  ∃ (x : ℤ → ℝ), x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ∧ |x - iα| < ε,
           from by {
                     use (iα),
                     use (↑i),
                     split,
                     have htemp3 := show int.fract (α * ↑i) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' set.univ, from by {simp [hi],},
                     simp [htemp3, hi],
                     have htemp_2 := show  1⁻¹ ∈ set.Icc 0 (1 : ℝ), from by {split, exact zero_lt_one, exact le_refl 1},
                     have htemp_3 := show 1⁻¹ = iα, by {rw ← int.fract_one,rw ← int.fract_fract_of_nat,ring,},
                     have htemp_4 := show  1⁻¹ ∈ set.Icc 0 (1 : ℝ), from by {rw htemp_3, exact htemp_2},
                     have htemp_5 := show |iα - iα| < 1⁻¹, from by {rw abs_of_nonneg (sub_nonneg.mpr (by {apply int.fract_nonneg})),rw int.fract_fract_of_nat,ring,},
                     exact lt_trans (htemp_5) (inv_pos one_pos),
                    },
           exact htemp2,

           },

  cases h8 (λ m : ℤ, int.fract (α * ↑m)) hb h6.r with ε (h9 : ε > 0),
  cases h9 with x (h9),
  cases h9 with hx hxmini,
  cases hx with i hi,
  rw ← hi at hxmini,
  have h10 := hxmini,
  have h11 : ∀ (ε : ℝ), ε > 0 → ∃ (i : ℤ), |x - int.fract (α * ↑i)| < ε,
  from by {
           assume (ε : ℝ) (h11 : ε > 0),
           have htemp : 0
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let α be an irrational number
  assume (α : ℝ) (hα_irrat : irrational α),
  -- Then for distinct $i,j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$
  have h1 : ∀ (i j : ℤ), i ≠ j → ∄ p q ∈ (@set.univ ℤ), p ≠ q ∧ int.fract (α * ↑p) = int.fract (α * ↑q), from assume (i : ℤ) (j : ℤ) (hint : i ≠ j), assume hpq : (∃ p q, p ∈ (@set.univ ℤ) ∧ q ∈ (set.univ) ∧ p ≠ q ∧ int.fract (α * ↑p) = int.fract (α * ↑q)),
  let ⟨p, q, h2, h3, h4, h5⟩ := hpq in by {
    have h6 : ∀ n : ℤ, n * α = n * int.fract α + n * int.nat_abs α, from int.fract_eq_of_nat_abs_mul_nat_abs,
    rw [h6 p, h6 q, ← int.fract_mul, ← int.fract_mul] at h5,
    have h7 : α = (int.fractα) / (int.nat_abs α), from eq.symm ((int.fract_eq_of_nat_abs_eq_one α hα_irrat).right.right),
    have h8 : p * α = p * int.fract α / (int.nat_abs α) + p * nat_abs α, from by rw h7 at h6 p,
    have h9 : q * α = q * int.fract α / (int.nat_abs α) + q * nat_abs α, from by rw h7 at h6 q,
    rw h8 at h5, rw h9 at h5,
    have h10 : ((p * int.fract α) / (int.nat_abs α)) + p * nat_abs α = ((q * int.fract α) / (int.nat_abs α)) + q * nat_abs α, from by rw h5,
    have h11 : (p * int.fract α) / (int.nat_abs α) = (q * int.fract α) / (int.nat_abs α), from by simp [h10],
    have h12 : (p * int.fract α) = ((q * int.fract α) / (int.nat_abs α)) * (int.nat_abs α), from by {rw ← h11, ring},
    have h13 : p * int.fract α = (q * int.fract α), from by {rw ← h12, apply int.nat_abs.eq_iff.2, linarith},
    have h14 : p * int.fract α = q * int.fract α, from by {rw h13, linarith},
    have h15 : int.fract (α * p) = int.fract (q * α), from by {rw [← int.fract_mul, ← int.fract_mul] at h14, exact h14},
    have h16 : α * p = q * α, from by {apply int.fract_eq_of_nat_abs_eq_one _ hα_irrat, split, linarith, exact h4, exact h15},
    have h17 : ((p : ℤ) : ℝ) = ((q : ℤ) : ℝ), from by rw h16,
    exact h4 (int.coe_nat_inj.2 (coe_int_inj h17)),
  },
  --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]$
  rw eq_empty_iff_forall_not_mem,
  have h18 : ∀ (n : ℤ), (n : ℝ) ≠ 0, from by {intros n hn, linarith},
  have h19 : (set.univ : set ℤ) ≠ ∅, from by {rw set.univ_ne_empty_iff, apply h18},
  have h20 : set.finite (set.univ : set ℤ), from by {apply set.finite_univ},
  have h21 : set.finite ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ), from by {apply set.finite_image, exact h20},
  have h22 : ∃ (n : ℤ), n ∈ (set.univ : set ℤ), from by {rw set.univ_ne_empty_iff, exact h18 0},
  have h23 : ∀ (n : ℤ), int.fract (α * ↑n) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ, from by {intros n, use n, simp, linarith},
  have h23a : ∀ (n : ℤ), int.fract (α * ↑n) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {intro n, use n, simp, linarith},
  have h24 : (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ ≠ ∅, from by {rw eq_empty_iff_forall_not_mem, exact h23},

  --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.
  have h26 : ∃ (p q : ℤ), p ∈ (set.univ : set ℤ) ∧ q ∈ (set.univ : set ℤ) ∧ p ≠ q ∧ int.fract (α * ↑p) = int.fract (α * ↑q), from by {apply exists_ne_of_infinite_of_finite_of_ne_empty h21 h24, },
  let ⟨p, q, h27, h28, h29, h30⟩ := h26 in by {

  --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 h31 : (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ ⊆ closure (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ, from by {apply set.subset_univ, },
  have h32 : ∃ (n : ℤ), n ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) '' (set.univ : set ℤ), from by {
    have h33 : ∃ (m : ℤ), m ∈ (λ (n : ℤ), int.fract (α * ↑n)) '' set.univ := h21,
    cases h33 with m h34,
    show ∃ (n : ℤ), n ∈ closure (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ, from by {
      use m,
      apply set.mem_closure_iff.2,
      use
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
  sorry
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    -- We have shown that irrational number $\alpha$ and its integer multiples $i \alpha$ has fractional parts $[0,1]$
    have h_nonempty : (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ ⊆ set.Icc 0 1, from by {
        assume (x : ℝ),
        by_contradiction h_false,
        apply x_mem_set_Icc_iff.1 h_false,
    },
    have h_dense_in_Icc : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ) ⊆ set.Icc 0 1, from by {
        assume x h,
        have h_non_empty : (λ (m : ℤ), int.fract (α * ↑m)) '' set.univ ≠ ∅, from by {
            exact set.nonempty_iff_exists_mem.2 ⟨int.fract α,set.mem_univ (int.fract α),rfl⟩,
        },
        exact closure_eq_of_is_closed_idem h_non_empty h_nonempty h,
    },
    let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in

    -- Then, we need to show that the fractional parts $\{i \alpha\}$ must be dense in $[0,1]$
    have h1 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' set.univ) = set.Icc 0 1, from by {

        -- So we have to show that the set of fractional parts $\{i \alpha\}$ is both open and closed in $[0,1]$
        apply set.eq_of_is_open_eq_of_is_closed_eq,

        -- First, we have to show that the set of fractional parts $\{i \alpha\}$ is open in $[0,1]$
        -- So we need to show that $q \in [0,1] \implies \exists \epsilon > 0: \forall x \in [0,1] : x \in (q - \epsilon, q + \epsilon) \implies x \in \{i \alpha\}$
        rw set.is_open_iff,
        -- Let $q \in [0,1]$
        assume q hq,
        -- Let $\epsilon > 0$ be $q$
        use q,
        -- By Bolzano-Weiestrass theorem, the set of fractioal parts $\{i \alpha\}$ has a limit point in $[0,1]$
        -- So we can find a pair of elements of $\{i \alpha\}$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $\{i \alpha\}$ is also an element of $\{i \alpha\}$, it follows that $0$ is a limit point of $\{i \alpha\}$
        -- The set of fractional parts is infinite as it contains $\alpha$, so it must have a limit point in $[0,1]$
        have h : ∃ x0, limit (λ (n : ℕ), int.fract (α * ↑n)) x0,
        from has_finite_limit.has_limit (λ (n : ℕ), α * ↑n) 0 α,
        cases h with limit_point h,
        cases h with ε h1,
        -- So we have that if $m x < y < (m + 1) x$, then $|y - \{m x\}| < \epsilon$
        have h2 : ∀ (nen : ℕ), ε > int.fract x → |int.fract (α * ↑nen) - limit_point| < ε, from
        by {
            assume n h3,
            have h4 : limit (λ (n : ℕ), int.fract (α * ↑n)) 0 → ∀ ε > 0, ∃ N, ∀ n > N, |(λ (n : ℕ), int.fract (α * ↑n)) n - 0| < ε, from h1,
            have h5 := (h4 ε h3),
            cases h5 with N h6,
            have h7 : ∀ n > N, |int.fract (α * ↑n) - limit_point| < ε, from h6,
            have h8 : |int.fract (α * ↑n) - limit_point| < ε,
            from h7 n (by linarith),
            exact h8,
        },
        -- selected $x = \{i \alpha\}$ such that $\{x\}<\epsilon$
        let x := limit_point,
        have h3 : ∃ N, ∀ n > N, |int.fract (α * ↑n) - limit_point| < ε, from h2 x ε,
        cases h3 with N h4,
        -- So we have that if $m x < y < (m + 1) x$, then $|y - \{m x\}| < \epsilon$
        have h5 : ∀ (nen : ℕ), ε > int.fract x → |int.fract (α * ↑nen) - limit_point| < ε, from h2 x ε,
        have h6 : |int.fract (α * ↑N) - limit_point| < ε, from h5 N (by linarith),
        have h7 : ∃ N, ∀ n > N, |int.fract (α * ↑n) - limit_point| < ε, from ⟨N,h4⟩,
        -- selected $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$
        let N0 := N,
        have h8 : int.fract (α * ↑N0) ≤ q ∧ q < int.fract (α * ↑N0) + int.fract x := by
        {
            split; linarith,
        },
        -- So $|y - \{N x\}|<\epsilon$
        have h9 : |q - int.fract (α * ↑N0)| < ε, from by
        {
            rw int.fract_eq_sub_floor_add_self at h8,
            have h10 : |int.fract (α * ↑N0) - limit_point| < ε, from h7 N0 (h8.left) h8.right,
            linarith,
        },
        have h10 : ∃ m : ℤ, int.fract (α * ↑m) = q, from
        exists_int_neq_of_nat_neq_of_int_floor_eq
        (x * (int.floor (α * ↑N0) / x)) (x * (int.floor x)) N0
        (int.floor (α * ↑N0)) (int.floor (α * ↑N0)) (int.fract x) h8.2,
        have h11 : ∃ m : ℤ, int.fract (α * ↑m) = int.fract (α * ↑N0), from
        exists_int_neq_of_nat_neq_of_int_floor_eq
        (x * (int.floor (α * ↑N0) / x)) (x * (int.floor x)) N0
        (int.floor (α * ↑N0)) (int.floor (α * ↑N0)) (int.fract x) h8.2,
        cases h10 with i h10,
        cases h11 with j h11,
        have h12 := int.fract_add α (α * ↑N0) j i,
        have h13 := int.fract_add α (α * ↑N0) N0 j,
        have h14 : int.fract (α * ↑j)
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α*i)) ≠ (int.fract (α*j)), from by {
    intros i j h, rw h,
    rw [rat.fract_eq_of_int, rat.fract_eq_of_int], ring,
  },
  have h2 : ∀ i j : ℤ, i ≠ j → (α * ↑i - int.nat_abs (↑i * α) : ℝ) ≠ (α * ↑j - int.nat_abs (↑j * α) : ℝ), from by {
    rintro i j h, rw [real.sub_eq_zero_iff_eq,real.sub_eq_zero_iff_eq], rw mul_comm, rw mul_comm, rw hα_irrat,
    linarith,
    linarith,
  },
  have h3 : ∀ i j : ℤ, i ≠ j → (α * ↑i - int.nat_abs (↑i * α) : ℝ) ≠ (α * ↑j - int.nat_abs (↑j * α) : ℝ), from by {
    intros i j h,
    apply h2, exact h,
  },
  have h4 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i) : ℝ) ≠ (int.fract (α * ↑j) : ℝ), from by {
    rintro i j h, rw [rat.fract_eq_of_int,rat.fract_eq_of_int], exact h3 i j h,
  },
  have h5 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∉ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    rintro i j h, intro h_contra, apply h4 i j h, exact h_contra,
  },
  have h6 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∉ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    intros i j h, exact h5 i j h,
  },
  have h7 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    intros i j h,
    apply h4 i j h,
  },
  have h8 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    intros i j h,
    exact h7 i j h,
  },
  have h9 : (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ (@set.univ ℝ) ∧ ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    split,
    {
      intros m hm,
      exact mem_univ _,
    },
    intros i j h, exact h7 i j h,
  },
  have h10 : (@set.univ ℤ) ⊆ ℕ, from by {
    intros i hi, rw ← int.coe_nat_lt, apply int.cast_lt.2, linarith,
  },
  have h11 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j, from by {
    intros i,
    refine ⟨i + 1, _⟩,
    linarith,
  },
  have h12 : ∀ i : ℤ, (int.fract (α * ↑i)) ∉ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    intros i,
    cases h11 i,
    rw mem_image,
    rw set.eq_empty_iff_forall_not_mem,
    rw set.compl_empty,
    rw set.univ_def,
    rw set.subset_univ,
    intros j h,
    exact h12 j h,
  },
  let S := (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h13 : ∀ i ∈ S, ∃ j ∈ S, i ≠ j, from by {
    intros i hi,
    cases hi with j hj,
    rw hj at *,
    refine ⟨_, _, _⟩,
    rw mem_image,
    use j + 1,
    split,
    {
      exact set.mem_univ _,
    },
    {
      rw ← hj,
      rw ← int.coe_nat_add,
      rw ← mul_add,
      ring,
    },
  },
  have h14 : ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ (@set.univ ℝ), from by {
    intros m hm,
    exact mem_univ _,
  },
  have h15 : (λ (m : ℕ), int.fract (α * ↑m)) '' (@set.univ ℕ) ⊆ (@set.univ ℝ), from by {
    intros m hm,
    exact h14 m hm,
  },
  have h16 : ∀ n : ℕ, (int.fract (α * ↑n)) ∈ ((λ (m : ℕ), int.fract (α * ↑m)) '' (@set.univ ℕ)), from by {
    intros n,
    rw mem_image,
    use n,
    split,
    {
      exact set.univ_mem _,
    },
    {
      refl,
    },
  },
  have h17 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j, from by {
    intros i,
    refine ⟨i + 1, _⟩,
    linarith,
  },
  have h18 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    intros i j h,
    rw h,
    rw [rat.fract_eq_of_int,rat.fract_eq_of_int], ring,
  },
  have h19 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ∈ S → (int.fract (α * ↑j)) ∈ S → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    intros i j h h1 h2,
    exact h18 i j h,
  },
  have h20 : ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ (@set.univ ℝ), from by {
    intros m hm,
    exact mem_univ _,
  },
  have h21 : ∀ n : ℕ, (int.fract (α * ↑n)) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℕ), from by {
    intros n,
    rw mem_image,
    use n,
    split,
    {
      exact set.mem_univ _,

end --Needs more than 2000 tokens!

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    have h : ∀ i j : ℤ, (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)) ↔ (i ≠ j),
    {
      intros i j,
      split,
      {
          assume h1,
          assume h2 : i = j,
          rw [h2] at h1,
          rw int.fract_mul at h1,
          rw int.fract_mul at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          have h3 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑i) - (int.floor (α * ↑i)),
          simp,
          rw h3 at h1,
          rw sub_eq_add_neg at h1,
          have h4 : (-(int.ceil (α * ↑i)) : ℤ) = (int.floor (α * ↑i)) - (α * ↑i),
          rw int.ceil_eq_int_floor_add_one,
          linarith,
          rw h4 at h1,
          have h5 : (1 : ℤ) = -(int.ceil (α * ↑i) - (α * ↑i)) + (α * ↑i - int.floor (α * ↑i)),
          linarith,
          rw h5 at h1,
          rw ← sub_eq_add_neg at h1,
          rw ← neg_add at h1,
          rw ← neg_neg at h1,
          rw ← int.fract_neg_add_one at h1,
          rw ← int.fract_neg_add_one at h1,
          have h6 : α = int.fract (α),
          rw int.fract_mk,
          linarith,
          rw h6 at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw add_zero int.fract at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          have h7 : (0 : ℤ) = int.floor (α) + int.fract (α),
          rw int.fract_mk,
          linarith,
          rw h7 at h1,
          have h8 : (0 : ℤ) = int.floor (α) + int.fract (α),
          rw int.fract_mk,
          linarith,
          rw h8 at h1,
          rw add_zero int.fract at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          have h9 : α = int.fract α,
          rw int.fract_mk,
          linarith,
          rw h9 at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          rw int.fract_mk at h1,
          have h10 : ((int.ceil (α * ↑i)) : ℤ) = int.ceil (α * ↑i),
          refl,
          have h11 : (((0 : ℕ)≥int.ceil (α * ↑i)-(α * ↑i)) : ℤ) = (0 ≥ int.ceil (α * ↑i)-(α * ↑i)),
          refl,
          rw h11 at h1,
          have h12 := α_irrational hα_irrat (int.ceil (α * ↑i)),
          rw add_zero int.fract at h12,
          rw add_assoc int.fract at h12,
          rw ← nat.add_sub_cancel (int.floor (α * ↑i)) int.fract at h12,
          rw add_zero at h12,
          rw int.ceil_eq_int_floor_add_one at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw int.fract_mk at h12,
          rw add_zero int.fract at h12,
          rw add_comm int.fract at h12,
          rw ← add_assoc int.fract at h12,
          rw ← add_assoc int.fract at h12,
          rw ← neg_add_rev at h12,
          rw ← add_assoc int.fract at h12,
          show (1 : ℝ) ≠ 0,
          rw [h1,h9,h8,h7,h6,h5,h4,h3,h2],
          linarith,
      },
      {
          intro h1,
          linarith,
      },
    },
    have h2 : ∀ i j : ℤ, (i ≠ j) ↔ (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)),
    {
      intros i j,
      split,
      {
          assume h3,
          assume h4 : i = j,
          rw h4 at h3,
          rw int.fract_mul at h3,
          rw int.fract_mul at h3,
          rw int.fract_mk at h3,
          rw int.fract_mk at h3,
          have h5 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑i) - (int.floor (α * ↑i)),
          simp,
          rw h5 at h3,
          rw sub_eq_add_neg at h3,
          have h6 : (-(int.ceil (α * ↑i)) : ℤ) = (int.floor (α * ↑i)) - (α * ↑i),
          rw int.ceil_eq_int_floor_add_one,
          linarith,
          rw h6 at h3,
          have h7 : (1 : ℤ) = -(int.ceil (α * ↑i) - (α * ↑i)) + (α * ↑i - int.floor (α * ↑i)),
          linarith,
          rw h7 at h3,
          rw ← sub_eq_add_neg at h3,
          rw ← neg_add at h3,
          rw ← neg_neg at h3,
          rw ← int.fract_neg_add_one at h3,
          rw ← int.fract_neg_add_one at h3,
          have h8 : α = int.fract (α),

end --Needs more than 2000 tokens!

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- "Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$."
  have h1 : ∀ (i j : ℤ) (h_distinct : i ≠ j), (int.fract (α * i) : ℝ) ≠ (int.fract (α * j)), from by {
    assume (i j : ℤ) (h_distinct : i ≠ j),
    -- "If this were not true, then"
    assume h2 : (int.fract (α * i)) = (int.fract (α * j)),
    -- then $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$
    have h3 : (α * ↑i - (α * ↑i).floor) = (int.fract (α * i)) ∧ (int.fract (α * j)) = (α * ↑j - (α * ↑j).floor), from by {
      split,
      rw h2,
      obviously,
    },
    -- then $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$
    have h4 :  α = ((α * ↑i).floor - (α * ↑j).floor) / (i - j), from by linarith,
    -- which is a contradiction of the irrationality of $\alpha$
    rw h4,
    have h5 : (irrational α) ↔ (∀ (x : ℚ), x ≠ α), from by {apply irrational_iff_eq_zero_of_mul_eq_zero},
    have h6 :  ∀ (x : ℚ), x ≠ α, from by {apply h5, assumption},
    have h7 :  (i - j) ≠ 0, from by {assumption},
    have h8 :  (i - j) ≠ 0, from by {assumption},
    rw h6,
    exact rat.denom_ne_zero _ h8,
  },

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$
  have h2 : is_infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    -- "By the Bolzano-Weierstrass theorem"
    apply is_infinite_of_no_finite_limit_points,
    -- "Then"
    have h3 :  ∀ (f : ℤ → ℂ), ∀ (l : ℂ), tendsto f at_top (𝓝 l) ↔
      ∀ (ε > 0), ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → |f (n : ℤ) - l| < ε,
    from by {apply tendsto_at_top_iff_nat},

    -- $S$ has a limit point in $[0, 1]$
    apply not_forall.mpr,
    assume h4 : ∀ (l : ℝ), ¬ is_limit_point (λ m : ℤ, int.fract (α * ↑m)) l,

    -- "One can thus find pairs of elements of $S$ that are arbitrarily close"
    -- Hence for a given $\epsilon > 0$ there exists a finite set $F \subseteq S$ such that $|y - x| < \epsilon$
    -- for every $(x, y) \in F \times F$
    have h5 : ∀ (ε > 0), ∃ (F : set ℝ) (n : ℕ), finite F ∧ F ⊆ insert 0 1 ∧ ((λ m : ℤ, int.fract (α * ↑m)) '' (finset.range n)) ⊆ F ∧
      ∀ (x : ℝ), x ∈ F → ∃ (y : ℝ), y ∈ F ∧ |x - y| < ε,
    from by {
      assume h5 : ε > 0,
      have h6 : ∀ (l : ℝ), l ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (finset.range n)) → l ∈
        insert 0 1,
      from by {
        assume (l : ℝ),
        assume h6 : l ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
        obtain ⟨n, h7⟩ := h6,
        have h8 : ((λ m : ℤ, int.fract (α * ↑m)) '' (finset.range n)) ⊆ (@set.univ ℤ), from by
          {apply set.image_subset_iff, apply finset.range_subset,},
        have h9 : l ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (finset.range n)) := by {exact set.mem_of_mem_closure h6,},
        have h10 : l ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
          rw h8 at h9, exact h9,
        },
        have h11 : ∀ (m : ℤ), m ∈ (@set.univ ℤ) → l ∈ (λ (m : ℤ), int.fract (α * m)) '' (@set.univ ℤ), from
          by {assumption,},
        obtain ⟨m, h12, h13⟩ : ∃ (m : ℤ), m ∈ (@set.univ ℤ) ∧ l ∈ (λ (m : ℤ), int.fract (α * m)) '' (@set.univ ℤ),
        from by {apply h11, exact h10},
        subst h13,
        -- We want to show that $\forall \epsilon > 0, \exists N : \mathbb{N}, |y - x| < \epsilon$
        -- But this follows from the fact that $x \in S$
        --
        have h14 : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → |int.fract (α * m) - int.fract (α * ↑n)| < ε, from by
          {apply h4, exact h3.right,},
        cases h14 with N h15,
        let F := (finset.range N).image (λ m : ℕ, int.fract (α * ↑m)),
        use F,
        use N,
        split,
        exact finset.finite_range N,
        split,
        apply set.image_subset,
        exact h7,
        intros m h,
        have h16 : m ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {exact set.mem_of_mem_closure h,},
        have h17 : m ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' finset.range N), from by {
          rw set.image_subset_iff at h7,
          obtain ⟨m0, h18, h19⟩ := h7 h16,
          use m0,
          split,
          exact h18, exact h19,
        },
        rw h7 at h17,
        have h20 : ∀ (m : ℤ), m ∈ finset.range N →
          l ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' finset.range N, from by {assumption,},
        obtain
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  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) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Devon Tuma
-/

import ring_theory.non_zero_divisors
import data.polynomial.algebra_map

/-!
# Scaling the roots of a polynomial

This file defines `scale_roots p s` for a polynomial `p` in one variable and a ring element `s` to
be the polynomial with root `r * s` for each root `r` of `p` and proves some basic results about it.
-/

section scale_roots

variables {A K R S : Type*} [comm_ring A] [is_domain A] [field K] [comm_ring R] [comm_ring S]
variables {M : submonoid A}

open polynomial
open_locale big_operators

/-- `scale_roots p s` is a polynomial with root `r * s` for each root `r` of `p`. -/
noncomputable def scale_roots (p : polynomial R) (s : R) : polynomial R :=
∑ i in p.support, monomial i (p.coeff i * s ^ (p.nat_degree - i))

@[simp] lemma coeff_scale_roots (p : polynomial R) (s : R) (i : ℕ) :
  (scale_roots p s).coeff i = coeff p i * s ^ (p.nat_degree - i) :=
by simp [scale_roots, coeff_monomial] {contextual := tt}

@[simp] lemma zero_scale_roots (s : R) : scale_roots 0 s = 0 := by { ext, simp }

lemma scale_roots_ne_zero {p : polynomial R} (hp : p ≠ 0) (s : R) :
  scale_roots p s ≠ 0 :=
begin
  intro h,
  have : p.coeff p.nat_degree ≠ 0 := mt leading_coeff_eq_zero.mp hp,
  have : (scale_roots p s).coeff p.nat_degree = 0 :=
    congr_fun (congr_arg (coeff : polynomial R → ℕ → R) h) p.nat_degree,
  rw [coeff_scale_roots_nat_degree] at this,
  contradiction
end

lemma support_scale_roots_le (p : polynomial R) (s : R) :
  (scale_roots p s).support ≤ p.support :=
by { intro, simpa using left_ne_zero_of_mul }

lemma support_scale_roots_eq (p : polynomial R) {s : R} (hs : s ∈ non_zero_divisors R) :
  (scale_roots p s).support = p.support :=
le_antisymm (support_scale_roots_le p s)
  begin
    intro i,
    simp only [coeff_scale_roots, polynomial.mem_support_iff],
    intros p_ne_zero ps_zero,
    have := ((non_zero_divisors R).pow_mem hs (p.nat_degree - i)) _ ps_zero,
    contradiction
  end

@[simp] lemma degree_scale_roots (p : polynomial R) {s : R} :
  degree (scale_roots p s) = degree p :=
begin
  haveI := classical.prop_decidable,
  by_cases hp : p = 0,
  { rw [hp, zero_scale_roots] },
  have := scale_roots_ne_zero hp s,
  refine le_antisymm (finset.sup_mono (support_scale_roots_le p s)) (degree_le_degree _),
  rw coeff_scale_roots_nat_degree,
  intro h,
  have := leading_coeff_eq_zero.mp h,
  contradiction,
end

@[simp] lemma nat_degree_scale_roots (p : polynomial R) (s : R) :
  nat_degree (scale_roots p s) = nat_degree p :=
by simp only [nat_degree, degree_scale_roots]

lemma monic_scale_roots_iff {p : polynomial R} (s : R) :
  monic (scale_roots p s) ↔ monic p :=
by simp only [monic, leading_coeff, nat_degree_scale_roots, coeff_scale_roots_nat_degree]

lemma scale_roots_eval₂_eq_zero {p : polynomial S} (f : S →+* R)
  {r : R} {s : S} (hr : eval₂ f r p = 0) :
  eval₂ f (f s * r) (scale_roots p s) = 0 :=
calc eval₂ f (f s * r) (scale_roots p s) =
  (scale_roots p s).support.sum (λ i, f (coeff p i * s ^ (p.nat_degree - i)) * (f s * r) ^ i) :
  by simp [eval₂_eq_sum, sum_def]
... = p.support.sum (λ i, f (coeff p i * s ^ (p.nat_degree - i)) * (f s * r) ^ i) :
  finset.sum_subset (support_scale_roots_le p s)
  (λ i hi hi', let this : coeff p i * s ^ (p.nat_degree - i) = 0 :=
  by simpa using hi' in by simp [this])
... = p.support.sum (λ (i : ℕ), f (p.coeff i) * f s ^ (p.nat_degree - i + i) * r ^ i) :
  finset.sum_congr rfl
  (λ i hi, by simp_rw [f.map_mul, f.map_pow, pow_add, mul_pow, mul_assoc])
... = p.support.sum (λ (i : ℕ), f s ^ p.nat_degree * (f (p.coeff i) * r ^ i)) :
  finset.sum_congr rfl
  (λ i hi, by { rw [mul_assoc, mul_left_comm, tsub_add_cancel_of_le],
                exact le_nat_degree_of_ne_zero (polynomial.mem_support_iff.mp hi) })
... = f s ^ p.nat_degree * p.support.sum (λ (i : ℕ), (f (p.coeff i) * r ^ i)) : finset.mul_sum.symm
... = f s ^ p.nat_degree * eval₂ f r p : by { simp [eval₂_eq_sum, sum_def] }
... = 0 : by rw [hr, _root_.mul_zero]

lemma scale_roots_aeval_eq_zero [algebra S R] {p : polynomial S}
  {r : R} {s : S} (hr : aeval r p = 0) :
  aeval (algebra_map S R s * r) (scale_roots p s) = 0 :=
scale_roots_eval₂_eq_zero (algebra_map S R) hr

lemma scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero
  {p : polynomial A} {f : A →+* K} (hf : function.injective f)
  {r s : A} (hr : eval₂ f (f r / f s) p = 0) (hs : s ∈ non_zero_divisors A) :
  eval₂ f (f r) (scale_roots p s) = 0 :=
begin
  convert scale_roots_eval₂_eq_zero f hr,
  rw [←mul_div_assoc, mul_comm, mul_div_cancel],
  exact f.map_ne_zero_of_mem_non_zero_divisors hf hs
end

lemma scale_roots_aeval_eq_zero_of_aeval_div_eq_zero [algebra A K]
  (inj : function.injective (algebra_map A K)) {p : polynomial A} {r s : A}
  (hr : aeval (algebra_map A K r / algebra_map A K s) p = 0) (hs : s ∈ non_zero_divisors A) :
  aeval (algebra_map A K r) (scale_roots p s) = 0 :=
scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero inj hr hs

end scale_roots


lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n :=
begin
induction n with b hb,
rwa [add_zero, pow_zero, mul_one],
rwa [add_succ, pow_succ, hb, pow_succ, mul_assoc],
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module topology.instances.rat
! leanprover-community/mathlib commit 560891c425c743b1a25d4f8447cce6dd60947c1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.MetricSpace.Basic
import Mathlib.Topology.Algebra.Order.Archimedean
import Mathlib.Topology.Instances.Int
import Mathlib.Topology.Instances.Nat
import Mathlib.Topology.Instances.Real

/-!
# Topology on the ratonal numbers

The structure of a metric space on `ℚ` is introduced in this file, induced from `ℝ`.
-/

open Metric Set Filter

namespace Rat

instance : MetricSpace ℚ :=
  MetricSpace.induced (↑) Rat.cast_injective Real.metricSpace

theorem dist_eq (x y : ℚ) : dist x y = |(x : ℝ) - y| := rfl
#align rat.dist_eq Rat.dist_eq

@[norm_cast, simp]
theorem dist_cast (x y : ℚ) : dist (x : ℝ) y = dist x y :=
  rfl
#align rat.dist_cast Rat.dist_cast

theorem uniformContinuous_coe_real : UniformContinuous ((↑) : ℚ → ℝ) :=
  uniformContinuous_comap
#align rat.uniform_continuous_coe_real Rat.uniformContinuous_coe_real

theorem uniformEmbedding_coe_real : UniformEmbedding ((↑) : ℚ → ℝ) :=
  uniformEmbedding_comap Rat.cast_injective
#align rat.uniform_embedding_coe_real Rat.uniformEmbedding_coe_real

theorem denseEmbedding_coe_real : DenseEmbedding ((↑) : ℚ → ℝ) :=
  uniformEmbedding_coe_real.denseEmbedding Rat.denseRange_cast
#align rat.dense_embedding_coe_real Rat.denseEmbedding_coe_real

theorem embedding_coe_real : Embedding ((↑) : ℚ → ℝ) :=
  denseEmbedding_coe_real.to_embedding
#align rat.embedding_coe_real Rat.embedding_coe_real

theorem continuous_coe_real : Continuous ((↑) : ℚ → ℝ) :=
  uniformContinuous_coe_real.continuous
#align rat.continuous_coe_real Rat.continuous_coe_real

end Rat

@[norm_cast, simp]
theorem Nat.dist_cast_rat (x y : ℕ) : dist (x : ℚ) y = dist x y := by
  rw [← Nat.dist_cast_real, ← Rat.dist_cast]; congr
#align nat.dist_cast_rat Nat.dist_cast_rat

theorem Nat.uniformEmbedding_coe_rat : UniformEmbedding ((↑) : ℕ → ℚ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one <| by simpa using Nat.pairwise_one_le_dist
#align nat.uniform_embedding_coe_rat Nat.uniformEmbedding_coe_rat

theorem Nat.closedEmbedding_coe_rat : ClosedEmbedding ((↑) : ℕ → ℚ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one <| by simpa using Nat.pairwise_one_le_dist
#align nat.closed_embedding_coe_rat Nat.closedEmbedding_coe_rat

@[norm_cast, simp]
theorem Int.dist_cast_rat (x y : ℤ) : dist (x : ℚ) y = dist x y := by
  rw [← Int.dist_cast_real, ← Rat.dist_cast]; congr
#align int.dist_cast_rat Int.dist_cast_rat

theorem Int.uniformEmbedding_coe_rat : UniformEmbedding ((↑) : ℤ → ℚ) :=
  uniformEmbedding_bot_of_pairwise_le_dist zero_lt_one <| by simpa using Int.pairwise_one_le_dist
#align int.uniform_embedding_coe_rat Int.uniformEmbedding_coe_rat

theorem Int.closedEmbedding_coe_rat : ClosedEmbedding ((↑) : ℤ → ℚ) :=
  closedEmbedding_of_pairwise_le_dist zero_lt_one <| by simpa using Int.pairwise_one_le_dist
#align int.closed_embedding_coe_rat Int.closedEmbedding_coe_rat

namespace Rat

instance : NoncompactSpace ℚ := Int.closedEmbedding_coe_rat.noncompactSpace

theorem uniformContinuous_add : UniformContinuous fun p : ℚ × ℚ => p.1 + p.2 :=
  Rat.uniformEmbedding_coe_real.toUniformInducing.uniformContinuous_iff.2 <| by
    simp only [(· ∘ ·), Rat.cast_add]
    exact Real.uniformContinuous_add.comp
      (Rat.uniformContinuous_coe_real.prod_map Rat.uniformContinuous_coe_real)
#align rat.uniform_continuous_add Rat.uniformContinuous_add

theorem uniformContinuous_neg : UniformContinuous (@Neg.neg ℚ _) :=
  Metric.uniformContinuous_iff.2 fun ε ε0 =>
    ⟨_, ε0, fun h => by rw [dist_comm] at h; simpa only [dist_eq, cast_neg, neg_sub_neg] using h⟩
#align rat.uniform_continuous_neg Rat.uniformContinuous_neg

instance : UniformAddGroup ℚ :=
  UniformAddGroup.mk' Rat.uniformContinuous_add Rat.uniformContinuous_neg

instance : TopologicalAddGroup ℚ := inferInstance

instance : OrderTopology ℚ := induced_orderTopology _ Rat.cast_lt exists_rat_btwn

theorem uniformContinuous_abs : UniformContinuous (abs : ℚ → ℚ) :=
  Metric.uniformContinuous_iff.2 fun ε ε0 =>
    ⟨ε, ε0, fun h =>
      lt_of_le_of_lt (by simpa [Rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩
#align rat.uniform_continuous_abs Rat.uniformContinuous_abs

instance : TopologicalRing ℚ := inferInstance

@[deprecated continuous_mul]
protected theorem continuous_mul : Continuous fun p : ℚ × ℚ => p.1 * p.2 := continuous_mul
#align rat.continuous_mul Rat.continuous_mul

nonrec theorem totallyBounded_Icc (a b : ℚ) : TotallyBounded (Icc a b) := by
  simpa only [preimage_cast_Icc] using
    totallyBounded_preimage Rat.uniformEmbedding_coe_real (totallyBounded_Icc (a : ℝ) b)
#align rat.totally_bounded_Icc Rat.totallyBounded_Icc

end Rat


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.preserves.basic
import Mathlib.PostPort

universes v u₁ u₂

namespace Mathlib

/-!
# Isomorphisms about functors which preserve (co)limits

If `G` preserves limits, and `C` and `D` have limits, then for any diagram `F : J ⥤ C` we have a
canonical isomorphism `preserves_limit_iso : G.obj (limit F) ≅ limit (F ⋙ G)`.
We also show that we can commute `is_limit.lift` of a preserved limit with `functor.map_cone`:
`(preserves_limit.preserves t).lift (G.map_cone c₂) = G.map (t.lift c₂)`.

The duals of these are also given. For functors which preserve (co)limits of specific shapes, see
`preserves/shapes.lean`.
-/

namespace category_theory

@[simp] theorem preserves_lift_map_cone {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_limit F G] (c₁ : limits.cone F) (c₂ : limits.cone F) (t : limits.is_limit c₁) : limits.is_limit.lift (limits.preserves_limit.preserves t) (functor.map_cone G c₂) =
  functor.map G (limits.is_limit.lift t c₂) := sorry

/--
If `G` preserves limits, we have an isomorphism from the image of the limit of a functor `F`
to the limit of the functor `F ⋙ G`.
-/
def preserves_limit_iso {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_limit F G] [limits.has_limit F] [limits.has_limit (F ⋙ G)] : functor.obj G (limits.limit F) ≅ limits.limit (F ⋙ G) :=
  limits.is_limit.cone_point_unique_up_to_iso (limits.preserves_limit.preserves (limits.limit.is_limit F))
    (limits.limit.is_limit (F ⋙ G))

@[simp] theorem preserves_limits_iso_hom_π_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_limit F G] [limits.has_limit F] [limits.has_limit (F ⋙ G)] (j : J) {X' : D} (f' : functor.obj (F ⋙ G) j ⟶ X') : iso.hom (preserves_limit_iso G F) ≫ limits.limit.π (F ⋙ G) j ≫ f' = functor.map G (limits.limit.π F j) ≫ f' := sorry

@[simp] theorem preserves_limits_iso_inv_π_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_limit F G] [limits.has_limit F] [limits.has_limit (F ⋙ G)] (j : J) {X' : D} (f' : functor.obj G (functor.obj F j) ⟶ X') : iso.inv (preserves_limit_iso G F) ≫ functor.map G (limits.limit.π F j) ≫ f' = limits.limit.π (F ⋙ G) j ≫ f' := sorry

@[simp] theorem lift_comp_preserves_limits_iso_hom_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_limit F G] [limits.has_limit F] [limits.has_limit (F ⋙ G)] (t : limits.cone F) {X' : D} (f' : limits.limit (F ⋙ G) ⟶ X') : functor.map G (limits.limit.lift F t) ≫ iso.hom (preserves_limit_iso G F) ≫ f' =
  limits.limit.lift (F ⋙ G) (functor.map_cone G t) ≫ f' := sorry

@[simp] theorem preserves_desc_map_cocone {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_colimit F G] (c₁ : limits.cocone F) (c₂ : limits.cocone F) (t : limits.is_colimit c₁) : limits.is_colimit.desc (limits.preserves_colimit.preserves t) (functor.map_cocone G c₂) =
  functor.map G (limits.is_colimit.desc t c₂) := sorry

/--
If `G` preserves colimits, we have an isomorphism from the image of the colimit of a functor `F`
to the colimit of the functor `F ⋙ G`.
-/
-- TODO: think about swapping the order here

def preserves_colimit_iso {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_colimit F G] [limits.has_colimit F] [limits.has_colimit (F ⋙ G)] : functor.obj G (limits.colimit F) ≅ limits.colimit (F ⋙ G) :=
  limits.is_colimit.cocone_point_unique_up_to_iso (limits.preserves_colimit.preserves (limits.colimit.is_colimit F))
    (limits.colimit.is_colimit (F ⋙ G))

@[simp] theorem ι_preserves_colimits_iso_inv_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_colimit F G] [limits.has_colimit F] [limits.has_colimit (F ⋙ G)] (j : J) {X' : D} (f' : functor.obj G (limits.colimit F) ⟶ X') : limits.colimit.ι (F ⋙ G) j ≫ iso.inv (preserves_colimit_iso G F) ≫ f' = functor.map G (limits.colimit.ι F j) ≫ f' := sorry

@[simp] theorem ι_preserves_colimits_iso_hom_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_colimit F G] [limits.has_colimit F] [limits.has_colimit (F ⋙ G)] (j : J) {X' : D} (f' : limits.colimit (F ⋙ G) ⟶ X') : functor.map G (limits.colimit.ι F j) ≫ iso.hom (preserves_colimit_iso G F) ≫ f' = limits.colimit.ι (F ⋙ G) j ≫ f' := sorry

@[simp] theorem preserves_colimits_iso_inv_comp_desc {C : Type u₁} [category C] {D : Type u₂} [category D] (G : C ⥤ D) {J : Type v} [small_category J] (F : J ⥤ C) [limits.preserves_colimit F G] [limits.has_colimit F] [limits.has_colimit (F ⋙ G)] (t : limits.cocone F) : iso.inv (preserves_colimit_iso G F) ≫ functor.map G (limits.colimit.desc F t) =
  limits.colimit.desc (F ⋙ G) (functor.map_cocone G t) := sorry


import ring_theory.fractional_ideal
import ring_theory.discrete_valuation_ring
import linear_algebra.basic
import order.zorn
universes u v

variables (R : Type u) [comm_ring R] {A : Type v} [comm_ring A]
variables (K : Type u) [field K] (R' : Type u) [integral_domain R']
variables [algebra R A]

open function
open_locale big_operators

structure is_integrally_closed_in : Prop :=
(inj : injective (algebra_map R A))
(closed : ∀ (a : A), is_integral R a → ∃ r : R, algebra_map R A r = a)

def is_integrally_closed_domain : Prop := ∀ {r s : R}, s ≠ 0 → (∃ (n : ℕ) (f : ℕ → R) (hf : f 0 = 1),
    ∑ ij in finset.nat.antidiagonal n, f ij.1 * r ^ ij.2 * s ^ ij.1 = 0) → s ∣ r

/-!
Any nontrivial localization of an integral domain results in an integral domain.
-/
theorem local_id_is_id [integral_domain R'] (S : submonoid R') (zero_non_mem : ((0 : R') ∉  S)) {f : localization_map S (localization S)} :
  is_integral_domain (localization S) :=
begin
  fsplit,
    {--nontrivial localization (pair ne)
      use [f.to_fun 1, f.to_fun 0],
      contrapose! zero_non_mem,
      -- intro one_eq_zero,
      have h2 := (localization_map.eq_iff_exists f).1 zero_non_mem,
      cases h2 with c h2,
      convert c.property, simp at h2; simp [h2],
    },
    { exact mul_comm },
    {--bulk
      intros x y mul_eq_zero,
      cases f.surj' x with a akey,
      cases f.surj' y with b bkey,
      have h1 : x * (f.to_fun a.snd) * y * (f.to_fun b.snd) = 0,
      { rw [mul_assoc x, ← mul_comm y, ← mul_assoc, mul_eq_zero], simp },
      rw [akey, mul_assoc, bkey, ← f.map_mul', ← f.map_zero'] at h1,
      rw f.eq_iff_exists' at h1,
      cases h1 with c h1,
      rw [zero_mul, mul_comm] at h1,
      have h2 := eq_zero_or_eq_zero_of_mul_eq_zero h1,
      cases h2 with c_eq_zero h2,
      { exfalso,
        rw ← c_eq_zero at zero_non_mem,
        exact zero_non_mem c.property },
      replace h2 := eq_zero_or_eq_zero_of_mul_eq_zero h2,
      cases h2 with a_eq_zero b_eq_zero,
      { left, rw a_eq_zero at akey,
        exact localization_map.eq_zero_of_fst_eq_zero f akey rfl },
      { right, rw b_eq_zero at bkey,
        exact localization_map.eq_zero_of_fst_eq_zero f bkey rfl },
    },
end

/-!
The localization of an integral domain at a prime ideal is an integral domain.
-/
lemma local_at_prime_of_id_is_id (P : ideal R') (hp_prime : P.is_prime) :
  integral_domain (localization.at_prime P) :=
begin
  have zero_non_mem : (0 : R') ∉ P.prime_compl,
  { have := ideal.zero_mem P, simpa },
  have h1 := local_id_is_id R' P.prime_compl zero_non_mem,
  exact is_integral_domain.to_integral_domain (localization.at_prime P) h1,
  exact localization.of (ideal.prime_compl P),
end

/-
Chopping block:
-- class discrete_valuation_ring [comm_ring R] : Prop :=
--     (int_domain : is_integral_domain(R))
--     (unique_nonzero_prime : ∃ Q : ideal R,
--     Q ≠ ⊥ → Q.is_prime →  (∀ P : ideal R, P.is_prime → P = ⊥ ∨ P = Q)
--     )
--     (is_pir : is_principal_ideal_ring(R))
-/

/-!
Def 1: integral domain, noetherian, integrally closed, nonzero prime ideals are maximal
-/
class dedekind_id [integral_domain R] : Prop :=
    (noetherian : is_noetherian_ring R)
    (int_closed : is_integrally_closed_domain R)
    (max_nonzero_primes : ∀ P ≠ (⊥ : ideal R), P.is_prime → P.is_maximal)
/-
Def 2: noetherian ring,
localization at each nonzero prime ideals is a DVR.

Something is a discrete valuation ring if
it is an integral domain and is a PIR and has one non-zero maximal ideal.
-/

class dedekind_dvr [integral_domain R'] : Prop :=
(noetherian : is_noetherian_ring R')
(local_dvr_nonzero_prime : ∀ P ≠ (⊥ : ideal R'), P.is_prime →
  @discrete_valuation_ring (localization.at_prime P) (by apply local_at_prime_of_id_is_id))

/-
Def 3: every nonzero fractional ideal is invertible.

Fractional ideal: I = {r | rI ⊆ R}
It is invertible if there exists a fractional ideal J
such that IJ=R.
-/

class dedekind_inv [integral_domain R'] (f : localization_map (non_zero_divisors R') $ localization (non_zero_divisors R')) : Prop :=
  (inv_ideals : ∀ I : ring.fractional_ideal f, (∃ t : I, t ≠ 0) → (∃ J : ring.fractional_ideal f, I * J = 1))

lemma dedekind_id_imp_dedekind_dvr (W : Type u) [integral_domain W] [dedekind_id W] : dedekind_dvr W :=
begin
  refine {noetherian := dedekind_id.noetherian, local_dvr_nonzero_prime := _},
  intros P hp_nonzero hp_prime, letI := hp_prime,
  have f := localization.of (ideal.prime_compl P),
  letI := local_at_prime_of_id_is_id W P hp_prime,
  rw discrete_valuation_ring.iff_PID_with_one_nonzero_prime (localization.at_prime P),
  split, swap,
  {
    have p' := local_ring.maximal_ideal (localization.at_prime P),
    have hp' := local_ring.maximal_ideal.is_maximal (localization.at_prime P),
    --use p' does not work

    repeat {sorry},
  },

  repeat {sorry},
end

-- CR jstark for kenji: You don't want both of these to be instances, since that creates a loop in typeclass inference.
-- I'd guess both of these just want to be lemmas
lemma dedekind_dvr_imp_dedekind_inv [dedekind_dvr R'] (f : fraction_map R' $ localization (non_zero_divisors R')) :
  dedekind_inv R' f :=
begin
    sorry,
end

lemma dedekind_inv_imp_dedekind_id (f : fraction_map R' $ localization (non_zero_divisors R')) [dedekind_inv R' f] :
  dedekind_id R' :=
begin
  sorry,
end

lemma dedekind_id_imp_dedekind_inv [dedekind_id R'] (f : fraction_map R' $ localization (non_zero_divisors R')) : dedekind_inv R' f :=
by {letI := dedekind_id_imp_dedekind_dvr R', exact dedekind_dvr_imp_dedekind_inv R' f,}

lemma dedekind_inv_imp_dedekind_dvr (f : fraction_map R' $ localization (non_zero_divisors R')) [dedekind_inv R' f] : dedekind_dvr R' :=
by {letI := dedekind_inv_imp_dedekind_id R', exact dedekind_id_imp_dedekind_dvr R',}

lemma dedekind_dvr_imp_dedekind_id (f : fraction_map R' $ localization (non_zero_divisors R')) [dedekind_dvr R'] : dedekind_id R' :=
by {letI := dedekind_dvr_imp_dedekind_inv R', exact dedekind_inv_imp_dedekind_id R' f,}

/-
Time to break a lot of things !

probably morally correct: fractional ideals have prime factorization !
(→ regular ideals have prime factorization)

-/

open_locale classical

/-
Currently mathlib has the following two characteristics of Noetherian modules
(i) - Every ascending chain of ideals is eventually constant i.e. I_1 ⊂ I_2 ⊂ I_3 ⊂ … ⊂ I_n ⊂ I_{n+1} = I_n
(ii) - Every ideal is finitely generated
This is the third that mathlib does not have (pertaining to rings, perhaps to modules(?)):
(iii) - Every non-empty set S of ideals has a maximal member. i.e. if M ⊂ I, then I = R ∨ I = M

Proof of equivalence: by mathlib (i) ↔ (ii).

(i → iii) - This is just the statement of Zorn's lemma applied to the poset of elements of S ordered under inclusion.
(iii → ii) - Let I be an ideal. Take S to be the set of subideals of I which are finitely generated.
Then the maximal element of S has to equal I.
-/
--this is not in mathlib for some reason(???)
lemma in_submodule_span_of_gen_set {X : Type u} [ring R'] [add_comm_group X] [module R' X]
{s : set X} {x : X} (h : x ∈ s) : x ∈ (submodule.span R' s) :=
submodule.subset_span h

    -- rcases mfg with ⟨ Mgen , Mgenkey⟩,
    -- use ↑Mgen, split, { apply finset.finite_to_set },
    -- convert Mgenkey, apply max,

theorem set_has_maximal_iff_noetherian {X : Type u} [add_comm_group X] [module R' X] : (∀(a : set $ submodule R' X), a.nonempty → ∃ (M ∈ a), ∀ (I ∈ a), M ≤ I → I=M) ↔ is_noetherian R' X :=
begin
  split; intro h,
  { split,
    intro I,
    let S := {J : submodule R' X | J ≤ I ∧ J.fg},
    have h2 : S.nonempty, { use (⊥ : submodule R' X), convert submodule.fg_bot, simp },
    rcases h S h2 with ⟨ M, ⟨hMI, ⟨Mgen, hMgen⟩⟩, max⟩,
    rw submodule.fg_def,
    contrapose! max,
    have : ∃ x ∈ I, x ∉ M,
    {
      have := max ↑Mgen (finset.finite_to_set Mgen),
      contrapose! this,
      rw hMgen, ext, tauto },
    rcases this with ⟨x, hxI, hxM⟩,
    use submodule.span R' (↑Mgen ∪ {x}), split,
    { split,
      { suffices : (↑Mgen : set X) ∪ {x} ⊆ I, { convert submodule.span_mono this, simp },
        have : (↑Mgen : set X) ⊆ M, { convert submodule.subset_span, cc },
        apply set.union_subset, { exact set.subset.trans this hMI }, { simp [hxI] } },
      { rw submodule.fg_def, use (↑Mgen ∪ {x}), split, { split, exact additive.fintype, }, refl } },
    split,
    { rw ← hMgen, convert submodule.span_mono _, simp },
    { contrapose! hxM, rw ← hxM, apply submodule.subset_span, exact (↑Mgen : set X).mem_union_right rfl, } },
  { rintros A ⟨a, ha⟩,
    rw is_noetherian_iff_well_founded at h,
    rw rel_embedding.well_founded_iff_no_descending_seq at h,
    by_contra hyp,
    push_neg at hyp,
    apply h,
    constructor,
    have h' : ∀ (M : submodule R' X), M ∈ A → (∃ (I : submodule R' X), I ∈ A ∧ M < I),
    {
      intros m mina,
      rcases hyp m mina with ⟨I, iina, mlei, mneqi⟩,
      use I, split, exact iina, split, exact mlei, intro ilem, apply mneqi, exact le_antisymm ilem mlei,
    },
    have h'' : ∀ M : A, ∃ I : A, (M : submodule R' X) < I,
    { rintros ⟨M, M_in⟩,
      rcases h' M M_in with ⟨I, I_in, hMI⟩,
      exact ⟨⟨I, I_in⟩, hMI⟩ },
    let f : ℕ → A := λ n, nat.rec_on n ⟨a, ha⟩ (λ n M, classical.some (h'' M)),
    exact rel_embedding.nat_gt (coe ∘ f) (λ n, classical.some_spec (h'' $ f n)),
  },
end

lemma set_has_maximal [is_noetherian_ring R'] (a : set $ ideal R') (ha : a.nonempty): ∃ (M ∈ a), ∀ (I ∈ a), M ≤ I → I = M :=
begin
  have : is_noetherian R' R' := by assumption,
  rw ← set_has_maximal_iff_noetherian at this,
  exact this _ ha,
end

--ring with id is most general(?)
lemma lt_add_nonmem (I : ideal R') (a ∉ I) : I < I+ideal.span{a} :=
begin
  have blah : ∀ (x y : ideal R'), x ≤ x ⊔ y,
  { intros x y, simp only [le_sup_left],},
  split, exact blah I (ideal.span{a}),
  have blah2 : ∀ (x y z : ideal R'),  x ⊔ y ≤ z → x ≤ z → y ≤ z,
  { intros x y z, simp only [sup_le_iff], tauto,},
  have h : I ≤ I, exact le_refl I,
  rw ideal.add_eq_sup,
  intro bad,
  have h1 := blah2 I (ideal.span{a}) I bad h,
  have h2 : a ∈ ideal.span{a},
  { rw ideal.mem_span_singleton', use 1, rw one_mul,},
  have : ∀ (x ∈ ideal.span{a}), x ∈ I, simpa only [],
  exact H (this a h2),
end

lemma zero_prime [integral_domain R'] : (⊥ : ideal R').is_prime :=
begin
  split,
  {
    intro,
    have h1 := (ideal.eq_top_iff_one) (⊥ : ideal R'),
    rw h1 at a,
    have : 1 = (0 : R'), tauto,
    simpa,
  },
  {
    intros,
    have h1 : x * y = 0, tauto,
    have x_or_y0 : x = 0 ∨ y = 0,
    exact zero_eq_mul.mp (eq.symm h1),
    tauto,
  },
end

namespace dedekind

/-
Suppose not, then the set of ideals that do not contain a product of primes is nonempty, and by set_has_maximal
must have a maximal element M.
Since M is not prime, ∃ (r,s : R-M) such that rs ∈ M.
Since r ∉ M, M+(r) > M, and since M is maximal, M+(r) and M+(s) must be divisible by some prime.
Now observe that (M+(r))(M+(s)) is divisible by some primes, but M*M ⊂ M, rM ⊂ M, sM ⊂ M, and rs ⊂ M, so
this is contained in M, but this is a contradiction.
-/
lemma ideal_contains_prime_product [dedekind_id R'] (I : ideal R') (gt_zero : ⊥ < I) : ∃(plist : list $ ideal R'), plist.prod ≤ I ∧ (∀(P ∈ plist), ideal.is_prime P ∧ ⊥ < P) :=
begin
  letI : is_noetherian_ring R', exact dedekind_id.noetherian,
  by_contra hyp,
  push_neg at hyp,
  let A := {J : ideal R' | ∀(qlist : list $ ideal R'), qlist.prod ≤ J → (∃ (P : ideal R'), P ∈ qlist ∧ (P.is_prime → ¬⊥ < P))},
  have key : A.nonempty,
  {use I, exact hyp,},
  rcases set_has_maximal R' A key with ⟨ M, Mkey, maximal⟩,
  rw set.mem_set_of_eq at Mkey,
  by_cases M = ⊥,
  {
    have h1 := maximal I,
    have h2 : I ∈ A, simpa,
    rw h at h1,
    have h3 := h1 h2,
    have h4 : ⊥ ≤ I,
    {cases gt_zero, exact gt_zero_left,},
    cases gt_zero,
    have := h3 h4,
    rw this at *, tauto,
  },
  by_cases M.is_prime,
  {
    have : [M].prod ≤  M, rw list.prod_singleton, exact le_refl M,
    sorry,
  },
  repeat{sorry},
end

/-
--what is this even trying to prove? chopping block 2.0
lemma ideal_contains_prime_product [dedekind_id R'] (I : ideal R') (gt_zero : ⊥  < I ) : ∃ (plist : list $ ideal R'), plist.prod ≤ I ∧ (∀(P ∈  plist), ideal.is_prime P ∧ ⊥ < P ) :=
begin
  /- IMPORTANT NOTE: some things here work that work for the wrong reasons (read: ne_top)
  -/
  letI : is_noetherian_ring R', exact dedekind_id.noetherian,
  by_contradiction hyp,
  push_neg at hyp,
  let A := {J : ideal R' | ∀(qlist : list $ ideal R'), qlist.prod ≤ J → (∃(P ∈ qlist), ideal.is_prime(P) →  ¬⊥ < P)},
  have key : A.nonempty,
  { use I, simpa only [exists_prop, set.mem_set_of_eq],},

  rcases set_has_maximal R' A key with ⟨ M, Mkey, maximal⟩,
  rw set.mem_set_of_eq at Mkey,
  by_cases M = ⊥,
  {
    have h1 := maximal I,
    have h2 : I ∈ A, simpa,
    rw h at h1,
    have h3 := h1 h2,
    have h4 : ⊥ ≤ I,
    { cases gt_zero, exact gt_zero_left,},
    cases gt_zero,
    have := h3 h4,
    rw this at *, tauto,
  },
  have h1 : ¬ M.is_prime,
  {
    by_contradiction,
    have h1 := Mkey [M],
    rw list.prod_singleton at h1,
    have : M ≤ M, exact le_refl M,
    rcases h1 this with ⟨ P, Pkey, hp ⟩,
    have blah: P = M, exact list.mem_singleton.mp Pkey,

    rw blah at hp,
    have hp' := hp a,
    clear' h1 Pkey this blah hp P,
    sorry,
  },
  unfold ideal.is_prime at h1,
  push_neg at h1,
  have ne_top : M ≠ ⊤ , sorry,
  have h2 := h1 ne_top,
  rcases h2 with ⟨r,s,rs_in_m, r_nin_m, s_nin_m⟩,
  set ray := M + ideal.span({r}) with mr,
  have hmr : M < ray,
  { exact lt_add_nonmem R' M r r_nin_m,},
  set say := M + ideal.span({s}) with ms,
  have hms : M < say,
  { exact lt_add_nonmem R' M s s_nin_m,},
  clear r_nin_m s_nin_m ne_top,
  have main : ray*say ≤ M,
  {--bashing simplifications, I think this would be a very nice simp tactic
    rw [ms,mr,left_distrib,right_distrib,right_distrib,← add_assoc],
    repeat {rw [ideal.add_eq_sup]},
    have blah : ∀ (x y z : ideal R'), x ≤ z → y ≤ z → x ⊔ y ≤ z, simp only [sup_le_iff], tauto,
    have part1 : M*M ≤ M, exact ideal.mul_le_left,
    have part2 : ideal.span{r} * M ≤ M, exact ideal.mul_le_left,
    have part3 : M*ideal.span{s} ≤ M, exact ideal.mul_le_right,
    have part4' : ideal.span {r} * ideal.span {s} = (ideal.span{r*s} : ideal R'),
    {
      unfold ideal.span,
      rw [submodule.span_mul_span, set.singleton_mul_singleton],
    },
    rw part4',
    have part4 : ideal.span{r*s} ≤ M,
    { rw ideal.span_le, simpa,},
    have h1 := blah (M*M) (ideal.span{r} * M ⊔  M * ideal.span {s} ⊔  ideal.span{r*s}) M part1,
    rw [←sup_assoc,← sup_assoc] at h1,
    apply h1,
    clear' h1 part1,
    have h1 := blah (ideal.span{r} * M) (M * ideal.span{s} ⊔ ideal.span{r*s}) M part2,
    rw [←sup_assoc] at h1,
    apply h1, clear' h1 part2,
    exact blah (M * ideal.span{s}) (ideal.span {r*s}) M part3 part4,
  },
  have say_contains_prime : ∃ (P : ideal R'), P.is_prime ∧ say < P,
  {--sketch: since M < say and M is maximal of the set, say is not in A, and so has prime factor
    sorry,
  },
  --there are too many variables that may or may not be needed....
  rcases say_contains_prime with ⟨ P , P_prime , P_dvd⟩,
  --have h2 : P ∣ M, {sorry,},
  --clear' P_dvd,
  --exact Mkey P P_prime h2,
  sorry,
end
-/
/-
For any proper ideal I, there exists an element, γ,  in K (the field of fractions of R) such that
γ I ⊂ R.
Proof: This is really annoying.
Pick some a ∈ I, then (a) contains a product of primes, and fix P_1, … such that
P_1…P_r ⊂ (a), etc.

broken, not sure how to state it.

lemma frac_mul_ideal_contains_ring [dedekind_id R'] (I : ideal R') (h_nonzero : I ≠ ⊥) (h_nontop : I ≠ ⊤ ) : ∃ (γ : fraction_ring R'), γI ⊂ R :=
begin
  sorry,
end

-/

/-
For any ideal I, there exists J such that IJ is principal.
proof:
Let 0 ≠ α ∈ I, and let J = { β ∈ R : β I ⊂ (α )}.
We can see that J is an ideal.
and we have that IJ ⊂ (α).
Since IJ ⊂ (α), we have that A = IJ/α is an ideal of R.

If A = R, then IJ = (α) and we are done,
otherwise, A is a proper ideal, and we can use frac_mul_ideal_contains_ring
to have a γ ∈ K-R such that γ A ⊂ R. Since R is integrally closed,
it suffices to show that γ is a root of a monic polynomial over R.

We have that J ⊂ A, as α ∈ I. so γ J ⊂ γ A ⊂ R.
We make the observation that γ J ⊂ J. (rest is sketchy and annoying)

Need to refine conditions (mainly non-zero).
-/
lemma exists_ideal_prod_principal [dedekind_id R'](I : ideal R') : ∃ (J : ideal R'), (I * J).is_principal ∧ (J ≠ ⊥ ) :=
begin
  sorry,
end

--this seems true, should check!
lemma ideal_mul_eq_zero [integral_domain R'] {I J : ideal R'} : (I * J = ⊥) ↔ I = ⊥ ∨ J = ⊥ :=
begin
  have hJ : inhabited J, by exact submodule.inhabited J,
  have j := inhabited.default J, clear hJ,
  split, swap,
  { intros,
    cases a,
    {rw [← ideal.mul_bot J, a, ideal.mul_comm],},
    {rw [← ideal.mul_bot I, a, ideal.mul_comm],},
  },
  intro hij,
  by_cases J = ⊥,
  tauto,
  left,
  rw submodule.eq_bot_iff,
  intros i hi,
  rcases J.ne_bot_iff.1 h with ⟨ j', hj, ne0⟩,
  rw submodule.eq_bot_iff at hij,
  specialize hij (i * j'),
  have := eq_zero_or_eq_zero_of_mul_eq_zero ( hij (ideal.mul_mem_mul hi hj)),
  tauto,
end

--this is probably useless and cumbersome to use (if ever used)
lemma prod_principal_eq_zero_iff_eq_zero [dedekind_id R'] (I : ideal R')
(J : ideal R') (hj : (I*J).is_principal) (nonzero : (J ≠ ⊥ )) : (I * J) = ⊥ ↔ I = ⊥ :=
begin
  split, swap,
  {intro, rw a, simp,},
  intro h,
  have h1 := (ideal_mul_eq_zero(R')).1 h,
  cases h1, exact h1, simpa only [],
end

lemma ddk_mul_right_inj [dedekind_id R'] (A B C : ideal R') (A ≠ ⊥ ) : A * B = A * C ↔ B=C :=
begin
  symmetry,
  split,
  {intro, rw a,},
  rcases exists_ideal_prod_principal(R')(A) with ⟨ J ,Jkey, ne_bot⟩,
  intro ab_eq_ac,
  have : J * A * B = J * A  * C,
  {rw [mul_assoc, ab_eq_ac,mul_assoc],},
  rw mul_comm(J)(A) at this,

  sorry,
end
/-
TODO: Refactor ddk_left_inj to be more like mul_left_inj
-/
lemma ddk_left_inj [dedekind_id R'] (A B C : ideal R') ( C ≠ ⊥ ) : A * C = B * C ↔ A = B :=
begin
  rw [mul_comm(A), mul_comm(B)],
  have h1 := ddk_mul_right_inj R' C A B C H, --why does this require so many args?
  exact h1,
end

--This is currently dead wrong
lemma ideal_prime_factorization [dedekind_id R'] (I : ideal R') : ∃ (pset : finset $ ideal R'), ∃(powset : finset $ ℕ ), (finset.card pset = finset.card powset) ∧ (∀(P ∈  pset), ideal.is_prime(P)) ∧ false :=
begin
  sorry,
end

--every nonzero ideal has an element that's not 0
lemma nonzero_mem_of_neq_bot [integral_domain R'] (I : ideal R') (gt_bot : ⊥ < I) : ∃ a : I, a ≠ 0 :=
begin
  have h := (submodule.lt_iff_le_and_exists.1 gt_bot).2,
  clear gt_bot,
  rcases h with ⟨ x, hx, key ⟩,
  use [x, hx],
  simp only [submodule.mem_bot] at key,
  simpa only [ne.def, submodule.mk_eq_zero],
end

--every ideal is generated by at most two elements of dedekind domain
lemma two_generators [dedekind_id R'] (I : ideal R')  : ∃ ( a b : R'), I = ideal.span {a,b} :=
begin
  by_cases ⊥ < I,
  tactic.swap,
  {
    have h1 : I = ⊥ ,
    sorry,
    use (0 : R'), use (0 : R'), rw h1, simp,
  },
  have h1 := nonzero_mem_of_neq_bot R' I h,
  cases h1 with a a_neq_zero,
  use a,

  sorry,
end
end dedekind


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.term
import Mathlib.PostPort

universes l

namespace Mathlib

/-
Linear natural number arithmetic terms in pre-normalized form.
-/

namespace omega

namespace nat

/-- The shadow syntax for arithmetic terms. All constants are reified to `cst`
(e.g., `5` is reified to `cst 5`) and all other atomic terms are reified to
`exp` (e.g., `5 * (list.length l)` is reified to `exp 5 \`(list.length l)`).
`exp` accepts a coefficient of type `nat` as its first argument because
multiplication by constant is allowed by the omega test. -/
/-- Similar to `exprterm`, except that all exprs are now replaced with
de Brujin indices of type `nat`. This is akin to generalizing over
the terms represented by the said exprs. -/
inductive preterm
where
| cst : ℕ → preterm
| var : ℕ → ℕ → preterm
| add : preterm → preterm → preterm
| sub : preterm → preterm → preterm

namespace preterm

/-- Helper tactic for proof by induction over preterms -/
/-- Preterm evaluation -/
def val (v : ℕ → ℕ) : preterm → ℕ :=
  sorry

@[simp] theorem val_const {v : ℕ → ℕ} {m : ℕ} : val v (cst m) = m :=
  rfl

@[simp] theorem val_var {v : ℕ → ℕ} {m : ℕ} {n : ℕ} : val v (var m n) = m * v n := sorry

@[simp] theorem val_add {v : ℕ → ℕ} {t : preterm} {s : preterm} : val v (add t s) = val v t + val v s :=
  rfl

@[simp] theorem val_sub {v : ℕ → ℕ} {t : preterm} {s : preterm} : val v (sub t s) = val v t - val v s :=
  rfl

/-- Fresh de Brujin index not used by any variable in argument -/
def fresh_index : preterm → ℕ :=
  sorry

/-- If variable assignments `v` and `w` agree on all variables that occur
in term `t`, the value of `t` under `v` and `w` are identical. -/
theorem val_constant (v : ℕ → ℕ) (w : ℕ → ℕ) (t : preterm) : (∀ (x : ℕ), x < fresh_index t → v x = w x) → val v t = val w t := sorry

def repr : preterm → string :=
  sorry

@[simp] def add_one (t : preterm) : preterm :=
  add t (cst 1)

/-- Preterm is free of subtractions -/
def sub_free : preterm → Prop :=
  sorry

end preterm

/-- Return a term (which is in canonical form by definition)
    that is equivalent to the input preterm -/
@[simp] def canonize : preterm → term :=
  sorry

@[simp] theorem val_canonize {v : ℕ → ℕ} {t : preterm} : preterm.sub_free t → term.val (fun (x : ℕ) => ↑(v x)) (canonize t) = ↑(preterm.val v t) := sorry


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import principia.logic
import principia.mynat.basic
import principia.mynat.le
import principia.mynat.nat_sub

namespace hidden

-- Basic definitions for integers
-- TODO:
-- - Prove basic theorems about arithmetic again
-- - Define some quotient/remainder things

inductive oldint: Type
| of_nat         : mynat → oldint
| neg_succ_of_nat: mynat → oldint

-- "has coercion" I think. Seems to introduce the notation
-- ↑n (\u n) for "coerce n"
instance: has_coe mynat oldint := ⟨oldint.of_nat⟩

-- lets you write -[1+ n] for negative numbers. Note the spacing is
-- unforgiving.
notation `-[1+ ` n `]` := oldint.neg_succ_of_nat n

namespace oldint
open oldint
open mynat

instance: has_zero oldint := ⟨of_nat 0⟩
instance: has_one oldint := ⟨of_nat 1⟩

def neg_of_nat: mynat → oldint
| 0        := 0
| (succ m) := -[1+ m]

def sub_nat_nat (m n: mynat): oldint :=
match m - n with
| 0 := neg_of_nat (n - m)
| d := d
end

def neg: oldint → oldint
| (of_nat n) := neg_of_nat n
| -[1+ n]    := succ n

instance: has_neg oldint := ⟨neg⟩

def abs : oldint → mynat
| (of_nat m) := m
| -[1+ m] := succ m

def sign : oldint → oldint
| (of_nat a) :=
match a with
| zero     := 0
| (succ _) := 1
end
| -[1+ _] := -1

variables {m n k: oldint}
variables {a b c: mynat}

-- Basic

lemma of_nat_zero : of_nat 0 = 0 := rfl

lemma of_nat_one : of_nat 1 = 1 := rfl

theorem zero_nat: (↑(0: mynat): oldint) = 0 := rfl

theorem one_nat: (↑(1:mynat):oldint) = 1 := rfl

theorem neg_one: -(1:oldint) = -[1+ 0] := rfl

theorem of_nat_ne_neg_succ: of_nat a ≠ -[1+ b] := by
  apply oldint.no_confusion

theorem zero_ne_neg_succ (a : mynat): 0 ≠ -[1+ a] := by
  apply of_nat_ne_neg_succ

@[simp]
theorem of_nat_cancel: (↑a: oldint) = ↑b ↔ a = b :=
begin
  split; assume h,
    cases h, refl,
  rw h,
end

@[simp]
theorem neg_succ_of_nat_cancel: -[1+ a] = -[1+ b] ↔ a = b :=
begin
  split; assume h,
    cases h, refl,
  congr, assumption,
end

-- Coercion

@[simp]
theorem coe_nat_eq (n: mynat): ↑n = of_nat n := rfl

-- Neg of nat

@[simp]
theorem neg_of_nat_zero: neg_of_nat 0 = 0 := rfl

@[simp]
theorem neg_succ: neg_of_nat (succ a) = -[1+ a] := rfl

-- Massive cash bash, for very basic theorem
@[simp]
theorem neg_of_nat_cancel: ∀ {a b}, neg_of_nat a = neg_of_nat b ↔ a = b :=
begin
  assume a b,
  split; assume h,
    cases a,
      cases b, refl,
      rw zz,
      rw [zz, neg_of_nat_zero, neg_succ] at h,
      exfalso,
      from zero_ne_neg_succ b h,
    cases b,
      rw [zz, neg_succ, neg_of_nat_zero] at h,
      exfalso, from zero_ne_neg_succ a h.symm,
    congr,
    rw [neg_succ, neg_succ] at h,
    rw ←neg_succ_of_nat_cancel,
    assumption,
  congr,
  assumption,
end

-- Sub nat nat

@[simp]
theorem zero_sub_neg: sub_nat_nat 0 a = neg_of_nat a :=
begin
  cases a,
    refl,
  refl,
end

@[simp]
theorem nat_sub_zero: sub_nat_nat a 0 = ↑a :=
begin
  cases a,
    refl,
  refl,
end

-- Extremely useful
@[simp]
theorem sub_succ_succ:
sub_nat_nat (succ a) (succ b) = sub_nat_nat a b :=
begin
  unfold sub_nat_nat,
  rw sub_succ_succ,
  cases (a - b),
  refl,
  refl,
end

@[simp]
theorem sub_self: ∀ a, sub_nat_nat a a = 0
| zero := rfl
| (succ a) := by rw [sub_succ_succ, sub_self]

-- Neg

lemma neg_eq_minus: neg m = -m := rfl

theorem neg_coe_eq_neg_of_nat: -(↑a) = neg_of_nat a := rfl

private theorem neg_neg_of_nat: ∀ {a}, -neg_of_nat a = ↑a
| zero     := rfl
| (succ a) := rfl

@[simp]
theorem neg_zero: -(0:oldint) = 0 := rfl

theorem neg_neg_succ: -(-[1+ a]) = ↑(succ a) := by
rw ←neg_eq_minus; refl

theorem neg_coe_succ: -(↑(succ a)) = -[1+ a] := rfl

@[simp]
theorem neg_neg: ∀ {m : oldint}, -(-m) = m
| (of_nat a) := by rw [←coe_nat_eq, neg_coe_eq_neg_of_nat];
                   from neg_neg_of_nat
| -[1+ a]    := by rw neg_neg_succ; refl

theorem neg_switch: -m = n → m = -n :=
begin
  assume h,
  -- To "do the same to both sides"
  have h₁ := congr_arg (λ m, -m) h,
  simp at h₁, -- To simp lambdas
  assumption,
end

@[simp]
theorem neg_cancel: -m = -n ↔ m = n :=
begin
  repeat {rw ←neg_eq_minus},
  split; assume h,
    repeat {rw neg_eq_minus at h},
    have h₁ := congr_arg (λ m, -m) h,
    simp at h₁,
    repeat {rw neg_neg at h₁},
    assumption,
  congr, assumption,
end

theorem sub_nat_nat_switch: ∀ {a b : mynat},
-(sub_nat_nat a b) = sub_nat_nat b a
| zero zero := rfl
| zero (succ b) := rfl
| (succ a) zero := rfl
| (succ a) (succ b) :=
by rw [sub_succ_succ, sub_succ_succ, sub_nat_nat_switch]

-- Abs

theorem abs_of_nat: abs ↑a = a := rfl

theorem abs_neg_succ: abs -[1+ a] = succ a := rfl

theorem abs_neg: ∀ {m}, abs (-m) = abs m
| (of_nat a) :=
begin
  rw ←coe_nat_eq,
  cases a, {
    rw [zz, zero_nat, neg_zero],
  }, {
    rw [←neg_neg_succ, neg_neg, neg_neg_succ, abs_of_nat,
        abs_neg_succ],
  },
end
| -[1+ a] :=
by rw [neg_neg_succ, abs_neg_succ, abs_of_nat]

-- Sign

theorem sign_zero: sign 0 = 0 := rfl

theorem sign_neg_succ: sign -[1+ a] = -1 := rfl

theorem sign_succ: sign ↑(succ a) = 1 := rfl

theorem zero_iff_sign_zero: m = 0 ↔ sign m = 0 :=
begin
  split; assume h, {
    subst h, refl,
  }, {
    cases m, {
      cases m, {
        rw [zz, ←coe_nat_eq, zero_nat],
      }, {
        exfalso,
        rw [←coe_nat_eq, sign_succ, ←zero_nat, ←one_nat, of_nat_cancel]
        at h,
        from mynat.no_confusion h,
      },
    }, {
      exfalso,
      rw [sign_neg_succ] at h,
      from oldint.no_confusion h,
    },
  },
end

theorem nzero_iff_sign_nzero: m ≠ 0 ↔ sign m ≠ 0 :=
iff_to_contrapositive zero_iff_sign_zero

-- Decidability

instance: decidable_eq oldint
| (of_nat a) (of_nat b) :=
by rw [←coe_nat_eq, ←coe_nat_eq, of_nat_cancel]; apply_instance
| (of_nat a) -[1+ b] := is_false of_nat_ne_neg_succ
| -[1+ a] (of_nat b) := is_false of_nat_ne_neg_succ.symm
| -[1+ a] -[1+ b] := by rw [neg_succ_of_nat_cancel]; apply_instance

theorem zero_ne_one : (0 : oldint) ≠ 1 :=
begin
  rw [←one_nat, ←zero_nat],
  assume h,
  rw of_nat_cancel at h,
  from zero_ne_one h,
end

end oldint
end hidden