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

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume i j h,
  begin
    assume h2,
    have h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      rw [← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), ← int.fract_mul α i, ← int.fract_mul α j, ← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), int.fract_eq_of_eq h2],
      ring,
    },
    have h4 : (i - j) ≠ 0, from by {
      assume h5,
      rw [h5, sub_self] at h3,
      have h6 : α = 0, from by {
        rw [← int.fract_eq_of_eq h3, int.fract_zero],
      },
      exact absurd h6 hα_irrat,
    },
    have h7 : (i - j) ∈ @set.univ ℤ, from by {
      rw [set.mem_univ],
    },
    have h8 : (i - j) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
      rw [set.mem_range],
      use (int.fract (α * ↑(i - j))),
      rw [← int.fract_mul α (i - j), ← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), int.fract_eq_of_eq h3, int.fract_zero],
      ring,
    },
    have h9 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h10 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h11 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h12 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h13 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h14 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h15 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h16 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h17 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h18 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h19 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h20 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h21 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h22 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h23 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h24 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h25 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h26 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h27 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h28 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h29 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h30 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h31 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h32 : (i -
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    assume i j : ℤ,
    assume h2 : i ≠ j,
    assume h3 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)),
    have h4 : α = (α * ↑i - int.floor (α * ↑i)) / ↑(i - j), from by {
      rw [← h3, int.fract_eq_iff_eq_or_eq_add_one],
      rw [← int.fract_eq_iff_eq_or_eq_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j), from by {
      rw [h2, int.fract_add_nat_abs, int.nat_abs_of_nonneg (le_of_lt (mul_pos hα_irrat (int.coe_nat_pos.2 (nat.zero_lt_succ 0)))), int.coe_nat_mul, int.coe_nat_mul],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
    },
    have h4 : α ∈ ℚ, from by {
      apply int.coe_nat_ne_zero_iff_pos.1,
      assume h5 : i - j = 0,
      have h6 : i = j, from by {rw h5, ring},
      contradiction,
    },
    exact hα_irrat h4,
  end,

  -- If this were not true, then
  -- $$
  -- i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
  -- $$
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h2 : ∀ i j : ℤ, i ≠ j → α ≠ (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from
  begin
    assume i j h,
    assume h3 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j),
    have h4 : α ∈ ℚ, from by {
      apply int.coe_nat_ne_zero_iff_pos.1,
      assume h5 : i - j = 0,
      have h6 : i = j, from by {rw h5, ring},
      contradiction,
    },
    exact hα_irrat h4,
  end,

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h3 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))) = ff, from
  begin
    apply set.finite_iff_fintype.2,
    apply set.fintype_range_int_fract,
  end,
  have h4 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h3,
  },
  have h5 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))) = tt, from by {
    apply set.finite_iff_fintype.1,
    apply set.fintype_range_int_fract,
  },
  have h6 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h5,
  },
  have h7 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h4,
  },
  have h8 : (set.range (λ m : ℤ, int.fract (α * ↑m))) ≠ ∅, from by {
    apply set.nonempty_range_int_fract,
    exact hα_irrat,
  },
  have h9 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h4,
  },

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h10 : ∃ x : ℝ, x ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ x ∈ closure (set.range (λ (m : ℤ), int.fract (α * ↑m))), from by {
    apply set.exists_mem_of_ne_empty,
    apply h8,
    have h11 : set.range (λ (m : ℤ), int.fract (α * ↑m)) ⊆ set.Icc 0 1, from by {
      rintros x h12,
      rcases h12 with ⟨m, h13⟩,
      rw h13,
      rw int.fract_lt_one,
    },
    apply set.subset_closure,
    exact h11,
  },
  cases h10 with x h11,
  cases h11 with h12 h13,

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h14 : ∀ ε > 0, ∃ (x y : ℤ), x ≠ y ∧ int.fract (α * ↑x) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ int.fract (α * ↑y) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ abs (int.fract (α * ↑x) - int.fract (α * ↑y)) < ε, from
  begin
    assume ε h15,
    cases h13 ε h15 with N h16,
    use (N+1),
    use N,
    split,
    exact nat.succ_ne_self N,
    split,
    exact h16 (nat.succ_le_of_lt (nat.lt_succ_self N)),
    split,
    exact h16 (nat.le_refl N),
    have h17 : int.fract (α * ↑(N+1)) - int.fract (α * ↑N) = α * ↑(N+1) - (α * ↑N - int.nat_abs (α * ↑N)), from by {
      rw int.fract_add_nat_abs,
      rw int.nat_abs_of_nonneg (le_of_lt (mul_pos hα_irrat (int.coe_nat_pos.2 (nat.zero_lt_succ 0)))),
      ring,
    },
    have h18 : int.fract (α * ↑(N+1)) - int.fract (α * ↑N) = α - int.nat_abs (α * ↑N), from
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ, assume h1 : i ≠ j,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      rw h2, rw sub_eq_zero, rw div_eq_mul_inv, rw mul_comm, rw mul_one, rw sub_self,
      rw inv_zero, rw mul_zero, },
    have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {
      apply quotient.exact h3, },
    exact hα_irrat h4,
  },

  --If this were not true, then
  --$i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  --Hence,
  --$S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  --is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
    assume i : ℤ,
    have h3 : int.fract (α * ↑i) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      use i, rw set.mem_univ,
    },
    show int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
      apply set.mem_Icc.2,
      split; linarith,
    },
  },

  have h3 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    assume i : ℤ,
    rw closure_eq_nhds,
    use i,
    use (int.fract (α * ↑i)),
    split,
    exact h2 i,
    use 1,
    split,
    linarith,
    linarith,
  },

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h4 : ∃ (x : ℝ), x ∈ set.Icc 0 1 ∧ x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    apply set.compact_Icc.exists_mem_of_finite_subcover,
    have h5 : ∀ (i : ℤ), ∃ (ε : ℝ), ε > 0 ∧ ∀ (x : ℝ), x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < ε → x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
      assume i : ℤ,
      use 1,
      split,
      linarith,
      assume x : ℝ,
      assume h6 : x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < 1,
      have h7 : x ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        use i,
        split,
        rw set.mem_univ,
        rw h6.right,
      },
      show x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
        rw closure_eq_nhds,
        use i,
        use x,
        split,
        exact h7,
        use 1,
        split,
        linarith,
        linarith,
      },
    },
    have h8 : ∀ (i : ℤ), ∃ (ε : ℝ), ε > 0 ∧ ∀ (x : ℝ), x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < ε → x ∈ set.Icc 0 1, from by {
      assume i : ℤ,
      use 1,
      split,
      linarith,
      assume x : ℝ,
      assume h9 : x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < 1,
      show x ∈ set.Icc 0 1, from by {
        exact h9.left,
      },
    },
    use h8,
    intros i h10,
    cases h5 i with ε h11,
    use ε,
    split,
    exact h11.left,
    exact h11.right,
  },

  cases h4 with x h5,

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h6 : ∀ (ε : ℝ), ε > 0 → ∃ (y : ℝ), y ∈ set.Icc 0 1 ∧ y ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ |x - y| < ε, from by {
    assume ε : ℝ,
    assume h6 : ε > 0,
    cases h5.right ε h6 with y h7,
    use y,
    split,
    exact h7.left,
    split,
    exact h7.right,
    exact h7.right_1,
  },

  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h8 : 0 ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    rw closure_eq_nhds,
    use x,
    use 0,
    split,
    exact h5.left,
    use 1,
    split,
    linarith,
    linarith,
  },

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h9 : ∀ (y : ℝ), y ∈ set.Icc 0 1 → ∀ (ε : ℝ), ε > 0 → ∃ (x : ℝ), x ∈ set.Icc 0 1 ∧ x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ |y - x| < ε, from by {
    assume (y : ℝ) (h10 : y ∈ set.Icc 0 1),
    assume (ε : ℝ) (h11 : ε > 0),
    cases h6 ε h11 with x h12,
    use x,

end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number.
  assume α,
  --Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    have h2 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by {
      rw int.fract_eq_sub_floor,
    },
    have h3 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by {
      rw int.fract_eq_sub_floor,
    },
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by {
      rw [h2,h3],
    },
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {
      rw [←int.cast_div,←int.cast_sub,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul],
      rw [mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number.
  assume α : ℝ,
  assume hα_irrat : irrational α,

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j), from by {
      rw [int.fract_add_nat_abs_of_nonneg, h2, int.fract_add_nat_abs_of_nonneg],
      rw [int.mul_sub, int.mul_sub, int.mul_sub],
      rw [mul_comm α i, mul_comm α j],
      ring,
    },
    have h4 : (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j) ∈ ℚ, from by {
      rw h3,
    },
    have h5 : irrational α, from hα_irrat,
    have h6 : ¬(α ∈ ℚ), from h5,
    show false, from h6 h4,
  end,

  -- If this were not true, then
  -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h7 : ∀ i j : ℤ, i ≠ j → α ≠ (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from
  begin
    assume i j h,
    assume h2 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j),
    have h3 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {
      rw [int.fract_add_nat_abs_of_nonneg, int.fract_add_nat_abs_of_nonneg],
      rw [int.mul_sub, int.mul_sub, int.mul_sub],
      rw [mul_comm α i, mul_comm α j],
      rw h2,
      ring,
    },
    have h4 : i ≠ j, from h,
    have h5 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1 i j h4,
    show false, from h5 h3,
  end,

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h8 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by {
    assume x h,
    cases h with m hm,
    rw ←hm,
    rw int.fract_mul,
    rw int.fract_lt_one,
    rw int.fract_lt_one,
  },
  have h9 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    have h10 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1,
    have h11 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ≠ (λ m : ℤ, int.fract (α * ↑m)) j, from by {
      assume i j h,
      rw [←int.fract_mul, ←int.fract_mul],
      exact h10 i j h,
    },
    have h12 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      use i,
      refl,
    },
    have h13 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) j ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      use j,
      refl,
    },
    have h14 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ (λ m : ℤ, int.fract (α * ↑m)) j ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      split,
      exact h12 i j h,
      exact h13 i j h,
    },
    have h15 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ≠ (λ m : ℤ, int.fract (α * ↑m)) j, from by {
      assume i j h,
      exact h11 i j h,
    },
    exact set.infinite_of_injective_of_ne_of_ne (λ m : ℤ, int.fract (α * ↑m)) h15 h14,
  },

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h16 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    exact set.bounded_has_sup_of_ne_empty h8,
  },

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h17 : ∀ ε > 0, ∃ x y : ℝ, x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ abs (x - y) < ε, from by {
    assume ε h,
    cases h16 with x hx,
    have h18 : ∃ y : ℝ, y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ abs (x - y) < ε, from by {
      have h19 : ∃ y : ℝ, y ∈ set.Icc 0 1 ∧ abs (x - y) < ε, from by {
        have h20 : ∃ y : ℝ, y ∈ set.Icc 0 1 ∧ abs (x - y) < ε, from by {
          have h21 : ∃ y : ℝ, y ∈
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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

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

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

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

Let $\epsilon > 0$.

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

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

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

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

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

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

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

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

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

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

Hence the result.
{{qed}}

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

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

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

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

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

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

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

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

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

  },

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

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

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

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

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

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


structure A :=
(x : Nat := 0)

def foo : A :=
{}

theorem ex1 : foo = { x := 0 } :=
rfl

theorem ex2 : foo.x = 0 :=
rfl

instance : EmptyCollection A :=
⟨{ x := 10 }⟩

def boo : A :=
{}  -- this is ambiguous


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.l1_space
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Density of simple functions

Show that each Borel measurable function can be approximated,
both pointwise and in `L¹` norm, by a sequence of simple functions.

## Main definitions

* `measure_theory.simple_func.nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ ℕ`: the `simple_func` sending
  each `x : α` to the point `e k` which is the nearest to `x` among `e 0`, ..., `e N`.
* `measure_theory.simple_func.approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α)
  (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) : β →ₛ α` : a simple function that takes values in `s`
  and approximates `f`. If `f x ∈ s`, then `measure_theory.simple_func.approx_on f hf s y₀ h₀ n x`
  tends to `f x` as `n` tends to `∞`. If `α` is a `normed_group`, `f x - y₀`
  is `measure_theory.integrable`, and `f x ∈ s` for a.e. `x`, then
  `simple_func.approx_on f hf s y₀ h₀ n` tends to `f` in `L₁`. The main use case is `s = univ`,
  `y₀ = 0`.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
-/

namespace measure_theory

namespace simple_func

/-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
`nearest_pt_ind e N x` returns the least of their indexes. -/
def nearest_pt_ind {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : ℕ → simple_func α ℕ :=
  sorry

/-- `nearest_pt e N x` is the nearest point to `x` among the points `e 0`, ..., `e N`. If more than
one point are at the same distance from `x`, then `nearest_pt e N x` returns the point with the
least possible index. -/
def nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) : simple_func α α :=
  map e (nearest_pt_ind e N)

@[simp] theorem nearest_pt_ind_zero {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : nearest_pt_ind e 0 = const α 0 :=
  rfl

@[simp] theorem nearest_pt_zero {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : nearest_pt e 0 = const α (e 0) :=
  rfl

theorem nearest_pt_ind_succ {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) : coe_fn (nearest_pt_ind e (N + 1)) x =
  ite (∀ (k : ℕ), k ≤ N → edist (e (N + 1)) x < edist (e k) x) (N + 1) (coe_fn (nearest_pt_ind e N) x) := sorry

theorem nearest_pt_ind_le {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) : coe_fn (nearest_pt_ind e N) x ≤ N := sorry

theorem edist_nearest_pt_le {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (x : α) {k : ℕ} {N : ℕ} (hk : k ≤ N) : edist (coe_fn (nearest_pt e N) x) x ≤ edist (e k) x := sorry

theorem tendsto_nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] {e : ℕ → α} {x : α} (hx : x ∈ closure (set.range e)) : filter.tendsto (fun (N : ℕ) => coe_fn (nearest_pt e N) x) filter.at_top (nhds x) := sorry

/-- Approximate a measurable function by a sequence of simple functions `F n` such that
`F n x ∈ s`. -/
def approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] (f : β → α) (hf : measurable f) (s : set α) (y₀ : α) (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) : simple_func β α :=
  comp (nearest_pt (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n) f hf

@[simp] theorem approx_on_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) : coe_fn (approx_on f hf s y₀ h₀ 0) x = y₀ :=
  rfl

theorem approx_on_mem {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) (x : β) : coe_fn (approx_on f hf s y₀ h₀ n) x ∈ s :=
  (fun (n_1 : ℕ) => nat.cases_on n_1 h₀ fun (n : ℕ) => subtype.mem (topological_space.dense_seq (↥s) n))
    (coe_fn (nearest_pt_ind (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n) (f x))

@[simp] theorem approx_on_comp {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {γ : Type u_3} [measurable_space γ] {f : β → α} (hf : measurable f) {g : γ → β} (hg : measurable g) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) : approx_on (f ∘ g) (measurable.comp hf hg) s y₀ h₀ n = comp (approx_on f hf s y₀ h₀ n) g hg :=
  rfl

theorem tendsto_approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {x : β} (hx : f x ∈ closure s) : filter.tendsto (fun (n : ℕ) => coe_fn (approx_on f hf s y₀ h₀ n) x) filter.at_top (nhds (f x)) := sorry

theorem edist_approx_on_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x) ≤ edist y₀ (f x) :=
  id (edist_nearest_pt_le (Nat.rec y₀ fun (n : ℕ) (ih : α) => ↑(topological_space.dense_seq (↥s) n)) (f x) (zero_le n))

theorem edist_approx_on_y0_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : edist y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) ≤ edist y₀ (f x) + edist y₀ (f x) :=
  le_trans (edist_triangle_right y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
    (add_le_add_left (edist_approx_on_le hf h₀ x n) (edist y₀ (f x)))

theorem norm_approx_on_zero_le {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f) {s : set E} (h₀ : 0 ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : norm (coe_fn (approx_on f hf s 0 h₀ n) x) ≤ norm (f x) + norm (f x) := sorry

theorem tendsto_approx_on_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {μ : measure β} (hμ : filter.eventually (fun (x : β) => f x ∈ closure s) (measure.ae μ)) (hi : has_finite_integral fun (x : β) => f x - y₀) : filter.tendsto (fun (n : ℕ) => lintegral μ fun (x : β) => edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
  filter.at_top (nhds 0) := sorry

theorem integrable_approx_on {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (hi₀ : integrable fun (x : β) => y₀) (n : ℕ) : integrable ⇑(approx_on f fmeas s y₀ h₀ n) := sorry

theorem tendsto_approx_on_univ_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) : filter.tendsto
  (fun (n : ℕ) => lintegral μ fun (x : β) => edist (coe_fn (approx_on f fmeas set.univ 0 trivial n) x) (f x))
  filter.at_top (nhds 0) := sorry

theorem integrable_approx_on_univ {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) (n : ℕ) : integrable ⇑(approx_on f fmeas set.univ 0 trivial n) :=
  integrable_approx_on fmeas hf trivial (integrable_zero β E μ) n

theorem tendsto_approx_on_univ_l1 {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) : filter.tendsto
  (fun (n : ℕ) => l1.of_fun (⇑(approx_on f fmeas set.univ 0 trivial n)) (integrable_approx_on_univ fmeas hf n))
  filter.at_top (nhds (l1.of_fun f hf)) :=
  iff.mpr tendsto_iff_edist_tendsto_0 (tendsto_approx_on_univ_l1_edist fmeas hf)


import topology.basic analysis.complex.exponential
import tactic.core data.list.defs
open real set

----------------------
/- Use `refine` alongside `apply` -/
namespace sin_sin
open tactic
meta def refine_list_expr : list expr → tactic unit
| []     := do {trace "fail", fail "no matching rule"}
| (h::t) := do {trace "refine, initial goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                (refine ``(%%h _ _)),
                trace (format!" REFINE: {h}"),
                trace "refine, final goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                pure() <|> refine_list_expr t }

meta def exact_list_expr : list expr → tactic unit
| []     := do {trace "fail", fail "no matching rule"}
| (h::t) := do {trace "exact, initial goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                trace (format!" EXACT: {h}"),
                -- Some problem here at first...
                exact h,
                trace "exact, final goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                pure() <|> exact_list_expr t }

meta def apply_list_expr : list expr → tactic unit
| []     := fail "no matching rule"
| (h::t) := do { trace "apply, initial goals:",
                 gs ← get_goals,
                 mmap infer_type gs >>= trace,
                 trace (format!" APPLY: {h}") ,
                 interactive.concat_tags (apply h),
                 trace "apply, final goals:",
                 gs ← get_goals,
                 mmap infer_type gs >>= trace,
                 pure() <|> apply_list_expr t }

open nat

-- these were adjusted so that I could get the counter to print out
meta def iterate_at_most_on_all_goals' : nat → tactic unit → tactic unit
| 0        tac := trace "All goals: maximal iterations reached"
| (succ n) tac := tactic.all_goals $ (do tac, trace (format!"All goals:{n}"), iterate_at_most_on_all_goals' n tac) <|> skip

meta def iterate_at_most_on_subgoals' : nat → tactic unit → tactic unit
| 0        tac := trace "Subgoals: maximal iterations reached"
| (succ n) tac := focus1 (do tac, trace (format!"Subgoals:{n}"), iterate_at_most_on_all_goals' n tac)

meta def apply_rules_with_refine (apps : list pexpr) (refs : list pexpr) (exas : list pexpr) (n : nat) : tactic unit :=
do a ← build_list_expr_for_apply apps,
   r ← build_list_expr_for_apply refs,
   e ← build_list_expr_for_apply exas,
   iterate_at_most_on_subgoals' n (assumption
                                    <|> (do t ← tactic.target,
                                          let a := expr.app_arg t,
                                          if (band (expr.is_lambda a)
                                                   (bnot (eq a `(λ (x : ℝ), x))))
                                          then refine_list_expr r
                                          else fail "can't refine")
                                    <|> (sin_sin.apply_list_expr a)),
   -- this doesn't work if run inside the loop, above, for some reason
   sin_sin.exact_list_expr e,
   pure()

end sin_sin
----------------------

namespace tactic
namespace interactive
open lean
open lean.parser
open interactive interactive.types expr

meta def apply_rules_with_refine_interactive (as : parse pexpr_list_or_texpr)
                                             (rs : parse pexpr_list_or_texpr)
                                             (es : parse pexpr_list_or_texpr)
                                             (n : nat := 50) : tactic unit :=
sin_sin.apply_rules_with_refine as rs es n

end interactive
end tactic

-- * sin(sin(x)) and friends are continuous on ℝ

open real

lemma continuous_sin_sin : continuous (λ x : ℝ, sin(sin(sin(sin(sin(sin x)))))) :=
begin
-- Chris Hughes helped me figure out that we need "@continuous_id ℝ _" rather than "continuous_id" here
apply_rules_with_refine_interactive [continuous_sin] [continuous.comp] [@continuous_id ℝ _] 7,
end

#print continuous_sin_sin


namespace Foo

scoped syntax "foo!" term:max : term

macro_rules
  | `(foo! $x) => `($x + 1)

#check foo! 20

theorem ex1 : foo! 20 = 21 := rfl

end Foo

#check foo! 10 -- Error

def foo! := 10

theorem ex2 : foo! = 10 := rfl

#check foo!

open Foo

#check foo! 20

theorem ex3 : foo! 10 = 11 := rfl

namespace Bla

scoped syntax "bla!" term:max : term

macro_rules
  | `(bla! $x) => `($x * 2)

theorem ex2 : bla! 3 = 6 := rfl

end Bla

def bla! := 20

theorem ex4 : bla! = 20 := rfl


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import ring_theory.localization.at_prime
import ring_theory.localization.basic
import ring_theory.localization.fraction_ring

/-!
# Localizations of localizations

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/
variables {R : Type*} [comm_ring R] (M : submonoid R) {S : Type*} [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]

open function
open_locale big_operators

namespace is_localization

section localization_localization

variable (M)

variables (N : submonoid S) (T : Type*) [comm_ring T] [algebra R T]

section

variables [algebra S T] [is_scalar_tower R S T]

/--
Localizing wrt `M ⊆ R` and then wrt `N ⊆ S = M⁻¹R` is equal to the localization of `R` wrt this
module. See `localization_localization_is_localization`.
-/
-- This should only be defined when `S` is the localization `M⁻¹R`, hence the nolint.
@[nolint unused_arguments]
def localization_localization_submodule : submonoid R :=
(N ⊔ M.map (algebra_map R S)).comap (algebra_map R S)

variables {M N}
@[simp]
lemma mem_localization_localization_submodule {x : R} :
  x ∈ localization_localization_submodule M N ↔
    ∃ (y : N) (z : M), algebra_map R S x = y * algebra_map R S z :=
begin
  rw [localization_localization_submodule, submonoid.mem_comap, submonoid.mem_sup],
  split,
  { rintros ⟨y, hy, _, ⟨z, hz, rfl⟩, e⟩, exact ⟨⟨y, hy⟩, ⟨z, hz⟩ ,e.symm⟩ },
  { rintros ⟨y, z, e⟩, exact ⟨y, y.prop, _, ⟨z, z.prop, rfl⟩, e.symm⟩ }
end

variables (M N) [is_localization M S]

lemma localization_localization_map_units [is_localization N T]
  (y : localization_localization_submodule M N) : is_unit (algebra_map R T y) :=
begin
  obtain ⟨y', z, eq⟩ := mem_localization_localization_submodule.mp y.prop,
  rw [is_scalar_tower.algebra_map_apply R S T, eq, ring_hom.map_mul, is_unit.mul_iff],
  exact ⟨is_localization.map_units T y',
    (is_localization.map_units _ z).map (algebra_map S T)⟩,
end

lemma localization_localization_surj [is_localization N T] (x : T) :
  ∃ (y : R × localization_localization_submodule M N),
    x * (algebra_map R T y.2) = algebra_map R T y.1 :=
begin
  rcases is_localization.surj N x with ⟨⟨y, s⟩, eq₁⟩, -- x = y / s
  rcases is_localization.surj M y with ⟨⟨z, t⟩, eq₂⟩, -- y = z / t
  rcases is_localization.surj M (s : S) with ⟨⟨z', t'⟩, eq₃⟩, -- s = z' / t'
  dsimp only at eq₁ eq₂ eq₃,
  use z * t', use z' * t, -- x = y / s = (z * t') / (z' * t)
  { rw mem_localization_localization_submodule,
    refine ⟨s, t * t', _⟩,
    rw [ring_hom.map_mul, ← eq₃, mul_assoc, ← ring_hom.map_mul, mul_comm t, submonoid.coe_mul] },
  { simp only [subtype.coe_mk, ring_hom.map_mul, is_scalar_tower.algebra_map_apply R S T,
      ← eq₃, ← eq₂, ← eq₁],
    ring },
end

lemma localization_localization_eq_iff_exists [is_localization N T] (x y : R) :
  algebra_map R T x = algebra_map R T y ↔
    ∃ (c : localization_localization_submodule M N), ↑c * x = ↑c * y :=
begin
  rw [is_scalar_tower.algebra_map_apply R S T, is_scalar_tower.algebra_map_apply R S T,
      is_localization.eq_iff_exists N T],
  split,
  { rintros ⟨z, eq₁⟩,
    rcases is_localization.surj M (z : S) with ⟨⟨z', s⟩, eq₂⟩,
    dsimp only at eq₂,
    obtain ⟨c, eq₃ :  ↑c * (x * z') = ↑c * (y * z')⟩ := (is_localization.eq_iff_exists M S).mp _,
    swap,
    { rw [map_mul, map_mul, ←eq₂, ←mul_assoc, ←mul_assoc, mul_comm _ ↑z, eq₁, mul_comm _ ↑z] },
    use c * z',
    { rw mem_localization_localization_submodule,
      refine ⟨z, c * s, _⟩,
      rw [map_mul, ← eq₂, submonoid.coe_mul, map_mul, mul_left_comm] },
    { rwa [mul_comm _ z', mul_comm _ z', ←mul_assoc, ←mul_assoc] at eq₃ } },
  { rintro ⟨⟨c, hc⟩, eq₁ : c * x = c * y⟩,
    rw mem_localization_localization_submodule at hc,
    rcases hc with ⟨z₁, z, eq₂⟩,
    use z₁,
    refine (is_localization.map_units S z).mul_right_inj.mp _,
    rw [←mul_assoc, mul_comm _ ↑z₁, ←eq₂, ←map_mul, eq₁, map_mul, eq₂, ←mul_assoc, mul_comm _ ↑z₁] }
end

/--
Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, we have
`N ⁻¹ S = T = (f⁻¹ (N • f(M))) ⁻¹ R`. I.e., the localization of a localization is a localization.
-/
lemma localization_localization_is_localization [is_localization N T] :
  is_localization (localization_localization_submodule M N) T :=
{ map_units := localization_localization_map_units M N T,
  surj := localization_localization_surj M N T,
  eq_iff_exists := localization_localization_eq_iff_exists M N T }

include M

/--
Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, if
`N` contains all the units of `S`, then `N ⁻¹ S = T = (f⁻¹ N) ⁻¹ R`. I.e., the localization of a
localization is a localization.
-/
lemma localization_localization_is_localization_of_has_all_units
  [is_localization N T] (H : ∀ (x : S), is_unit x → x ∈ N) :
  is_localization (N.comap (algebra_map R S)) T :=
begin
  convert localization_localization_is_localization M N T,
  symmetry,
  rw sup_eq_left,
  rintros _ ⟨x, hx, rfl⟩,
  exact H _ (is_localization.map_units _ ⟨x, hx⟩),
end

/--
Given a submodule `M ⊆ R` and a prime ideal `p` of `S = M⁻¹R`, with `f : R →+* S` the localization
map, then `T = Sₚ` is the localization of `R` at `f⁻¹(p)`.
-/
lemma is_localization_is_localization_at_prime_is_localization (p : ideal S) [Hp : p.is_prime]
  [is_localization.at_prime T p] :
  is_localization.at_prime T (p.comap (algebra_map R S)) :=
begin
  apply localization_localization_is_localization_of_has_all_units M p.prime_compl T,
  intros x hx hx',
  exact (Hp.1 : ¬ _) (p.eq_top_of_is_unit_mem hx' hx),
end

instance (p : ideal (localization M)) [p.is_prime] : algebra R (localization.at_prime p) :=
localization.algebra

instance (p : ideal (localization M)) [p.is_prime] :
  is_scalar_tower R (localization M) (localization.at_prime p) :=
is_scalar_tower.of_algebra_map_eq' rfl

instance localization_localization_at_prime_is_localization (p : ideal (localization M))
  [p.is_prime] : is_localization.at_prime (localization.at_prime p) (p.comap (algebra_map R _)) :=
is_localization_is_localization_at_prime_is_localization M _ _

/--
Given a submodule `M ⊆ R` and a prime ideal `p` of `M⁻¹R`, with `f : R →+* S` the localization
map, then `(M⁻¹R)ₚ` is isomorphic (as an `R`-algebra) to the localization of `R` at `f⁻¹(p)`.
-/
noncomputable
def localization_localization_at_prime_iso_localization (p : ideal (localization M)) [p.is_prime] :
  localization.at_prime (p.comap (algebra_map R (localization M))) ≃ₐ[R] localization.at_prime p :=
is_localization.alg_equiv (p.comap (algebra_map R (localization M))).prime_compl _ _

end

variables (S)

/-- Given submonoids `M ≤ N` of `R`, this is the canonical algebra structure
of `M⁻¹S` acting on `N⁻¹S`. -/
noncomputable
def localization_algebra_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T] :
  algebra S T :=
(is_localization.lift (λ y, (map_units T ⟨↑y, h y.prop⟩ : _)) : S →+* T).to_algebra

/-- If `M ≤ N` are submonoids of `R`, then the natural map `M⁻¹S →+* N⁻¹S` commutes with the
localization maps -/
lemma localization_is_scalar_tower_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T] :
  @@is_scalar_tower R S T _ (localization_algebra_of_submonoid_le S T M N h).to_has_smul _ :=
begin
  letI := localization_algebra_of_submonoid_le S T M N h,
  exact is_scalar_tower.of_algebra_map_eq' (is_localization.lift_comp _).symm
end

noncomputable
instance (x : ideal R) [H : x.is_prime] [is_domain R] :
  algebra (localization.at_prime x) (localization (non_zero_divisors R)) :=
localization_algebra_of_submonoid_le _ _ x.prime_compl (non_zero_divisors R)
  (by { intros a ha, rw mem_non_zero_divisors_iff_ne_zero, exact λ h, ha (h.symm ▸ x.zero_mem) })

/-- If `M ≤ N` are submonoids of `R`, then `N⁻¹S` is also the localization of `M⁻¹S` at `N`. -/
lemma is_localization_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T]
  [algebra S T] [is_scalar_tower R S T] :
  is_localization (N.map (algebra_map R S)) T :=
{ map_units := begin
    rintro ⟨_, ⟨y, hy, rfl⟩⟩,
    convert is_localization.map_units T ⟨y, hy⟩,
    exact (is_scalar_tower.algebra_map_apply _ _ _ _).symm
  end,
  surj := λ y, begin
    obtain ⟨⟨x, s⟩, e⟩ := is_localization.surj N y,
    refine ⟨⟨algebra_map _ _ x, _, _, s.prop, rfl⟩, _⟩,
    simpa [← is_scalar_tower.algebra_map_apply] using e
  end,
  eq_iff_exists := λ x₁ x₂, begin
    obtain ⟨⟨y₁, s₁⟩, e₁⟩ := is_localization.surj M x₁,
    obtain ⟨⟨y₂, s₂⟩, e₂⟩ := is_localization.surj M x₂,
    refine iff.trans _ (set.exists_image_iff (algebra_map R S) N (λ c, c * x₁ = c * x₂)).symm,
    dsimp only at e₁ e₂ ⊢,
    suffices : algebra_map R T (y₁ * s₂) = algebra_map R T (y₂ * s₁) ↔
      ∃ (a : N), algebra_map R S (a * (y₁ * s₂)) = algebra_map R S (a * (y₂ * s₁)),
    { have h₁ := (is_localization.map_units T ⟨_, h s₁.prop⟩).mul_left_inj,
      have h₂ := (is_localization.map_units T ⟨_, h s₂.prop⟩).mul_left_inj,
      simp only [is_scalar_tower.algebra_map_apply R S T, subtype.coe_mk] at h₁ h₂,
      simp only [is_scalar_tower.algebra_map_apply R S T, map_mul, ← e₁, ← e₂, ← mul_assoc,
        mul_right_comm _ (algebra_map R S s₂),
        mul_right_comm _ (algebra_map S T (algebra_map R S s₂)),
        (is_localization.map_units S s₁).mul_left_inj,
        (is_localization.map_units S s₂).mul_left_inj] at this,
      rw [h₂, h₁] at this,
      simpa only [mul_comm] using this },
    simp_rw [is_localization.eq_iff_exists N T, is_localization.eq_iff_exists M S],
    split,
    { rintro ⟨a, e⟩, exact ⟨a, 1, by { convert e using 1; simp; ring }⟩ },
    { rintro ⟨a, b, e⟩, exact ⟨a * (⟨_, h b.prop⟩ : N), by { convert e using 1; simp; ring }⟩ }
  end }

/-- If `M ≤ N` are submonoids of `R` such that `∀ x : N, ∃ m : R, m * x ∈ M`, then the
localization at `N` is equal to the localizaton of `M`. -/
lemma is_localization_of_is_exists_mul_mem (M N : submonoid R) [is_localization M S] (h : M ≤ N)
    (h' : ∀ x : N, ∃ m : R, m * x ∈ M) : is_localization N S :=
{ map_units := λ y, begin
    obtain ⟨m, hm⟩ := h' y,
    have := is_localization.map_units S ⟨_, hm⟩,
    erw map_mul at this,
    exact (is_unit.mul_iff.mp this).2
  end,
  surj := λ z, by { obtain ⟨⟨y, s⟩, e⟩ := is_localization.surj M z, exact ⟨⟨y, _, h s.prop⟩, e⟩ },
  eq_iff_exists := λ x₁ x₂, begin
    rw is_localization.eq_iff_exists M,
    refine ⟨λ ⟨x, hx⟩, ⟨⟨_, h x.prop⟩, hx⟩, _⟩,
    rintros ⟨x, h⟩,
    obtain ⟨m, hm⟩ := h' x,
    refine ⟨⟨_, hm⟩, _⟩,
    simp [h, mul_assoc],
  end }

end localization_localization

end is_localization

namespace is_fraction_ring

open is_localization

variable (M)

lemma is_fraction_ring_of_is_localization (S T : Type*) [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  [is_localization M S] [is_fraction_ring R T] (hM : M ≤ non_zero_divisors R) :
  is_fraction_ring S T :=
begin
  have := is_localization_of_submonoid_le S T M (non_zero_divisors R) _,
  refine @@is_localization_of_is_exists_mul_mem _ _ _ _ _ _ this _ _,
  { exact map_non_zero_divisors_le M S },
  { rintro ⟨x, hx⟩,
    obtain ⟨⟨y, s⟩, e⟩ := is_localization.surj M x,
    use algebra_map R S s,
    rw [mul_comm, subtype.coe_mk, e],
    refine set.mem_image_of_mem (algebra_map R S) _,
    intros z hz,
    apply is_localization.injective S hM,
    rw map_zero,
    apply hx,
    rw [← (map_units S s).mul_left_inj, mul_assoc, e, ← map_mul, hz, map_zero, zero_mul] },
  { exact hM }
end

lemma is_fraction_ring_of_is_domain_of_is_localization [is_domain R] (S T : Type*)
  [comm_ring S] [comm_ring T] [algebra R S] [algebra R T] [algebra S T]
  [is_scalar_tower R S T] [is_localization M S] [is_fraction_ring R T] : is_fraction_ring S T :=
begin
  haveI := is_fraction_ring.nontrivial R T,
  haveI := (algebra_map S T).domain_nontrivial,
  apply is_fraction_ring_of_is_localization M S T,
  intros x hx,
  rw mem_non_zero_divisors_iff_ne_zero,
  intro hx',
  apply @zero_ne_one S,
  rw [← (algebra_map R S).map_one, ← @mk'_one R _ M, @comm _ eq, mk'_eq_zero_iff],
  exact ⟨⟨x, hx⟩, by simp [hx'] ⟩,
end

end is_fraction_ring


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import ring_theory.localization
import ring_theory.ideal.over
import ring_theory.jacobson_ideal

/-!
# Jacobson Rings
The following conditions are equivalent for a ring `R`:
1. Every radical ideal `I` is equal to its Jacobson radical
2. Every radical ideal `I` can be written as an intersection of maximal ideals
3. Every prime ideal `I` is equal to its Jacobson radical
Any ring satisfying any of these equivalent conditions is said to be Jacobson.
Some particular examples of Jacobson rings are also proven.
`is_jacobson_quotient` says that the quotient of a Jacobson ring is Jacobson.
`is_jacobson_localization` says the localization of a Jacobson ring to a single element is Jacobson.
`is_jacobson_polynomial_iff_is_jacobson` says polynomials over a Jacobson ring form a Jacobson ring.
## Main definitions
Let `R` be a commutative ring. Jacobson Rings are defined using the first of the above conditions
* `is_jacobson R` is the proposition that `R` is a Jacobson ring. It is a class,
  implemented as the predicate that for any ideal, `I.radical = I` implies `I.jacobson = I`.

## Main statements
* `is_jacobson_iff_prime_eq` is the equivalence between conditions 1 and 3 above.
* `is_jacobson_iff_Inf_maximal` is the equivalence between conditions 1 and 2 above.
* `is_jacobson_of_surjective` says that if `R` is a Jacobson ring and `f : R →+* S` is surjective,
  then `S` is also a Jacobson ring
* `is_jacobson_mv_polynomial` says that multi-variate polynomials over a Jacobson ring are Jacobson.
## Tags
Jacobson, Jacobson Ring
-/

namespace ideal

open polynomial

section is_jacobson
variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}

/-- A ring is a Jacobson ring if for every radical ideal `I`,
 the Jacobson radical of `I` is equal to `I`.
 See `is_jacobson_iff_prime_eq` and `is_jacobson_iff_Inf_maximal` for equivalent definitions. -/
class is_jacobson (R : Type*) [comm_ring R] : Prop :=
(out' : ∀ (I : ideal R), I.radical = I → I.jacobson = I)

theorem is_jacobson_iff {R} [comm_ring R] :
  is_jacobson R ↔ ∀ (I : ideal R), I.radical = I → I.jacobson = I :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_jacobson.out {R} [comm_ring R] :
  is_jacobson R → ∀ {I : ideal R}, I.radical = I → I.jacobson = I := is_jacobson_iff.1

/--  A ring is a Jacobson ring if and only if for all prime ideals `P`,
 the Jacobson radical of `P` is equal to `P`. -/
lemma is_jacobson_iff_prime_eq : is_jacobson R ↔ ∀ P : ideal R, is_prime P → P.jacobson = P :=
begin
  refine is_jacobson_iff.trans ⟨λ h I hI, h I (is_prime.radical hI), _⟩,
  refine λ h I hI, le_antisymm (λ x hx, _) (λ x hx, mem_Inf.mpr (λ _ hJ, hJ.left hx)),
  rw [← hI, radical_eq_Inf I, mem_Inf],
  intros P hP,
  rw set.mem_set_of_eq at hP,
  erw mem_Inf at hx,
  erw [← h P hP.right, mem_Inf],
  exact λ J hJ, hx ⟨le_trans hP.left hJ.left, hJ.right⟩
end

/-- A ring `R` is Jacobson if and only if for every prime ideal `I`,
 `I` can be written as the infimum of some collection of maximal ideals.
 Allowing ⊤ in the set `M` of maximal ideals is equivalent, but makes some proofs cleaner. -/
lemma is_jacobson_iff_Inf_maximal : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal.1 (H.out (is_prime.radical h)),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal.2 (H hP))⟩

lemma is_jacobson_iff_Inf_maximal' : is_jacobson R ↔
  ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R),
  (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
⟨λ H I h, eq_jacobson_iff_Inf_maximal'.1 (H.out (is_prime.radical h)),
  λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal'.2 (H hP))⟩

lemma radical_eq_jacobson [H : is_jacobson R] (I : ideal R) : I.radical = I.jacobson :=
le_antisymm (le_Inf (λ J ⟨hJ, hJ_max⟩, (is_prime.radical_le_iff hJ_max.is_prime).mpr hJ))
            ((H.out (radical_idem I)) ▸ (jacobson_mono le_radical))

/-- Fields have only two ideals, and the condition holds for both of them.  -/
@[priority 100]
instance is_jacobson_field {K : Type*} [field K] : is_jacobson K :=
⟨λ I hI, or.rec_on (eq_bot_or_top I)
(λ h, le_antisymm
  (Inf_le ⟨le_of_eq rfl, (eq.symm h) ▸ bot_is_maximal⟩)
  ((eq.symm h) ▸ bot_le))
(λ h, by rw [h, jacobson_eq_top_iff])⟩

theorem is_jacobson_of_surjective [H : is_jacobson R] :
  (∃ (f : R →+* S), function.surjective f) → is_jacobson S :=
begin
  rintros ⟨f, hf⟩,
  rw is_jacobson_iff_Inf_maximal,
  intros p hp,
  use map f '' {J : ideal R | comap f p ≤ J ∧ J.is_maximal },
  use λ j ⟨J, hJ, hmap⟩, hmap ▸ or.symm (map_eq_top_or_is_maximal_of_surjective f hf hJ.right),
  have : p = map f ((comap f p).jacobson),
  from (is_jacobson.out' (comap f p) (by rw [← comap_radical, is_prime.radical hp])).symm
    ▸ (map_comap_of_surjective f hf p).symm,
  exact eq.trans this (map_Inf hf (λ J ⟨hJ, _⟩, le_trans (ideal.ker_le_comap f) hJ)),
end

@[priority 100]
instance is_jacobson_quotient [is_jacobson R] : is_jacobson (R ⧸ I) :=
is_jacobson_of_surjective ⟨quotient.mk I, (by rintro ⟨x⟩; use x; refl)⟩

lemma is_jacobson_iso (e : R ≃+* S) : is_jacobson R ↔ is_jacobson S :=
⟨λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e : R →+* S), e.surjective⟩,
  λ h, @is_jacobson_of_surjective _ _ _ _ h ⟨(e.symm : S →+* R), e.symm.surjective⟩⟩

lemma is_jacobson_of_is_integral [algebra R S] (hRS : algebra.is_integral R S)
  (hR : is_jacobson R) : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  introsI P hP,
  by_cases hP_top : comap (algebra_map R S) P = ⊤,
  { simp [comap_eq_top_iff.1 hP_top] },
  { haveI : nontrivial (R ⧸ comap (algebra_map R S) P) := quotient.nontrivial hP_top,
    rw jacobson_eq_iff_jacobson_quotient_eq_bot,
    refine eq_bot_of_comap_eq_bot (is_integral_quotient_of_is_integral hRS) _,
    rw [eq_bot_iff, ← jacobson_eq_iff_jacobson_quotient_eq_bot.1 ((is_jacobson_iff_prime_eq.1 hR)
      (comap (algebra_map R S) P) (comap_is_prime _ _)), comap_jacobson],
    refine Inf_le_Inf (λ J hJ, _),
    simp only [true_and, set.mem_image, bot_le, set.mem_set_of_eq],
    haveI : J.is_maximal, { simpa using hJ },
    exact exists_ideal_over_maximal_of_is_integral (is_integral_quotient_of_is_integral hRS) J
      (comap_bot_le_of_injective _ algebra_map_quotient_injective) }
end

lemma is_jacobson_of_is_integral' (f : R →+* S) (hf : f.is_integral)
  (hR : is_jacobson R) : is_jacobson S :=
@is_jacobson_of_is_integral _ _ _ _ f.to_algebra hf hR

end is_jacobson

section localization
open is_localization submonoid
variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}
variables (y : R) [algebra R S] [is_localization.away y S]

lemma disjoint_powers_iff_not_mem (hI : I.radical = I) :
  disjoint ((submonoid.powers y) : set R) ↑I ↔ y ∉ I.1 :=
begin
  refine ⟨λ h, set.disjoint_left.1 h (mem_powers _), λ h, (disjoint_iff).mpr (eq_bot_iff.mpr _)⟩,
  rintros x ⟨⟨n, rfl⟩, hx'⟩,
  rw [← hI] at hx',
  exact absurd (hI ▸ mem_radical_of_pow_mem hx' : y ∈ I.carrier) h
end

variables (S)

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its comap.
See `le_rel_iso_of_maximal` for the more general relation isomorphism -/
lemma is_maximal_iff_is_maximal_disjoint [H : is_jacobson R] (J : ideal S) :
  J.is_maximal ↔ (comap (algebra_map R S) J).is_maximal ∧ y ∉ ideal.comap (algebra_map R S) J :=
begin
  split,
  { refine λ h, ⟨_, λ hy, h.ne_top (ideal.eq_top_of_is_unit_mem _ hy
      (map_units _ ⟨y, submonoid.mem_powers _⟩))⟩,
    have hJ : J.is_prime := is_maximal.is_prime h,
    rw is_prime_iff_is_prime_disjoint (submonoid.powers y) at hJ,
    have : y ∉ (comap (algebra_map R S) J).1 :=
      set.disjoint_left.1 hJ.right (submonoid.mem_powers _),
    erw [← H.out (is_prime.radical hJ.left), mem_Inf] at this,
    push_neg at this,
    rcases this with ⟨I, hI, hI'⟩,
    convert hI.right,
    by_cases hJ : J = map (algebra_map R S) I,
    { rw [hJ, comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI.right)],
      rwa disjoint_powers_iff_not_mem y (is_maximal.is_prime hI.right).radical },
    { have hI_p : (map (algebra_map R S) I).is_prime,
      { refine is_prime_of_is_prime_disjoint (powers y) _ I hI.right.is_prime _,
        rwa disjoint_powers_iff_not_mem y (is_maximal.is_prime hI.right).radical },
      have : J ≤ map (algebra_map R S) I :=
        (map_comap (submonoid.powers y) S J) ▸ (map_mono hI.left),
      exact absurd (h.1.2 _ (lt_of_le_of_ne this hJ)) hI_p.1 } },
  { refine λ h, ⟨⟨λ hJ, h.1.ne_top (eq_top_iff.2 _), λ I hI, _⟩⟩,
    { rwa [eq_top_iff, ← (is_localization.order_embedding (powers y) S).le_iff_le] at hJ },
    { have := congr_arg (map (algebra_map R S)) (h.1.1.2 _ ⟨comap_mono (le_of_lt hI), _⟩),
      rwa [map_comap (powers y) S I, map_top] at this,
      refine λ hI', hI.right _,
      rw [← map_comap (powers y) S I, ← map_comap (powers y) S J],
      exact map_mono hI' } }
end

variables {S}

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y`.
This lemma gives the correspondence in the particular case of an ideal and its map.
See `le_rel_iso_of_maximal` for the more general statement, and the reverse of this implication -/
lemma is_maximal_of_is_maximal_disjoint [is_jacobson R] (I : ideal R) (hI : I.is_maximal)
  (hy : y ∉ I) : (map (algebra_map R S) I).is_maximal :=
begin
  rw [is_maximal_iff_is_maximal_disjoint S y,
    comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI)
    ((disjoint_powers_iff_not_mem y (is_maximal.is_prime hI).radical).2 hy)],
  exact ⟨hI, hy⟩
end

/-- If `R` is a Jacobson ring, then maximal ideals in the localization at `y`
correspond to maximal ideals in the original ring `R` that don't contain `y` -/
def order_iso_of_maximal [is_jacobson R] :
  {p : ideal S // p.is_maximal} ≃o {p : ideal R // p.is_maximal ∧ y ∉ p} :=
{ to_fun := λ p,
    ⟨ideal.comap (algebra_map R S) p.1, (is_maximal_iff_is_maximal_disjoint S y p.1).1 p.2⟩,
  inv_fun := λ p,
    ⟨ideal.map (algebra_map R S) p.1, is_maximal_of_is_maximal_disjoint y p.1 p.2.1 p.2.2⟩,
  left_inv := λ J, subtype.eq (map_comap (powers y) S J),
  right_inv := λ I, subtype.eq (comap_map_of_is_prime_disjoint _ _ I.1 (is_maximal.is_prime I.2.1)
    ((disjoint_powers_iff_not_mem y I.2.1.is_prime.radical).2 I.2.2)),
  map_rel_iff' := λ I I', ⟨λ h, (show I.val ≤ I'.val,
    from (map_comap (powers y) S I.val) ▸ (map_comap (powers y) S I'.val) ▸ (ideal.map_mono h)),
    λ h x hx, h hx⟩ }

include y

/-- If `S` is the localization of the Jacobson ring `R` at the submonoid generated by `y : R`, then
`S` is Jacobson. -/
lemma is_jacobson_localization [H : is_jacobson R] : is_jacobson S :=
begin
  rw is_jacobson_iff_prime_eq,
  refine λ P' hP', le_antisymm _ le_jacobson,
  obtain ⟨hP', hPM⟩ := (is_localization.is_prime_iff_is_prime_disjoint (powers y) S P').mp hP',
  have hP := H.out (is_prime.radical hP'),
  refine (le_of_eq (is_localization.map_comap (powers y) S P'.jacobson).symm).trans
    ((map_mono _).trans (le_of_eq (is_localization.map_comap (powers y) S P'))),
  have : Inf { I : ideal R | comap (algebra_map R S) P' ≤ I ∧ I.is_maximal ∧ y ∉ I } ≤
    comap (algebra_map R S) P',
  { intros x hx,
    have hxy : x * y ∈ (comap (algebra_map R S) P').jacobson,
    { rw [ideal.jacobson, mem_Inf],
      intros J hJ,
      by_cases y ∈ J,
      { exact J.smul_mem x h },
      { exact (mul_comm y x) ▸ J.smul_mem y ((mem_Inf.1 hx) ⟨hJ.left, ⟨hJ.right, h⟩⟩) } },
    rw hP at hxy,
    cases hP'.mem_or_mem hxy with hxy hxy,
    { exact hxy },
    { exact (hPM ⟨submonoid.mem_powers _, hxy⟩).elim } },
  refine le_trans _ this,
  rw [ideal.jacobson, comap_Inf', Inf_eq_infi],
  refine infi_le_infi_of_subset (λ I hI, ⟨map (algebra_map R S) I, ⟨_, _⟩⟩),
  { exact ⟨le_trans (le_of_eq ((is_localization.map_comap (powers y) S P').symm)) (map_mono hI.1),
    is_maximal_of_is_maximal_disjoint y _ hI.2.1 hI.2.2⟩ },
  { exact is_localization.comap_map_of_is_prime_disjoint _ S I (is_maximal.is_prime hI.2.1)
    ((disjoint_powers_iff_not_mem y hI.2.1.is_prime.radical).2 hI.2.2) }
end

end localization

namespace polynomial
open polynomial

section comm_ring
variables {R S : Type*} [comm_ring R] [comm_ring S] [is_domain S]
variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [comm_ring Sₘ]

/-- If `I` is a prime ideal of `polynomial R` and `pX ∈ I` is a non-constant polynomial,
  then the map `R →+* R[x]/I` descends to an integral map when localizing at `pX.leading_coeff`.
  In particular `X` is integral because it satisfies `pX`, and constants are trivially integral,
  so integrality of the entire extension follows by closure under addition and multiplication. -/
lemma is_integral_is_localization_polynomial_quotient
  (P : ideal (polynomial R)) (pX : polynomial R) (hpX : pX ∈ P)
  [algebra (R ⧸ P.comap (C : R →+* _)) Rₘ]
  [is_localization.away (pX.map (quotient.mk (P.comap C))).leading_coeff Rₘ]
  [algebra (polynomial R ⧸ P) Sₘ]
  [is_localization ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).map
    (quotient_map P C le_rfl) : submonoid (polynomial R ⧸ P)) Sₘ] :
  (is_localization.map Sₘ (quotient_map P C le_rfl)
    ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).le_comap_map) : Rₘ →+* _)
    .is_integral :=
begin
  let P' : ideal R := P.comap C,
  let M : submonoid (R ⧸ P') :=
  submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff,
  let M' : submonoid (polynomial R ⧸ P) :=
  (submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).map (quotient_map P C le_rfl),
  let φ : R ⧸ P' →+* polynomial R ⧸ P := quotient_map P C le_rfl,
  let φ' := is_localization.map Sₘ φ M.le_comap_map,
  have hφ' : φ.comp (quotient.mk P') = (quotient.mk P).comp C := rfl,
  intro p,
  obtain ⟨⟨p', ⟨q, hq⟩⟩, hp⟩ := is_localization.surj M' p,
  suffices : φ'.is_integral_elem (algebra_map _ _ p'),
  { obtain ⟨q', hq', rfl⟩ := hq,
    obtain ⟨q'', hq''⟩ := is_unit_iff_exists_inv'.1 (is_localization.map_units Rₘ (⟨q', hq'⟩ : M)),
    refine φ'.is_integral_of_is_integral_mul_unit p (algebra_map _ _ (φ q')) q'' _ (hp.symm ▸ this),
    convert trans (trans (φ'.map_mul _ _).symm (congr_arg φ' hq'')) φ'.map_one using 2,
    rw [← φ'.comp_apply, is_localization.map_comp, ring_hom.comp_apply, subtype.coe_mk] },
  refine is_integral_of_mem_closure''
    (((algebra_map _ Sₘ).comp (quotient.mk P)) '' (insert X {p | p.degree ≤ 0})) _ _ _,
  { rintros x ⟨p, hp, rfl⟩,
    refine hp.rec_on (λ hy, _) (λ hy, _),
    { refine hy.symm ▸ (φ.is_integral_elem_localization_at_leading_coeff ((quotient.mk P) X)
        (pX.map (quotient.mk P')) _ M ⟨1, pow_one _⟩),
      rwa [eval₂_map, hφ', ← hom_eval₂, quotient.eq_zero_iff_mem, eval₂_C_X] },
    { rw [set.mem_set_of_eq, degree_le_zero_iff] at hy,
      refine hy.symm ▸ ⟨X - C (algebra_map _ _ ((quotient.mk P') (p.coeff 0))), monic_X_sub_C _, _⟩,
      simp only [eval₂_sub, eval₂_C, eval₂_X],
      rw [sub_eq_zero, ← φ'.comp_apply, is_localization.map_comp],
      refl } },
  { obtain ⟨p, rfl⟩ := quotient.mk_surjective p',
    refine polynomial.induction_on p
      (λ r, subring.subset_closure $ set.mem_image_of_mem _ (or.inr degree_C_le))
      (λ _ _ h1 h2, _) (λ n _ hr, _),
    { convert subring.add_mem _ h1 h2,
      rw [ring_hom.map_add, ring_hom.map_add] },
    { rw [pow_succ X n, mul_comm X, ← mul_assoc, ring_hom.map_mul, ring_hom.map_mul],
      exact subring.mul_mem _ hr (subring.subset_closure (set.mem_image_of_mem _ (or.inl rfl))) } },
end

/-- If `f : R → S` descends to an integral map in the localization at `x`,
  and `R` is a Jacobson ring, then the intersection of all maximal ideals in `S` is trivial -/
lemma jacobson_bot_of_integral_localization
  {R : Type*} [comm_ring R] [is_domain R] [is_jacobson R]
  (Rₘ Sₘ : Type*) [comm_ring Rₘ] [comm_ring Sₘ]
  (φ : R →+* S) (hφ : function.injective φ) (x : R) (hx : x ≠ 0)
  [algebra R Rₘ] [is_localization.away x Rₘ]
  [algebra S Sₘ] [is_localization ((submonoid.powers x).map φ : submonoid S) Sₘ]
  (hφ' : ring_hom.is_integral
    (is_localization.map Sₘ φ (submonoid.powers x).le_comap_map : Rₘ →+* Sₘ)) :
  (⊥ : ideal S).jacobson = (⊥ : ideal S) :=
begin
  have hM : ((submonoid.powers x).map φ : submonoid S) ≤ non_zero_divisors S :=
    φ.map_le_non_zero_divisors_of_injective hφ (powers_le_non_zero_divisors_of_no_zero_divisors hx),
  letI : is_domain Sₘ := is_localization.is_domain_of_le_non_zero_divisors _ hM,
  let φ' : Rₘ →+* Sₘ := is_localization.map _ φ (submonoid.powers x).le_comap_map,
  suffices : ∀ I : ideal Sₘ, I.is_maximal → (I.comap (algebra_map S Sₘ)).is_maximal,
  { have hϕ' : comap (algebra_map S Sₘ) (⊥ : ideal Sₘ) = (⊥ : ideal S),
    { rw [← ring_hom.ker_eq_comap_bot, ← ring_hom.injective_iff_ker_eq_bot],
      exact is_localization.injective Sₘ hM },
    have hSₘ : is_jacobson Sₘ := is_jacobson_of_is_integral' φ' hφ' (is_jacobson_localization x),
    refine eq_bot_iff.mpr (le_trans _ (le_of_eq hϕ')),
    rw [← hSₘ.out radical_bot_of_is_domain, comap_jacobson],
    exact Inf_le_Inf (λ j hj, ⟨bot_le, let ⟨J, hJ⟩ := hj in hJ.2 ▸ this J hJ.1.2⟩) },
  introsI I hI,
  -- Remainder of the proof is pulling and pushing ideals around the square and the quotient square
  haveI : (I.comap (algebra_map S Sₘ)).is_prime := comap_is_prime _ I,
  haveI : (I.comap φ').is_prime := comap_is_prime φ' I,
  haveI : (⊥ : ideal (S ⧸ I.comap (algebra_map S Sₘ))).is_prime := bot_prime,
  have hcomm: φ'.comp (algebra_map R Rₘ) = (algebra_map S Sₘ).comp φ := is_localization.map_comp _,
  let f := quotient_map (I.comap (algebra_map S Sₘ)) φ le_rfl,
  let g := quotient_map I (algebra_map S Sₘ) le_rfl,
  have := is_maximal_comap_of_is_integral_of_is_maximal' φ' hφ' I
    (by convert hI; casesI _inst_4; refl),
  have := ((is_maximal_iff_is_maximal_disjoint Rₘ x _).1 this).left,
  have : ((I.comap (algebra_map S Sₘ)).comap φ).is_maximal,
  { rwa [comap_comap, hcomm, ← comap_comap] at this },
  rw ← bot_quotient_is_maximal_iff at this ⊢,
  refine is_maximal_of_is_integral_of_is_maximal_comap' f _ ⊥
    ((eq_bot_iff.2 (comap_bot_le_of_injective f quotient_map_injective)).symm ▸ this),
  exact f.is_integral_tower_bot_of_is_integral g quotient_map_injective
    ((comp_quotient_map_eq_of_comp_eq hcomm I).symm ▸
    (ring_hom.is_integral_trans _ _ (ring_hom.is_integral_of_surjective _
      (is_localization.surjective_quotient_map_of_maximal_of_localization (submonoid.powers x) Rₘ
      (by rwa [comap_comap, hcomm, ← bot_quotient_is_maximal_iff])))
      (ring_hom.is_integral_quotient_of_is_integral _ hφ'))),
end

/-- Used to bootstrap the proof of `is_jacobson_polynomial_iff_is_jacobson`.
  That theorem is more general and should be used instead of this one. -/
private lemma is_jacobson_polynomial_of_domain
  (R : Type*) [comm_ring R] [is_domain R] [hR : is_jacobson R]
  (P : ideal (polynomial R)) [is_prime P] (hP : ∀ (x : R), C x ∈ P → x = 0) :
  P.jacobson = P :=
begin
  by_cases Pb : P = ⊥,
  { exact Pb.symm ▸ jacobson_bot_polynomial_of_jacobson_bot
      (hR.out radical_bot_of_is_domain) },
  { rw jacobson_eq_iff_jacobson_quotient_eq_bot,
    haveI : (P.comap (C : R →+* polynomial R)).is_prime := comap_is_prime C P,
    obtain ⟨p, pP, p0⟩ := exists_nonzero_mem_of_ne_bot Pb hP,
    let x := (polynomial.map (quotient.mk (comap (C : R →+* _) P)) p).leading_coeff,
    have hx : x ≠ 0 := by rwa [ne.def, leading_coeff_eq_zero],
    refine jacobson_bot_of_integral_localization
      (localization.away x)
      (localization ((submonoid.powers x).map (P.quotient_map C le_rfl) :
        submonoid (polynomial R ⧸ P)))
      (quotient_map P C le_rfl) quotient_map_injective
      x hx
      _,
    -- `convert` is noticeably faster than `exact` here:
    convert is_integral_is_localization_polynomial_quotient P p pP }
end

lemma is_jacobson_polynomial_of_is_jacobson (hR : is_jacobson R) :
  is_jacobson (polynomial R) :=
begin
  refine is_jacobson_iff_prime_eq.mpr (λ I, _),
  introI hI,
  let R' : subring (polynomial R ⧸ I) := ((quotient.mk I).comp C).range,
  let i : R →+* R' := ((quotient.mk I).comp C).range_restrict,
  have hi : function.surjective (i : R → R') := ((quotient.mk I).comp C).range_restrict_surjective,
  have hi' : (polynomial.map_ring_hom i : polynomial R →+* polynomial R').ker ≤ I,
  { refine λ f hf, polynomial_mem_ideal_of_coeff_mem_ideal I f (λ n, _),
    replace hf := congr_arg (λ (g : polynomial (((quotient.mk I).comp C).range)), g.coeff n) hf,
    change (polynomial.map ((quotient.mk I).comp C).range_restrict f).coeff n = 0 at hf,
    rw [coeff_map, subtype.ext_iff] at hf,
    rwa [mem_comap, ← quotient.eq_zero_iff_mem, ← ring_hom.comp_apply], },
  haveI : (ideal.map (map_ring_hom i) I).is_prime :=
    map_is_prime_of_surjective (map_surjective i hi) hi',
  suffices : (I.map (polynomial.map_ring_hom i)).jacobson = (I.map (polynomial.map_ring_hom i)),
  { replace this := congr_arg (comap (polynomial.map_ring_hom i)) this,
    rw [← map_jacobson_of_surjective _ hi',
      comap_map_of_surjective _ _, comap_map_of_surjective _ _] at this,
    refine le_antisymm (le_trans (le_sup_of_le_left le_rfl)
      (le_trans (le_of_eq this) (sup_le le_rfl hi'))) le_jacobson,
    all_goals {exact polynomial.map_surjective i hi} },
  exact @is_jacobson_polynomial_of_domain R' _ _ (is_jacobson_of_surjective ⟨i, hi⟩)
    (map (map_ring_hom i) I) _ (eq_zero_of_polynomial_mem_map_range I),
end

theorem is_jacobson_polynomial_iff_is_jacobson :
  is_jacobson (polynomial R) ↔ is_jacobson R :=
begin
  refine ⟨_, is_jacobson_polynomial_of_is_jacobson⟩,
  introI H,
  exact is_jacobson_of_surjective ⟨eval₂_ring_hom (ring_hom.id _) 1, λ x,
    ⟨C x, by simp only [coe_eval₂_ring_hom, ring_hom.id_apply, eval₂_C]⟩⟩,
end

instance [is_jacobson R] : is_jacobson (polynomial R) :=
is_jacobson_polynomial_iff_is_jacobson.mpr ‹is_jacobson R›

end comm_ring

section
variables {R : Type*} [comm_ring R] [is_jacobson R]
variables (P : ideal (polynomial R)) [hP : P.is_maximal]

include P hP

lemma is_maximal_comap_C_of_is_maximal [nontrivial R] (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  is_maximal (comap C P : ideal R) :=
begin
  haveI hp'_prime : (P.comap C : ideal R).is_prime := comap_is_prime C P,
  obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_of_maximal P polynomial_not_is_field),
  have : (m : polynomial R) ≠ 0, rwa [ne.def, submodule.coe_eq_zero],
  let φ : R ⧸ P.comap C →+* polynomial R ⧸ P := quotient_map P C le_rfl,
  let M : submonoid (R ⧸ P.comap C) :=
    submonoid.powers ((m : polynomial R).map (quotient.mk (P.comap C : ideal R))).leading_coeff,
  rw ← bot_quotient_is_maximal_iff,
  have hp0 : ((m : polynomial R).map (quotient.mk (P.comap C : ideal R))).leading_coeff ≠ 0 :=
    λ hp0', this $ map_injective (quotient.mk (P.comap C : ideal R))
      ((quotient.mk (P.comap C : ideal R)).injective_iff.2 (λ x hx,
      by rwa [quotient.eq_zero_iff_mem, (by rwa eq_bot_iff : (P.comap C : ideal R) = ⊥)] at hx))
      (by simpa only [leading_coeff_eq_zero, polynomial.map_zero] using hp0'),
  have hM : (0 : R ⧸ P.comap C) ∉ M := λ ⟨n, hn⟩, hp0 (pow_eq_zero hn),
  suffices : (⊥ : ideal (localization M)).is_maximal,
  { rw ← is_localization.comap_map_of_is_prime_disjoint M (localization M) ⊥ bot_prime
        (λ x hx, hM (hx.2 ▸ hx.1)),
    refine ((is_maximal_iff_is_maximal_disjoint (localization M) _ _).mp (by rwa map_bot)).1,
    swap, exact localization.is_localization },
  let M' : submonoid (polynomial R ⧸ P) := M.map φ,
  have hM' : (0 : polynomial R ⧸ P) ∉ M' :=
    λ ⟨z, hz⟩, hM (quotient_map_injective (trans hz.2 φ.map_zero.symm) ▸ hz.1),
  haveI : is_domain (localization M') :=
    is_localization.is_domain_localization (le_non_zero_divisors_of_no_zero_divisors hM'),
  suffices : (⊥ : ideal (localization M')).is_maximal,
  { rw le_antisymm bot_le (comap_bot_le_of_injective _ (is_localization.map_injective_of_injective
      M (localization M) (localization M')
      quotient_map_injective (le_non_zero_divisors_of_no_zero_divisors hM'))),
    refine is_maximal_comap_of_is_integral_of_is_maximal' _ _ ⊥ this,
    apply is_integral_is_localization_polynomial_quotient P _ (submodule.coe_mem m) },
  rw (map_bot.symm : (⊥ : ideal (localization M')) =
                     map (algebra_map (polynomial R ⧸ P) (localization M')) ⊥),
  let bot_maximal := ((bot_quotient_is_maximal_iff _).mpr hP),
  refine map.is_maximal (algebra_map _ _) (localization_map_bijective_of_field hM' _) bot_maximal,
  rwa [← quotient.maximal_ideal_iff_is_field_quotient, ← bot_quotient_is_maximal_iff],
end

/-- Used to bootstrap the more general `quotient_mk_comp_C_is_integral_of_jacobson` -/
private lemma quotient_mk_comp_C_is_integral_of_jacobson' [nontrivial R] (hR : is_jacobson R)
  (hP' : ∀ (x : R), C x ∈ P → x = 0) :
  ((quotient.mk P).comp C : R →+* polynomial R ⧸ P).is_integral :=
begin
  refine (is_integral_quotient_map_iff _).mp _,
  let P' : ideal R := P.comap C,
  obtain ⟨pX, hpX, hp0⟩ :=
    exists_nonzero_mem_of_ne_bot (ne_of_lt (bot_lt_of_maximal P polynomial_not_is_field)).symm hP',
  let M : submonoid (R ⧸ P') := submonoid.powers (pX.map (quotient.mk P')).leading_coeff,
  let φ : R ⧸ P' →+* polynomial R ⧸ P := quotient_map P C le_rfl,
  haveI hp'_prime : P'.is_prime := comap_is_prime C P,
  have hM : (0 : R ⧸ P') ∉ M := λ ⟨n, hn⟩, hp0 $ leading_coeff_eq_zero.mp (pow_eq_zero hn),
  let M' : submonoid (polynomial R ⧸ P) := M.map (quotient_map P C le_rfl),
  refine ((quotient_map P C le_rfl).is_integral_tower_bot_of_is_integral
    (algebra_map _ (localization M')) _ _),
  { refine is_localization.injective (localization M')
      (show M' ≤ _, from le_non_zero_divisors_of_no_zero_divisors (λ hM', hM _)),
    exact (let ⟨z, zM, z0⟩ := hM' in (quotient_map_injective (trans z0 φ.map_zero.symm)) ▸ zM) },
  { rw ← is_localization.map_comp M.le_comap_map,
    refine ring_hom.is_integral_trans (algebra_map (R ⧸ P') (localization M))
      (is_localization.map _ _ M.le_comap_map) _ _,
    { exact (algebra_map (R ⧸ P') (localization M)).is_integral_of_surjective
        (localization_map_bijective_of_field hM
          ((quotient.maximal_ideal_iff_is_field_quotient _).mp
          (is_maximal_comap_C_of_is_maximal P hP'))).2 },
    { -- `convert` here is faster than `exact`, and this proof is near the time limit.
      convert is_integral_is_localization_polynomial_quotient P pX hpX } }
end

/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `polynomial R`,
  then `R → (polynomial R)/P` is an integral map. -/
lemma quotient_mk_comp_C_is_integral_of_jacobson :
  ((quotient.mk P).comp C : R →+* polynomial R ⧸ P).is_integral :=
begin
  let P' : ideal R := P.comap C,
  haveI : P'.is_prime := comap_is_prime C P,
  let f : polynomial R →+* polynomial (R ⧸ P') := polynomial.map_ring_hom (quotient.mk P'),
  have hf : function.surjective f := map_surjective (quotient.mk P') quotient.mk_surjective,
  have hPJ : P = (P.map f).comap f,
  { rw comap_map_of_surjective _ hf,
    refine le_antisymm (le_sup_of_le_left le_rfl) (sup_le le_rfl _),
    refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
    simpa only [coeff_map, coe_map_ring_hom] using (polynomial.ext_iff.mp hp) n },
  refine ring_hom.is_integral_tower_bot_of_is_integral _ _ (injective_quotient_le_comap_map P) _,
  rw ← quotient_mk_maps_eq,
  refine ring_hom.is_integral_trans _ _
    ((quotient.mk P').is_integral_of_surjective quotient.mk_surjective) _,
  apply quotient_mk_comp_C_is_integral_of_jacobson' _ _ (λ x hx, _),
  any_goals { exact ideal.is_jacobson_quotient },
  { exact or.rec_on (map_eq_top_or_is_maximal_of_surjective f hf hP)
    (λ h, absurd (trans (h ▸ hPJ : P = comap f ⊤) comap_top : P = ⊤) hP.ne_top) id },
  { apply_instance, },
  { obtain ⟨z, rfl⟩ := quotient.mk_surjective x,
    rwa [quotient.eq_zero_iff_mem, mem_comap, hPJ, mem_comap, coe_map_ring_hom, map_C] }
end

lemma is_maximal_comap_C_of_is_jacobson :
  (P.comap (C : R →+* polynomial R)).is_maximal :=
begin
  rw [← @mk_ker _ _ P, ring_hom.ker_eq_comap_bot, comap_comap],
  exact is_maximal_comap_of_is_integral_of_is_maximal' _
    (quotient_mk_comp_C_is_integral_of_jacobson P) ⊥ ((bot_quotient_is_maximal_iff _).mpr hP),
end

omit P hP

lemma comp_C_integral_of_surjective_of_jacobson
  {S : Type*} [field S] (f : (polynomial R) →+* S) (hf : function.surjective f) :
  (f.comp C).is_integral :=
begin
  haveI : (f.ker).is_maximal := f.ker_is_maximal_of_surjective hf,
  let g : polynomial R ⧸ f.ker →+* S := ideal.quotient.lift f.ker f (λ _ h, h),
  have hfg : (g.comp (quotient.mk f.ker)) = f := ring_hom_ext' rfl rfl,
  rw [← hfg, ring_hom.comp_assoc],
  refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f.ker)
    (g.is_integral_of_surjective _), --(quotient.lift_surjective f.ker f _ hf)),
  rw [← hfg] at hf,
  exact function.surjective.of_comp hf,
end

end

end polynomial

open mv_polynomial ring_hom

namespace mv_polynomial

lemma is_jacobson_mv_polynomial_fin {R : Type*} [comm_ring R] [H : is_jacobson R] :
  ∀ (n : ℕ), is_jacobson (mv_polynomial (fin n) R)
| 0 := ((is_jacobson_iso ((rename_equiv R
  (equiv.equiv_pempty (fin 0))).to_ring_equiv.trans (is_empty_ring_equiv R pempty))).mpr H)
| (n+1) := (is_jacobson_iso (fin_succ_equiv R n).to_ring_equiv).2
  (polynomial.is_jacobson_polynomial_iff_is_jacobson.2 (is_jacobson_mv_polynomial_fin n))

/-- General form of the nullstellensatz for Jacobson rings, since in a Jacobson ring we have
  `Inf {P maximal | P ≥ I} = Inf {P prime | P ≥ I} = I.radical`. Fields are always Jacobson,
  and in that special case this is (most of) the classical Nullstellensatz,
  since `I(V(I))` is the intersection of maximal ideals containing `I`, which is then `I.radical` -/
instance {R : Type*} [comm_ring R] {ι : Type*} [fintype ι] [is_jacobson R] :
  is_jacobson (mv_polynomial ι R) :=
begin
  haveI := classical.dec_eq ι,
  let e := fintype.equiv_fin ι,
  rw is_jacobson_iso (rename_equiv R e).to_ring_equiv,
  exact is_jacobson_mv_polynomial_fin _
end

variables {n : ℕ}

lemma quotient_mk_comp_C_is_integral_of_jacobson
  {R : Type*} [comm_ring R] [is_jacobson R]
  (P : ideal (mv_polynomial (fin n) R)) [P.is_maximal] :
  ((quotient.mk P).comp mv_polynomial.C : R →+* mv_polynomial _ R ⧸ P).is_integral :=
begin
  unfreezingI {induction n with n IH},
  { refine ring_hom.is_integral_of_surjective _ (function.surjective.comp quotient.mk_surjective _),
    exact C_surjective (fin 0) },
  { rw [← fin_succ_equiv_comp_C_eq_C, ← ring_hom.comp_assoc, ← ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc (polynomial.C),
      ← quotient_map_comp_mk le_rfl, ring_hom.comp_assoc, ring_hom.comp_assoc,
      ← quotient_map_comp_mk le_rfl, ← ring_hom.comp_assoc (quotient.mk _)],
    refine ring_hom.is_integral_trans _ _ _ _,
    { refine ring_hom.is_integral_trans _ _ (is_integral_of_surjective _ quotient.mk_surjective) _,
      refine ring_hom.is_integral_trans _ _ _ _,
      { apply (is_integral_quotient_map_iff _).mpr (IH _),
        apply polynomial.is_maximal_comap_C_of_is_jacobson _,
        { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
        { apply comap_is_maximal_of_surjective,
          exact (fin_succ_equiv R n).symm.surjective } },
      { refine (is_integral_quotient_map_iff _).mpr _,
        rw ← quotient_map_comp_mk le_rfl,
        refine ring_hom.is_integral_trans _ _ _ ((is_integral_quotient_map_iff _).mpr _),
        { exact ring_hom.is_integral_of_surjective _ quotient.mk_surjective },
        { apply polynomial.quotient_mk_comp_C_is_integral_of_jacobson _,
          { exact mv_polynomial.is_jacobson_mv_polynomial_fin n },
          { exact comap_is_maximal_of_surjective _ (fin_succ_equiv R n).symm.surjective } } } },
    { refine (is_integral_quotient_map_iff _).mpr _,
      refine ring_hom.is_integral_trans _ _ _ (is_integral_of_surjective _ quotient.mk_surjective),
      exact ring_hom.is_integral_of_surjective _ (fin_succ_equiv R n).symm.surjective } }
end

lemma comp_C_integral_of_surjective_of_jacobson
  {R : Type*} [comm_ring R] [is_jacobson R]
  {σ : Type*} [fintype σ] {S : Type*} [field S] (f : mv_polynomial σ R →+* S)
  (hf : function.surjective f) : (f.comp C).is_integral :=
begin
  haveI := classical.dec_eq σ,
  obtain ⟨e⟩ := fintype.trunc_equiv_fin σ,
  let f' : mv_polynomial (fin _) R →+* S :=
    f.comp (rename_equiv R e.symm).to_ring_equiv.to_ring_hom,
  have hf' : function.surjective f' :=
    ((function.surjective.comp hf (rename_equiv R e.symm).surjective)),
  have : (f'.comp C).is_integral,
  { haveI : (f'.ker).is_maximal := f'.ker_is_maximal_of_surjective hf',
    let g : mv_polynomial _ R ⧸ f'.ker →+* S := ideal.quotient.lift f'.ker f' (λ _ h, h),
    have hfg : (g.comp (quotient.mk f'.ker)) = f' := ring_hom_ext (λ r, rfl) (λ i, rfl),
    rw [← hfg, ring_hom.comp_assoc],
    refine ring_hom.is_integral_trans _ g (quotient_mk_comp_C_is_integral_of_jacobson f'.ker)
      (g.is_integral_of_surjective _),
    rw ← hfg at hf',
    exact function.surjective.of_comp hf' },
  rw ring_hom.comp_assoc at this,
  convert this,
  refine ring_hom.ext (λ x, _),
  exact ((rename_equiv R e.symm).commutes' x).symm,
end

end mv_polynomial

end ideal


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach, Joël Riou
-/
import category_theory.comm_sq

/-!
# Lifting properties

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

This file defines the lifting property of two morphisms in a category and
shows basic properties of this notion.

## Main results
- `has_lifting_property`: the definition of the lifting property

## Tags
lifting property

@TODO :
1) define llp/rlp with respect to a `morphism_property`
2) retracts, direct/inverse images, (co)products, adjunctions

-/

universe v

namespace category_theory

open category

variables {C : Type*} [category C] {A B B' X Y Y' : C}
  (i : A ⟶ B) (i' : B ⟶ B') (p : X ⟶ Y) (p' : Y ⟶ Y')

/-- `has_lifting_property i p` means that `i` has the left lifting
property with respect to `p`, or equivalently that `p` has
the right lifting property with respect to `i`. -/
class has_lifting_property : Prop :=
(sq_has_lift : ∀ {f : A ⟶ X} {g : B ⟶ Y} (sq : comm_sq f i p g), sq.has_lift)

@[priority 100]
instance sq_has_lift_of_has_lifting_property {f : A ⟶ X} {g : B ⟶ Y} (sq : comm_sq f i p g)
  [hip : has_lifting_property i p] : sq.has_lift := by apply hip.sq_has_lift

namespace has_lifting_property

variables {i p}

lemma op (h : has_lifting_property i p) : has_lifting_property p.op i.op :=
⟨λ f g sq, begin
  simp only [comm_sq.has_lift.iff_unop, quiver.hom.unop_op],
  apply_instance,
end⟩

lemma unop {A B X Y : Cᵒᵖ} {i : A ⟶ B} {p : X ⟶ Y}
  (h : has_lifting_property i p) : has_lifting_property p.unop i.unop :=
⟨λ f g sq, begin
  rw comm_sq.has_lift.iff_op,
  simp only [quiver.hom.op_unop],
  apply_instance,
end⟩

lemma iff_op : has_lifting_property i p ↔ has_lifting_property p.op i.op := ⟨op, unop⟩

lemma iff_unop {A B X Y : Cᵒᵖ} (i : A ⟶ B) (p : X ⟶ Y) :
  has_lifting_property i p ↔ has_lifting_property p.unop i.unop := ⟨unop, op⟩

variables (i p)

@[priority 100]
instance of_left_iso [is_iso i] : has_lifting_property i p :=
⟨λ f g sq, comm_sq.has_lift.mk'
  { l := inv i ≫ f,
    fac_left' := by simp only [is_iso.hom_inv_id_assoc],
    fac_right' := by simp only [sq.w, assoc, is_iso.inv_hom_id_assoc], }⟩

@[priority 100]
instance of_right_iso [is_iso p] : has_lifting_property i p :=
⟨λ f g sq, comm_sq.has_lift.mk'
  { l := g ≫ inv p,
    fac_left' := by simp only [← sq.w_assoc, is_iso.hom_inv_id, comp_id],
    fac_right' := by simp only [assoc, is_iso.inv_hom_id, comp_id], }⟩

instance of_comp_left [has_lifting_property i p] [has_lifting_property i' p] :
  has_lifting_property (i ≫ i') p :=
⟨λ f g sq, begin
  have fac := sq.w,
  rw assoc at fac,
  exact comm_sq.has_lift.mk'
    { l := (comm_sq.mk (comm_sq.mk fac).fac_right).lift,
      fac_left' := by simp only [assoc, comm_sq.fac_left],
      fac_right' := by simp only [comm_sq.fac_right], },
end⟩

instance of_comp_right [has_lifting_property i p] [has_lifting_property i p'] :
  has_lifting_property i (p ≫ p') :=
⟨λ f g sq, begin
  have fac := sq.w,
  rw ← assoc at fac,
  let sq₂ := (comm_sq.mk ((comm_sq.mk fac).fac_left.symm)).lift,
  exact comm_sq.has_lift.mk'
    { l := (comm_sq.mk ((comm_sq.mk fac).fac_left.symm)).lift,
      fac_left' := by simp only [comm_sq.fac_left],
      fac_right' := by simp only [comm_sq.fac_right_assoc, comm_sq.fac_right], },
end⟩

lemma of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'}
  (e : arrow.mk i ≅ arrow.mk i') (p : X ⟶ Y)
  [hip : has_lifting_property i p] : has_lifting_property i' p :=
by { rw arrow.iso_w' e, apply_instance, }

lemma of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'}
  (e : arrow.mk p ≅ arrow.mk p')
  [hip : has_lifting_property i p] : has_lifting_property i p' :=
by { rw arrow.iso_w' e, apply_instance, }

lemma iff_of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'}
  (e : arrow.mk i ≅ arrow.mk i') (p : X ⟶ Y) :
  has_lifting_property i p ↔ has_lifting_property i' p :=
by { split; introI, exacts [of_arrow_iso_left e p, of_arrow_iso_left e.symm p], }

lemma iff_of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'}
  (e : arrow.mk p ≅ arrow.mk p') :
  has_lifting_property i p ↔ has_lifting_property i p' :=
by { split; introI, exacts [of_arrow_iso_right i e, of_arrow_iso_right i e.symm], }

end has_lifting_property

end category_theory