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


import tactic

open tactic

/-!

This file contains three tactic-programming exercises of increasing difficulty.

They were (hastily) written to follow the metaprogramming tutorial at
Lean for the Curious Mathematician 2020.

If you're looking for more (better) exercises, we strongly recommend the
exercises by Blanchette et al
for the course Logical Verification at the Vrije Universiteit Amsterdam,
and the corresponding chapter of the course notes:

https://github.com/blanchette/logical_verification_2020/blob/master/lean/love07_metaprogramming_exercise_sheet.lean
https://github.com/blanchette/logical_verification_2020/raw/master/hitchhikers_guide.pdf

## Exercise 1

Write a `contradiction` tactic.
The tactic should look through the hypotheses in the local context
trying to find two that contradict each other,
i.e. proving `P` and `¬ P` for some proposition `P`.
It should use this contradiction to close the goal.

Bonus: handle `P → false` as well as `¬ P`.

This exercise is to practice manipulating the hypotheses and goal.

Note: this exists as `tactic.interactive.contradiction`.

-/

meta def tactic.interactive.contr : tactic unit :=
admit -- change this

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : ¬ Q) : false :=
by contr

example (P Q R : Prop) (hnq : ¬ Q) (hp : P) (hq : Q) (hr : ¬ R) : 0 = 1 :=
by contr

example (P Q R : Prop) (hp : P) (hq : Q) (hr : ¬ R) (hnq : Q → false) : false :=
by contr

/-!

## Exercise 2

Write a tactic that proves a given `nat`-valued declaration is nonnegative.
The tactic should take the name of a declaration whose return type is `ℕ`
(presumably with some arguments), e.g. `nat.add : ℕ → ℕ → ℕ`
or `list.length : Π α : Type, list α → ℕ`.
It should add a new declaration to the environment which proves all applications
of this function are nonnegative,
e.g. `nat.add_nonneg : ∀ m n : ℕ, 0 ≤ nat.add m n`.

Bonus: create reasonable names for these declarations, and/or take an optional argument
for the new name.

This tactic is not useful by itself, but it's a good way to practice
querying and modifying an environment and working under binders.
It is not a tactic to be used during a proof, but rather as a command.

Hints:
* For looking at declarations in the environment, you will need the `declaration` type,
  as well as the tactics `get_decl` and `add_decl`.
* You will have to manipulate an expression under binders.
  The tactics `mk_local_pis` and `pis`, or their lambda equivalents, will be helpful here.
* `mk_mapp` is a variant of `mk_app` that lets you provide implicit arguments.
-/

meta def add_nonneg_proof (n : name) : tactic unit :=
sorry

-- these test cases should succeed when you're done

-- run_cmd add_nonneg_proof `nat.add
-- run_cmd add_nonneg_proof `list.length

-- #check nat.add_nonneg
-- #check list.length_nonneg

/-!

## Exercise 3 (challenge!)

The mathlib tactic `cancel_denoms` is intended to get rid of division by numerals
in expressions where this makes sense. For example,

-/

example (q : ℚ) (h : q / 3 > 0) : q > 0 :=
begin
  cancel_denoms at h, exact h
end

/-!

But it is not complete. In particular, it doesn't like nested division
or other operators in denominators. These all fail:

-/

example (q : ℚ) (h : q / (3 / 4) > 0) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

example (p q : ℚ) (h : q / 2 / 3 < q) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

example (p q : ℚ) (h : q / 2 < 3 / (4*q)) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

-- this one succeeds but doesn't do what it should
example (p q : ℚ) (h : q / (2*3) < q) : false :=
begin
  -- cancel_denoms at h,
  sorry
end

/-!

Look at the code in `src/tactic/cancel_denoms.lean` and try to fix it.
See if you can solve any or all of these failing test cases.

If you succeed, a pull request to mathlib is strongly encouraged!

-/


/-
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