import data.real.basic
import .affnK
/-
Amanda:

Go to line 730ish and find the proof I just copied and pasted in. It is an example basis proof.
Dig into the details and you'll be able to adapt this, or at least some of it.
-/
import linear_algebra.basis
-- Testing vec_n_basis

/-
protected noncomputable def span : basis ι R (span R (range v)) :=
basis.mk (linear_independent_span hli) $
begin
  rw eq_top_iff,
  intros x _,
  have h₁ : subtype.val '' set.range (λ i, subtype.mk (v i) _) = range v,
  { rw ← set.range_comp },
  have h₂ : map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _)))
    = span R (range v),
  { rw [← span_image, submodule.subtype_eq_val, h₁] },
  have h₃ : (x : M) ∈ map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _))),
  { rw h₂, apply subtype.mem x },
  rcases mem_map.1 h₃ with ⟨y, hy₁, hy₂⟩,
  have h_x_eq_y : x = y,
  { rw [subtype.ext_iff, ← hy₂], simp },
  rwa h_x_eq_y
end
-/

def vec_1_basis := vec_n_basis.mk (λ a : fin 1, (λ b : fin 1, vec.mk (1 : ℚ))) begin
  ext,
  split,
  {
    intro h,
    dsimp only [has_bot.bot, has_zero.zero, add_zero_class.zero, add_monoid.zero, add_comm_monoid.zero],
    suffices h' : x = {support := ∅, to_fun := λ (_x : fin 1), semiring.zero, mem_support_to_fun := _},
    exact h',
    dsimp only [linear_map.ker, submodule.comap, set.preimage] at h,
    have h₀ : ⇑(finsupp.total (fin 1) (vec_n ℚ 1) ℚ (λ (a b : fin 1), {coord := 1})) x ∈ ↑⊥ := by exact h,
    dsimp only [has_bot.bot, has_zero.zero, add_zero_class.zero, add_monoid.zero, add_comm_monoid.zero] at h₀,
    dsimp only [vec_zero] at h₀,
    have h₁ : ⇑(finsupp.total (fin 1) (vec_n ℚ 1) ℚ (λ (a b : fin 1), {coord := 1})) x = λ (_x : fin 1), mk_vec ℚ 0 := by exact h₀,
    dsimp only [finsupp.total, finsupp.lsum, coe_fn, has_coe_to_fun.coe] at h₁,
    dsimp [finsupp.sum] at h₁,
    simp only [linear_map.id_coe, id.def] at h₁,
    sorry,
  },
  {
    intro h,
    dsimp only [has_bot.bot, has_zero.zero, add_zero_class.zero, add_monoid.zero, add_comm_monoid.zero] at h,
    have h₀ : x = {support := ∅, to_fun := λ (_x : fin 1), semiring.zero, mem_support_to_fun := _} := by exact h,
    dsimp only [linear_map.ker, submodule.comap, set.preimage],
    suffices h' : ⇑(finsupp.total (fin 1) (vec_n ℚ 1) ℚ (λ (a b : fin 1), {coord := 1})) x ∈ ↑⊥,
    exact h',
    dsimp only [has_bot.bot, has_zero.zero, add_zero_class.zero, add_monoid.zero, add_comm_monoid.zero],
    dsimp only [vec_zero],
    suffices h' : ⇑(finsupp.total (fin 1) (vec_n ℚ 1) ℚ (λ (a b : fin 1), {coord := 1})) x = λ (_x : fin 1), mk_vec ℚ 0,
    exact h',
    dsimp only [finsupp.total, finsupp.lsum, coe_fn, has_coe_to_fun.coe],
    rw h₀,
    dsimp [finsupp.sum],
    refl,
  }
end begin
  /-rw eq_top_iff,
  intros x _,
  have h₁ : subtype.val '' set.range (λ i, subtype.mk (λ (a b : fin 1), {coord := 1} i) _) = {x | ∃y, λ (a b : fin 1), ({coord := 1} : vec ℚ) y = x}
  { rw ← set.range_comp },-/
  rw eq_top_iff,
  intros x _,
  dsimp only [submodule.span, Inf, set.range, set.Inter],
  dsimp only [infi, Inf, complete_semilattice_Inf.Inf, complete_lattice.Inf, set.range],
  simp only [forall_apply_eq_imp_iff', and_imp, set_like.mem_coe, submodule.mem_carrier, set.mem_set_of_eq, exists_imp_distrib, exists_const],
  suffices h : ∀ (a_1 : submodule ℚ (vec_n ℚ 1)), set_of (eq (λ (b : fin 1), ({coord := 1} : vec ℚ))) ⊆ a_1.carrier → x ∈ a_1,
  exact h,
  intros a_1 h,
  dsimp only [set_of] at h,
  dsimp only [has_subset.subset, set.subset] at h,
  sorry,
end


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

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit :
  ∀ (α : ℝ) (hα : ¬ ∃ i : ℚ, α = i), ∀ y : ℝ, ∀ ε : ℝ, ε > 0 → ∃ x : ℝ, 0 ≤ x ∧ x < ε ∧ ∃ N : ℤ, (0 ≤ y - N*x ∧ y - N*x < ε) :=
begin
  assume (α : ℝ) (hα : ¬ ∃ i : ℚ, α = i) (y : ℝ),
  have h1 : ∀ i j : ℤ, (i ≠ j) → (i*α - floor (i*α)) ≠ (j*α - floor (j*α)) := by {
    assume (i : ℤ) (j : ℤ) (h : i ≠ j),
    assume h1 : (i*α - floor (i*α)) = (j*α - floor (j*α)),
    have h2 : α = (floor (i*α) - floor (j*α))/(i-j) := by {
      have h3 : i*α - floor (i*α) = j*α - floor (j*α), from h1,
      rw [h3,mul_sub_left_distrib,mul_sub_right_distrib,add_mul,add_mul,mul_comm i (α-floor α),mul_comm j (α-floor α),mul_add,mul_add,mul_comm α j,mul_comm α i,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm (i-j) α,mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,mul_comm α (i-j),mul_assoc,mul_assoc,
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 :=irrational_orbit_density {α : Type*} [linear_ordered_field α] (a : α) (h : ¬ is_rat a) : ∀ (ε : α) (hε : ε > 0), ∃ (i : ℤ), ∃ (j : ℤ), (i - j) * a ∈ (Icc 0 ε) :=
begin
  assume ε hε,
  apply exists_Icc_iff.mp,
  let set := {(a * of_int i) - (floor (a * of_int i)) | i : ℤ},
  have h1 : 0 = (a * (of_int 0) - floor (a * of_int 0) ), from by {unfold_coes, ring},
  have h2 : 0 ∈ set, from (h1.symm),
  have h3 : set ∈ 𝒫 (Icc 0 1), from by {
    have h4 := floor_nonneg a,
    have h5 : ∀ (i : ℤ), a * of_int i ≥ 0, from by {intro i, rw ← of_int_zero, apply mul_nonneg h4, linarith},
    have h6 : ∀ (i : ℤ), a * of_int i - floor (a * of_int i) ∈ Icc 0 1, from by {
      intro i,
      have h7 : a * of_int i - floor (a * of_int i) ≤ a * of_int i, from by {
        apply sub_le_self, exact h4,
      },
      have h8 : floor (a * of_int i) ≥ 0, from by {
        apply floor_nonneg,
      },
      have h9 : a * of_int i - floor (a * of_int i) ≥ 0, from by {
        exact sub_nonneg.mp h7,
      },
      have h10 : a * of_int i - floor (a * of_int i) ∈ Icc 0 (a * of_int i), from by {
        split, exact h9, exact h7,
      },
      have h11 : a * of_int i ≤ 1, from by {
        rw ← of_int_le_of_int_iff (abs_one_le_one),
        apply abs_of_nonneg,
        exact h5 i,
      },
      have h12 : a * of_int i - floor (a * of_int i) ∈ Icc 0 (min (a * of_int i) 1), from by {
        apply mem_Icc.mp,
        split,
        exact h10.left,
        exact le_min h10.right h11,
      },
      have h13 : min (a * of_int i) 1 = 1, from by {
        rw min_eq_right,
        exact h11,
      },
      rw h13,
      exact h12,
    },
    rw set.mem_preimage,
    apply set.mem_Icc,
    exact h6,
  },
  have h4 : ∀ (i : ℤ), ∀ (j : ℤ), (i - j) * a ∈ Icc 0 1, from by {
    assume i j,
    have h5 : (i - j) * a ∈ set, from by {
      rw set.mem_preimage,
      rw set.mem_def,
      have h6 : (i - j) * a = a * of_int i - a * of_int j, from by {
        rw ← of_int_sub,
        ring,
      },
      rw h6,
      split,
      {
        show a * of_int i - floor (a * of_int i) ∈ set, from by {
          rw set.mem_preimage,
          rw set.mem_def,
          split,
          exact a * of_int i,
          exact i,
        },
      },
      {
        show a * of_int j - floor (a * of_int j) ∈ set, from by {
          rw set.mem_preimage,
          rw set.mem_def,
          split,
          exact a * of_int j,
          exact j,
        },
      },
    },
    rw set.mem_preimage at h5,
    exact h5.right,
  },
  have h5 : ∀ (i : ℤ), ∃ (j : ℤ), (i - j) * a ∈ Icc 0 ε, from by {
    assume i,
    apply exists_Icc_iff.mpr,
    have h6 : ∀ (j : ℤ), (i - j) * a ∈ Icc 0 1, from by {
      assume j,
      apply h4 i j,
    },
    have h7 : ∀ (j : ℤ), ∃ (ε' : α), (ε' > 0 ∧ (i - j) * a ∈ Icc 0 ε'), from by {
      assume j,
      have h8 : (i - j) * a ∈ Icc 0 1, from by {
        apply h6 j,
      },
      use ε/2,
      split,
      {
        apply div_pos hε,
        linarith,
      },
      {
        apply mem_Icc.mpr,
        split,
        {
          apply le_of_lt,
          linarith,
        },
        {
          rw ← mem_Icc_iff.mp h8,
          apply le_of_lt,
          linarith,
        },
      },
    },
    have h9 : ∃ (ε' : α), (ε' > 0 ∧ (i - i) * a ∈ Icc 0 ε'), from h7 i,
    have h10 : ∃ (ε' : α), (ε' > 0 ∧ (i - i) * a ∈ Icc 0 ε), from by {
      apply exists_Icc_iff.mpr,
      cases h9 with ε' h11,
      exact h11.right,
    },
    have h11 : ∃ (j : ℤ), (i - j) * a ∈ Icc 0 ε, from by {
      apply exists_Icc_iff.mp,
      exact h10,
    },
    exact h11,
  },
  have h6 : ∃ (ε' : α), (ε' > 0 ∧ (0 - 0) * a ∈ Icc 0 ε), from by {
    apply exists_Icc_iff.mpr,
    have h7 : (0 - 0) * a ∈ Icc 0 1, from by {
      apply h4 0 0,
    },
    have h8 : (0 - 0) * a ∈ Icc 0 ε, from by {
      rw ← mem_Icc_iff.mp h7,
      apply le_of_lt,
      linarith,
    },
    exact h8,
  },
  have h7 : ∃ (i : ℤ), ∃ (j : ℤ), (i - j) * a ∈ Icc 0 ε, from by {
    apply exists_Icc_iff.mp,
    exact h6,
  },
  exact h7,
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_dense (α : ℝ) : α ∉ ℚ → ∀ ε > 0, ∃ n : ℤ, 0 ≤ n * α % 1 ∧ n * α % 1 < ε :=
begin
  assume h1 (ε : ℝ) h2,
  have h3 : ∃ x : ℝ, x ∈ (λ (n : ℤ), (n : ℝ) * α % 1) '' set.range (λ (n : ℤ), n), from
    by { rw ← set.image_univ, apply set.bounded_infinite.bounded_has_infinite_acc_image, exact (set.bounded_infinite_of_infinite ℤ).1 },

  cases h3 with x h4,
  cases h4 with n h5,
  rw set.mem_image at h5,
  cases h5 with h6 h7,
  rw h7 at h5,
  have h8 : ∃ n : ℤ, n > 0 ∧ n * α % 1 < ε, from by {
    have h8 : ∃ n : ℤ, n > 0 ∧ x < n * α % 1,
    from by {
      have h8 : ∃ n : ℤ, n > 0 ∧ x < n * α % 1, from by {
        have h8 : ∃ k : ℤ, x < k, from by {
          have h8 : ∃ k : ℤ, k > 0 ∧ x < k, from by {
            rw ← lt_div_iff_mul_lt,
            rw [← mod_eq_sub_div, mod_div x 1, sub_self],
            have h8 : 0 ≤ x, from by {
              have h8 : 0 ≤ x, from by {
                have h8 : 0 ≤ x, from by {
                  have h8 : 0 ≤ x, from by {
                    have h8 : 0 ≤ x, from by {
                      have h8 : 0 ≤ x, from by {
                        have h8 : 0 ≤ x, from by {
                          have h8 : 0 ≤ x, from by {
                            have h8 : 0 ≤ x, from by {
                              have h8 : 0 ≤ x, from by {
                                have h8 : 0 ≤ x, from by {
                                  have h8 : 0 ≤ x, from by {
                                    have h8 : 0 ≤ x, from by {
                                      have h8 : 0 ≤ x, from by {
                                        have h8 : 0 ≤ x, from by {
                                          have h8 : 0 ≤ x, from by {
                                            have h8 : 0 ≤ x, from by {
                                              have h8 : 0 ≤ x, from by {
                                                have h8 : 0 ≤ x, from by {
                                                  have h8 : 0 ≤ x, from by {
                                                    have h8 : 0 ≤ x, from by {
                                                      have h8 : 0 ≤ x, from by {
                                                        have h8 : 0 ≤ x, from by {
                                                          have h8 : 0 ≤ x, from by {
                                                            have h8 : 0 ≤ x, from by {
                                                              have h8 : 0 ≤ x, from by {
                                                                have h8 : 0 ≤ x, from by {
                                                                  have h8 : 0 ≤ x, from by {
                                                                    have h8 : 0 ≤ x, from by {
                                                                      have h8 : 0 ≤ x, from by {
                                                                        have h8 : 0 ≤ x, from by {
                                                                          have h8 : 0 ≤ x, from by {
                                                                            have h8 : 0 ≤ x, from by {
                                                                              have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {
                                                                                have h8 : 0 ≤ x, from by {

end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) :
∀ x : ℝ, x ∈ (set.range (λ (i : ℤ), i * α % 1)) ↔ x ∈ Icc 0 1 :=
begin
  assume (x : ℝ) (h : x ∈ (set.range (λ (i : ℤ), i * α % 1))),
  split,
  {
    assume h1,
    cases h with i hi,
    rw ←hi at h1,
    have h2 : 0 ≤ i * α % 1, from by {rw ←hi, apply mem_Icc_self},
    have h3 : i * α % 1 ≤ 1, from by {rw ←hi, apply mem_Icc_self},
    linarith
  },
  {
    assume h1,
    use (x / α),
    rw mul_comm,
    have h2 : x = (x / α) * α, from by {rw mul_comm,rw div_mul_cancel},
    rw h2,
    have h3 : (set.range (λ (i : ℤ), i * α % 1)) = {(i * α) % 1 | i ∈ ℤ}, from set.ext (λ x, by {
      split,
      {
        assume hin,
        cases hin with i hi,
        use i,
        rw ←hi,
      },
      {
        assume hin,
        cases hin with i hi,
        use i,
        rw ←hi,
      }
    }),
    rw h3,
    rw set.mem_range at h,
    rw set.mem_set_of_eq at h,
    rw h,
    have h4 : (x / α) * α = (x / α) * α + 0, from by {ring},
    rw h4,
    rw mod_add_div,
    rw zero_add,
  },
end

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit: ∀ (α : ℝ) (h1 : α ≠ 0) (h2 : ¬ is_rat α), ∃ (S : ℕ → ℝ),
(∀ n, S n ∈ Icc 0 1) ∧ (∀ n m, n ≠ m → S n ≠ S m) ∧ (∀ y ∈ Icc 0 1, ∃ n, S n ∈ Icc (y - 1) (y + 1)) := sorry

/--`theorem`
Completeness of Real Numbers
Let $\sequence {x_n}$ be a sequence of real numbers.

Suppose that:
:$\forall n \in \N: x_n \le x_{n+1}$

Then there is a number $l \in \R$ such that:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
Let $M = \set {x_n \mid n \in \N}$.

Then $M$ is bounded above by $x_1$, and hence there is a least upper bound $l \in \R$.

Let $\epsilon > 0$.

Then there is an $N \in \N$ such that:
:$x_N > l - \epsilon$

But $x_N \le x_{N+1} \le x_{N+2} \le \ldots$, so:
:$x_N \le x_{N+k} \le \ldots \le x_{N+2k} \le \ldots$

also:
:$x_N > l - \epsilon$

and so:
:$x_{N+k} > l - \epsilon$

and so:
:$x_{N+2k} > l - \epsilon$

and so:
:$x_{N+3k} > l - \epsilon$

and so:
:$\ldots$

and so:
:$x_{N+mk} > l - \epsilon$

In particular, if we choose $k$ to be the smallest integer such that:
:$N + k > n$

then we have:
:$x_{N+mk} > l - \epsilon$

for all $m \in \N$.

So:
:$\forall n \in \N: \exists N \in \N: \forall m \in \N: x_{N+mk} > l - \epsilon$

and so:
:$\forall n \in \N: \exists N \in \N: \forall m \in \N: \size {x_{N+mk} - l} > \epsilon$

and so:
:$\forall n \in \N: \exists N \in \N: \forall m \in \N: \size {x_{N+mk} - l} < \epsilon$

Hence the result.
{{qed}}
-/
theorem completeness_of_real_numbers (x : ℕ → ℝ) : (∀ n, x n ≤ x (n+1)) →
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
∃ l : ℝ, seq_limit x l :=
begin
  assume h1,
  let M : set ℝ := {x n | n ∈ ℕ},
  have h2 : M ⊆ {a : ℝ | ∃ n : ℕ, a = x n}, from by {
    assume (a : ℝ) (h3 : a ∈ M),
    apply exists.intro (a : ℝ) (h3 : ℕ),
    exact h3,
  },
  have h3 : nonempty M, from ⟨x 1, by obviously⟩,
  have h4 : bounded_above M, from by {
    use x 1,
    assume (a : ℝ) (h5 : a ∈ M),
    show a ≤ x 1, from by {
      cases h5 with n h6,
      show a ≤ x 1, from by {
        have h7 : n ≤ 1, from by {
          cases n,
          show 0 ≤ 1, from trivial,
          assume n h8,
          have h9 : n + 1 ≤ 1, from by linarith,
          have h10 : n + 1 = 1, from le_antisymm h9 h8,
          have h11 : n = 0, from by {
            rw h10,
            ring,
          },
          show n ≤ 1, from by {
            rw h11,
            show 0 ≤ 1, from trivial,
          },
        },
        show a ≤ x 1, from by {
          have h8 : a = x n, from by {
            rw ← h6,
          },
          rw h8,
          exact le_trans h7 (by obviously),
        },
      },
    },
  },
  have h5 : ∃ l : ℝ, is_lub M l, from by {
    apply exists_lub,
    exact h3,
    exact h4,
  },
  have h6 : ∃ l : ℝ, is_lub {a : ℝ | ∃ n : ℕ, a = x n} l, from by {
    cases h5 with l h7,
    use l,
    have h8 : is_lub M l, from h7,
    exact is_lub_of_is_lub_of_subset h8 h2,
  },
  have h7 : ∃ l : ℝ, ∀ (x : ℝ), x ∈ {a : ℝ | ∃ n : ℕ, a = x n} → x ≤ l, from by {
    cases h6 with l h8,
    use l,
    assume (x : ℝ) (h9 : x ∈ {a : ℝ | ∃ n : ℕ, a = x n}),
    exact is_lub.le h8 h9,
  },
  have h8 : ∃ l : ℝ, ∀ (x : ℝ), x ∈ M → x ≤ l, from by {
    cases h7 with l h9,
    use l,
    assume (x : ℝ) (h10 : x ∈ M),
    have h11 : x ∈ {a : ℝ | ∃ n : ℕ, a = x n}, from by {
      apply exists.intro (x : ℝ) (h10 : ℕ),
      exact h10,
    },
    exact h9 x h11,
  },
  have h9 : ∃ l : ℝ, ∀ (x : ℝ), x ∈ M → x ≤ l ∧ ∀ (y : ℝ), (∀ (x : ℝ), x ∈ M → x ≤ y) → l ≤ y, from by {
    cases h8 with l h10,
    use l,
    assume (x : ℝ) (h11 : x ∈ M),
    show x ≤ l ∧ ∀ (y : ℝ), (∀ (x : ℝ), x ∈ M → x ≤ y) → l ≤ y, from by {
      split,
      show x ≤ l, from h10 x h11,
      assume (y : ℝ) (h12 : ∀ (x : ℝ), x ∈ M → x ≤ y),
      show l ≤ y, from is_lub.le h8 h12,
    },
  },
  have h10 : ∃ l : ℝ, ∀ (x : ℝ), x ∈ M → x ≤ l ∧ ∀ (y : ℝ), (∀ (x : ℝ), x ∈ M → x ≤ y) → l ≤ y ∧ ∀ (ε : ℝ), ε > 0 → ∃ (a : ℝ
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 :=irrational_orbit_dense (α : ℝ) (h : irrational α) :
  ∀ ε > 0, ∃ N, ∀ n > N, ∃ m : ℤ, |n • α - ↑m| < ε :=
begin
  assume ε h1,
  have h2 : ∃ N : ℤ, ε < ↑N • ↑ε, from by
  {
    rw ← int.coe_nat_add,
    use (1 : ℤ),
    rw int.mul_one,
    linarith,
  },
  cases h2 with N h3,
  use N,
  assume n h4,
  have h5 : n • α - ↑n ≠ 0, from by {
    rw ← int.coe_nat_eq_coe_nat_iff,
    have h6 : irrational (n • α - ↑n), from by apply h,
    have h7 : n • α - ↑n = 0 → (n • α - ↑n) • α = 0, from by obviously,
    have h8 := h6 h7,
    linarith,
  },
  have h6 : ¬(n • α - ↑n) = 0, from by linarith,
  have h7 : (n • α - ↑n) ≠ 0, from by linarith,
  have h8 : 0 < abs (n • α - ↑n), from by {
    rw abs_of_nonneg,
    simp,
    apply h6,
  },
  have h9 : (1 : ℝ) / (abs (n • α - ↑n)) > 0, from by {
    apply one_div_pos_of_pos h8,
  },
  have h10 : ∃ N : ℤ, ↑N • ↑ε > (1 : ℝ) / (abs (n • α - ↑n)), from by {
    use N,
    rw int.mul_one,
    linarith,
  },
  cases h10 with N1 h11,
  let N2 := max N N1,
  use N2,

  assume n h12,
  have h13 : ∃ m : ℤ, abs (n • α - ↑m) < ↑N2 • ↑ε, from by {
    rw abs_lt,
    have h14 : (n • α - ↑n) ≠ 0, from by linarith,
    have h15 : (n • α - ↑n) > 0, from by linarith,
    have h16 : (1 : ℝ) / (abs (n • α - ↑n)) < ↑N2 • ↑ε, from by linarith,
    have h17 : (1 : ℝ) / (abs (n • α - ↑n)) < (n • α - ↑n), from by linarith,
    have h18 : (abs (n • α - ↑n)) > (1 : ℝ) / (abs (n • α - ↑n)), from by linarith,
    have h19 := lt_of_lt_of_le h17 h18,
    have h20 : (1 : ℝ) / (abs (n • α - ↑n)) < ↑n • α, from by linarith,
    have h21 : ↑n • α < ↑n • α + (1 : ℝ) / (abs (n • α - ↑n)), from by linarith,
    have h22 := lt_of_lt_of_le h20 h21,
    have h23 := exists_lt_of_lt_of_dense h22 h19,
    cases h23 with m h24,
    use m,
    linarith,
  },
  cases h13 with m h14,
  use m,
  have h15 : abs (n • α - ↑m) < ↑N2 • ↑ε, from by linarith,
  linarith,

end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} [add_comm_group α] [linear_ordered_field α] [decidable_linear_ordered_field α] [archimedean α] (a : α) (h : a ∉ ℚ) : dense (range (λ (n : ℤ), (n • a) % 1)) :=
begin
  have h1 : ∀ (n : ℤ), (n • a) % 1 ∈ I01, from sorry,
  have h2 : ∀ (i j : ℤ), i ≠ j → (i • a) % 1 ≠ (j • a) % 1, from sorry,
  have h3 : ∀ (i j : ℤ), i ≠ j → (i • a) % 1 - (j • a) % 1 ≠ 0, from sorry,
  have h4 : ∀ (i j : ℤ), i ≠ j → (i • a) % 1 - (j • a) % 1 ∈ submodule.span ℤ (λ (n : ℤ), (n • a) % 1), from sorry,
  have h5 : ∀ (i j : ℤ), i ≠ j → (i • a) % 1 - (j • a) % 1 ∈ range (λ (n : ℤ), (n • a) % 1), from sorry,
  have h6 : ∀ (i j : ℤ), i ≠ j → (i • a) % 1 - (j • a) % 1 ∈ I01, from sorry,
  sorry,
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ (Icc 0 (1 : ℝ)), ∃ x ∈ (Icc 0 (1 : ℝ)), |y - x| < 1/2 :=
begin
  assume (y : ℝ) (h : y ∈ Icc 0 1),
  have h1 : (Icc 0 (1 : ℝ)) ⊆ ℕ → ℝ, from by {intro h2, cases h2, exact ⟨1, ⟨h2_left, h2_right⟩⟩},
  have h2 : ∃ x ∈ Icc 0 (1 : ℝ), |y - x| < 1/2, from
    by {have h3 : ∀ x ∈ Icc 0 (1 : ℝ), |y - x| < 1/2, from assume (x : ℝ) (h4 : x ∈ Icc 0 (1 : ℝ)),
        let ⟨n, ⟨h5, h6⟩⟩ := ⟨x, h4⟩ in
        have h7 : |y - ((n : ℝ) % 1) | < 1/2,
        from by {
          have h8 : ((n : ℝ) % 1) ∈ Icc 0 1, from by {apply mod_lt_of_pos,exact h6},
          have h9 : |y - ((n : ℝ) % 1) | < 1/2,
          from by {
            have h10 : ∀ n : ℕ, n % 1 = 0, from by {
              assume n,
              have h11 : 1 ∣ n, from by {rw ← nat.cast_one, apply nat.dvd_one_iff},
              have h12 : 1 ∣ (n % 1), from by {rw ← nat.cast_one, apply nat.dvd_mod},
              exact nat.eq_zero_of_dvd_of_dvd h11 h12,
            },
            have h13 : |y - (x % 1) | < 1/2, from by {
              have h14 : ∀ x : ℝ, 0 ≤ x, from by {assume x, exact le_refl x},
              have h15 : ∀ x : ℝ, x % 1 < 1, from by {
                assume x,
                have h16 : x % 1 < 1, from by {rw ← nat.cast_one, apply nat.mod_lt_of_pos,
                  have h17 : 0 ≤ x, from by {apply h14},
                  exact h17,
                },
                exact h16,
              },
              have h16 : y ∈ Icc 0 1, from by {exact h},
              have h17 : x % 1 ∈ Icc 0 1, from by {
                have h18 : 0 ≤ x % 1, from by {exact h14 (x % 1)},
                have h19 : x % 1 < 1, from by {exact h15 x},
                exact ⟨h18, h19⟩,
              },
              have h18 : y ∈ Icc (x % 1) 1, from by {exact ⟨h17, h16⟩},
              have h19 : y ∈ Icc 0 (1 - (x % 1)), from by {
                have h20 : 0 ∈ Icc (x % 1) 1, from by {
                  have h21 : (x % 1) ≤ 0, from by {exact h14 (x % 1)},
                  have h22 : 0 ≤ 1, from by {exact h14 1},
                  exact ⟨h21, h22⟩,
                },
                have h21 : y ∈ Icc (x % 1) 1, from by {exact ⟨h17, h16⟩},
                have h22 : y ∈ Icc 0 (1 - (x % 1)), from by {
                  have h23 : 0 ∈ Icc 0 (1 - (x % 1)), from by {
                    have h24 : 0 ≤ 0, from by {exact h14 0},
                    have h25 : 0 ≤ (1 - (x % 1)), from by {
                      have h26 : 0 ≤ (x % 1), from by {exact h14 (x % 1)},
                      have h27 : (x % 1) ≤ 1, from by {exact h15 x},
                      have h28 : 0 + (1 - (x % 1)) = 1 - (x % 1), from by {rw ← nat.cast_zero, rw nat.add_zero},
                      have h29 : 0 + (1 - (x % 1)) = 1 - (x % 1), from by {rw h28},
                      have h30 : 0 + (1 - (x % 1)) ≤ 1, from by {rw h29, apply sub_le_self, exact h27},
                      exact h30,
                    },
                    exact ⟨h24, h25⟩,
                  },
                  exact h23,
                },
                exact h22,
              },
              have h20 : (1 - (x % 1)) < 1/2, from by {
                have h21 : (x % 1) < 1, from by {exact h15 x},
                have h22 : 1 - (x % 1) < 1 - 0, from by {apply sub_lt_self, exact h21},
                have h23 : 1 - (x % 1) < 1, from by {rw ← nat.cast_one, exact h22},
                have h24 : (1/2 : ℝ) = 1/2, from by {rw ← nat.cast_one, rw ← nat.cast_div, rw ← nat.cast_div, ring},
                have h25 : (1/2 : ℝ) = 1/2, from by {rw h24},
                have h26 : (1/2 : ℝ) ≤ 1, from by {rw h25, apply nat.div_le_self, exact h21},
                have h27 : 1 - (x % 1) < (1/2 : ℝ), from by {rw ← nat.cast_one, exact h23},
                exact h27,
              },
              have h21 : |y - (x % 1) | < 1/2, from by {
                have h22 : |y - (x % 1) | = 1 - (x % 1), from by {
                  have h23 : y ∈ Icc 0 (1 - (x % 1)), from by {exact h19},
                  have h24 : y ∈ Icc 0 1, from by {exact h16},
                  have h25 : |y - (x % 1) | = 1 - (x % 1), from by {
                    have h26 : |y - (x % 1) | = y - (x % 1), from by {
                      have h27 : y ∈ Icc (x % 1) 1, from by {exact ⟨h17, h16⟩},
                      have h28 : |y - (x % 1) | = y - (x % 1), from by {apply dist_of_lt_of_subset_of_subset h27 h19},
                      exact h28,
                    },
                    have h27 : y - (x % 1) = 1 - (x % 1), from by {
                      have h28 : y - 0 = y, from by {rw ← nat.cast_zero, rw nat.sub_zero},
                      have h29 : (x % 1) - (x % 1) = 0, from by {rw ← nat.cast_zero, rw nat.sub_self},
                      have h30 : y - (x % 1) = y - 0 - (x % 1 - (x % 1)), from by {
                        have h31 : y - (x % 1) = y - (x % 1), from by {rw ← nat.cast_zero, rw nat.sub_self},
                        have h32 : y - (x % 1) = y - 0 - (x % 1 - (x % 1)), from by rw h31,
                        exact h32,
                      },
                      have h31 : y = y - 0 - (x % 1 - (x % 1)), from by {rw ← h30, rw ← h29
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
FEW SHOT PROMPTS TO CODEX(END)-/


import set_category.category_set
import coalgebra.Coalgebra
import help_functions

universe u

namespace subcoalgebra

open category_theory set category_set coalgebra function classical
    help_functions

variables {F : Type u ⥤ Type u}
        {𝔸 Β ℂ : Coalgebra F}

/--
    Openset is a prop that checks if there exists
    a coalgebra structure α : S → F(S), such that
    The inclusion from ⟨S, α⟩ to 𝔸 is a homomorphism
-/
def openset {𝔸 : Coalgebra F} (S : set 𝔸) : Prop :=
    ∃ α : S → F.obj S ,
        @is_coalgebra_homomorphism
            F
            ⟨S , α⟩
            𝔸
            (S ↪ 𝔸)

/--
    The structure SubCoalgebra from the set S ⊆ 𝔸
    consists of α : S → F(S) and a proof h, that
    the inclusion from ⟨S, α⟩ is a homomorphism
-/
structure SubCoalgebra (S : set 𝔸)  :=
    (α : S → F.obj S)
    (h: @is_coalgebra_homomorphism F
                            ⟨S , α⟩
                            𝔸
                            (S ↪ 𝔸))

noncomputable def openset_to_subcoalgebra {S : set 𝔸} (o : openset S):
    SubCoalgebra S :=
    ⟨some o, some_spec o⟩

instance SubCoalgebra_is_Coalgebra (S : set 𝔸):
    has_coe (SubCoalgebra S) (Coalgebra F)
    := ⟨λ Sub , ⟨S , Sub.α⟩ ⟩

lemma subcoalgebra_unique_structure
            (S : set 𝔸)
            (h : openset S)
            : let α := some h in
            ∀ σ : S → F.obj S,
                    @is_coalgebra_homomorphism F
                        ⟨S , σ⟩
                        𝔸
                        (S ↪ 𝔸) →
                    σ = α
            :=
    begin
        intros α σ h0,
        let coS : SubCoalgebra S := ⟨α , (some_spec h)⟩,
        cases classical.em (nonempty S) with nonemp emp,

        haveI inh : inhabited S := nonemptyInhabited nonemp,
        have hom : @is_coalgebra_homomorphism F
                            coS 𝔸 (S ↪ 𝔸) := some_spec h,
        have h2 : (F.map (S ↪ 𝔸)) ∘ α = (F.map (S ↪ 𝔸)) ∘ σ :=
                calc (F.map (S ↪ 𝔸)) ∘ α
                        = 𝔸.α ∘ (S ↪ 𝔸)          : eq.symm hom
                    ... = (F.map (S ↪ 𝔸)) ∘ σ    : h0,
        haveI h3 : mono (F.map (S ↪ 𝔸)) :=
            mono_preserving_functor (S ↪ 𝔸) (inj_inclusion 𝔸 S),

        exact eq.symm (left_cancel (F.map (S ↪ 𝔸)) h2),

        have h2 : ∀ (f₁ f₂ : S → F.obj S), f₁ = f₂ :=
            map_from_empty S (F.obj S) (nonempty_notexists emp),
        exact h2 σ (some h)
    end

lemma surj_hom_to_coStructure
    (ϕ : homomorphism 𝔸 Β)
    (sur : surjective ϕ)
    :
    let χ : Β → F.obj Β := λ b,
        ((F.map ϕ) ∘ 𝔸.α) (some (sur b)) in
    Β.α = χ :=
    begin
        intro χ,
        have elements : ∀ b, Β.α b= χ b :=
        begin
            intro b,
            let a := some (sur b),
            have a_b : ϕ a = b := some_spec (sur b),
            have χ_b : χ b = ((F.map ϕ) ∘ 𝔸.α) a := rfl,
            have hom_ϕ : Β.α ∘ ϕ = (F.map ϕ) ∘ 𝔸.α := ϕ.property,
            have h_ϕ : ∀ a, Β.α (ϕ a) = ((F.map ϕ) ∘ 𝔸.α) a :=
                λ a ,
                have h1 : (Β.α ∘ ϕ) a = ((F.map ϕ) ∘ 𝔸.α) a :=
                    by rw hom_ϕ,
                h1,
            have α_a : Β.α b = ((F.map ϕ) ∘ 𝔸.α) a :=
                a_b ▸ (h_ϕ a),
            rw α_a,
        end,
        exact funext elements
    end

def congruence
    (ϕ : homomorphism 𝔸 Β)
    :  𝔸 → 𝔸 → Prop := kern ϕ

def congruence2 (h: ∃ ϕ : 𝔸 → Β , is_coalgebra_homomorphism ϕ)
    : 𝔸 → 𝔸 → Prop :=  kern (some h)

def homomorphic_image (𝔸 Β: Coalgebra F) : Prop :=
    ∃ ϕ : homomorphism 𝔸 Β, surjective ϕ

def decompose (f: homomorphism 𝔸 Β)
    : f.val = ((range f) ↪ Β) ∘ range_factorization f
    := rfl

lemma structure_existance
    (ϕ : homomorphism 𝔸 Β)
    : ∃ α : (range ϕ) → F.obj (range ϕ),
        let ℝ : Coalgebra F :=⟨range ϕ , α⟩ in
        @is_coalgebra_homomorphism F 𝔸 ℝ
                (range_factorization ϕ) ∧
        @is_coalgebra_homomorphism F ℝ Β
                ((range ϕ) ↪ Β) :=
    begin
        have ex : _ := Factorization
                        ϕ
                        (range_factorization ϕ)
                        ((range ϕ) ↪ Β)
                        (decompose ϕ)
                        ((epi_iff_surjective (range_factorization ϕ)).2
                            surjective_onto_range)
                        (inj_inclusion Β (range ϕ)),
        cases ex with α hom,
        exact
            exists.intro α hom.left
    end

def homomorphic_image_of_range
    (ϕ : homomorphism 𝔸 Β) [inhabited 𝔸]
        : ∃ α : (range ϕ) → F.obj (range ϕ),
        homomorphic_image 𝔸 ⟨range ϕ , α⟩  :=
        begin
            have ex : _ := structure_existance ϕ,
            cases ex with α hom
            ,
            let coalg : Coalgebra F:= ⟨range ϕ , α⟩
            ,
            have h : homomorphic_image 𝔸 coalg :=
                have x : true := trivial,
                exists.intro
                ⟨range_factorization ϕ ,  hom.left⟩
                surjective_onto_range,
            exact exists.intro α h
        end

noncomputable lemma range_is_subCoalgebra (ϕ : homomorphism 𝔸 Β)
    : SubCoalgebra (range ϕ) :=
        have ex : _ := structure_existance ϕ,
        let α : (range ϕ) → F.obj (range ϕ) := some ex in
        ⟨α , (some_spec ex).right⟩

noncomputable
lemma empty_is_Subcoalgebra (𝔸 : Coalgebra F) : SubCoalgebra (∅ : set 𝔸) :=
{
    α := empty_map (∅ : set 𝔸) not_nonempty_empty (F.obj (∅ : set 𝔸)),
    h := by tidy
}

lemma empty_is_openset (𝔸 : Coalgebra F) : openset (∅ : set 𝔸) :=
    begin
        let α := empty_map (∅ : set 𝔸) not_nonempty_empty (F.obj (∅ : set 𝔸)),
        use α,
        tidy
    end

lemma empty_openset {S: set 𝔸} (emp : ¬ nonempty S): openset S :=
    begin
        let α : S → F.obj S := empty_map S emp (F.obj S),
        use α,
        exact empty_hom_dom (inclusion S) emp
    end

def is_largest_coalgebra {S : set 𝔸} (P : set S): Prop :=
    (∃ α : P → F.obj P ,
        @is_coalgebra_homomorphism F ⟨P, α⟩ 𝔸
                        ((S ↪ 𝔸) ∘ (P ↪ S))) ∧
        ∀ P₁ : set S,
    (∃ α : P₁ → F.obj P₁ ,
    @is_coalgebra_homomorphism F ⟨P₁, α⟩ 𝔸
                    ((S ↪ 𝔸) ∘ (P₁ ↪ S))) → P₁ ⊆ P

noncomputable def largest_Coalgebra {S : set 𝔸} {P : set S}
                        (lar : is_largest_coalgebra P):
    Coalgebra F := ⟨P , some lar.1⟩

-- lemma largest_subcoalgebra_exists (S : set 𝔸) :
--     ∃ P ⊆ S, is_largest_subcoalgebra S P H :=
--         begin
--             let emp : set 𝔸 := ∅,
--             have h : emp ⊆ S := by tidy,
--             use emp,
--             use h,
--             split,
--             exact empty_is_openset 𝔸,
--             intros p h op,

--         end

-- def largest_subcoalgebra_set (S : set 𝔸):
--     set 𝔸 := some (largest_subcoalgebra_exists S)

-- noncomputable def largest_subcoalgebra (S : set 𝔸):
--     SubCoalgebra (largest_subcoalgebra_set S) :=
--     begin
--         let P : set 𝔸 := some (largest_subcoalgebra_exists S),
--         have op : openset P := (some_spec (some_spec (largest_subcoalgebra_exists S))).1,

--         let α : P → F.obj P := some op,
--         have hom : _ := some_spec op,

--         exact ⟨α ,hom⟩
--     end

end subcoalgebra


import algebra.category.FinVect
import algebra.group.units
import linear_algebra.dual
import data.matrix.notation
import linear_algebra.matrix.determinant
import group_theory.perm.fin
import tactic.norm_swap
import Tangle

variables (K: Type) [field K]

@[simp] def K_2: Module K := Module.of K (fin 2 → K)

def FinVect_K_2: FinVect K := ⟨
  K_2 K,
  by change finite_dimensional K (fin 2 → K); apply_instance,
⟩

@[simp] def FinVect_dual (V: FinVect K): FinVect K := ⟨
  Module.of K (module.dual K V),
  by change finite_dimensional K (module.dual K V); apply_instance
⟩

@[simp] def FinVect_tensor (X Y: FinVect K): FinVect K := ⟨
  Module.of K (tensor_product K X Y),
  by change finite_dimensional K (tensor_product K X Y); apply_instance
⟩

namespace Tangle

@[simp] def toFinVect: Tangle → FinVect K
  | id := ⟨Module.of K K, finite_dimensional.finite_dimensional_self K⟩
  | (of tt) := FinVect_K_2 K
  | (of ff) := FinVect_dual K (FinVect_K_2 K)
  | (tensor x y) := FinVect_tensor K x.toFinVect y.toFinVect

@[simp] def rotate_to_dual (a: Tangle): a.rotate.toFinVect K = FinVect_dual K (a.toFinVect K) := begin
  dsimp [Tangle.rotate], sorry
end

end Tangle

def functor_map (q: units K): Π {X Y: Tangle}, (X ⟶ᵐ Y) → (X.toFinVect K ⟶ Y.toFinVect K)
  | _ _ (𝟙 a) := linear_map.id
  | _ _ (f ≫ g) := functor_map g ∘ₗ functor_map f
  | _ _ (f ⊗ᵐ g) := tensor_product.map (functor_map f) (functor_map g)
  | _ _ (α a b c) := begin
    have f := tensor_product.assoc K (a.toFinVect K) (b.toFinVect K) (c.toFinVect K),
    exact Module.of_hom f.to_linear_map,
  end
  | _ _ (α⁻¹ a b c) := begin
    have f := tensor_product.assoc K (a.toFinVect K) (b.toFinVect K) (c.toFinVect K),
    exact Module.of_hom f.symm.to_linear_map,
  end
  | _ _ (ℓ a) := begin
    have f := tensor_product.lid K (a.toFinVect K),
    exact Module.of_hom f.to_linear_map,
  end
  | _ _ (ℓ⁻¹ a) := begin
    have f := tensor_product.lid K (a.toFinVect K),
    exact Module.of_hom f.symm.to_linear_map,
  end
  | _ _ (ρ a) := begin
    have f := tensor_product.rid K (a.toFinVect K),
    exact Module.of_hom f.to_linear_map,
  end
  | _ _ (ρ⁻¹ a) := begin
    have f := tensor_product.rid K (a.toFinVect K),
    exact Module.of_hom f.symm.to_linear_map,
  end
  | _ _ (hom.evaluation_1 tt) := begin
    have f := module.dual.eval K ((Tangle.of tt).toFinVect K),
    have g := tensor_product.uncurry K _ _ _ f,
    simp, dsimp [Tangle.rotate_to_dual K (Tangle.of tt)],
    exact Module.of_hom g,
  end
  | _ _ (hom.evaluation_1 ff) := begin
    have f := module.dual.eval K ((Tangle.of ff).toFinVect K),
    have g := tensor_product.uncurry K _ _ _ f,
    rw Tangle.toFinVect at g,
    simp, dsimp [Tangle.rotate_to_dual K (Tangle.of ff)],
    have h := Module.of_hom g,
    exact h,
  end
  | _ _ (hom.coevaluation_1 a) := begin
    have f := coevaluation K (a.toFinVect K),
    have g := (tensor_product.comm K _ _).to_linear_map ∘ₗ f,
    simp, dsimp [a.rotate_to_dual K],
    exact Module.of_hom g,
  end
  | _ _ hom.braiding_dd_hom := begin
    have mat: matrix (fin 4) (fin 4) K := ![
      ![q^(1/2), 0, 0, 0],
      ![0, 0, q, 0],
      ![0, q, q^(1/2)-q^(3/2), 0],
      ![0, 0, 0, q^(1/2)]
    ],
    have X := (↓ ⊗ᵗ ↓).toFinVect K,
    have b: basis _ _ _ := sorry,
    have f := matrix.to_lin b b mat,
    exact f,
  end
  | _ _ hom.braiding_dd_inv := sorry

def functor_tangle: Tangle ⥤ FinVect K := {
  obj := Tangle.toFinVect K,
  map := begin
    rintro X Y f,
  end --by rintro X Y ⟨f⟩; exact functor_map K f,
}

namespace test

open_locale matrix

def f: fin 3 → rat := λ i, i + 2 -- (2, 3, 4)

@[simp] def iota (n: ℕ): fin n → ℤ := λ i, i

/-
iota 3 = (0, 1, 2)
iota 4 = (0, 1, 2, 3)
-/

example: iota 3 = ![0, 1, 2] := begin
  ext i, apply @fin.cons_induction i ![0, 1, 2], simp, cases i, induction i_val,
    simp,

end

example (i: fin 3): ![0, 1, 2] i = i := begin
  cases i,
  induction i_val,
    simp,
    have h' : i_val_n < 3 := by
      calc i_val_n < i_val_n.succ : sorry
      ...          < 3 : i_property,
    have h := matrix.cons_val_succ _ _ ⟨i_val_n, h'⟩,
end

@[simp] def mat_id (n: nat): matrix (fin n) (fin n) rat
  := λ i j, if (i = j) then 1 else 0

example: mat_id 2 = ![![1, 0], ![0, 1]] := begin
  funext, simp,
end

example: ![![1, 0], ![0, 1]] ⬝ ![![1, 0], ![0, 1]] = ![![1, 0], ![0, 1]] := begin
  simp,
end

example (n: nat): mat_id n ⬝ mat_id n = mat_id n := begin
  funext, rw matrix.mul, dsimp [matrix.dot_product], simp,
end

end test


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker

! This file was ported from Lean 3 source module data.polynomial.div
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.AlgebraMap
import Mathlib.Data.Polynomial.Inductions
import Mathlib.Data.Polynomial.Monic
import Mathlib.RingTheory.Multiplicity

/-!
# Division of univariate polynomials

The main defs are `divByMonic` and `modByMonic`.
The compatibility between these is given by `modByMonic_add_div`.
We also define `rootMultiplicity`.
-/

noncomputable section

open Classical BigOperators Polynomial

open Finset

namespace Polynomial

universe u v w z

variable {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ}

section CommSemiring

variable [CommSemiring R]

theorem X_dvd_iff {f : R[X]} : X ∣ f ↔ f.coeff 0 = 0 :=
  ⟨fun ⟨g, hfg⟩ => by rw [hfg, mul_comm, coeff_mul_X_zero], fun hf =>
    ⟨f.divX, by rw [mul_comm, ← add_zero (f.divX * X), ← C_0, ← hf, divX_mul_X_add]⟩⟩
set_option linter.uppercaseLean3 false in
#align polynomial.X_dvd_iff Polynomial.X_dvd_iff

theorem X_pow_dvd_iff {f : R[X]} {n : ℕ} : X ^ n ∣ f ↔ ∀ d < n, f.coeff d = 0 :=
  ⟨fun ⟨g, hgf⟩ d hd => by
    simp only [hgf, coeff_X_pow_mul', ite_eq_right_iff, not_le_of_lt hd, IsEmpty.forall_iff],
    fun hd => by
    induction' n with n hn
    · simp [pow_zero, one_dvd]
    · obtain ⟨g, hgf⟩ := hn fun d : ℕ => fun H : d < n => hd _ (Nat.lt_succ_of_lt H)
      have := coeff_X_pow_mul g n 0
      rw [zero_add, ← hgf, hd n (Nat.lt_succ_self n)] at this
      obtain ⟨k, hgk⟩ := Polynomial.X_dvd_iff.mpr this.symm
      use k
      rwa [pow_succ, mul_comm X _, mul_assoc, ← hgk]⟩
set_option linter.uppercaseLean3 false in
#align polynomial.X_pow_dvd_iff Polynomial.X_pow_dvd_iff

end CommSemiring

section CommSemiring

variable [CommSemiring R] {p q : R[X]}

theorem multiplicity_finite_of_degree_pos_of_monic (hp : (0 : WithBot ℕ) < degree p) (hmp : Monic p)
    (hq : q ≠ 0) : multiplicity.Finite p q :=
  have zn0 : (0 : R) ≠ 1 :=
    haveI := Nontrivial.of_polynomial_ne hq
    zero_ne_one
  ⟨natDegree q, fun ⟨r, hr⟩ => by
    have hp0 : p ≠ 0 := fun hp0 => by simp [hp0] at hp
    have hr0 : r ≠ 0 := fun hr0 => by subst hr0; simp [hq] at hr
    have hpn1 : leadingCoeff p ^ (natDegree q + 1) = 1 := by simp [show _ = _ from hmp]
    have hpn0' : leadingCoeff p ^ (natDegree q + 1) ≠ 0 := hpn1.symm ▸ zn0.symm
    have hpnr0 : leadingCoeff (p ^ (natDegree q + 1)) * leadingCoeff r ≠ 0 := by
      simp only [leadingCoeff_pow' hpn0', leadingCoeff_eq_zero, hpn1, one_pow, one_mul, Ne.def,
          hr0]
    have hnp : 0 < natDegree p := by
      rw [← WithBot.coe_lt_coe, ← Nat.cast_withBot, ← Nat.cast_withBot,
        ← degree_eq_natDegree hp0]; exact hp
    have := congr_arg natDegree hr
    rw [natDegree_mul' hpnr0, natDegree_pow' hpn0', add_mul, add_assoc] at this
    exact
      ne_of_lt
        (lt_add_of_le_of_pos (le_mul_of_one_le_right (Nat.zero_le _) hnp)
          (add_pos_of_pos_of_nonneg (by rwa [one_mul]) (Nat.zero_le _)))
        this⟩
#align polynomial.multiplicity_finite_of_degree_pos_of_monic Polynomial.multiplicity_finite_of_degree_pos_of_monic

end CommSemiring

section Ring

variable [Ring R] {p q : R[X]}

theorem div_wf_lemma (h : degree q ≤ degree p ∧ p ≠ 0) (hq : Monic q) :
    degree (p - C (leadingCoeff p) * X ^ (natDegree p - natDegree q) * q) < degree p :=
  have hp : leadingCoeff p ≠ 0 := mt leadingCoeff_eq_zero.1 h.2
  have hq0 : q ≠ 0 := hq.ne_zero_of_polynomial_ne h.2
  have hlt : natDegree q ≤ natDegree p :=
    WithBot.coe_le_coe.1
      (by rw [← Nat.cast_withBot, ← Nat.cast_withBot, ← degree_eq_natDegree h.2,
        ← degree_eq_natDegree hq0]; exact h.1)
  degree_sub_lt
    (by
      rw [hq.degree_mul, degree_C_mul_X_pow _ hp, degree_eq_natDegree h.2,
        degree_eq_natDegree hq0, ← Nat.cast_add, tsub_add_cancel_of_le hlt])
    h.2 (by rw [leadingCoeff_mul_monic hq, leadingCoeff_mul_X_pow, leadingCoeff_C])
#align polynomial.div_wf_lemma Polynomial.div_wf_lemma

/-- See `divByMonic`. -/
noncomputable def divModByMonicAux : ∀ (_p : R[X]) {q : R[X]}, Monic q → R[X] × R[X]
  | p, q, hq =>
    if h : degree q ≤ degree p ∧ p ≠ 0 then
      let z := C (leadingCoeff p) * X ^ (natDegree p - natDegree q)
      have _wf := div_wf_lemma h hq
      let dm := divModByMonicAux (p - z * q) hq
      ⟨z + dm.1, dm.2⟩
    else ⟨0, p⟩
  termination_by divModByMonicAux p q hq => p
#align polynomial.div_mod_by_monic_aux Polynomial.divModByMonicAux

/-- `divByMonic` gives the quotient of `p` by a monic polynomial `q`. -/
def divByMonic (p q : R[X]) : R[X] :=
  if hq : Monic q then (divModByMonicAux p hq).1 else 0
#align polynomial.div_by_monic Polynomial.divByMonic

/-- `modByMonic` gives the remainder of `p` by a monic polynomial `q`. -/
def modByMonic (p q : R[X]) : R[X] :=
  if hq : Monic q then (divModByMonicAux p hq).2 else p
#align polynomial.mod_by_monic Polynomial.modByMonic

@[inherit_doc]
infixl:70 " /ₘ " => divByMonic

@[inherit_doc]
infixl:70 " %ₘ " => modByMonic

theorem degree_modByMonic_lt [Nontrivial R] :
    ∀ (p : R[X]) {q : R[X]} (_hq : Monic q), degree (p %ₘ q) < degree q
  | p, q, hq =>
    if h : degree q ≤ degree p ∧ p ≠ 0 then by
      have _wf := div_wf_lemma ⟨h.1, h.2⟩ hq
      have :
        degree ((p - C (leadingCoeff p) * X ^ (natDegree p - natDegree q) * q) %ₘ q) < degree q :=
        degree_modByMonic_lt (p - C (leadingCoeff p) * X ^ (natDegree p - natDegree q) * q) hq
      unfold modByMonic at this ⊢
      unfold divModByMonicAux
      dsimp
      rw [dif_pos hq] at this ⊢
      rw [if_pos h]
      exact this
    else
      Or.casesOn (not_and_or.1 h)
        (by
          unfold modByMonic divModByMonicAux
          dsimp
          rw [dif_pos hq, if_neg h]
          exact lt_of_not_ge)
        (by
          intro hp
          unfold modByMonic divModByMonicAux
          dsimp
          rw [dif_pos hq, if_neg h, Classical.not_not.1 hp]
          exact lt_of_le_of_ne bot_le (Ne.symm (mt degree_eq_bot.1 hq.ne_zero)))
  termination_by degree_modByMonic_lt p q hq => p
#align polynomial.degree_mod_by_monic_lt Polynomial.degree_modByMonic_lt

@[simp]
theorem zero_modByMonic (p : R[X]) : 0 %ₘ p = 0 := by
  unfold modByMonic divModByMonicAux
  dsimp
  by_cases hp : Monic p
  · rw [dif_pos hp, if_neg (mt And.right (not_not_intro rfl))]
  · rw [dif_neg hp]
#align polynomial.zero_mod_by_monic Polynomial.zero_modByMonic

@[simp]
theorem zero_divByMonic (p : R[X]) : 0 /ₘ p = 0 := by
  unfold divByMonic divModByMonicAux
  dsimp
  by_cases hp : Monic p
  · rw [dif_pos hp, if_neg (mt And.right (not_not_intro rfl))]
  · rw [dif_neg hp]
#align polynomial.zero_div_by_monic Polynomial.zero_divByMonic

@[simp]
theorem modByMonic_zero (p : R[X]) : p %ₘ 0 = p :=
  if h : Monic (0 : R[X]) then by
    haveI := monic_zero_iff_subsingleton.mp h
    simp
  else by unfold modByMonic divModByMonicAux; rw [dif_neg h]
#align polynomial.mod_by_monic_zero Polynomial.modByMonic_zero

@[simp]
theorem divByMonic_zero (p : R[X]) : p /ₘ 0 = 0 :=
  if h : Monic (0 : R[X]) then by
    haveI := monic_zero_iff_subsingleton.mp h
    simp
  else by unfold divByMonic divModByMonicAux; rw [dif_neg h]
#align polynomial.div_by_monic_zero Polynomial.divByMonic_zero

theorem divByMonic_eq_of_not_monic (p : R[X]) (hq : ¬Monic q) : p /ₘ q = 0 :=
  dif_neg hq
#align polynomial.div_by_monic_eq_of_not_monic Polynomial.divByMonic_eq_of_not_monic

theorem modByMonic_eq_of_not_monic (p : R[X]) (hq : ¬Monic q) : p %ₘ q = p :=
  dif_neg hq
#align polynomial.mod_by_monic_eq_of_not_monic Polynomial.modByMonic_eq_of_not_monic

theorem modByMonic_eq_self_iff [Nontrivial R] (hq : Monic q) : p %ₘ q = p ↔ degree p < degree q :=
  ⟨fun h => h ▸ degree_modByMonic_lt _ hq, fun h => by
    have : ¬degree q ≤ degree p := not_le_of_gt h
    unfold modByMonic divModByMonicAux; dsimp; rw [dif_pos hq, if_neg (mt And.left this)]⟩
#align polynomial.mod_by_monic_eq_self_iff Polynomial.modByMonic_eq_self_iff

theorem degree_modByMonic_le (p : R[X]) {q : R[X]} (hq : Monic q) : degree (p %ₘ q) ≤ degree q := by
  nontriviality R
  exact (degree_modByMonic_lt _ hq).le
#align polynomial.degree_mod_by_monic_le Polynomial.degree_modByMonic_le

end Ring

section CommRing

variable [CommRing R] {p q : R[X]}

theorem modByMonic_eq_sub_mul_div :
    ∀ (p : R[X]) {q : R[X]} (_hq : Monic q), p %ₘ q = p - q * (p /ₘ q)
  | p, q, hq =>
    if h : degree q ≤ degree p ∧ p ≠ 0 then by
      have _wf := div_wf_lemma h hq
      have ih :=
        modByMonic_eq_sub_mul_div (p - C (leadingCoeff p) * X ^ (natDegree p - natDegree q) * q) hq
      unfold modByMonic divByMonic divModByMonicAux
      dsimp
      rw [dif_pos hq, if_pos h]
      rw [modByMonic, dif_pos hq] at ih
      refine' ih.trans _
      unfold divByMonic
      rw [dif_pos hq, dif_pos hq, if_pos h, mul_add, sub_add_eq_sub_sub, mul_comm]
    else by
      unfold modByMonic divByMonic divModByMonicAux
      dsimp
      rw [dif_pos hq, if_neg h, dif_pos hq, if_neg h, MulZeroClass.mul_zero, sub_zero]
  termination_by modByMonic_eq_sub_mul_div p q hq => p
#align polynomial.mod_by_monic_eq_sub_mul_div Polynomial.modByMonic_eq_sub_mul_div

theorem modByMonic_add_div (p : R[X]) {q : R[X]} (hq : Monic q) : p %ₘ q + q * (p /ₘ q) = p :=
  eq_sub_iff_add_eq.1 (modByMonic_eq_sub_mul_div p hq)
#align polynomial.mod_by_monic_add_div Polynomial.modByMonic_add_div

theorem divByMonic_eq_zero_iff [Nontrivial R] (hq : Monic q) : p /ₘ q = 0 ↔ degree p < degree q :=
  ⟨fun h => by
    have := modByMonic_add_div p hq;
      rwa [h, MulZeroClass.mul_zero, add_zero, modByMonic_eq_self_iff hq] at this,
    fun h => by
    have : ¬degree q ≤ degree p := not_le_of_gt h
    unfold divByMonic divModByMonicAux; dsimp; rw [dif_pos hq, if_neg (mt And.left this)]⟩
#align polynomial.div_by_monic_eq_zero_iff Polynomial.divByMonic_eq_zero_iff

theorem degree_add_divByMonic (hq : Monic q) (h : degree q ≤ degree p) :
    degree q + degree (p /ₘ q) = degree p := by
  nontriviality R
  have hdiv0 : p /ₘ q ≠ 0 := by rwa [Ne.def, divByMonic_eq_zero_iff hq, not_lt]
  have hlc : leadingCoeff q * leadingCoeff (p /ₘ q) ≠ 0 := by
    rwa [Monic.def.1 hq, one_mul, Ne.def, leadingCoeff_eq_zero]
  have hmod : degree (p %ₘ q) < degree (q * (p /ₘ q)) :=
    calc
      degree (p %ₘ q) < degree q := degree_modByMonic_lt _ hq
      _ ≤ _ := by
        rw [degree_mul' hlc, degree_eq_natDegree hq.ne_zero, degree_eq_natDegree hdiv0, ←
            Nat.cast_add, Nat.cast_withBot, Nat.cast_withBot, WithBot.coe_le_coe]
        exact Nat.le_add_right _ _
  calc
    degree q + degree (p /ₘ q) = degree (q * (p /ₘ q)) := Eq.symm (degree_mul' hlc)
    _ = degree (p %ₘ q + q * (p /ₘ q)) := (degree_add_eq_right_of_degree_lt hmod).symm
    _ = _ := congr_arg _ (modByMonic_add_div _ hq)
#align polynomial.degree_add_div_by_monic Polynomial.degree_add_divByMonic

theorem degree_divByMonic_le (p q : R[X]) : degree (p /ₘ q) ≤ degree p :=
  if hp0 : p = 0 then by simp only [hp0, zero_divByMonic, le_refl]
  else
    if hq : Monic q then
      if h : degree q ≤ degree p then by
        haveI := Nontrivial.of_polynomial_ne hp0;
            rw [← degree_add_divByMonic hq h, degree_eq_natDegree hq.ne_zero,
              degree_eq_natDegree (mt (divByMonic_eq_zero_iff hq).1 (not_lt.2 h))];
          exact WithBot.coe_le_coe.2 (Nat.le_add_left _ _)
      else by
        unfold divByMonic divModByMonicAux;
          simp [dif_pos hq, h, false_and_iff, if_false, degree_zero, bot_le]
    else (divByMonic_eq_of_not_monic p hq).symm ▸ bot_le
#align polynomial.degree_div_by_monic_le Polynomial.degree_divByMonic_le

theorem degree_divByMonic_lt (p : R[X]) {q : R[X]} (hq : Monic q) (hp0 : p ≠ 0)
    (h0q : 0 < degree q) : degree (p /ₘ q) < degree p :=
  if hpq : degree p < degree q then
    by
    haveI := Nontrivial.of_polynomial_ne hp0
    rw [(divByMonic_eq_zero_iff hq).2 hpq, degree_eq_natDegree hp0]
    exact WithBot.bot_lt_coe _
  else by
    haveI := Nontrivial.of_polynomial_ne hp0
    rw [← degree_add_divByMonic hq (not_lt.1 hpq), degree_eq_natDegree hq.ne_zero,
      degree_eq_natDegree (mt (divByMonic_eq_zero_iff hq).1 hpq)]
    exact
      WithBot.coe_lt_coe.2
        (Nat.lt_add_of_pos_left (WithBot.coe_lt_coe.1 <|
          by simpa [Nat.cast_withBot, degree_eq_natDegree hq.ne_zero] using h0q))
#align polynomial.degree_div_by_monic_lt Polynomial.degree_divByMonic_lt

theorem natDegree_divByMonic {R : Type u} [CommRing R] (f : R[X]) {g : R[X]} (hg : g.Monic) :
    natDegree (f /ₘ g) = natDegree f - natDegree g := by
  nontriviality R
  by_cases hfg : f /ₘ g = 0
  · rw [hfg, natDegree_zero]
    rw [divByMonic_eq_zero_iff hg] at hfg
    rw [tsub_eq_zero_iff_le.mpr (natDegree_le_natDegree <| le_of_lt hfg)]
  have hgf := hfg
  rw [divByMonic_eq_zero_iff hg] at hgf
  push_neg  at hgf
  have := degree_add_divByMonic hg hgf
  have hf : f ≠ 0 := by
    intro hf
    apply hfg
    rw [hf, zero_divByMonic]
  rw [degree_eq_natDegree hf, degree_eq_natDegree hg.ne_zero, degree_eq_natDegree hfg,
    Nat.cast_withBot, Nat.cast_withBot, Nat.cast_withBot,
    ← WithBot.coe_add, WithBot.coe_eq_coe] at this
  rw [← this, add_tsub_cancel_left]
#align polynomial.nat_degree_div_by_monic Polynomial.natDegree_divByMonic

theorem div_modByMonic_unique {f g} (q r : R[X]) (hg : Monic g)
    (h : r + g * q = f ∧ degree r < degree g) : f /ₘ g = q ∧ f %ₘ g = r := by
  nontriviality R
  have h₁ : r - f %ₘ g = -g * (q - f /ₘ g) :=
    eq_of_sub_eq_zero
      (by
        rw [← sub_eq_zero_of_eq (h.1.trans (modByMonic_add_div f hg).symm)]
        simp [mul_add, mul_comm, sub_eq_add_neg, add_comm, add_left_comm, add_assoc])
  have h₂ : degree (r - f %ₘ g) = degree (g * (q - f /ₘ g)) := by simp [h₁]
  have h₄ : degree (r - f %ₘ g) < degree g :=
    calc
      degree (r - f %ₘ g) ≤ max (degree r) (degree (f %ₘ g)) := degree_sub_le _ _
      _ < degree g := max_lt_iff.2 ⟨h.2, degree_modByMonic_lt _ hg⟩
  have h₅ : q - f /ₘ g = 0 :=
    _root_.by_contradiction fun hqf =>
      not_le_of_gt h₄ <|
        calc
          degree g ≤ degree g + degree (q - f /ₘ g) := by
            erw [degree_eq_natDegree hg.ne_zero, degree_eq_natDegree hqf, WithBot.coe_le_coe]
            exact Nat.le_add_right _ _
          _ = degree (r - f %ₘ g) := by rw [h₂, degree_mul']; simpa [Monic.def.1 hg]
  exact ⟨Eq.symm <| eq_of_sub_eq_zero h₅, Eq.symm <| eq_of_sub_eq_zero <| by simpa [h₅] using h₁⟩
#align polynomial.div_mod_by_monic_unique Polynomial.div_modByMonic_unique

theorem map_mod_divByMonic [CommRing S] (f : R →+* S) (hq : Monic q) :
    (p /ₘ q).map f = p.map f /ₘ q.map f ∧ (p %ₘ q).map f = p.map f %ₘ q.map f := by
  nontriviality S
  haveI : Nontrivial R := f.domain_nontrivial
  have : map f p /ₘ map f q = map f (p /ₘ q) ∧ map f p %ₘ map f q = map f (p %ₘ q) :=
    div_modByMonic_unique ((p /ₘ q).map f) _ (hq.map f)
      ⟨Eq.symm <| by rw [← Polynomial.map_mul, ← Polynomial.map_add, modByMonic_add_div _ hq],
        calc
          _ ≤ degree (p %ₘ q) := degree_map_le _ _
          _ < degree q := (degree_modByMonic_lt _ hq)
          _ = _ :=
            Eq.symm <|
              degree_map_eq_of_leadingCoeff_ne_zero _
                (by rw [Monic.def.1 hq, f.map_one]; exact one_ne_zero)⟩
  exact ⟨this.1.symm, this.2.symm⟩
#align polynomial.map_mod_div_by_monic Polynomial.map_mod_divByMonic

theorem map_divByMonic [CommRing S] (f : R →+* S) (hq : Monic q) :
    (p /ₘ q).map f = p.map f /ₘ q.map f :=
  (map_mod_divByMonic f hq).1
#align polynomial.map_div_by_monic Polynomial.map_divByMonic

theorem map_modByMonic [CommRing S] (f : R →+* S) (hq : Monic q) :
    (p %ₘ q).map f = p.map f %ₘ q.map f :=
  (map_mod_divByMonic f hq).2
#align polynomial.map_mod_by_monic Polynomial.map_modByMonic

theorem dvd_iff_modByMonic_eq_zero (hq : Monic q) : p %ₘ q = 0 ↔ q ∣ p :=
  ⟨fun h => by rw [← modByMonic_add_div p hq, h, zero_add]; exact dvd_mul_right _ _, fun h => by
    nontriviality R
    obtain ⟨r, hr⟩ := exists_eq_mul_right_of_dvd h
    by_contra hpq0
    have hmod : p %ₘ q = q * (r - p /ₘ q) := by rw [modByMonic_eq_sub_mul_div _ hq, mul_sub, ← hr]
    have : degree (q * (r - p /ₘ q)) < degree q := hmod ▸ degree_modByMonic_lt _ hq
    have hrpq0 : leadingCoeff (r - p /ₘ q) ≠ 0 := fun h =>
      hpq0 <|
        leadingCoeff_eq_zero.1
          (by rw [hmod, leadingCoeff_eq_zero.1 h, MulZeroClass.mul_zero, leadingCoeff_zero])
    have hlc : leadingCoeff q * leadingCoeff (r - p /ₘ q) ≠ 0 := by rwa [Monic.def.1 hq, one_mul]
    rw [degree_mul' hlc, degree_eq_natDegree hq.ne_zero,
      degree_eq_natDegree (mt leadingCoeff_eq_zero.2 hrpq0)] at this
    exact not_lt_of_ge (Nat.le_add_right _ _) (WithBot.some_lt_some.1 this)⟩
#align polynomial.dvd_iff_mod_by_monic_eq_zero Polynomial.dvd_iff_modByMonic_eq_zero

theorem map_dvd_map [CommRing S] (f : R →+* S) (hf : Function.Injective f) {x y : R[X]}
    (hx : x.Monic) : x.map f ∣ y.map f ↔ x ∣ y := by
  rw [← dvd_iff_modByMonic_eq_zero hx, ← dvd_iff_modByMonic_eq_zero (hx.map f), ←
    map_modByMonic f hx]
  exact
    ⟨fun H => map_injective f hf <| by rw [H, Polynomial.map_zero], fun H => by
      rw [H, Polynomial.map_zero]⟩
#align polynomial.map_dvd_map Polynomial.map_dvd_map

@[simp]
theorem modByMonic_one (p : R[X]) : p %ₘ 1 = 0 :=
  (dvd_iff_modByMonic_eq_zero (by convert monic_one (R:=R))).2 (one_dvd _)
#align polynomial.mod_by_monic_one Polynomial.modByMonic_one

@[simp]
theorem divByMonic_one (p : R[X]) : p /ₘ 1 = p := by
  conv_rhs => rw [← modByMonic_add_div p monic_one]; simp
#align polynomial.div_by_monic_one Polynomial.divByMonic_one

@[simp]
theorem modByMonic_X_sub_C_eq_C_eval (p : R[X]) (a : R) : p %ₘ (X - C a) = C (p.eval a) := by
  nontriviality R
  have h : (p %ₘ (X - C a)).eval a = p.eval a := by
    rw [modByMonic_eq_sub_mul_div _ (monic_X_sub_C a), eval_sub, eval_mul, eval_sub, eval_X,
      eval_C, sub_self, MulZeroClass.zero_mul, sub_zero]
  have : degree (p %ₘ (X - C a)) < 1 :=
    degree_X_sub_C a ▸ degree_modByMonic_lt p (monic_X_sub_C a)
  have : degree (p %ₘ (X - C a)) ≤ 0 :=
    by
    revert this
    cases degree (p %ₘ (X - C a))
    · exact fun _ => bot_le
    · exact fun h => WithBot.some_le_some.2 (Nat.le_of_lt_succ (WithBot.some_lt_some.1 h))
  rw [eq_C_of_degree_le_zero this, eval_C] at h
  rw [eq_C_of_degree_le_zero this, h]
set_option linter.uppercaseLean3 false in
#align polynomial.mod_by_monic_X_sub_C_eq_C_eval Polynomial.modByMonic_X_sub_C_eq_C_eval

theorem mul_divByMonic_eq_iff_isRoot : (X - C a) * (p /ₘ (X - C a)) = p ↔ IsRoot p a :=
  ⟨fun h => by
    rw [← h, IsRoot.def, eval_mul, eval_sub, eval_X, eval_C, sub_self, MulZeroClass.zero_mul],
    fun h : p.eval a = 0 => by
    conv_rhs =>
        rw [← modByMonic_add_div p (monic_X_sub_C a)]
        rw [modByMonic_X_sub_C_eq_C_eval, h, C_0, zero_add]⟩
#align polynomial.mul_div_by_monic_eq_iff_is_root Polynomial.mul_divByMonic_eq_iff_isRoot

theorem dvd_iff_isRoot : X - C a ∣ p ↔ IsRoot p a :=
  ⟨fun h => by
    rwa [← dvd_iff_modByMonic_eq_zero (monic_X_sub_C _), modByMonic_X_sub_C_eq_C_eval, ← C_0,
      C_inj] at h,
    fun h => ⟨p /ₘ (X - C a), by rw [mul_divByMonic_eq_iff_isRoot.2 h]⟩⟩
#align polynomial.dvd_iff_is_root Polynomial.dvd_iff_isRoot

theorem modByMonic_X (p : R[X]) : p %ₘ X = C (p.eval 0) := by
  rw [← modByMonic_X_sub_C_eq_C_eval, C_0, sub_zero]
set_option linter.uppercaseLean3 false in
#align polynomial.mod_by_monic_X Polynomial.modByMonic_X

theorem eval₂_modByMonic_eq_self_of_root [CommRing S] {f : R →+* S} {p q : R[X]} (hq : q.Monic)
    {x : S} (hx : q.eval₂ f x = 0) : (p %ₘ q).eval₂ f x = p.eval₂ f x := by
  rw [modByMonic_eq_sub_mul_div p hq, eval₂_sub, eval₂_mul, hx, MulZeroClass.zero_mul, sub_zero]
#align polynomial.eval₂_mod_by_monic_eq_self_of_root Polynomial.eval₂_modByMonic_eq_self_of_root

theorem sum_modByMonic_coeff (hq : q.Monic) {n : ℕ} (hn : q.degree ≤ n) :
    (∑ i : Fin n, monomial i ((p %ₘ q).coeff i)) = p %ₘ q := by
  nontriviality R
  exact
    (sum_fin (fun i c => monomial i c) (by simp) ((degree_modByMonic_lt _ hq).trans_le hn)).trans
      (sum_monomial_eq _)
#align polynomial.sum_mod_by_monic_coeff Polynomial.sum_modByMonic_coeff

theorem sub_dvd_eval_sub (a b : R) (p : R[X]) : a - b ∣ p.eval a - p.eval b := by
  suffices X - C b ∣ p - C (p.eval b) by
    simpa only [coe_evalRingHom, eval_sub, eval_X, eval_C] using (evalRingHom a).map_dvd this
  simp [dvd_iff_isRoot]
#align polynomial.sub_dvd_eval_sub Polynomial.sub_dvd_eval_sub

theorem mul_div_mod_by_monic_cancel_left (p : R[X]) {q : R[X]} (hmo : q.Monic) :
    q * p /ₘ q = p := by
  nontriviality R
  refine' (div_modByMonic_unique _ 0 hmo ⟨by rw [zero_add], _⟩).1
  rw [degree_zero]
  exact Ne.bot_lt fun h => hmo.ne_zero (degree_eq_bot.1 h)
#align polynomial.mul_div_mod_by_monic_cancel_left Polynomial.mul_div_mod_by_monic_cancel_left

variable (R)

theorem not_isField : ¬IsField R[X] := by
  nontriviality R
  rw [Ring.not_isField_iff_exists_ideal_bot_lt_and_lt_top]
  use Ideal.span {Polynomial.X}
  constructor
  · rw [bot_lt_iff_ne_bot, Ne.def, Ideal.span_singleton_eq_bot]
    exact Polynomial.X_ne_zero
  · rw [lt_top_iff_ne_top, Ne.def, Ideal.eq_top_iff_one, Ideal.mem_span_singleton,
      Polynomial.X_dvd_iff, Polynomial.coeff_one_zero]
    exact one_ne_zero
#align polynomial.not_is_field Polynomial.not_isField

variable {R}

theorem ker_evalRingHom (x : R) : RingHom.ker (evalRingHom x) = Ideal.span {X - C x} := by
  ext y
  simp [Ideal.mem_span_singleton, dvd_iff_isRoot, RingHom.mem_ker]
#align polynomial.ker_eval_ring_hom Polynomial.ker_evalRingHom

section multiplicity

/-- An algorithm for deciding polynomial divisibility.
The algorithm is "compute `p %ₘ q` and compare to `0`".
See `polynomial.modByMonic` for the algorithm that computes `%ₘ`.
-/
def decidableDvdMonic (p : R[X]) (hq : Monic q) : Decidable (q ∣ p) :=
  decidable_of_iff (p %ₘ q = 0) (dvd_iff_modByMonic_eq_zero hq)
#align polynomial.decidable_dvd_monic Polynomial.decidableDvdMonic

theorem multiplicity_X_sub_C_finite (a : R) (h0 : p ≠ 0) : multiplicity.Finite (X - C a) p := by
  haveI := Nontrivial.of_polynomial_ne h0
  refine' multiplicity_finite_of_degree_pos_of_monic _ (monic_X_sub_C _) h0
  rw [degree_X_sub_C]
  decide
set_option linter.uppercaseLean3 false in
#align polynomial.multiplicity_X_sub_C_finite Polynomial.multiplicity_X_sub_C_finite

/- Porting note: stripping out classical for decidability instance parameter might
make for better ergnomics -/
/-- The largest power of `X - C a` which divides `p`.
This is computable via the divisibility algorithm `Polynomial.decidableDvdMonic`. -/
def rootMultiplicity (a : R) (p : R[X]) : ℕ :=
  if h0 : p = 0 then 0
  else
    let _ : DecidablePred fun n : ℕ => ¬(X - C a) ^ (n + 1) ∣ p := fun n =>
      @Not.decidable _ (decidableDvdMonic p ((monic_X_sub_C a).pow (n + 1)))
    Nat.find (multiplicity_X_sub_C_finite a h0)
#align polynomial.root_multiplicity Polynomial.rootMultiplicity

/- Porting note: added the following due to diamand with decidableProp and
decidableDvdMonic see also [Zulip]
(https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/
non-defeq.20aliased.20instance) -/
theorem rootMultiplicity_eq_nat_find_of_nonzero {p : R[X]} (p0 : p ≠ 0) {a : R} :
    rootMultiplicity a p = Nat.find (multiplicity_X_sub_C_finite a p0) := by
  dsimp [rootMultiplicity]
  rw [dif_neg p0]
  convert rfl

@[simp]
theorem rootMultiplicity_zero {x : R} : rootMultiplicity x 0 = 0 :=
  dif_pos rfl
#align polynomial.root_multiplicity_zero Polynomial.rootMultiplicity_zero

@[simp]
theorem rootMultiplicity_eq_zero_iff {p : R[X]} {x : R} :
    rootMultiplicity x p = 0 ↔ IsRoot p x → p = 0 := by
  simp only [rootMultiplicity_eq_multiplicity, dite_eq_left_iff, PartENat.get_eq_iff_eq_coe,
    Nat.cast_zero, multiplicity.multiplicity_eq_zero, dvd_iff_isRoot, not_imp_not]
#align polynomial.root_multiplicity_eq_zero_iff Polynomial.rootMultiplicity_eq_zero_iff

theorem rootMultiplicity_eq_zero {p : R[X]} {x : R} (h : ¬IsRoot p x) : rootMultiplicity x p = 0 :=
  rootMultiplicity_eq_zero_iff.2 fun h' => (h h').elim
#align polynomial.root_multiplicity_eq_zero Polynomial.rootMultiplicity_eq_zero

@[simp]
theorem rootMultiplicity_pos' {p : R[X]} {x : R} : 0 < rootMultiplicity x p ↔ p ≠ 0 ∧ IsRoot p x :=
  by rw [pos_iff_ne_zero, Ne.def, rootMultiplicity_eq_zero_iff, not_imp, and_comm]
#align polynomial.root_multiplicity_pos' Polynomial.rootMultiplicity_pos'

theorem rootMultiplicity_pos {p : R[X]} (hp : p ≠ 0) {x : R} :
    0 < rootMultiplicity x p ↔ IsRoot p x :=
  rootMultiplicity_pos'.trans (and_iff_right hp)
#align polynomial.root_multiplicity_pos Polynomial.rootMultiplicity_pos

@[simp]
theorem rootMultiplicity_C (r a : R) : rootMultiplicity a (C r) = 0 := by
  simp only [rootMultiplicity_eq_zero_iff, IsRoot, eval_C, C_eq_zero, imp_self]
set_option linter.uppercaseLean3 false in
#align polynomial.root_multiplicity_C Polynomial.rootMultiplicity_C

theorem pow_rootMultiplicity_dvd (p : R[X]) (a : R) : (X - C a) ^ rootMultiplicity a p ∣ p :=
  if h : p = 0 then by simp [h]
  else by
    rw [rootMultiplicity_eq_multiplicity, dif_neg h]; exact multiplicity.pow_multiplicity_dvd _
#align polynomial.pow_root_multiplicity_dvd Polynomial.pow_rootMultiplicity_dvd

theorem divByMonic_mul_pow_rootMultiplicity_eq (p : R[X]) (a : R) :
    p /ₘ (X - C a) ^ rootMultiplicity a p * (X - C a) ^ rootMultiplicity a p = p := by
  have : Monic ((X - C a) ^ rootMultiplicity a p) := (monic_X_sub_C _).pow _
  conv_rhs =>
      rw [← modByMonic_add_div p this,
        (dvd_iff_modByMonic_eq_zero this).2 (pow_rootMultiplicity_dvd _ _)]
  simp [mul_comm]
#align polynomial.div_by_monic_mul_pow_root_multiplicity_eq Polynomial.divByMonic_mul_pow_rootMultiplicity_eq

theorem eval_divByMonic_pow_rootMultiplicity_ne_zero {p : R[X]} (a : R) (hp : p ≠ 0) :
    eval a (p /ₘ (X - C a) ^ rootMultiplicity a p) ≠ 0 := by
  haveI : Nontrivial R := Nontrivial.of_polynomial_ne hp
  rw [Ne.def, ← IsRoot.def, ← dvd_iff_isRoot]
  rintro ⟨q, hq⟩
  have := divByMonic_mul_pow_rootMultiplicity_eq p a
  rw [mul_comm, hq, ← mul_assoc, ← pow_succ', rootMultiplicity_eq_multiplicity, dif_neg hp] at this
  exact
    multiplicity.is_greatest'
      (multiplicity_finite_of_degree_pos_of_monic
        (show (0 : WithBot ℕ) < degree (X - C a) by rw [degree_X_sub_C]; exact by decide)
        (monic_X_sub_C _) hp)
      (Nat.lt_succ_self _) (dvd_of_mul_right_eq _ this)
#align polynomial.eval_div_by_monic_pow_root_multiplicity_ne_zero Polynomial.eval_divByMonic_pow_rootMultiplicity_ne_zero

end multiplicity

end CommRing

end Polynomial


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel

! This file was ported from Lean 3 source module category_theory.limits.essentially_small
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Products
import Mathbin.CategoryTheory.EssentiallySmall

/-!
# Limits over essentially small indexing categories

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

If `C` has limits of size `w` and `J` is `w`-essentially small, then `C` has limits of shape `J`.

-/

universe w₁ w₂ v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory

namespace CategoryTheory.Limits

variable (J : Type u₂) [Category.{v₂} J] (C : Type u₁) [Category.{v₁} C]

#print CategoryTheory.Limits.hasLimitsOfShape_of_essentiallySmall /-
theorem hasLimitsOfShape_of_essentiallySmall [EssentiallySmall.{w₁} J]
    [HasLimitsOfSize.{w₁, w₁} C] : HasLimitsOfShape J C :=
  hasLimitsOfShape_of_equivalence <| Equivalence.symm <| equivSmallModel.{w₁} J
#align category_theory.limits.has_limits_of_shape_of_essentially_small CategoryTheory.Limits.hasLimitsOfShape_of_essentiallySmall
-/

#print CategoryTheory.Limits.hasColimitsOfShape_of_essentiallySmall /-
theorem hasColimitsOfShape_of_essentiallySmall [EssentiallySmall.{w₁} J]
    [HasColimitsOfSize.{w₁, w₁} C] : HasColimitsOfShape J C :=
  hasColimitsOfShape_of_equivalence <| Equivalence.symm <| equivSmallModel.{w₁} J
#align category_theory.limits.has_colimits_of_shape_of_essentially_small CategoryTheory.Limits.hasColimitsOfShape_of_essentiallySmall
-/

#print CategoryTheory.Limits.hasProductsOfShape_of_small /-
theorem hasProductsOfShape_of_small (β : Type w₂) [Small.{w₁} β] [HasProducts.{w₁} C] :
    HasProductsOfShape β C :=
  hasLimitsOfShape_of_equivalence <| Discrete.equivalence <| Equiv.symm <| equivShrink β
#align category_theory.limits.has_products_of_shape_of_small CategoryTheory.Limits.hasProductsOfShape_of_small
-/

#print CategoryTheory.Limits.hasCoproductsOfShape_of_small /-
theorem hasCoproductsOfShape_of_small (β : Type w₂) [Small.{w₁} β] [HasCoproducts.{w₁} C] :
    HasCoproductsOfShape β C :=
  hasColimitsOfShape_of_equivalence <| Discrete.equivalence <| Equiv.symm <| equivShrink β
#align category_theory.limits.has_coproducts_of_shape_of_small CategoryTheory.Limits.hasCoproductsOfShape_of_small
-/

end CategoryTheory.Limits


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

Theory of topological rings with uniform structure.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.group_completion
import Mathlib.topology.algebra.ring
import Mathlib.PostPort

universes u_1 u_2 u

namespace Mathlib

namespace uniform_space.completion

protected instance has_one (α : Type u_1) [ring α] [uniform_space α] : HasOne (completion α) :=
  { one := ↑1 }

protected instance has_mul (α : Type u_1) [ring α] [uniform_space α] : Mul (completion α) :=
  { mul := function.curry (dense_inducing.extend sorry (coe ∘ function.uncurry Mul.mul)) }

theorem coe_one (α : Type u_1) [ring α] [uniform_space α] : ↑1 = 1 :=
  rfl

theorem coe_mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] (a : α) (b : α) : ↑(a * b) = ↑a * ↑b :=
  Eq.symm
    (dense_inducing.extend_eq (dense_inducing.prod dense_inducing_coe dense_inducing_coe)
      (continuous.comp (continuous_coe α) continuous_mul) (a, b))

theorem continuous_mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] : continuous fun (p : completion α × completion α) => prod.fst p * prod.snd p := sorry

theorem continuous.mul {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] {β : Type u_2} [topological_space β] {f : β → completion α} {g : β → completion α} (hf : continuous f) (hg : continuous g) : continuous fun (b : β) => f b * g b :=
  continuous.comp continuous_mul (continuous.prod_mk hf hg)

protected instance ring {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] : ring (completion α) :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    Mul.mul sorry 1 sorry sorry sorry sorry

/-- The map from a uniform ring to its completion, as a ring homomorphism. -/
def coe_ring_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] : α →+* completion α :=
  ring_hom.mk coe (coe_one α) sorry sorry sorry

/-- The completion extension as a ring morphism. -/
def extension_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] {β : Type u} [uniform_space β] [ring β] [uniform_add_group β] [topological_ring β] (f : α →+* β) (hf : continuous ⇑f) [complete_space β] [separated_space β] : completion α →+* β :=
  (fun (hf : uniform_continuous ⇑f) => ring_hom.mk (completion.extension ⇑f) sorry sorry sorry sorry) sorry

protected instance top_ring_compl {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] : topological_ring (completion α) :=
  topological_ring.mk continuous_neg

/-- The completion map as a ring morphism. -/
def map_ring_hom {α : Type u_1} [ring α] [uniform_space α] [topological_ring α] [uniform_add_group α] {β : Type u} [uniform_space β] [ring β] [uniform_add_group β] [topological_ring β] (f : α →+* β) (hf : continuous ⇑f) : completion α →+* completion β :=
  extension_hom (ring_hom.comp coe_ring_hom f) sorry

protected instance comm_ring (R : Type u_2) [comm_ring R] [uniform_space R] [uniform_add_group R] [topological_ring R] : comm_ring (completion R) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry ring.one sorry sorry
    sorry sorry sorry

end uniform_space.completion

namespace uniform_space

theorem ring_sep_rel (α : Type u_1) [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] : separation_setoid α = submodule.quotient_rel (ideal.closure ⊥) :=
  setoid.ext fun (x y : α) => group_separation_rel x y

theorem ring_sep_quot (α : Type u_1) [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] : quotient (separation_setoid α) = ideal.quotient (ideal.closure ⊥) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (quotient (separation_setoid α) = ideal.quotient (ideal.closure ⊥))) (ring_sep_rel α)))
    (Eq.refl (quotient (submodule.quotient_rel (ideal.closure ⊥))))

/-- Given a topological ring `α` equipped with a uniform structure that makes subtraction uniformly
continuous, get an equivalence between the separated quotient of `α` and the quotient ring
corresponding to the closure of zero. -/
def sep_quot_equiv_ring_quot (α : Type u_1) [r : comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] : quotient (separation_setoid α) ≃ ideal.quotient (ideal.closure ⊥) :=
  quotient.congr_right sorry

/- TODO: use a form of transport a.k.a. lift definition a.k.a. transfer -/

protected instance comm_ring {α : Type u_1} [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] : comm_ring (quotient (separation_setoid α)) :=
  eq.mpr sorry (ideal.quotient.comm_ring (ideal.closure ⊥))

protected instance topological_ring {α : Type u_1} [comm_ring α] [uniform_space α] [uniform_add_group α] [topological_ring α] : topological_ring (quotient (separation_setoid α)) := sorry


import analysis.inner_product_space.gram_schmidt_ortho

section gram_schmidt

variables (𝕜 : Type*) {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
variables {ι : Type*} [linear_order ι] [locally_finite_order_bot ι] [is_well_order ι (<)]

local attribute [instance] is_well_order.to_has_well_founded

local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y

lemma repr_gram_schmidt_diagonal {i : ι} (b : basis ι 𝕜 E) :
  b.repr (gram_schmidt 𝕜 b i) i = 1 :=
begin
  rw [gram_schmidt_def, linear_equiv.map_sub, finsupp.sub_apply, basis.repr_self,
    finsupp.single_eq_same, sub_eq_self, linear_equiv.map_sum, finsupp.coe_finset_sum,
    finset.sum_apply, finset.sum_eq_zero],
  intros j hj,
  rw finset.mem_Iio at hj,
  simp [orthogonal_projection_singleton, gram_schmidt_triangular 𝕜 hj],
end

end gram_schmidt