/-
Copyright (c) 2022 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca
-/
import data.nat.choose.dvd
import ring_theory.integrally_closed
import ring_theory.norm
import ring_theory.polynomial.cyclotomic.basic

/-!
# Eisenstein polynomials
In this file we gather more miscellaneous results about Eisenstein polynomials

## Main results
* `mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at`: let `K` be the field of fraction
  of an integrally closed domain `R` and let `L` be a separable extension of `K`, generated by an
  integral power basis `B` such that the minimal polynomial of `B.gen` is Eisenstein at `p`. Given
  `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`, then `z ∈ adjoin R {B.gen}`.
  Together with `algebra.discr_mul_is_integral_mem_adjoin` this result often allows to compute the
  ring of integers of `L`.

-/

universes u v w z

variables {R : Type u}

open ideal algebra finset

open_locale big_operators polynomial

section cyclotomic

variables (p : ℕ)

local notation `𝓟` := submodule.span ℤ {p}

open polynomial

lemma cyclotomic_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] :
  ((cyclotomic p ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
begin
  refine monic.is_eisenstein_at_of_mem_of_not_mem _
    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
    nat.prime_iff_prime_int.1 hp.out) (λ i hi, _) _,
  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
    refine ((cyclotomic.monic p ℤ).comp (monic_X_add_C 1) (λ h, _)),
    rw [nat_degree_X_add_C] at h,
    exact zero_ne_one h.symm },
  { rw [cyclotomic_prime, geom_sum_X_comp_X_add_one_eq_sum, ← lcoeff_apply,
      linear_map.map_sum],
    conv { congr, congr, skip, funext,
      rw [lcoeff_apply, ← C_eq_nat_cast, C_mul_X_pow_eq_monomial, coeff_monomial] },
    rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C, mul_one,
      nat_degree_cyclotomic, nat.totient_prime hp.out] at hi,
    simp only [hi.trans_le (nat.sub_le _ _), sum_ite_eq', mem_range, if_true,
      ideal.submodule_span_eq, ideal.mem_span_singleton, int.coe_nat_dvd],
    exact hp.out.dvd_choose_self i.succ_ne_zero (lt_tsub_iff_right.1 hi) },
  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime, eval_add, eval_X,
      eval_one, zero_add, eval_geom_sum, one_geom_sum,
      ideal.submodule_span_eq, ideal.span_singleton_pow, ideal.mem_span_singleton],
    intro h,
    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
    rw [← mul_assoc, mul_one, mul_assoc] at hk,
    nth_rewrite 0 [← nat.mul_one p] at hk,
    rw [mul_right_inj' hp.out.ne_zero] at hk,
    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
end

lemma cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] (n : ℕ) :
  ((cyclotomic (p ^ (n + 1)) ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
begin
  refine monic.is_eisenstein_at_of_mem_of_not_mem _
    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
    nat.prime_iff_prime_int.1 hp.out) _ _,
  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
    refine ((cyclotomic.monic _ ℤ).comp (monic_X_add_C 1) (λ h, _)),
    rw [nat_degree_X_add_C] at h,
    exact zero_ne_one h.symm },
  { induction n with n hn,
    { intros i hi,
      rw [zero_add, pow_one] at hi ⊢,
      exact (cyclotomic_comp_X_add_one_is_eisenstein_at p).mem hi },
    { intros i hi,
      rw [ideal.submodule_span_eq, ideal.mem_span_singleton, ← zmod.int_coe_zmod_eq_zero_iff_dvd,
        ← int.coe_cast_ring_hom, ← coeff_map, map_comp, map_cyclotomic, polynomial.map_add, map_X,
        polynomial.map_one, pow_add, pow_one, cyclotomic_mul_prime_dvd_eq_pow, pow_comp,
        ← zmod.expand_card, coeff_expand hp.out.pos],
      { simp only [ite_eq_right_iff],
        rintro ⟨k, hk⟩,
        rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C,
          mul_one, nat_degree_cyclotomic, nat.totient_prime_pow hp.out (nat.succ_pos _),
          nat.succ_sub_one] at hn hi,
        rw [hk, pow_succ, mul_assoc] at hi,
        rw [hk, mul_comm, nat.mul_div_cancel _ hp.out.pos],
        replace hn := hn (lt_of_mul_lt_mul_left' hi),
        rw [ideal.submodule_span_eq, ideal.mem_span_singleton,
          ← zmod.int_coe_zmod_eq_zero_iff_dvd, ← int.coe_cast_ring_hom, ← coeff_map] at hn,
        simpa [map_comp] using hn },
      { exact ⟨p ^ n, by rw [pow_succ]⟩ } } },
  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime_pow_eq_geom_sum hp.out, eval_add,
      eval_X, eval_one, zero_add, eval_finset_sum],
    simp only [eval_pow, eval_X, one_pow, sum_const, card_range, nat.smul_one_eq_coe,
      submodule_span_eq, ideal.submodule_span_eq,
      ideal.span_singleton_pow, ideal.mem_span_singleton],
    intro h,
    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
    rw [← mul_assoc, mul_one, mul_assoc] at hk,
    nth_rewrite 0 [← nat.mul_one p] at hk,
    rw [mul_right_inj' hp.out.ne_zero] at hk,
    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
end

end cyclotomic

section is_integral

variables {K : Type v} {L : Type z} {p : R} [comm_ring R] [field K] [field L]
variables [algebra K L] [algebra R L] [algebra R K] [is_scalar_tower R K L] [is_separable K L]
variables [is_domain R] [is_fraction_ring R K] [is_integrally_closed R]

local notation `𝓟` := submodule.span R {p}

open is_integrally_closed power_basis nat polynomial is_scalar_tower

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `Q : R[X]` is such that
`aeval B.gen Q = p • z`, then `p ∣ Q.coeff 0`. -/
lemma dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {z : L} {Q : R[X]}
  (hQ : aeval B.gen Q = p • z) (hzint : is_integral R z)
  (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) : p ∣ Q.coeff 0 :=
begin
  -- First define some abbreviations.
  letI := B.finite_dimensional,
  let P := minpoly R B.gen,
  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
  have finrank_K_L : finite_dimensional.finrank K L = B.dim := B.finrank,
  have deg_K_P : (minpoly K B.gen).nat_degree = B.dim := B.nat_degree_minpoly,
  have deg_R_P : P.nat_degree = B.dim,
  { rw [← deg_K_P, minpoly.is_integrally_closed_eq_field_fractions' K hBint,
        (minpoly.monic hBint).nat_degree_map (algebra_map R K)] },
  choose! f hf using hei.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
    (minpoly.aeval R B.gen) (minpoly.monic hBint),
  simp only [(minpoly.monic hBint).nat_degree_map, deg_R_P] at hf,

  -- The Eisenstein condition shows that `p` divides `Q.coeff 0`
  -- if `p^n.succ` divides the following multiple of `Q.coeff 0^n.succ`:
  suffices : p ^ n.succ ∣
    (Q.coeff 0 ^ n.succ * ((-1) ^ (n.succ * n) * (minpoly R B.gen).coeff 0 ^ n)),
  { have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
      hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
    refine prime.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd hp ((_ : _ ^ n.succ ∣ _)) hndiv,
    convert (is_unit.dvd_mul_right ⟨(-1) ^ (n.succ * n), rfl⟩).mpr this using 1,
    push_cast,
    ring_nf, simp [pow_right_comm _ _ 2] },

  -- We claim the quotient of `Q^n * _` by `p^n` is the following `r`:
  have aux : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0, B.dim ≤ i + n,
  { intros i hi,
    simp only [mem_range, mem_erase] at hi,
    rw [hn],
    exact le_add_pred_of_pos _ hi.1 },
  have hintsum : is_integral R (z * B.gen ^ n -
    ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0, Q.coeff x • f (x + n)),
  { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
      (is_integral.sum _ (λ i hi, (is_integral_smul _ _))),
    exact adjoin_le_integral_closure hBint (hf _ (aux i hi)).1 },
  obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
  use r,

  -- Do the computation in `K` so we can work in terms of `z` instead of `r`.
  apply is_fraction_ring.injective R K,
  simp only [_root_.map_mul, _root_.map_pow, _root_.map_neg, _root_.map_one],
  -- Both sides are actually norms:
  calc _ = norm K (Q.coeff 0 • B.gen ^ n) : _
  ... = norm K (p • (z * B.gen ^ n) - ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
          p • Q.coeff x • f (x + n))
    : congr_arg (norm K) (eq_sub_of_add_eq _)
  ... = _ : _,
  { simp only [algebra.smul_def, algebra_map_apply R K L, algebra.norm_algebra_map, _root_.map_mul,
      _root_.map_pow, finrank_K_L, power_basis.norm_gen_eq_coeff_zero_minpoly,
      minpoly.is_integrally_closed_eq_field_fractions' K hBint, coeff_map, ← hn],
    ring_exp },
  swap, { simp_rw [← smul_sum, ← smul_sub, algebra.smul_def p, algebra_map_apply R K L,
      _root_.map_mul, algebra.norm_algebra_map, finrank_K_L, hr, ← hn] },

  calc _ = (Q.coeff 0 • 1 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
              Q.coeff x • B.gen ^ x) * B.gen ^ n : _
  ... = (Q.coeff 0 • B.gen ^ 0 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
              Q.coeff x • B.gen ^ x) * B.gen ^ n : by rw pow_zero
  ... = (aeval B.gen Q) * B.gen ^ n : _
  ... = _ : by rw [hQ, algebra.smul_mul_assoc],
  { have : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0,
      Q.coeff i • (B.gen ^ i * B.gen ^ n) =
      p • Q.coeff i • f (i + n),
    { intros i hi,
      rw [←pow_add, ←(hf _ (aux i hi)).2, ←algebra.smul_def, smul_smul, mul_comm _ p, smul_smul] },
    simp only [add_mul, smul_mul_assoc, one_mul, sum_mul, sum_congr rfl this] },
  { rw [aeval_eq_sum_range,
        finset.add_sum_erase (range (Q.nat_degree + 1)) (λ i, Q.coeff i • B.gen ^ i)],
    simp },
end

lemma mem_adjoin_of_dvd_coeff_of_dvd_aeval {A B : Type*} [comm_semiring A] [comm_ring B]
  [algebra A B] [no_zero_smul_divisors A B] {Q : A[X]} {p : A} {x z : B} (hp : p ≠ 0)
  (hQ : ∀ i ∈ range (Q.nat_degree + 1), p ∣ Q.coeff i) (hz : aeval x Q = p • z) :
  z ∈ adjoin A ({x} : set B) :=
begin
  choose! f hf using hQ,
  rw [aeval_eq_sum_range, sum_range] at hz,
  conv_lhs at hz { congr, skip, funext,
    rw [hf i (mem_range.2 (fin.is_lt i)), ← smul_smul] },
  rw [← smul_sum] at hz,
  rw [← smul_right_injective _ hp hz],
  exact subalgebra.sum_mem _ (λ _ _, subalgebra.smul_mem _
    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _) _)
end

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p • z ∈ adjoin R {B.gen}`, then
`z ∈ adjoin R {B.gen}`. -/
lemma mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {z : L} (hzint : is_integral R z)
  (hz : p • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
  z ∈ adjoin R ({B.gen} : set L) :=
begin
  -- First define some abbreviations.
  have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
    hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
  letI := finite_dimensional B,
  set P := minpoly R B.gen with hP,
  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
  haveI : no_zero_smul_divisors R L := no_zero_smul_divisors.trans R K L,
  let P₁ := P.map (algebra_map R L),

  -- There is a polynomial `Q` such that `p • z = aeval B.gen Q`. We can assume that
  -- `Q.degree < P.degree` and `Q ≠ 0`.
  rw [adjoin_singleton_eq_range_aeval] at hz,
  obtain ⟨Q₁, hQ⟩ := hz,
  set Q := Q₁ %ₘ P with hQ₁,
  replace hQ : aeval B.gen Q = p • z,
  { rw [← mod_by_monic_add_div Q₁ (minpoly.monic hBint)] at hQ,
    simpa using hQ },
  by_cases hQzero : Q = 0,
  { simp only [hQzero, algebra.smul_def, zero_eq_mul, aeval_zero] at hQ,
    cases hQ with H H₁,
    { have : function.injective (algebra_map R L),
      { rw [algebra_map_eq R K L],
        exact (algebra_map K L).injective.comp (is_fraction_ring.injective R K) },      exfalso,
      exact hp.ne_zero ((injective_iff_map_eq_zero _).1 this _ H) },
    { rw [H₁],
      exact subalgebra.zero_mem _ } },

  -- It is enough to prove that all coefficients of `Q` are divisible by `p`, by induction.
  -- The base case is `dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at`.
  refine mem_adjoin_of_dvd_coeff_of_dvd_aeval hp.ne_zero (λ i, _) hQ,
  refine nat.case_strong_induction_on i _ (λ j hind, _),
  { intro H,
    exact dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at
      hp hBint hQ hzint hei },
  { intro hj,
    refine hp.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd _ hndiv,
    exact n,

    -- Two technical results we will need about `P.nat_degree` and `Q.nat_degree`.
    have H := degree_mod_by_monic_lt Q₁ (minpoly.monic hBint),
    rw [← hQ₁, ← hP] at H,
    replace H:= nat.lt_iff_add_one_le.1 (lt_of_lt_of_le (lt_of_le_of_lt
      (nat.lt_iff_add_one_le.1 (nat.lt_of_succ_lt_succ (mem_range.1 hj))) (lt_succ_self _))
      (nat.lt_iff_add_one_le.1 (((nat_degree_lt_nat_degree_iff hQzero).2 H)))),
    rw [add_assoc] at H,
    have Hj : Q.nat_degree + 1 = j + 1 + (Q.nat_degree - j),
    { rw [← add_comm 1, ← add_comm 1, add_assoc, add_right_inj, ← nat.add_sub_assoc
        (nat.lt_of_succ_lt_succ (mem_range.1 hj)).le, add_comm, nat.add_sub_cancel] },

    -- By induction hypothesis we can find `g : ℕ → R` such that
    -- `k ∈ range (j + 1) → Q.coeff k • B.gen ^ k = (algebra_map R L) p * g k • B.gen ^ k`-
    choose! g hg using hind,
    replace hg : ∀ k ∈ range (j + 1), Q.coeff k • B.gen ^ k =
      (algebra_map R L p) * (g k • B.gen ^ k),
    { intros k hk,
      rw [hg k (mem_range_succ_iff.1 hk) (mem_range_succ_iff.2 (le_trans (mem_range_succ_iff.1 hk)
        (succ_le_iff.1 (mem_range_succ_iff.1 hj)).le)), algebra.smul_def, algebra.smul_def,
        ring_hom.map_mul, mul_assoc] },

    -- Since `minpoly R B.gen` is Eiseinstein, we can find `f : ℕ → L` such that
    -- `(map (algebra_map R L) (minpoly R B.gen)).nat_degree ≤ i` implies `f i ∈ adjoin R {B.gen}`
    -- and `(algebra_map R L) p * f i = B.gen ^ i`. We will also need `hf₁`, a reformulation of this
    -- property.
    choose! f hf using (is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
    (minpoly.aeval R B.gen) (minpoly.monic hBint) hei.is_weakly_eisenstein_at),
    have hf₁ : ∀ k ∈ (range (Q.nat_degree - j)).erase 0,
      Q.coeff (j + 1 + k) • B.gen ^ (j + 1 + k) * B.gen ^ (P.nat_degree - (j + 2)) =
      (algebra_map R L) p * Q.coeff (j + 1 + k) • f (k + P.nat_degree - 1),
    { intros k hk,
      rw [smul_mul_assoc, ← pow_add, ← nat.add_sub_assoc H, ← add_assoc j 1 1,
        add_comm (j + 1) 1, add_assoc (j + 1), add_comm _ (k + P.nat_degree),
        nat.add_sub_add_right, ← (hf (k + P.nat_degree - 1) _).2, mul_smul_comm],
      rw [(minpoly.monic hBint).nat_degree_map, add_comm, nat.add_sub_assoc,
        le_add_iff_nonneg_right],
      { exact nat.zero_le _ },
      { refine one_le_iff_ne_zero.2 (λ h, _),
        rw [h] at hk,
        simpa using hk },
      { apply_instance } },

  -- The Eisenstein condition shows that `p` divides `Q.coeff j`
  -- if `p^n.succ` divides the following multiple of `Q.coeff (succ j)^n.succ`:
   suffices : p ^ n.succ ∣
    Q.coeff (succ j) ^ n.succ * (minpoly R B.gen).coeff 0 ^ (succ j + (P.nat_degree - (j + 2))),
  { convert this,
    rw [nat.succ_eq_add_one, add_assoc, ← nat.add_sub_assoc H, ← add_assoc, add_comm (j + 1),
      nat.add_sub_add_left, ← nat.add_sub_assoc, nat.add_sub_add_left, hP,
      ← (minpoly.monic hBint).nat_degree_map  (algebra_map R K),
      ← minpoly.is_integrally_closed_eq_field_fractions' K hBint, nat_degree_minpoly, hn,
        nat.sub_one, nat.pred_succ],
    linarith },

  -- Using `hQ : aeval B.gen Q = p • z`, we write `p • z` as a sum of terms of degree less than
  -- `j+1`, that are multiples of `p` by induction, and terms of degree at least `j+1`.
  rw [aeval_eq_sum_range, Hj, range_add, sum_union (disjoint_range_add_left_embedding _ _),
      sum_congr rfl hg, add_comm] at hQ,
  -- We multiply this equality by `B.gen ^ (P.nat_degree-(j+2))`, so we can use `hf₁` on the terms
  -- we didn't know were multiples of `p`, and we take the norm on both sides.
  replace hQ := congr_arg (λ x, x * B.gen ^ (P.nat_degree - (j + 2))) hQ,
  simp_rw [sum_map, add_left_embedding_apply, add_mul, sum_mul, mul_assoc] at hQ,
  rw [← insert_erase (mem_range.2 (tsub_pos_iff_lt.2 $ nat.lt_of_succ_lt_succ $ mem_range.1 hj)),
      sum_insert (not_mem_erase 0 _), add_zero, sum_congr rfl hf₁, ← mul_sum, ← mul_sum,
      add_assoc, ← mul_add, smul_mul_assoc, ← pow_add, algebra.smul_def] at hQ,
  replace hQ := congr_arg (norm K) (eq_sub_of_add_eq hQ),

  -- We obtain an equality of elements of `K`, but everything is integral, so we can move to `R`
  -- and simplify `hQ`.
  have hintsum : is_integral R (z * B.gen ^ (P.nat_degree - (j + 2)) -
      (∑ (x : ℕ) in (range (Q.nat_degree - j)).erase 0, Q.coeff (j + 1 + x) •
        f (x + P.nat_degree - 1) +
      ∑ (x : ℕ) in range (j + 1), g x • B.gen ^ x * B.gen ^ (P.nat_degree - (j + 2)))),
    { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
        (is_integral_add (is_integral.sum _ (λ k hk, is_integral_smul _ _))
        (is_integral.sum _ (λ k hk, is_integral_mul (is_integral_smul _ (is_integral.pow hBint _))
        ((is_integral.pow hBint _))))),
      refine adjoin_le_integral_closure hBint (hf _ _).1,
      rw [(minpoly.monic hBint).nat_degree_map (algebra_map R L)],
      rw [add_comm, nat.add_sub_assoc, le_add_iff_nonneg_right],
      { exact zero_le _ },
      { refine one_le_iff_ne_zero.2 (λ h, _),
        rw [h] at hk,
        simpa using hk } },
    obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
    rw [algebra.smul_def, mul_assoc, ← mul_sub, _root_.map_mul, algebra_map_apply R K L, map_pow,
      algebra.norm_algebra_map, _root_.map_mul, algebra_map_apply R K L, algebra.norm_algebra_map,
      finrank B, ← hr, power_basis.norm_gen_eq_coeff_zero_minpoly,
      minpoly.is_integrally_closed_eq_field_fractions' K hBint,
      coeff_map, show (-1 : K) = algebra_map R K (-1), by simp, ← map_pow, ← map_pow,
      ← _root_.map_mul, ← map_pow, ← _root_.map_mul, ← map_pow, ← _root_.map_mul] at hQ,

    -- We can now finish the proof.
    have hppdiv : p ^ B.dim ∣ p ^ B.dim * r := dvd_mul_of_dvd_left dvd_rfl _,
    rwa [← is_fraction_ring.injective R K hQ, mul_comm, ← units.coe_neg_one, mul_pow,
      ← units.coe_pow, ← units.coe_pow, mul_assoc, is_unit.dvd_mul_left _ _ _ ⟨_, rfl⟩, mul_comm,
      ← nat.succ_eq_add_one, hn] at hppdiv }
end

/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`,
then `z ∈ adjoin R {B.gen}`. Together with `algebra.discr_mul_is_integral_mem_adjoin` this result
often allows to compute the ring of integers of `L`. -/
lemma mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
  (hp : prime p) (hBint : is_integral R B.gen) {n : ℕ} {z : L} (hzint : is_integral R z)
  (hz : p ^ n • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
  z ∈ adjoin R ({B.gen} : set L) :=
begin
  induction n with n hn,
  { simpa using hz },
  { rw [pow_succ, mul_smul] at hz,
    exact hn (mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at
      hp hBint (is_integral_smul _ hzint) hz hei) }
end

end is_integral


open expr tactic classical

section logical_equivalences
  local attribute [instance] prop_decidable
  variables {a b : Prop}

  theorem not_not_iff (a : Prop) : ¬¬a ↔ a :=
  iff.intro classical.by_contradiction not_not_intro.

  theorem implies_iff_not_or (a b : Prop) : (a → b) ↔ (¬ a ∨ b) :=
  iff.intro
    (λ h, if ha : a then or.inr (h ha) else or.inl ha)
    (λ h, or.elim h (λ hna ha, absurd ha hna) (λ hb ha, hb))

  theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b) :=
  assume ⟨ha, hb⟩, or.elim h (assume hna, hna ha) (assume hnb, hnb hb)

  theorem not_or_not_of_not_and (h : ¬ (a ∧ b)) : ¬ a ∨ ¬ b :=
  if ha : a then
    or.inr (show ¬ b, from assume hb, h ⟨ha, hb⟩)
  else
    or.inl ha

  theorem not_and_iff (a b : Prop) : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
  iff.intro not_or_not_of_not_and not_and_of_not_or_not

  theorem not_or_of_not_and_not (h : ¬ a ∧ ¬ b) : ¬ (a ∨ b) :=
  assume h₁, or.elim h₁ (assume ha, h^.left ha) (assume hb, h^.right hb)

  theorem not_and_not_of_not_or (h : ¬ (a ∨ b)) : ¬ a ∧ ¬ b :=
  and.intro (assume ha, h (or.inl ha)) (assume hb, h (or.inr hb))

  theorem not_or_iff (a b : Prop) : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
  iff.intro not_and_not_of_not_or not_or_of_not_and_not
end logical_equivalences

meta def normalize_hyp (lemmas : list expr) (hyp : expr) : tactic unit :=
do s ← simp_lemmas.append simp_lemmas.mk lemmas,
   try (simp_hyp s [] hyp)

meta def normalize_hyps : tactic unit :=
do hyps ← local_context,
   lemmas ← monad.mapm mk_const [``iff_iff_implies_and_implies,
         ``implies_iff_not_or, ``not_and_iff, ``not_or_iff, ``not_not_iff,
         ``not_true_iff, ``not_false_iff],
   hyps.mmap' (normalize_hyp lemmas)

example (p q r : Prop) (h₁ : ¬ (p ↔ (q ∧ ¬ r))) (h₂ : ¬ (p → (q → ¬ r))) : true :=
by do normalize_hyps,
      trace_state,
      triv

meta def add_fact (prf : expr) : tactic unit :=
do nh ← get_unused_name `h none,
   p ← infer_type prf,
   assertv nh p prf,
   return ()

meta def is_conj (e : expr) : tactic bool :=
do t ← infer_type e,
   return (is_app_of t `and)

meta def add_conjuncts : expr → tactic unit | e :=
do e₁ ← mk_app `and.left [e],
   monad.cond (is_conj e₁) (add_conjuncts e₁) (add_fact e₁),
   e₂ ← mk_app `and.right [e],
   monad.cond (is_conj e₂) (add_conjuncts e₂) (add_fact e₂)

meta def split_conjs_at (h : expr) : tactic unit :=
do monad.cond (is_conj h)
     (add_conjuncts h >> clear h)
     skip

meta def split_conjs : tactic unit :=
do l ← local_context,
   l.mmap' split_conjs_at

meta def deny_conclusion : tactic unit :=
do refine ```(classical.by_contradiction _),
   nh ← get_unused_name `h none,
   intro nh,
   return ()

meta def find_disj : tactic (option expr) :=
do l ← local_context,
   (first $ l.map
     (λ h, do t ← infer_type h,
              cond (is_app_of t `or)
                (return (option.some h)) failed)) <|>
   return none

meta def prop_prover_aux : ℕ → tactic unit
| 0            :=  fail "prop prover max depth reached"
| (nat.succ n) :=
  do split_conjs,
     contradiction <|>
     do (option.some h) ← find_disj |
          fail "prop_prover failed: unprovable goal",
        cases h,
        prop_prover_aux n,
        prop_prover_aux n

meta def prop_prover : tactic unit :=
do deny_conclusion,
   normalize_hyps,
   prop_prover_aux 30

section
  variables a b c d : Prop

  example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∨ c :=
  by prop_prover

  example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∧ ¬ c :=
  by prop_prover

  -- not valid
  -- example (h₁ : a ∧ b) (h₂ : b ∧ ¬ c) : a ∧ c :=
  -- by prop_prover

  example : ((a → b) → a) → a :=
  by prop_prover

  example : (a → b) ∧ (b → c) → a → c :=
  by prop_prover

  example (α : Type) (x y z w : α) :
    x = y ∧ (x = y → z = w) → z = w :=
  by prop_prover

  example : ¬ (a ↔ ¬ a) :=
  by prop_prover
end


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import ring_theory.adjoin.basic
import ring_theory.power_basis
import linear_algebra.matrix.basis

/-!
# Power basis for `algebra.adjoin R {x}`

This file defines the canonical power basis on `algebra.adjoin R {x}`,
where `x` is an integral element over `R`.
-/

variables {K S : Type*} [field K] [comm_ring S] [algebra K S]

namespace algebra

open polynomial
open power_basis

open_locale big_operators

/-- The elements `1, x, ..., x ^ (d - 1)` for a basis for the `K`-module `K[x]`,
where `d` is the degree of the minimal polynomial of `x`. -/
noncomputable def adjoin.power_basis_aux {x : S} (hx : is_integral K x) :
  basis (fin (minpoly K x).nat_degree) K (adjoin K ({x} : set S)) :=
begin
  have hST : function.injective (algebra_map (adjoin K ({x} : set S)) S) := subtype.coe_injective,
  have hx' : is_integral K
    (show adjoin K ({x} : set S), from ⟨x, subset_adjoin (set.mem_singleton x)⟩),
  { apply (is_integral_algebra_map_iff hST).mp,
    convert hx,
    apply_instance },
  have minpoly_eq := minpoly.eq_of_algebra_map_eq hST hx' rfl,
  apply @basis.mk (fin (minpoly K x).nat_degree) _
    (adjoin K {x}) (λ i, ⟨x, subset_adjoin (set.mem_singleton x)⟩ ^ (i : ℕ)),
  { have := linear_independent_pow _,
    rwa minpoly_eq at this },
  { rintros ⟨y, hy⟩ _,
    have := hx'.mem_span_pow,
    rw minpoly_eq at this,
    apply this,
    { rw [adjoin_singleton_eq_range_aeval] at hy,
      obtain ⟨f, rfl⟩ := (aeval x).mem_range.mp hy,
      use f,
      ext,
      exact aeval_algebra_map_apply S (⟨x, _⟩ : adjoin K {x}) _, } }
end

/-- The power basis `1, x, ..., x ^ (d - 1)` for `K[x]`,
where `d` is the degree of the minimal polynomial of `x`. See `algebra.adjoin.power_basis'` for
a version over a more general base ring. -/
@[simps gen dim] noncomputable def adjoin.power_basis {x : S} (hx : is_integral K x) :
  power_basis K (adjoin K ({x} : set S)) :=
{ gen := ⟨x, subset_adjoin (set.mem_singleton x)⟩,
  dim := (minpoly K x).nat_degree,
  basis := adjoin.power_basis_aux hx,
  basis_eq_pow := basis.mk_apply _ _ }

end algebra

open algebra

/-- The power basis given by `x` if `B.gen ∈ adjoin K {x}`. See `power_basis.of_gen_mem_adjoin'`
for a version over a more general base ring. -/
@[simps] noncomputable def power_basis.of_gen_mem_adjoin {x : S} (B : power_basis K S)
  (hint : is_integral K x) (hx : B.gen ∈ adjoin K ({x} : set S)) : power_basis K S :=
(algebra.adjoin.power_basis hint).map $
  (subalgebra.equiv_of_eq _ _ $ power_basis.adjoin_eq_top_of_gen_mem_adjoin hx).trans
  subalgebra.top_equiv

section is_integral

namespace power_basis

open polynomial

open_locale polynomial

variables {R : Type*} [comm_ring R] [algebra R S] [algebra R K] [is_scalar_tower R K S]
variables {A : Type*} [comm_ring A] [algebra R A] [algebra S A]
variables [is_scalar_tower R S A] {B : power_basis S A} (hB : is_integral R B.gen)

include hB

/-- If `B : power_basis S A` is such that `is_integral R B.gen`, then
`is_integral R (B.basis.repr (B.gen ^ n) i)` for all `i` if
`minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)`. This is the case if `R` is a GCD domain
and `S` is its fraction ring. -/
lemma repr_gen_pow_is_integral [is_domain S]
  (hmin : minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)) (n : ℕ) :
  ∀ i, is_integral R (B.basis.repr (B.gen ^ n) i) :=
begin
  intro i,
  let Q := (X ^ n) %ₘ (minpoly R B.gen),
  have : B.gen ^ n = aeval B.gen Q,
  { rw [← @aeval_X_pow R _ _ _ _ B.gen, ← mod_by_monic_add_div (X ^ n) (minpoly.monic hB)],
    simp },
  by_cases hQ : Q = 0,
  { simp [this, hQ, is_integral_zero] },
  have hlt : Q.nat_degree < B.dim,
  { rw [← B.nat_degree_minpoly, hmin, (minpoly.monic hB).nat_degree_map,
      nat_degree_lt_nat_degree_iff hQ],
    letI : nontrivial R := nontrivial.of_polynomial_ne hQ,
    exact degree_mod_by_monic_lt _ (minpoly.monic hB),
    apply_instance },
  rw [this, aeval_eq_sum_range' hlt],
  simp only [linear_equiv.map_sum, linear_equiv.map_smulₛₗ, ring_hom.id_apply, finset.sum_apply'],
  refine is_integral.sum _ (λ j hj, _),
  replace hj := finset.mem_range.1 hj,
  rw [← fin.coe_mk hj, ← B.basis_eq_pow, algebra.smul_def,
    is_scalar_tower.algebra_map_apply R S A, ← algebra.smul_def, linear_equiv.map_smul],
  simp only [algebra_map_smul, finsupp.coe_smul, pi.smul_apply, B.basis.repr_self_apply],
  by_cases hij : (⟨j, hj⟩ : fin _) = i,
  { simp only [hij, eq_self_iff_true, if_true],
    rw [algebra.smul_def, mul_one],
    exact is_integral_algebra_map },
  { simp [hij, is_integral_zero] }
end

variable {B}

/-- Let `B : power_basis S A` be such that `is_integral R B.gen`, and let `x y : A` be elements with
integral coordinates in the base `B.basis`. Then `is_integral R ((B.basis.repr (x * y) i)` for all
`i` if `minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)`. This is the case if `R` is a GCD
domain and `S` is its fraction ring. -/
lemma repr_mul_is_integral [is_domain S] {x y : A} (hx : ∀ i, is_integral R (B.basis.repr x i))
  (hy : ∀ i, is_integral R (B.basis.repr y i))
  (hmin : minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)) :
  ∀ i, is_integral R ((B.basis.repr (x * y) i)) :=
begin
  intro i,
  rw [← B.basis.sum_repr x, ← B.basis.sum_repr y, finset.sum_mul_sum, linear_equiv.map_sum,
    finset.sum_apply'],
  refine is_integral.sum _ (λ I hI, _),
  simp only [algebra.smul_mul_assoc, algebra.mul_smul_comm, linear_equiv.map_smulₛₗ,
    ring_hom.id_apply, finsupp.coe_smul, pi.smul_apply, id.smul_eq_mul],
  refine is_integral_mul (hy _) (is_integral_mul (hx _) _),
  simp only [coe_basis, ← pow_add],
  refine repr_gen_pow_is_integral hB hmin _ _,
end

/-- Let `B : power_basis S A` be such that `is_integral R B.gen`, and let `x : A` be and element
with integral coordinates in the base `B.basis`. Then `is_integral R ((B.basis.repr (x ^ n) i)` for
all `i` and all `n` if `minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)`. This is the case
if `R` is a GCD domain and `S` is its fraction ring. -/
lemma repr_pow_is_integral [is_domain S] {x : A} (hx : ∀ i, is_integral R (B.basis.repr x i))
  (hmin : minpoly S B.gen = (minpoly R B.gen).map (algebra_map R S)) (n : ℕ) :
  ∀ i, is_integral R ((B.basis.repr (x ^ n) i)) :=
begin
  nontriviality A using [subsingleton.elim (x ^ n) 0, is_integral_zero],
  revert hx,
  refine nat.case_strong_induction_on n _ (λ n hn, _),
  { intros hx i,
    rw [pow_zero, ← pow_zero B.gen, ← fin.coe_mk B.dim_pos, ← B.basis_eq_pow,
      B.basis.repr_self_apply],
    split_ifs,
    { exact is_integral_one },
    { exact is_integral_zero } },
  { intros hx,
    rw [pow_succ],
    exact repr_mul_is_integral hB hx (λ _, hn _ le_rfl (λ _, hx _) _) hmin }
end

/-- Let `B B' : power_basis K S` be such that `is_integral R B.gen`, and let `P : R[X]` be such that
`aeval B.gen P = B'.gen`. Then `is_integral R (B.basis.to_matrix B'.basis i j)` for all `i` and `j`
if `minpoly K B.gen = (minpoly R B.gen).map (algebra_map R L)`. This is the case
if `R` is a GCD domain and `K` is its fraction ring. -/
lemma to_matrix_is_integral {B B' : power_basis K S} {P : R[X]} (h : aeval B.gen P = B'.gen)
  (hB : is_integral R B.gen) (hmin : minpoly K B.gen = (minpoly R B.gen).map (algebra_map R K)) :
  ∀ i j, is_integral R (B.basis.to_matrix B'.basis i j) :=
begin
  intros i j,
  rw [B.basis.to_matrix_apply, B'.coe_basis],
  refine repr_pow_is_integral hB (λ i, _) hmin _ _,
  rw [← h, aeval_eq_sum_range, linear_equiv.map_sum, finset.sum_apply'],
  refine is_integral.sum _ (λ n hn, _),
  rw [algebra.smul_def, is_scalar_tower.algebra_map_apply R K S, ← algebra.smul_def,
    linear_equiv.map_smul, algebra_map_smul],
  exact is_integral_smul _ (repr_gen_pow_is_integral hB hmin _ _),
end

end power_basis

end is_integral


import LeanUtils
open Nat

theorem n_cube_plus_2_n (n : Nat) : divisible 3 (n^3 + 2*n) := by
  match n with
  | 0 => repeat (first | trivial | ring | simp_all)
  | k+1 =>
    have h₁ : divisible 3 (k ^ 3 + 2 * k) := n_cube_plus_2_n _

    have ⟨z, h₂⟩ : ∃ z, k^3 + 2*k = 3*z := by
      repeat (first | ring | simp_all)

    have h₃ : (k + 1) ^ 3 + 2 * (k + 1) = 3*(z + k^2 + k + 1) := by
      calc
        (k + 1) ^ 3 + 2 * (k + 1) = k^3 + 3*k^2 + 5*k + 3 := by
          repeat (first | ring | simp_all)
        _ = k^3 + 2*k + 3 * (k^2 + k + 1) := by
          repeat (first | ring | simp_all)
        _ = 3*z + 3 * (k^2 + k + 1) := by
          repeat (first | ring | simp_all)
        _ = 3 * (z + k^2 + k + 1) := by
          repeat (first | ring | simp_all)
    try rw [h₃]

    apply mod_rewrite.mpr
    exact ⟨_, by repeat (first | trivial | ring | simp_all)⟩


import measure_theory.integration
import data.real.ereal

/-
This file contain the definition of absolutely continuous for measures.
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal

variables {α β : Type*}
variables [measurable_space α] [measurable_space β]

namespace measure_theory

-- ↓ These are already in mathlib
def absolutely_continuous (ν μ : measure α) : Prop :=
  ∀ (A : set α) (hA₁ : measurable_set A) (hA₂ : μ A = 0), ν A = 0

variables {μ : measure α}

infix ` << `:60 := absolutely_continuous
infix ` . `:max := measure.with_density

lemma lintegral_in_eq_zero {f : α → ℝ≥0∞} (hf : measurable f)
  {A : set α} (hA : μ A = 0) : ∫⁻ a in A, f a ∂μ = 0 :=
begin
  rw lintegral_eq_zero_iff hf,
  ext,
  rw measure.restrict_zero_set hA,
  refl,
end

lemma map_absolutely_continuous (f : α → ℝ≥0∞) (hf : measurable f) (μ : measure α) :
  μ . f << μ :=
begin
  intros A hA₁ hA₂,
  rw with_density_apply _ hA₁,
  exact lintegral_in_eq_zero hf hA₂
end

end measure_theory


open nat

example : ∃ x : ℕ, x > 0 :=
have h : 1 > 0, from zero_lt_succ 0,
exists.intro 1 h

example (x : ℕ) (h : x > 0) : ∃ y, y < x :=
exists.intro 0 h

example (x y z : ℕ) (hxy : x < y) (hyz : y < z) :
  ∃ w, x < w ∧ w < z :=
exists.intro y (and.intro hxy hyz)

#check @exists.intro


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.lie.basic
import Mathlib.algebra.ring_quot
import Mathlib.linear_algebra.tensor_algebra
import Mathlib.PostPort

universes u₁ u₂ u₃

namespace Mathlib

/-!
# Universal enveloping algebra

Given a commutative ring `R` and a Lie algebra `L` over `R`, we construct the universal
enveloping algebra of `L`, together with its universal property.

## Main definitions

  * `universal_enveloping_algebra`: the universal enveloping algebra, endowed with an
    `R`-algebra structure.
  * `universal_enveloping_algebra.ι`: the Lie algebra morphism from `L` to its universal
    enveloping algebra.
  * `universal_enveloping_algebra.lift`: given an associative algebra `A`, together with a Lie
    algebra morphism `f : L →ₗ⁅R⁆ A`, `lift R L f : universal_enveloping_algebra R L →ₐ[R] A` is the
    unique morphism of algebras through which `f` factors.
  * `universal_enveloping_algebra.ι_comp_lift`: states that the lift of a morphism is indeed part
    of a factorisation.
  * `universal_enveloping_algebra.lift_unique`: states that lifts of morphisms are indeed unique.
  * `universal_enveloping_algebra.hom_ext`: a restatement of `lift_unique` as an extensionality
    lemma.

## Tags

lie algebra, universal enveloping algebra, tensor algebra
-/

namespace universal_enveloping_algebra

/-- The quotient by the ideal generated by this relation is the universal enveloping algebra.

Note that we have avoided using the more natural expression:
| lie_compat (x y : L) : rel (ιₜ ⁅x, y⁆) ⁅ιₜ x, ιₜ y⁆
so that our construction needs only the semiring structure of the tensor algebra. -/
inductive rel (R : Type u₁) (L : Type u₂) [comm_ring R] [lie_ring L] [lie_algebra R L] :
    tensor_algebra R L → tensor_algebra R L → Prop
    where
| lie_compat :
    ∀ (x y : L),
      rel R L
        (coe_fn (tensor_algebra.ι R) (has_bracket.bracket x y) +
          coe_fn (tensor_algebra.ι R) y * coe_fn (tensor_algebra.ι R) x)
        (coe_fn (tensor_algebra.ι R) x * coe_fn (tensor_algebra.ι R) y)

end universal_enveloping_algebra

/-- The universal enveloping algebra of a Lie algebra. -/
def universal_enveloping_algebra (R : Type u₁) (L : Type u₂) [comm_ring R] [lie_ring L]
    [lie_algebra R L] :=
  ring_quot sorry

namespace universal_enveloping_algebra

/-- The quotient map from the tensor algebra to the universal enveloping algebra as a morphism of
associative algebras. -/
def mk_alg_hom (R : Type u₁) (L : Type u₂) [comm_ring R] [lie_ring L] [lie_algebra R L] :
    alg_hom R (tensor_algebra R L) (universal_enveloping_algebra R L) :=
  ring_quot.mk_alg_hom R (rel R L)

/-- The natural Lie algebra morphism from a Lie algebra to its universal enveloping algebra. -/
def ι (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L] [lie_algebra R L] :
    lie_algebra.morphism R L (universal_enveloping_algebra R L) :=
  lie_algebra.morphism.mk
    (linear_map.to_fun
      (linear_map.comp (alg_hom.to_linear_map (mk_alg_hom R L)) (tensor_algebra.ι R)))
    sorry sorry sorry

/-- The universal property of the universal enveloping algebra: Lie algebra morphisms into
associative algebras lift to associative algebra morphisms from the universal enveloping algebra. -/
def lift (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L] [lie_algebra R L] {A : Type u₃}
    [ring A] [algebra R A] :
    lie_algebra.morphism R L A ≃ alg_hom R (universal_enveloping_algebra R L) A :=
  equiv.mk
    (fun (f : lie_algebra.morphism R L A) =>
      coe_fn (ring_quot.lift_alg_hom R)
        { val := coe_fn (tensor_algebra.lift R) ↑f, property := sorry })
    (fun (F : alg_hom R (universal_enveloping_algebra R L) A) =>
      lie_algebra.morphism.comp (lie_algebra.of_associative_algebra_hom F) (ι R))
    sorry sorry

@[simp] theorem lift_symm_apply (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L]
    [lie_algebra R L] {A : Type u₃} [ring A] [algebra R A]
    (F : alg_hom R (universal_enveloping_algebra R L) A) :
    coe_fn (equiv.symm (lift R)) F =
        lie_algebra.morphism.comp (lie_algebra.of_associative_algebra_hom F) (ι R) :=
  rfl

@[simp] theorem ι_comp_lift (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L] [lie_algebra R L]
    {A : Type u₃} [ring A] [algebra R A] (f : lie_algebra.morphism R L A) :
    ⇑(coe_fn (lift R) f) ∘ ⇑(ι R) = ⇑f :=
  funext (iff.mp lie_algebra.morphism.ext_iff (equiv.symm_apply_apply (lift R) f))

@[simp] theorem lift_ι_apply (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L]
    [lie_algebra R L] {A : Type u₃} [ring A] [algebra R A] (f : lie_algebra.morphism R L A)
    (x : L) : coe_fn (coe_fn (lift R) f) (coe_fn (ι R) x) = coe_fn f x :=
  sorry

theorem lift_unique (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L] [lie_algebra R L]
    {A : Type u₃} [ring A] [algebra R A] (f : lie_algebra.morphism R L A)
    (g : alg_hom R (universal_enveloping_algebra R L) A) :
    ⇑g ∘ ⇑(ι R) = ⇑f ↔ g = coe_fn (lift R) f :=
  sorry

/-- See note [partially-applied ext lemmas]. -/
theorem hom_ext (R : Type u₁) {L : Type u₂} [comm_ring R] [lie_ring L] [lie_algebra R L]
    {A : Type u₃} [ring A] [algebra R A] {g₁ : alg_hom R (universal_enveloping_algebra R L) A}
    {g₂ : alg_hom R (universal_enveloping_algebra R L) A} (h : ⇑g₁ ∘ ⇑(ι R) = ⇑g₂ ∘ ⇑(ι R)) :
    g₁ = g₂ :=
  sorry

end Mathlib