/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

# Ring-theoretic supplement of data.polynomial.

## Main results
* `mv_polynomial.integral_domain`:
  If a ring is an integral domain, then so is its polynomial ring over finitely many variables.
* `polynomial.is_noetherian_ring`:
  Hilbert basis theorem, that if a ring is noetherian then so is its polynomial ring.
* `polynomial.wf_dvd_monoid`:
  If an integral domain is a `wf_dvd_monoid`, then so is its polynomial ring.
* `polynomial.unique_factorization_monoid`:
  If an integral domain is a `unique_factorization_monoid`, then so is its polynomial ring.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.char_p.basic
import Mathlib.data.mv_polynomial.comm_ring
import Mathlib.data.mv_polynomial.equiv
import Mathlib.data.polynomial.field_division
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.ring_theory.polynomial.content
import Mathlib.PostPort

universes u u_1 v w

namespace Mathlib

namespace polynomial

protected instance char_p {R : Type u} [semiring R] (p : ℕ) [h : char_p R p] : char_p (polynomial R) p :=
  sorry

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree ≤ `n`. -/
def degree_le (R : Type u) [comm_ring R] (n : with_bot ℕ) : submodule R (polynomial R) :=
  infi fun (k : ℕ) => infi fun (h : ↑k > n) => linear_map.ker (lcoeff R k)

/-- The `R`-submodule of `R[X]` consisting of polynomials of degree < `n`. -/
def degree_lt (R : Type u) [comm_ring R] (n : ℕ) : submodule R (polynomial R) :=
  infi fun (k : ℕ) => infi fun (h : k ≥ n) => linear_map.ker (lcoeff R k)

theorem mem_degree_le {R : Type u} [comm_ring R] {n : with_bot ℕ} {f : polynomial R} : f ∈ degree_le R n ↔ degree f ≤ n := sorry

theorem degree_le_mono {R : Type u} [comm_ring R] {m : with_bot ℕ} {n : with_bot ℕ} (H : m ≤ n) : degree_le R m ≤ degree_le R n :=
  fun (f : polynomial R) (hf : f ∈ degree_le R m) => iff.mpr mem_degree_le (le_trans (iff.mp mem_degree_le hf) H)

theorem degree_le_eq_span_X_pow {R : Type u} [comm_ring R] {n : ℕ} : degree_le R ↑n = submodule.span R ↑(finset.image (fun (n : ℕ) => X ^ n) (finset.range (n + 1))) := sorry

theorem mem_degree_lt {R : Type u} [comm_ring R] {n : ℕ} {f : polynomial R} : f ∈ degree_lt R n ↔ degree f < ↑n := sorry

theorem degree_lt_mono {R : Type u} [comm_ring R] {m : ℕ} {n : ℕ} (H : m ≤ n) : degree_lt R m ≤ degree_lt R n :=
  fun (f : polynomial R) (hf : f ∈ degree_lt R m) =>
    iff.mpr mem_degree_lt (lt_of_lt_of_le (iff.mp mem_degree_lt hf) (iff.mpr with_bot.coe_le_coe H))

theorem degree_lt_eq_span_X_pow {R : Type u} [comm_ring R] {n : ℕ} : degree_lt R n = submodule.span R ↑(finset.image (fun (n : ℕ) => X ^ n) (finset.range n)) := sorry

/-- The first `n` coefficients on `degree_lt n` form a linear equivalence with `fin n → F`. -/
def degree_lt_equiv (F : Type u_1) [field F] (n : ℕ) : linear_equiv F (↥(degree_lt F n)) (fin n → F) :=
  linear_equiv.mk (fun (p : ↥(degree_lt F n)) (n_1 : fin n) => coeff ↑p ↑n_1) sorry sorry
    (fun (f : fin n → F) =>
      { val := finset.sum finset.univ fun (i : fin n) => coe_fn (monomial ↑i) (f i), property := sorry })
    sorry sorry

/-- Given a polynomial, return the polynomial whose coefficients are in
the ring closure of the original coefficients. -/
def restriction {R : Type u} [comm_ring R] (p : polynomial R) : polynomial ↥(ring.closure ↑(finsupp.frange p)) :=
  finsupp.mk (finsupp.support p) (fun (i : ℕ) => { val := finsupp.to_fun p i, property := sorry }) sorry

@[simp] theorem coeff_restriction {R : Type u} [comm_ring R] {p : polynomial R} {n : ℕ} : ↑(coeff (restriction p) n) = coeff p n :=
  rfl

@[simp] theorem coeff_restriction' {R : Type u} [comm_ring R] {p : polynomial R} {n : ℕ} : subtype.val (coeff (restriction p) n) = coeff p n :=
  rfl

@[simp] theorem map_restriction {R : Type u} [comm_ring R] (p : polynomial R) : map (algebra_map (↥(ring.closure ↑(finsupp.frange p))) R) (restriction p) = p := sorry

@[simp] theorem degree_restriction {R : Type u} [comm_ring R] {p : polynomial R} : degree (restriction p) = degree p :=
  rfl

@[simp] theorem nat_degree_restriction {R : Type u} [comm_ring R] {p : polynomial R} : nat_degree (restriction p) = nat_degree p :=
  rfl

@[simp] theorem monic_restriction {R : Type u} [comm_ring R] {p : polynomial R} : monic (restriction p) ↔ monic p :=
  { mp := fun (H : monic (restriction p)) => congr_arg subtype.val H, mpr := fun (H : monic p) => subtype.eq H }

@[simp] theorem restriction_zero {R : Type u} [comm_ring R] : restriction 0 = 0 :=
  rfl

@[simp] theorem restriction_one {R : Type u} [comm_ring R] : restriction 1 = 1 := sorry

theorem eval₂_restriction {R : Type u} [comm_ring R] {S : Type v} [ring S] {f : R →+* S} {x : S} {p : polynomial R} : eval₂ f x p = eval₂ (ring_hom.comp f (is_subring.subtype (ring.closure ↑(finsupp.frange p)))) x (restriction p) :=
  id (Eq.refl (finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e))

/-- Given a polynomial `p` and a subring `T` that contains the coefficients of `p`,
return the corresponding polynomial whose coefficients are in `T. -/
def to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : polynomial ↥T :=
  finsupp.mk (finsupp.support p) (fun (i : ℕ) => { val := finsupp.to_fun p i, property := sorry }) sorry

@[simp] theorem coeff_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) {n : ℕ} : ↑(coeff (to_subring p T hp) n) = coeff p n :=
  rfl

@[simp] theorem coeff_to_subring' {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) {n : ℕ} : subtype.val (coeff (to_subring p T hp) n) = coeff p n :=
  rfl

@[simp] theorem degree_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : degree (to_subring p T hp) = degree p :=
  rfl

@[simp] theorem nat_degree_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : nat_degree (to_subring p T hp) = nat_degree p :=
  rfl

@[simp] theorem monic_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : monic (to_subring p T hp) ↔ monic p :=
  { mp := fun (H : monic (to_subring p T hp)) => congr_arg subtype.val H, mpr := fun (H : monic p) => subtype.eq H }

@[simp] theorem to_subring_zero {R : Type u} [comm_ring R] (T : set R) [is_subring T] : to_subring 0 T (set.empty_subset T) = 0 :=
  rfl

@[simp] theorem to_subring_one {R : Type u} [comm_ring R] (T : set R) [is_subring T] : to_subring 1 T
    (set.subset.trans (iff.mpr finset.coe_subset finsupp.frange_single)
      (iff.mpr finset.singleton_subset_set_iff is_submonoid.one_mem)) =
  1 := sorry

@[simp] theorem map_to_subring {R : Type u} [comm_ring R] (p : polynomial R) (T : set R) [is_subring T] (hp : ↑(finsupp.frange p) ⊆ T) : map (is_subring.subtype T) (to_subring p T hp) = p :=
  ext fun (n : ℕ) => coeff_map (is_subring.subtype T) n

/-- Given a polynomial whose coefficients are in some subring, return
the corresponding polynomial whose coefificents are in the ambient ring. -/
def of_subring {R : Type u} [comm_ring R] (T : set R) [is_subring T] (p : polynomial ↥T) : polynomial R :=
  finsupp.mk (finsupp.support p) (subtype.val ∘ finsupp.to_fun p) sorry

@[simp] theorem frange_of_subring {R : Type u} [comm_ring R] (T : set R) [is_subring T] {p : polynomial ↥T} : ↑(finsupp.frange (of_subring T p)) ⊆ T := sorry

end polynomial

namespace ideal

/-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself -/
theorem polynomial_mem_ideal_of_coeff_mem_ideal {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (p : polynomial R) (hp : ∀ (n : ℕ), polynomial.coeff p n ∈ comap polynomial.C I) : p ∈ I :=
  polynomial.sum_C_mul_X_eq p ▸
    submodule.sum_mem I fun (n : ℕ) (hn : n ∈ finsupp.support p) => mul_mem_right I (polynomial.X ^ n) (hp n)

/-- The push-forward of an ideal `I` of `R` to `polynomial R` via inclusion
 is exactly the set of polynomials whose coefficients are in `I` -/
theorem mem_map_C_iff {R : Type u} [comm_ring R] {I : ideal R} {f : polynomial R} : f ∈ map polynomial.C I ↔ ∀ (n : ℕ), polynomial.coeff f n ∈ I := sorry

theorem quotient_map_C_eq_zero {R : Type u} [comm_ring R] {I : ideal R} (a : R) (H : a ∈ I) : coe_fn (ring_hom.comp (quotient.mk (map polynomial.C I)) polynomial.C) a = 0 := sorry

theorem eval₂_C_mk_eq_zero {R : Type u} [comm_ring R] {I : ideal R} (f : polynomial R) (H : f ∈ map polynomial.C I) : coe_fn (polynomial.eval₂_ring_hom (ring_hom.comp polynomial.C (quotient.mk I)) polynomial.X) f = 0 := sorry

/-- If `I` is an ideal of `R`, then the ring polynomials over the quotient ring `I.quotient` is
isomorphic to the quotient of `polynomial R` by the ideal `map C I`,
where `map C I` contains exactly the polynomials whose coefficients all lie in `I` -/
def polynomial_quotient_equiv_quotient_polynomial {R : Type u} [comm_ring R] (I : ideal R) : polynomial (quotient I) ≃+* quotient (map polynomial.C I) :=
  ring_equiv.mk
    ⇑(polynomial.eval₂_ring_hom
        (quotient.lift I (ring_hom.comp (quotient.mk (map polynomial.C I)) polynomial.C) quotient_map_C_eq_zero)
        (coe_fn (quotient.mk (map polynomial.C I)) polynomial.X))
    ⇑(quotient.lift (map polynomial.C I)
        (polynomial.eval₂_ring_hom (ring_hom.comp polynomial.C (quotient.mk I)) polynomial.X) eval₂_C_mk_eq_zero)
    sorry sorry sorry sorry

/-- If `P` is a prime ideal of `R`, then `R[x]/(P)` is an integral domain. -/
theorem is_integral_domain_map_C_quotient {R : Type u} [comm_ring R] {P : ideal R} (H : is_prime P) : is_integral_domain (quotient (map polynomial.C P)) :=
  ring_equiv.is_integral_domain (polynomial (quotient P))
    (integral_domain.to_is_integral_domain (polynomial (quotient P)))
    (ring_equiv.symm (polynomial_quotient_equiv_quotient_polynomial P))

/-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
theorem is_prime_map_C_of_is_prime {R : Type u} [comm_ring R] {P : ideal R} (H : is_prime P) : is_prime (map polynomial.C P) :=
  iff.mp (quotient.is_integral_domain_iff_prime (map polynomial.C P)) (is_integral_domain_map_C_quotient H)

/-- Given any ring `R` and an ideal `I` of `polynomial R`, we get a map `R → R[x] → R[x]/I`.
  If we let `R` be the image of `R` in `R[x]/I` then we also have a map `R[x] → R'[x]`.
  In particular we can map `I` across this map, to get `I'` and a new map `R' → R'[x] → R'[x]/I`.
  This theorem shows `I'` will not contain any non-zero constant polynomials
  -/
theorem eq_zero_of_polynomial_mem_map_range {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (x : ↥(ring_hom.range (ring_hom.comp (quotient.mk I) polynomial.C))) (hx : coe_fn polynomial.C x ∈
  map (polynomial.map_ring_hom (ring_hom.range_restrict (ring_hom.comp (quotient.mk I) polynomial.C))) I) : x = 0 := sorry

/-- `polynomial R` is never a field for any ring `R`. -/
theorem polynomial_not_is_field {R : Type u} [comm_ring R] : ¬is_field (polynomial R) := sorry

/-- The only constant in a maximal ideal over a field is `0`. -/
theorem eq_zero_of_constant_mem_of_maximal {R : Type u} [comm_ring R] (hR : is_field R) (I : ideal (polynomial R)) [hI : is_maximal I] (x : R) (hx : coe_fn polynomial.C x ∈ I) : x = 0 := sorry

/-- Transport an ideal of `R[X]` to an `R`-submodule of `R[X]`. -/
def of_polynomial {R : Type u} [comm_ring R] (I : ideal (polynomial R)) : submodule R (polynomial R) :=
  submodule.mk (submodule.carrier I) sorry sorry sorry

theorem mem_of_polynomial {R : Type u} [comm_ring R] {I : ideal (polynomial R)} (x : polynomial R) : x ∈ of_polynomial I ↔ x ∈ I :=
  iff.rfl

/-- Given an ideal `I` of `R[X]`, make the `R`-submodule of `I`
consisting of polynomials of degree ≤ `n`. -/
def degree_le {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : with_bot ℕ) : submodule R (polynomial R) :=
  polynomial.degree_le R n ⊓ of_polynomial I

/-- Given an ideal `I` of `R[X]`, make the ideal in `R` of
leading coefficients of polynomials in `I` with degree ≤ `n`. -/
def leading_coeff_nth {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : ℕ) : ideal R :=
  submodule.map (polynomial.lcoeff R n) (degree_le I ↑n)

theorem mem_leading_coeff_nth {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (n : ℕ) (x : R) : x ∈ leading_coeff_nth I n ↔
  ∃ (p : polynomial R), ∃ (H : p ∈ I), polynomial.degree p ≤ ↑n ∧ polynomial.leading_coeff p = x := sorry

theorem mem_leading_coeff_nth_zero {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (x : R) : x ∈ leading_coeff_nth I 0 ↔ coe_fn polynomial.C x ∈ I := sorry

theorem leading_coeff_nth_mono {R : Type u} [comm_ring R] (I : ideal (polynomial R)) {m : ℕ} {n : ℕ} (H : m ≤ n) : leading_coeff_nth I m ≤ leading_coeff_nth I n := sorry

/-- Given an ideal `I` in `R[X]`, make the ideal in `R` of the
leading coefficients in `I`. -/
def leading_coeff {R : Type u} [comm_ring R] (I : ideal (polynomial R)) : ideal R :=
  supr fun (n : ℕ) => leading_coeff_nth I n

theorem mem_leading_coeff {R : Type u} [comm_ring R] (I : ideal (polynomial R)) (x : R) : x ∈ leading_coeff I ↔ ∃ (p : polynomial R), ∃ (H : p ∈ I), polynomial.leading_coeff p = x := sorry

theorem is_fg_degree_le {R : Type u} [comm_ring R] (I : ideal (polynomial R)) [is_noetherian_ring R] (n : ℕ) : submodule.fg (degree_le I ↑n) := sorry

end ideal

namespace polynomial

protected instance wf_dvd_monoid {R : Type u_1} [integral_domain R] [wf_dvd_monoid R] : wf_dvd_monoid (polynomial R) := sorry

end polynomial

/-- Hilbert basis theorem: a polynomial ring over a noetherian ring is a noetherian ring. -/
protected instance polynomial.is_noetherian_ring {R : Type u} [comm_ring R] [is_noetherian_ring R] : is_noetherian_ring (polynomial R) := sorry

namespace polynomial

theorem exists_irreducible_of_degree_pos {R : Type u} [integral_domain R] [wf_dvd_monoid R] {f : polynomial R} (hf : 0 < degree f) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f :=
  wf_dvd_monoid.exists_irreducible_factor (fun (huf : is_unit f) => ne_of_gt hf (degree_eq_zero_of_is_unit huf))
    fun (hf0 : f = 0) => not_lt_of_lt hf (Eq.symm hf0 ▸ Eq.symm degree_zero ▸ with_bot.bot_lt_coe 0)

theorem exists_irreducible_of_nat_degree_pos {R : Type u} [integral_domain R] [wf_dvd_monoid R] {f : polynomial R} (hf : 0 < nat_degree f) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f := sorry

theorem exists_irreducible_of_nat_degree_ne_zero {R : Type u} [integral_domain R] [wf_dvd_monoid R] {f : polynomial R} (hf : nat_degree f ≠ 0) : ∃ (g : polynomial R), irreducible g ∧ g ∣ f :=
  exists_irreducible_of_nat_degree_pos (nat.pos_of_ne_zero hf)

theorem linear_independent_powers_iff_eval₂ {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : linear_map R M M) (v : M) : (linear_independent R fun (n : ℕ) => coe_fn (f ^ n) v) ↔ ∀ (p : polynomial R), coe_fn (coe_fn (aeval f) p) v = 0 → p = 0 := sorry

theorem disjoint_ker_aeval_of_coprime {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R} (hpq : is_coprime p q) : disjoint (linear_map.ker (coe_fn (aeval f) p)) (linear_map.ker (coe_fn (aeval f) q)) := sorry

theorem sup_aeval_range_eq_top_of_coprime {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R} (hpq : is_coprime p q) : linear_map.range (coe_fn (aeval f) p) ⊔ linear_map.range (coe_fn (aeval f) q) = ⊤ := sorry

theorem sup_ker_aeval_le_ker_aeval_mul {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] {f : linear_map R M M} {p : polynomial R} {q : polynomial R} : linear_map.ker (coe_fn (aeval f) p) ⊔ linear_map.ker (coe_fn (aeval f) q) ≤ linear_map.ker (coe_fn (aeval f) (p * q)) := sorry

theorem sup_ker_aeval_eq_ker_aeval_mul_of_coprime {R : Type u} {M : Type w} [comm_ring R] [add_comm_group M] [module R M] (f : linear_map R M M) {p : polynomial R} {q : polynomial R} (hpq : is_coprime p q) : linear_map.ker (coe_fn (aeval f) p) ⊔ linear_map.ker (coe_fn (aeval f) q) = linear_map.ker (coe_fn (aeval f) (p * q)) := sorry

end polynomial

namespace mv_polynomial

theorem is_noetherian_ring_fin_0 {R : Type u} [comm_ring R] [is_noetherian_ring R] : is_noetherian_ring (mv_polynomial (fin 0) R) :=
  is_noetherian_ring_of_ring_equiv R
    (ring_equiv.trans (ring_equiv.symm (pempty_ring_equiv R)) (ring_equiv_of_equiv R (equiv.symm fin_zero_equiv')))

theorem is_noetherian_ring_fin {R : Type u} [comm_ring R] [is_noetherian_ring R] {n : ℕ} : is_noetherian_ring (mv_polynomial (fin n) R) := sorry

/-- The multivariate polynomial ring in finitely many variables over a noetherian ring
is itself a noetherian ring. -/
protected instance is_noetherian_ring {R : Type u} {σ : Type v} [comm_ring R] [fintype σ] [is_noetherian_ring R] : is_noetherian_ring (mv_polynomial σ R) :=
  trunc.induction_on (fintype.equiv_fin σ)
    fun (e : σ ≃ fin (fintype.card σ)) =>
      is_noetherian_ring_of_ring_equiv (mv_polynomial (fin (fintype.card σ)) R) (ring_equiv_of_equiv R (equiv.symm e))

theorem is_integral_domain_fin_zero (R : Type u) [comm_ring R] (hR : is_integral_domain R) : is_integral_domain (mv_polynomial (fin 0) R) :=
  ring_equiv.is_integral_domain R hR (ring_equiv.trans (ring_equiv_of_equiv R fin_zero_equiv') (pempty_ring_equiv R))

/-- Auxilliary lemma:
Multivariate polynomials over an integral domain
with variables indexed by `fin n` form an integral domain.
This fact is proven inductively,
and then used to prove the general case without any finiteness hypotheses.
See `mv_polynomial.integral_domain` for the general case. -/
theorem is_integral_domain_fin (R : Type u) [comm_ring R] (hR : is_integral_domain R) (n : ℕ) : is_integral_domain (mv_polynomial (fin n) R) := sorry

theorem is_integral_domain_fintype (R : Type u) (σ : Type v) [comm_ring R] [fintype σ] (hR : is_integral_domain R) : is_integral_domain (mv_polynomial σ R) := sorry

/-- Auxilliary definition:
Multivariate polynomials in finitely many variables over an integral domain form an integral domain.
This fact is proven by transport of structure from the `mv_polynomial.integral_domain_fin`,
and then used to prove the general case without finiteness hypotheses.
See `mv_polynomial.integral_domain` for the general case. -/
def integral_domain_fintype (R : Type u) (σ : Type v) [integral_domain R] [fintype σ] : integral_domain (mv_polynomial σ R) :=
  is_integral_domain.to_integral_domain (mv_polynomial σ R) sorry

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {R : Type u} [integral_domain R] {σ : Type v} (p : mv_polynomial σ R) (q : mv_polynomial σ R) (h : p * q = 0) : p = 0 ∨ q = 0 := sorry

/-- The multivariate polynomial ring over an integral domain is an integral domain. -/
protected instance integral_domain {R : Type u} {σ : Type v} [integral_domain R] : integral_domain (mv_polynomial σ R) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry mv_polynomial.eq_zero_or_eq_zero_of_mul_eq_zero

theorem map_mv_polynomial_eq_eval₂ {R : Type u} {σ : Type v} [comm_ring R] {S : Type u_1} [comm_ring S] [fintype σ] (ϕ : mv_polynomial σ R →+* S) (p : mv_polynomial σ R) : coe_fn ϕ p = eval₂ (ring_hom.comp ϕ C) (fun (s : σ) => coe_fn ϕ (X s)) p := sorry

end mv_polynomial

namespace polynomial

protected instance unique_factorization_monoid {D : Type u} [integral_domain D] [unique_factorization_monoid D] : unique_factorization_monoid (polynomial D) :=
  Mathlib.ufm_of_gcd_of_wf_dvd_monoid


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.exposed
import combinatorics.simplicial_complex.extreme

open_locale classical affine big_operators
open set
--TODO: Generalise to LCTVS
variables {E : Type*} [normed_group E] [normed_space ℝ E] {x : E} {A B C : set E}
  {X : finset E} {l : E →L[ℝ] ℝ}

namespace is_exposed

lemma subset_frontier (hAB : is_exposed A B) (hBA : ¬ A ⊆ B) :
  B ⊆ frontier A :=
hAB.is_extreme.subset_frontier hBA

lemma span_lt (hAB : is_exposed A B) (hBA : ¬ A ⊆ B) :
  affine_span ℝ B < affine_span ℝ A :=
begin
  apply (affine_span_mono _ hAB.subset).lt_of_ne,
  rintro h,
  sorry
end

end is_exposed

/-lemma is_exposed.dim_lt (hAB : is_exposed A B) (hBA : ¬ A ⊆ B) :
  (affine_span ℝ B).rank < (affine_span ℝ A).rank :=
begin

end-/

lemma mem_exposed_set_iff_mem_frontier (hA₁ : convex A) (hA₂ : (interior A).nonempty) :
  (∃ B : set E, is_exposed A B ∧ ¬A ⊆ B ∧ x ∈ B) ↔ x ∈ A ∧ x ∈ frontier A :=
begin
  use λ ⟨B, hAB, hBA, hxB⟩, ⟨hAB.subset hxB, hAB.subset_frontier hBA hxB⟩,
  rintro ⟨hxA, hxfA⟩,
  obtain ⟨y, hyA⟩ := id hA₂,
  obtain ⟨l, hl⟩ := geometric_hahn_banach_open_point (convex.interior hA₁) is_open_interior hxfA.2,
  refine ⟨{x ∈ A | ∀ y ∈ A, l y ≤ l x}, λ _, ⟨l, rfl⟩, λ h,
    not_le.2 (hl y hyA) ((h (interior_subset hyA)).2 x hxA), hxA, λ z hzA, _⟩,
  suffices h : l '' closure (interior A) ⊆ closure (Iio (l x)),
  { rw [closure_Iio, ←closure_eq_closure_interior hA₁ hA₂] at h,
    exact h ⟨z, subset_closure hzA, rfl⟩ },
  refine subset.trans (image_closure_subset_closure_image l.continuous) (closure_mono _),
  rintro _ ⟨w, hw, rfl⟩,
  exact hl w hw,
end

lemma mem_extreme_set_iff_mem_frontier (hA₁ : convex A) (hA₂ : (interior A).nonempty) :
  (∃ B : set E, is_extreme A B ∧ ¬A ⊆ B ∧ x ∈ B) ↔ x ∈ A ∧ x ∈ frontier A :=
begin
  use λ ⟨B, hAB, hBA, hxB⟩, ⟨hAB.1 hxB, hAB.subset_frontier hBA hxB⟩,
  rintro h,
  obtain ⟨B, hAB, hBA, hxB⟩ := (mem_exposed_set_iff_mem_frontier hA₁ hA₂).2 h,
  exact ⟨B, hAB.is_extreme, hBA, hxB⟩,
end

/-! # Harder stuff -/

/-- Eidelheit's Theorem -/
theorem eq_Inter_halfspaces (hA₁ : convex A) (hA₂ : is_closed A) :
  A = ⋂ (l : E →L[ℝ] ℝ), {x | ∃ y ∈ A, l x ≤ l y} :=
begin
  ext,
  simp only [mem_Inter],
  use λ hx l, ⟨x, hx, le_rfl⟩,
  rintro hx,
  by_contra,
  obtain ⟨l, s, hlA, hl⟩ := geometric_hahn_banach_closed_point hA₁ hA₂ h,
  obtain ⟨y, hy, hxy⟩ := hx l,
  linarith [hlA y hy],
end

lemma closed_extreme_points [finite_dimensional ℝ E] (hE : finite_dimensional.finrank ℝ E = 2)
(hA₁ : convex A) (hA₂ : is_closed A) :
  is_closed A.extreme_points :=
begin
  sorry
end

--theorem of S. Straszewicz proved in 1935
lemma limit_exposed_points_of_extreme (hA₁ : convex A) (hA₂ : is_closed A) :
  A.extreme_points ⊆ closure (A.exposed_points) :=
begin
  sorry
end


namespace list

variables {α : Type}

lemma append_take_drop :
  ∀ k (as : list α), as.take k ++ as.drop k = as
| 0 as := rfl
| k [] := begin cases k; simp end
| (k+1) (a::as) :=
  begin simp [append_take_drop] end

#exit
def split : nat → list α → (list α × list α)
| 0 []          := ([],[])
| (k+1) []      := ([],[])
| 0     (a::as) := ⟨[], a::as⟩
| (k+1) (a::as) := let (as1,as2) := as.split k in (a::as1,as2)

lemma split_succ_cons (k a) (as : list α) :
  split (k+1) (a::as) = (a::(split k as).fst, (split k as).snd) :=
begin simp only [split], cases (split k as) with as1 as2, refl end

lemma append_split : ∀ (k) (as : list α),
  (split k as).fst ++ (split k as).snd = as
| k [] := begin cases k; refl end
| 0 as := begin cases as with a as; refl end
| (k+1) (a::as) :=
  begin rw split_succ_cons, simp [append_split] end

lemma length_fst_split : ∀ (m n) (as : list α),
  as.length = m + n → (split m as).fst.length = m
| 0 n as h := begin cases as with a as; refl end
| (m+1) n as h :=
  begin
    cases as with a as, { simp at h, cases h },
    { rw split_succ_cons, simp, rw length_fst_split m n, simp,
      rw [length_cons, add_comm m 1, add_assoc,
          nat.add_one, nat.one_add] at h,
      simp at h, assumption }
  end

lemma length_snd_split : ∀ (m n) (as : list α),
  as.length = m + n → (split m as).snd.length = n
| 0 n [] h := begin  simp at h, simp [split], assumption end
| 0 n (a::as) h := begin simp at h, simp [split], assumption end
| (m+1) n [] h := begin simp at h, cases h end
| (m+1) n (a::as) h :=
  begin
    simp at h, rw split_succ_cons, simp, apply length_snd_split,
    rw [← add_assoc, nat.add_one, nat.one_add] at h, simp at h,
    assumption
  end

end list


import order.order_iso finsupp user_classes

namespace finsupp

section linear_order
variables {α : Type*} {β : Type*} [decidable_eq α] [decidable_canonically_ordered_monoid β]
variables [linear_order (α →₀ β)] [is_well_founded (α →₀ β) (<)] [is_monomial_order (α →₀ β) (≤)]

instance : ordered_cancel_comm_monoid (α →₀ β) := {
    add_left_cancel := λ a b c, (finsupp.add_left_cancel_iff_eq a b c).1,
    add_right_cancel := λ a b c, (finsupp.add_right_cancel_iff_eq a b c).1,
    add_le_add_left := _inst_5.monomial_order,
    le_of_add_le_add_left := λ a b c h, begin
        rcases lt_trichotomy b c with hbc | hbc | hbc,
        apply le_of_lt hbc,
        apply le_of_eq hbc,
        have h' : a + c ≤ a + b, apply _inst_5.monomial_order, apply le_of_lt hbc,
        simp [(finsupp.add_left_cancel_iff_eq a c b).1 (antisymm h' h)],
    end,
    .._inst_3,
    ..finsupp.add_comm_monoid
}

private def f (x : α →₀ β) : ℕ → (α →₀ β)
| 0 := 0
| (n + 1) := x + f n

private lemma f_nez {x : α →₀ β} (hx : x ≠ 0): ∀ n ≠ 0, (f x) n ≠ 0
| 0 := by simp
| (n + 1) := λ _ h, begin
    simp [f, add_eqz] at h,
    exact hx h.left,
end

private lemma f_inj {x : α →₀ β} (hx : x ≠ 0) : ∀ n m : ℕ, (f x) n = (f x) m → n = m
| 0 0 := by simp
| 0 (m + 1) :=
    by simp_intros h [f]; apply absurd (eq.symm h) (f_nez hx (m + 1) (by simp))
| (n + 1) 0 :=
    by simp_intros h [f]; apply absurd h (f_nez hx (n + 1) (by simp))
| (n + 1) (m + 1) :=
    begin simp_intros h [f, add_left_cancel_iff], simpa using f_inj _ _ h, end

private lemma f_lt_zero {x : α →₀ β} (hx : x < 0) : ∀ a ≠ 0, f x a < 0
| 0 := by simp
| (a + 1) := λ _, begin
    by_cases a = 0; simp [h, f, hx],
    apply lt_trans _ (f_lt_zero _ h),
    simpa using add_lt_add_right hx (f x a),
end

private lemma f_descend_seq₁ {x : α →₀ β} (hx : x < 0) : ∀ a b, (f x) (a + b + 1) < f x a
| a 0 := by simpa [f] using add_lt_add_right hx (f x a)
| a (b + 1) := begin
    apply lt_trans _ (f_descend_seq₁ a b),
    rw [←add_assoc a b, ←nat.succ_eq_add_one],
    simpa [f] using add_lt_add_right hx (f x (a + b + 1)),
end

private lemma f_descend_seq₂ {x : α →₀ β} (hx : x < 0) : ∀ a b, f x a < f x b → a > b
| 0 0 := by simp [lt_irrefl]
| 0 (b + 1) := begin
    simp_intros hb [f],
    apply absurd (lt_trans (f_lt_zero hx (b + 1) (by simp)) hb) (lt_irrefl _),
end
| (a + 1) 0 := λ _, nat.zero_lt_succ a
| (a + 1) (b + 1) := begin
    simp_intros h [f],
    apply add_lt_add_right (f_descend_seq₂ _ _ h),
end

private lemma f_descend_seq {x : α →₀ β} (hx : x < 0) : ∀ (a b : ℕ), a > b ↔ f x a < f x b :=
λ a b,
⟨λ h, begin
    have hab := nat.add_sub_cancel' (nat.succ_le_of_lt h),
    rw [nat.succ_add, nat.succ_eq_add_one, nat.succ_eq_add_one] at hab,
    simpa [hab] using f_descend_seq₁ hx b (a - (b + 1)),
end,
f_descend_seq₂ hx a b⟩

lemma not_lt_zero (x : α →₀ β) : ¬ x < 0 :=
λ hx, order_embedding.well_founded_iff_no_descending_seq.1 _inst_4.wf begin
    constructor, apply order_embedding.mk ⟨f x, f_inj (ne_of_lt hx)⟩,
    simp_intros,
    apply f_descend_seq hx a b,
end

theorem zero_le (x : α →₀ β) : 0 ≤ x := le_of_not_lt (not_lt_zero x)

lemma le_zero_iff (x : α →₀ β) : x ≤ 0 ↔ x = 0 :=
⟨λ ha, begin
    apply antisymm ha,
    exact zero_le x,
end, λ h, by simp [h]⟩

lemma zero_lt_iff_ne_zero {x : α →₀ β} : 0 < x ↔ x ≠ 0 :=
    by finish [lt_iff_le_and_ne, zero_le x]

lemma ne_zero_of_gt {x y : α →₀ β} : y < x → x ≠ 0 :=
λ h, zero_lt_iff_ne_zero.1 (lt_of_le_of_lt (zero_le y) h)

end linear_order
end finsupp


import tactic

namespace natree

  --inductive structure of pre-trees (natural trees pre-quotienting)
  inductive pre
  | node : pre
  | app : pre → pre → pre
  | ref : char → pre

  namespace pre

    notation `𝕋'` := pre
    notation `▢` := node
    infixl `◦`:60 := app
    prefix `#`:60 := ref

    --reduction rules of tree calculus, specified as an inductive binary relation on pre-trees
    inductive reduces : 𝕋' → 𝕋' → Prop
    | kernel         (y) {z} : reduces (▢◦   ▢   ◦y◦z) y
    |   stem     (x) (y) (z) : reduces (▢◦ (▢◦x) ◦y◦z) (y◦z◦(x◦z))
    |   fork (w) (x) {y} (z) : reduces (▢◦(▢◦w◦x)◦y◦z) (z◦w◦x)
    |   left {a₁ a₂ b₁} (h : reduces a₁ b₁) : reduces (a₁◦a₂) (b₁◦a₂)
    |  right {a₁ a₂ b₂} (h : reduces a₂ b₂) : reduces (a₁◦a₂) (a₁◦b₂)
    infixr ` ↦ `:60 := reduces

    --equivalence relation on pre-trees generated by reflexive, symmetric, transitive closure of (↦)
    instance equiv : setoid 𝕋' := eqv_gen.setoid (↦)

    namespace equiv

      lemma lift_reduces_to {a b} : a ↦ b → a ≈ b :=
      begin
        intro h,
        apply eqv_gen.rel,
        assumption,
      end

      theorem kernel {y z} : (▢◦▢◦y◦z) ≈ y :=
      begin
        apply lift_reduces_to,
        apply reduces.kernel,
      end

      theorem stem {x y z} : (▢◦(▢◦x)◦y◦z) ≈ (y◦z◦(x◦z)) :=
      begin
        apply lift_reduces_to,
        apply reduces.stem,
      end

      theorem fork {w x y z} : (▢◦(▢◦w◦x)◦y◦z) ≈ (z◦w◦x) :=
      begin
        apply lift_reduces_to,
        apply reduces.fork,
      end

      lemma congr_left {a₁ a₂ b₁} : a₁ ≈ b₁ → a₁◦a₂ ≈ b₁◦a₂ :=
      begin
        intro h,
        induction h with x y h _ x y h₁ h₂ x y z h₁ h₂ h₃ h₄,
              apply eqv_gen.rel,
              apply reduces.left,
              assumption,
            apply eqv_gen.refl,
          apply eqv_gen.symm,
          assumption,
        apply eqv_gen.trans,
            assumption,
        assumption,
      end

      lemma congr_right {a₁ a₂ b₂} : a₂ ≈ b₂ → a₁◦a₂ ≈ a₁◦b₂ :=
      begin
        intro h,
        induction h with x y h _ x y h₁ h₂ x y z h₁ h₂ h₃ h₄,
              apply eqv_gen.rel,
              apply reduces.right,
              assumption,
            apply eqv_gen.refl,
          apply eqv_gen.symm,
          assumption,
        apply eqv_gen.trans,
            assumption,
        assumption,
      end

      theorem congr {a₁ a₂ b₁ b₂} : a₁ ≈ b₁ → a₂ ≈ b₂ → a₁◦a₂ ≈ b₁◦b₂ :=
      begin
        intros h₁ h₂,
        apply eqv_gen.trans,
            apply congr_left,
            assumption,
        apply congr_right,
        assumption,
      end

    end equiv

  end pre

end natree


/-
Copyright (c) 2021 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca, Johan Commelin
-/
import analysis.normed.group.SemiNormedGroup
import category_theory.preadditive.additive_functor
import analysis.normed.group.hom_completion

/-!
# Completions of normed groups

This file contains an API for completions of seminormed groups (basic facts about
objects and morphisms).

## Main definitions

- `SemiNormedGroup.Completion : SemiNormedGroup ⥤ SemiNormedGroup` : the completion of a
  seminormed group (defined as a functor on `SemiNormedGroup` to itself).
- `SemiNormedGroup.Completion.lift (f : V ⟶ W) : (Completion.obj V ⟶ W)` : a normed group hom
  from `V` to complete `W` extends ("lifts") to a seminormed group hom from the completion of
  `V` to `W`.

## Projects

1. Construct the category of complete seminormed groups, say `CompleteSemiNormedGroup`
  and promote the `Completion` functor below to a functor landing in this category.
2. Prove that the functor `Completion : SemiNormedGroup ⥤ CompleteSemiNormedGroup`
  is left adjoint to the forgetful functor.

-/

noncomputable theory

universe u

open uniform_space mul_opposite category_theory normed_group_hom

namespace SemiNormedGroup

/-- The completion of a seminormed group, as an endofunctor on `SemiNormedGroup`. -/
@[simps]
def Completion : SemiNormedGroup.{u} ⥤ SemiNormedGroup.{u} :=
{ obj := λ V, SemiNormedGroup.of (completion V),
  map := λ V W f, f.completion,
  map_id' := λ V, completion_id,
  map_comp' := λ U V W f g, (completion_comp f g).symm }

instance Completion_complete_space {V : SemiNormedGroup} : complete_space (Completion.obj V) :=
completion.complete_space _

/-- The canonical morphism from a seminormed group `V` to its completion. -/
@[simps]
def Completion.incl {V : SemiNormedGroup} : V ⟶ Completion.obj V :=
{ to_fun := λ v, (v : completion V),
  map_add' := completion.coe_add,
  bound' := ⟨1, λ v, by simp⟩ }

lemma Completion.norm_incl_eq {V : SemiNormedGroup} {v : V} : ∥Completion.incl v∥ = ∥v∥ := by simp

/-- Given a normed group hom `V ⟶ W`, this defines the associated morphism
from the completion of `V` to the completion of `W`.
The difference from the definition obtained from the functoriality of completion is in that the
map sending a morphism `f` to the associated morphism of completions is itself additive. -/
def Completion.map_hom (V W : SemiNormedGroup.{u}) :
  (V ⟶ W) →+ (Completion.obj V ⟶ Completion.obj W) :=
add_monoid_hom.mk' (category_theory.functor.map Completion) $ λ f g,
  f.completion_add g

@[simp] lemma Completion.map_zero (V W : SemiNormedGroup) : Completion.map (0 : V ⟶ W) = 0 :=
(Completion.map_hom V W).map_zero

instance : preadditive SemiNormedGroup.{u} :=
{ hom_group := λ P Q, infer_instance,
  add_comp' := by { intros, ext,
    simp only [normed_group_hom.add_apply, category_theory.comp_apply, normed_group_hom.map_add] },
  comp_add' := by { intros, ext,
    simp only [normed_group_hom.add_apply, category_theory.comp_apply, normed_group_hom.map_add] } }

instance : functor.additive Completion :=
{ map_add' := λ X Y, (Completion.map_hom _ _).map_add }

/-- Given a normed group hom `f : V → W` with `W` complete, this provides a lift of `f` to
the completion of `V`. The lemmas `lift_unique` and `lift_comp_incl` provide the api for the
universal property of the completion. -/
def Completion.lift {V W : SemiNormedGroup} [complete_space W] [separated_space W] (f : V ⟶ W) :
  Completion.obj V ⟶ W :=
{ to_fun := f.extension,
  map_add' := f.extension.to_add_monoid_hom.map_add',
  bound' := f.extension.bound' }

lemma Completion.lift_comp_incl {V W : SemiNormedGroup} [complete_space W] [separated_space W]
  (f : V ⟶ W) : Completion.incl ≫ (Completion.lift f) = f :=
by { ext, apply normed_group_hom.extension_coe }

lemma Completion.lift_unique {V W : SemiNormedGroup} [complete_space W] [separated_space W]
  (f : V ⟶ W) (g : Completion.obj V ⟶ W) : Completion.incl ≫ g = f → g = Completion.lift f :=
λ h, (normed_group_hom.extension_unique _ (λ v, ((ext_iff.1 h) v).symm)).symm

end SemiNormedGroup


import basic
open IncidencePlane

noncomputable theory
open_locale classical

variables {Ω : Type} [IncidencePlane Ω]
variables {A B C P Q R : Ω}
variables {ℓ r s t : Line Ω}

lemma collinear_of_between' {A B C : Ω} : (A * B * C) → collinear ({A, B, C} : set Ω) :=
begin
intro h,
cases collinear_of_between h with r hr,
use r,
simp,
exact hr,
end

lemma ne_of_not_share_point  (hPr : P ∈ r)(hPs : P ∉ s): r ≠ s:=
begin
intro h,
apply hPs,
rw ← h,
exact hPr,
end
--
lemma same_side_trans_of_noncollinear (h : ¬ collinear ({A, C, B} : set Ω)):
    same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

-- our lemma :D
lemma collinear_iff_on_line_through {X Y Z : Ω } (h: X ≠ Y) : (collinear({X, Y, Z} : set Ω )) ↔  Z ∈ line_through X Y :=
begin
sorry,
end

--second lemma
lemma exists_point_on_line_not_other (ℓ m : Line Ω) (h1: ℓ ≠ m) : ∃ (A : Ω), A ∈ ℓ ∧ A ∉ m :=
begin
sorry,
end

-- added
lemma line_through_from_and (P Q : Ω) (ℓ : Line Ω) (h1 : P ≠ Q)
(h2 : P ∈ ℓ ∧ Q ∈ ℓ) : ℓ = line_through P Q :=
begin
cases h2 with hP hQ,
exact incidence h1 hP hQ,
end

-- added
lemma point_in_line_not_point {P Q: Ω} {r : Line Ω} (hP : P ∈ r) (hQ : Q ∉ r): P ≠ Q :=
begin
  intro h1,
  apply hQ,
  rw ← h1,
  exact hP,
end

-- added
lemma exists_point_not_in_line (ℓ : Line Ω) : ∃ (P : Ω), P ∉ ℓ :=
begin
rcases (existence Ω) with ⟨A : Ω, B, C, ⟨h1, h2, h3, h4⟩⟩,
by_cases h: line_through A B = ℓ,
{ use C,
  rw ← h,
  exact h4 },
{ by_cases a: A ∈ ℓ, { use B,
    intro p,
    apply h,
    rw incidence h1 a p },
  { use A }, },
end

lemma auxiliary_point (ℓ : Line Ω) (h : collinear ({A, B, C} : set Ω)) (hA : A ∉ ℓ) (hB : B ∉ ℓ)
  (hC : C ∉ ℓ) (hAB : A ≠ B) (hAC : A ≠ C) (hBC : B ≠ C)  :
  ∃ (D E : Ω), D ∈ ℓ ∧ ¬ E ∈ ℓ ∧ same_side ℓ A E ∧ (D * A * E) ∧
  ¬ collinear ({A, B, E} : set Ω) ∧
  ¬ collinear ({E, C, B} : set Ω) ∧
  ¬ collinear ({A, C, E} : set Ω)  :=
begin
    -- define what a b c line is, m
    set m := line_through A B with hm,

    have hAM: A ∈ m,
    exact line_through_left A B,

    have hBM: B ∈ m,
    exact line_through_right A B,

    have hCM:= (collinear_iff_on_line_through hAB).1 h,

--    cases h with h h2,
    --l is not m
    have lm := ne_of_not_share_point hAM hA,
    --there is point in l, not in m, D
    have hD := exists_point_on_line_not_other ℓ m (ne.symm lm),
    rcases hD with ⟨D, ⟨hD1, hD2⟩⟩,

    have hDA:= point_in_line_not_point hD1 hA,
    rcases (point_on_ray hDA) with ⟨E, hE⟩,

    use D,
    use E,

    split,
    exact hD1,
    have hDnotE := different_of_between hE,
    repeat {split},
    {
      by_contradiction hEL,
      have hDAE := incidence hDnotE.2.1 hD1 hEL,
      have hDAE2 := collinear_of_between hE,
      cases hDAE2 with n,
      have hhh := incidence hDnotE.2.1 hDAE2_h.1 hDAE2_h.2.2,
      rw ← hhh at hDAE,
      rw ← hDAE at hDAE2_h,
      exact hA hDAE2_h.2.1,
    },
    {
      unfold same_side,
      simp [set.eq_empty_iff_forall_not_mem],
      repeat {split},
      {
        exact hA,
      },
      {
      by_contradiction hEL,
      have hDAE := incidence hDnotE.2.1 hD1 hEL,
      have hDAE2 := collinear_of_between hE,
      cases hDAE2 with n,
      have hhh := incidence hDnotE.2.1 hDAE2_h.1 hDAE2_h.2.2,
      rw ← hhh at hDAE,
      rw ← hDAE at hDAE2_h,
      exact hA hDAE2_h.2.1,
      },
      {
        intro P,
        intro hP,
        intro hPL,
        have PnotD: P ≠ D,
        {
          sorry
        },
        apply hA,
        have hK : ℓ = line_through P D,
        {
          apply equal_lines_of_contain_two_points PnotD hPL (line_through_left P D) hD1 (line_through_right P D),

        },
        rw hK,
        rw ← collinear_iff_on_line_through PnotD,
        have hEA := (different_of_between hE).2.2,

        have hT := collinear_union ({D, A, E}: set Ω) ({A, P, E}: set Ω) hEA (collinear_of_between' hE) (collinear_of_between' hP),
        simp at hT,
        apply collinear_subset ({P, D, A} : set Ω) ({P, D, A, E} : set Ω)_ hT,
        intros x hx,
        simp at hx ⊢,
        tauto,
      },

    },
    {
      exact hE,
    },
    {
      cases hDnotE with hDnotE1 hDnotE2,
      cases hDnotE2 with hDnotE2 hDnotE3,
      intro,

    },
    {
      sorry
    },
    {
      sorry
    }

    --have hE := point_on_ray D A

    --D*A*E w point on ray

    -- D A E are collinear collinear of between, meaning there is a line s. Have to get a line

    -- l is different s

    -- E is not in l.

    -- A E same side of l

    -- E is not in m.
    --

--  rcases (exists_point_on_line ℓ) with ⟨F, hF⟩,
  --have g:= point_in_line_not_point hE hD,

end

lemma same_side_trans_of_collinear (h : collinear ({A, C, B} : set Ω)):
    same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

lemma same_side_trans_general : same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
  sorry
end

lemma at_least_two_classes (ℓ : Line Ω):
      ∃ A B : Ω, (A ∉ ℓ) ∧ (B ∉ ℓ) ∧ (¬ same_side ℓ A B) :=
begin
  sorry
end

lemma at_most_two_classes_of_noncollinear (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C)
    (h : ¬ collinear ({A, B, C} : set Ω)) : same_side ℓ B C :=
begin
  sorry
end

lemma at_most_two_classes_of_collinear (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C)
    (h : collinear ({A, B, C} : set Ω)) : same_side ℓ B C :=
begin
  sorry
end

lemma at_most_two_classes_general (hA : A ∉ ℓ) (hB : B ∉ ℓ) (hC : C ∉ ℓ)
    (hBneqC : B ≠ C) (hAB: ¬ same_side ℓ A B) (hAC: ¬ same_side ℓ A C): same_side ℓ B C :=
begin
  sorry
end


import algebra.group_power.order
import analysis.normed.group.basic
import data.hash_map
import data.int.basic
import data.int.order
import data.nat.basic
import data.rat.basic
import data.rat.order
import data.rat.sqrt
import data.real.basic
import data.real.sqrt

def point := ℤ × ℤ
-- def point := ℚ × ℚ
instance : has_repr point :=
  ⟨λ p, "(" ++ (repr p.1) ++ ", " ++ (repr p.2) ++ ")"⟩
instance : has_add point :=
  ⟨λ p₁ p₂, (p₁.1 + p₂.1, p₁.2 + p₂.2)⟩
instance : has_sub point :=
  ⟨λ p₁ p₂, (p₁.1 - p₂.1, p₁.2 - p₂.2)⟩
instance : has_neg point :=
  ⟨λ p, (-p.1, -p.2)⟩
instance : inhabited point :=
  ⟨(0, 0)⟩

-- NOTE: This is the *squared* ℓ₂ norm.  It should be fine for our purposes,
-- because it's a monotonic isomorphism, but we should think some more to make
-- sure.
-- instance : has_norm point :=
--   ⟨λ p, ⟩

#check ℕ

-- lemma coe_nat_to_int_preserves_leq :
--   ∀ (x y : ℕ), x ≤ y → (↑x : ℤ) ≤ (↑y : ℤ)
--   :=
--   begin
--     sorry
--   end

-- lemma coe_nat_times_coe_nat_eq_coe_nat_times_nat :
--   ∀ (x y : ℕ), x ≤ y → (↑x : ℤ) ≤ (↑y : ℤ)

-- lemma square_positive : ∀ (x : ℤ), x * x ≥ 0 :=
-- begin
--   intros x,
--   cases x,
--   simp [int.mul],
--   apply sq_nonneg,
--   sorry,
--   sorry
-- end

-- lemma pos_implies_of_nat : ∀ (x : ℤ), (0 ≤ x) → (∃ (n : ℕ), (x = int.of_nat n)) :=
-- begin
--   intros x x_nonneg,
--   cases x,
--   apply exists.intro x,
--   refl,
--   simp at x_nonneg,
--   contradiction
-- end

-- NOTE: We don't want to use the `has_norm` typeclass, because that asserts the
-- result is a real.
def point_norm (p : point) : ℤ :=
  p.1 * p.1 + p.2 * p.2

notation `∥` e `∥` := point_norm e

def point_le (xy zw : option (point × point)) : Prop :=
  match (xy, zw) with
  | (none, none) := true
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ ≤ ∥ z - w ∥
  end

def point_le' (xy zw : option (point × point)) : bool :=
  match (xy, zw) with
  | (none, none) := true
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ ≤ ∥ z - w ∥
  end

instance : has_le (option (point × point)) := ⟨point_le⟩

def point_lt (xy zw : option (point × point)) : Prop :=
  match (xy, zw) with
  | (none, none) := false
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ < ∥ z - w ∥
  end

def point_lt' (xy zw : option (point × point)) : bool :=
  match (xy, zw) with
  | (none, none) := false
  | (none, some _) := false
  | (some _, none) := true
  | (some (x, y), some (z, w)) := ∥ x - y ∥ < ∥ z - w ∥
  end

instance : has_lt (option (point × point)) := ⟨point_lt⟩

lemma point_lt_iff_point_lt' :
  ∀ (xy zw : option (point × point)),
    point_lt xy zw ↔ ↥(point_lt' xy zw) := sorry

    -- ↥(point_lt' (get_min_dist_pair_in_neighbs p (grid_points c qs)) (aux (grid_points c qs) ps'))

lemma point_norm_symm :
  ∀ (x y : point),
    ∥x - y∥ = ∥y - x∥ := begin
  sorry
end

lemma le_iff_neg_lt :
  ∀ (xy zw : option (point × point)),
    xy ≤ zw ↔ ¬(xy > zw) := sorry

lemma neg_le_iff_lt :
  ∀ (xy zw : option (point × point)),
    ¬(xy ≤ zw) ↔ zw < xy := sorry

-- instance (xy zw : option (point × point)) : decidable (point_le xy zw) :=
--   begin
--     cases xy;
--     cases zw,
--     exact (is_true true),
--     simp [point_le],
--   end
--   match (xy, zw) with
--   | (none, none) := is_true (by begin
--       simp [point_le],

--     end)
--   | (none, some _) := false
--   | (some _, none) := true
--   | (some (x, y), some (z, w)) := ∥ x - y ∥ ≤ ∥ z - w ∥
--   end
--   if hp : p then
--     if hq : q then is_true ⟨hp, hq⟩
--     else is_false (assume h : p ∧ q, hq (and.right h))
--   else is_false (assume h : p ∧ q, hp (and.left h))

-- instance (pq rs : option (point × point)) : decidable (point_le pq rs) :=
  -- sorry

lemma option_pt_lt_trans :
  ∀ (pq xy zw : option (point × point)),
    pq < xy →
    xy < zw →
    pq < zw := begin
  intros pq xy zw h1 h2,
  sorry,
end

lemma option_pt_le_trans :
  ∀ (pq xy zw : option (point × point)),
    pq ≤ xy →
    xy ≤ zw →
    pq ≤ zw := sorry

lemma option_pt_le_symm :
  ∀ (pq : option (point × point)) (x y : point),
    pq ≤ some (x, y) →
    pq ≤ some (y, x) := sorry

lemma option_pt_le_lt_trans :
  ∀ (pq xy zw : option (point × point)),
    pq ≤ xy →
    xy < zw →
    pq < zw := sorry

lemma option_pt_lt_le_trans :
  ∀ (pq xy zw : option (point × point)),
    pq < xy →
    xy ≤ zw →
    pq < zw := sorry

lemma option_pt_lt_to_le :
  ∀ (xy zw : option (point × point)),
    xy < zw →
    xy ≤ zw := sorry

lemma not_x_le_y_and_gt_y :
  ∀ (x y : option (point × point)),
    x ≤ y →
    y < x →
    false
    := begin
  sorry
end

lemma int_le_trans :
  ∀ (x y z : ℤ),
    x ≤ y →
    y ≤ z →
    x ≤ z := begin
  intros x y z h1 h2,
  linarith,
end

lemma point_lt'_iff_point_lt :
  ∀ (xy zw : option (point × point)),
    ↥(point_lt' xy zw) ↔ xy < zw := sorry

lemma option_pt_le_some_eq_some :
  ∀ (xy : option (point × point)) (z w : point),
    xy ≤ some (z, w) → ∃ (x y : point), xy = some (x, y) := sorry

lemma int_nonneg_add :
  ∀ (x y : ℤ), int.nonneg x → int.nonneg y → int.nonneg (x + y) := begin
  intros x y h1 h2,
  sorry
end

lemma int_x_times_x_nonneg :
  ∀ (x : ℤ), int.nonneg (x * x) := begin
    intros x,
    sorry
end

lemma nonneg_iff_leq_zero :
  ∀ (x : ℤ), int.nonneg x ↔ 0 ≤ x := begin
    sorry
  end

lemma a_nonneg_times_b_nonneq_means_a_times_b_nonneg :
  ∀ (a b : ℤ), int.nonneg a → int.nonneg b → int.nonneg (a * b) := begin
    sorry
end

lemma lift_nat_nonneg :
  ∀ (n : ℕ), int.nonneg ↑n := begin
    sorry
end

lemma x_div_plus_y_div_eq_x_plus_y_div_minus_sum_mod_div :
  ∀ (x y z : ℤ), x/z + y/z = (x + y)/z - (x % z + y % z) := begin
    sorry
  end

lemma x_div_y_times_y :
  ∀ (x y : ℤ), (x / y) * y = x - x % y := begin
    sorry
end

lemma point_norm_nonneg :
  ∀ (p : point), int.nonneg (∥ p ∥) := begin
    intros p,
    unfold point_norm,
    apply int_nonneg_add,
    apply int_x_times_x_nonneg,
    apply int_x_times_x_nonneg
end

lemma point_norm_add_comm :
  ∀ (p q : point), ∥ p + q ∥ = ∥ q + p ∥ := begin
    sorry
end

lemma point_norm_sub_comm :
  ∀ (p q : point), ∥ p - q ∥ = ∥ q - p ∥ := begin
    sorry
end

lemma not_leq_and_gt : ∀ (p : point) (n : ℤ),
  ¬((∥p∥ ≤ n) ∧ (n < ∥p∥)) := begin
    sorry
end

lemma not_x_lt_y_and_gt_y :
  ∀ (x y : ℤ),
    ¬(x < y ∧ y < x) := begin
  sorry
end

lemma not_le_and_gt :
  ∀ (x y : ℤ),
    ¬(x ≤ y ∧ y < x) := begin
  sorry
end

lemma not_lt_and_not_gt_implies_eq :
  ∀ (x y : ℤ),
    ¬(x < y) →
    ¬(y < x) →
    x = y := begin
  sorry
end

-- lemma sum_nonneg_nonneg :
--   ∀ (x y : ℚ), (x ≥ 0) → (y ≥ 0) → (x + y ≥ 0) :=
--   begin
--     intros p q p_nonneg q_nonneg,

--   end

/-
def point_norm (p : point) : ℚ :=
  p.1 * p.1 + p.2 * p.2

notation `∥` e `∥` := point_norm e

lemma x_times_x_nonneg :
  ∀ (x : ℚ), rat.nonneg (x * x) := begin
    sorry
end

lemma point_norm_nonneg :
  ∀ (p : point), rat.nonneg ∥ p ∥ := begin
    intros p,
    unfold point_norm,
    apply rat.nonneg_add,
    apply x_times_x_nonneg,
    apply x_times_x_nonneg
  end
-/

#eval ((1, 2) : point) + ((-3, -4) : point)

-- def point_hash : point → ℕ
-- | (a, b) := a.num.nat_abs * a.denom * b.num.nat_abs * b.denom
def point_hash : point → ℕ
| (a, b) := a.nat_abs + b.nat_abs

#eval point_hash (1, 4)


/-
Copyright (c) 2022 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.integral.bochner
import measure_theory.group.measure
import measure_theory.group.action

/-!
# Integration on Groups

We develop properties of integrals with a group as domain.
This file contains properties about integrability, Lebesgue integration and Bochner integration.
-/

namespace measure_theory

open measure topological_space
open_locale ennreal

variables {𝕜 M α G E F : Type*} [measurable_space G]
variables [normed_group E] [normed_space ℝ E] [complete_space E] [normed_group F]
variables {μ : measure G} {f : G → E} {g : G}

section measurable_inv

variables [group G] [has_measurable_inv G]

@[to_additive]
lemma integrable.comp_inv [is_inv_invariant μ] {f : G → F} (hf : integrable f μ) :
  integrable (λ t, f t⁻¹) μ :=
(hf.mono_measure (map_inv_eq_self μ).le).comp_measurable measurable_inv

@[to_additive]
lemma integral_inv_eq_self (f : G → E) (μ : measure G) [is_inv_invariant μ] :
  ∫ x, f (x⁻¹) ∂μ = ∫ x, f x ∂μ :=
begin
  have h : measurable_embedding (λ x : G, x⁻¹) :=
  (measurable_equiv.inv G).measurable_embedding,
  rw [← h.integral_map, map_inv_eq_self]
end

end measurable_inv

section measurable_mul

variables [group G] [has_measurable_mul G]

/-- Translating a function by left-multiplication does not change its `measure_theory.lintegral`
with respect to a left-invariant measure. -/
@[to_additive "Translating a function by left-addition does not change its
`measure_theory.lintegral` with respect to a left-invariant measure."]
lemma lintegral_mul_left_eq_self [is_mul_left_invariant μ] (f : G → ℝ≥0∞) (g : G) :
  ∫⁻ x, f (g * x) ∂μ = ∫⁻ x, f x ∂μ :=
begin
  convert (lintegral_map_equiv f $ measurable_equiv.mul_left g).symm,
  simp [map_mul_left_eq_self μ g]
end

/-- Translating a function by right-multiplication does not change its `measure_theory.lintegral`
with respect to a right-invariant measure. -/
@[to_additive "Translating a function by right-addition does not change its
`measure_theory.lintegral` with respect to a right-invariant measure."]
lemma lintegral_mul_right_eq_self [is_mul_right_invariant μ] (f : G → ℝ≥0∞) (g : G) :
  ∫⁻ x, f (x * g) ∂μ = ∫⁻ x, f x ∂μ :=
begin
  convert (lintegral_map_equiv f $ measurable_equiv.mul_right g).symm,
  simp [map_mul_right_eq_self μ g]
end

@[simp, to_additive]
lemma lintegral_div_right_eq_self [is_mul_right_invariant μ] (f : G → ℝ≥0∞) (g : G) :
  ∫⁻ x, f (x / g) ∂μ = ∫⁻ x, f x ∂μ :=
by simp_rw [div_eq_mul_inv, lintegral_mul_right_eq_self f g⁻¹]

/-- Translating a function by left-multiplication does not change its integral with respect to a
left-invariant measure. -/
@[simp, to_additive "Translating a function by left-addition does not change its integral with
  respect to a left-invariant measure."]
lemma integral_mul_left_eq_self [is_mul_left_invariant μ] (f : G → E) (g : G) :
  ∫ x, f (g * x) ∂μ = ∫ x, f x ∂μ :=
begin
  have h_mul : measurable_embedding (λ x, g * x) :=
    (measurable_equiv.mul_left g).measurable_embedding,
  rw [← h_mul.integral_map, map_mul_left_eq_self]
end

/-- Translating a function by right-multiplication does not change its integral with respect to a
right-invariant measure. -/
@[simp, to_additive "Translating a function by right-addition does not change its integral with
  respect to a right-invariant measure."]
lemma integral_mul_right_eq_self [is_mul_right_invariant μ] (f : G → E) (g : G) :
  ∫ x, f (x * g) ∂μ = ∫ x, f x ∂μ :=
begin
  have h_mul : measurable_embedding (λ x, x * g) :=
    (measurable_equiv.mul_right g).measurable_embedding,
  rw [← h_mul.integral_map, map_mul_right_eq_self]
end

@[simp, to_additive]
lemma integral_div_right_eq_self [is_mul_right_invariant μ] (f : G → E) (g : G) :
  ∫ x, f (x / g) ∂μ = ∫ x, f x ∂μ :=
by simp_rw [div_eq_mul_inv, integral_mul_right_eq_self f g⁻¹]

/-- If some left-translate of a function negates it, then the integral of the function with respect
to a left-invariant measure is 0. -/
@[to_additive "If some left-translate of a function negates it, then the integral of the function
with respect to a left-invariant measure is 0."]
lemma integral_eq_zero_of_mul_left_eq_neg [is_mul_left_invariant μ] (hf' : ∀ x, f (g * x) = - f x) :
  ∫ x, f x ∂μ = 0 :=
by simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_left_eq_self]

/-- If some right-translate of a function negates it, then the integral of the function with respect
to a right-invariant measure is 0. -/
@[to_additive "If some right-translate of a function negates it, then the integral of the function
with respect to a right-invariant measure is 0."]
lemma integral_eq_zero_of_mul_right_eq_neg [is_mul_right_invariant μ]
  (hf' : ∀ x, f (x * g) = - f x) : ∫ x, f x ∂μ = 0 :=
by simp_rw [← self_eq_neg ℝ E, ← integral_neg, ← hf', integral_mul_right_eq_self]

@[to_additive]
lemma integrable.comp_mul_left {f : G → F} [is_mul_left_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (g * t)) μ :=
(hf.mono_measure (map_mul_left_eq_self μ g).le).comp_measurable $ measurable_const_mul g

@[to_additive]
lemma integrable.comp_mul_right {f : G → F} [is_mul_right_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (t * g)) μ :=
(hf.mono_measure (map_mul_right_eq_self μ g).le).comp_measurable $ measurable_mul_const g

@[to_additive]
lemma integrable.comp_div_right {f : G → F} [is_mul_right_invariant μ] (hf : integrable f μ)
  (g : G) : integrable (λ t, f (t / g)) μ :=
by { simp_rw [div_eq_mul_inv], exact hf.comp_mul_right g⁻¹ }

variables [has_measurable_inv G]

@[to_additive]
lemma integrable.comp_div_left {f : G → F}
  [is_inv_invariant μ] [is_mul_left_invariant μ] (hf : integrable f μ) (g : G) :
  integrable (λ t, f (g / t)) μ :=
begin
  rw [← map_mul_right_inv_eq_self μ g⁻¹, integrable_map_measure, function.comp],
  { simp_rw [div_inv_eq_mul, mul_inv_cancel_left], exact hf },
  { refine ae_strongly_measurable.comp_measurable _ (measurable_id.const_div g),
    simp_rw [map_map (measurable_id'.const_div g) (measurable_id'.const_mul g⁻¹).inv,
      function.comp, div_inv_eq_mul, mul_inv_cancel_left, map_id'],
    exact hf.ae_strongly_measurable },
  { exact (measurable_id'.const_mul g⁻¹).inv.ae_measurable }
end

@[simp, to_additive]
lemma integrable_comp_div_left (f : G → F)
  [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
  integrable (λ t, f (g / t)) μ ↔ integrable f μ :=
begin
  refine ⟨λ h, _, λ h, h.comp_div_left g⟩,
  convert h.comp_inv.comp_mul_left g⁻¹,
  simp_rw [div_inv_eq_mul, mul_inv_cancel_left]
end

@[simp, to_additive]
lemma integral_div_left_eq_self (f : G → E) (μ : measure G) [is_inv_invariant μ]
  [is_mul_left_invariant μ] (x' : G) : ∫ x, f (x' / x) ∂μ = ∫ x, f x ∂μ :=
by simp_rw [div_eq_mul_inv, integral_inv_eq_self (λ x, f (x' * x)) μ,
  integral_mul_left_eq_self f x']

end measurable_mul

section smul

variables [group G] [measurable_space α] [mul_action G α] [has_measurable_smul G α]

@[simp, to_additive]

end smul

section topological_group

variables [topological_space G] [group G] [topological_group G] [borel_space G]
  [is_mul_left_invariant μ]

/-- For nonzero regular left invariant measures, the integral of a continuous nonnegative function
  `f` is 0 iff `f` is 0. -/
@[to_additive "For nonzero regular left invariant measures, the integral of a continuous nonnegative
function `f` is 0 iff `f` is 0."]
lemma lintegral_eq_zero_of_is_mul_left_invariant [regular μ] (hμ : μ ≠ 0)
  {f : G → ℝ≥0∞} (hf : continuous f) :
  ∫⁻ x, f x ∂μ = 0 ↔ f = 0 :=
begin
  haveI := is_open_pos_measure_of_mul_left_invariant_of_regular hμ,
  rw [lintegral_eq_zero_iff hf.measurable, hf.ae_eq_iff_eq μ continuous_zero]
end

end topological_group

end measure_theory


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import linear_algebra.finite_dimensional
import ring_theory.integral_closure
import data.polynomial.integral_normalization

/-!
# Algebraic elements and algebraic extensions

An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial.
An R-algebra is algebraic over R if and only if all its elements are algebraic over R.
The main result in this file proves transitivity of algebraicity:
a tower of algebraic field extensions is algebraic.
-/

universes u v

open_locale classical
open polynomial

section
variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]

/-- An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial. -/
def is_algebraic (x : A) : Prop :=
∃ p : polynomial R, p ≠ 0 ∧ aeval x p = 0

/-- An element of an R-algebra is transcendental over R if it is not algebraic over R. -/
def transcendental (x : A) : Prop := ¬ is_algebraic R x

variables {R}

/-- A subalgebra is algebraic if all its elements are algebraic. -/
def subalgebra.is_algebraic (S : subalgebra R A) : Prop := ∀ x ∈ S, is_algebraic R x

variables (R A)

/-- An algebra is algebraic if all its elements are algebraic. -/
def algebra.is_algebraic : Prop := ∀ x : A, is_algebraic R x

variables {R A}

/-- A subalgebra is algebraic if and only if it is algebraic an algebra. -/
lemma subalgebra.is_algebraic_iff (S : subalgebra R A) :
  S.is_algebraic ↔ @algebra.is_algebraic R S _ _ (S.algebra) :=
begin
  delta algebra.is_algebraic subalgebra.is_algebraic,
  rw [subtype.forall'],
  apply forall_congr, rintro ⟨x, hx⟩,
  apply exists_congr, intro p,
  apply and_congr iff.rfl,
  have h : function.injective (S.val) := subtype.val_injective,
  conv_rhs { rw [← h.eq_iff, alg_hom.map_zero], },
  rw [← aeval_alg_hom_apply, S.val_apply]
end

/-- An algebra is algebraic if and only if it is algebraic as a subalgebra. -/
lemma algebra.is_algebraic_iff : algebra.is_algebraic R A ↔ (⊤ : subalgebra R A).is_algebraic :=
begin
  delta algebra.is_algebraic subalgebra.is_algebraic,
  simp only [algebra.mem_top, forall_prop_of_true, iff_self],
end

lemma is_algebraic_iff_not_injective {x : A} : is_algebraic R x ↔
  ¬ function.injective (polynomial.aeval x : polynomial R →ₐ[R] A) :=
by simp only [is_algebraic, alg_hom.injective_iff, not_forall, and.comm, exists_prop]

end

section zero_ne_one
variables (R : Type u) {A : Type v} [comm_ring R] [nontrivial R] [ring A] [algebra R A]

/-- An integral element of an algebra is algebraic.-/
lemma is_integral.is_algebraic {x : A} (h : is_integral R x) : is_algebraic R x :=
by { rcases h with ⟨p, hp, hpx⟩, exact ⟨p, hp.ne_zero, hpx⟩ }

variables {R}

/-- An element of `R` is algebraic, when viewed as an element of the `R`-algebra `A`. -/
lemma is_algebraic_algebra_map (a : R) : is_algebraic R (algebra_map R A a) :=
⟨X - C a, X_sub_C_ne_zero a, by simp only [aeval_C, aeval_X, alg_hom.map_sub, sub_self]⟩

end zero_ne_one

section field
variables (K : Type u) {A : Type v} [field K] [ring A] [algebra K A]

/-- An element of an algebra over a field is algebraic if and only if it is integral.-/
lemma is_algebraic_iff_is_integral {x : A} :
  is_algebraic K x ↔ is_integral K x :=
begin
  refine ⟨_, is_integral.is_algebraic K⟩,
  rintro ⟨p, hp, hpx⟩,
  refine ⟨_, monic_mul_leading_coeff_inv hp, _⟩,
  rw [← aeval_def, alg_hom.map_mul, hpx, zero_mul],
end

lemma is_algebraic_iff_is_integral' :
  algebra.is_algebraic K A ↔ algebra.is_integral K A :=
⟨λ h x, (is_algebraic_iff_is_integral K).mp (h x),
  λ h x, (is_algebraic_iff_is_integral K).mpr (h x)⟩

end field

namespace algebra
variables {K : Type*} {L : Type*} {R : Type*} {S : Type*} {A : Type*}
variables [field K] [field L] [comm_ring R] [comm_ring S] [comm_ring A]
variables [algebra K L] [algebra L A] [algebra K A] [is_scalar_tower K L A]
variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]

/-- If L is an algebraic field extension of K and A is an algebraic algebra over L,
then A is algebraic over K. -/
lemma is_algebraic_trans (L_alg : is_algebraic K L) (A_alg : is_algebraic L A) :
  is_algebraic K A :=
begin
  simp only [is_algebraic, is_algebraic_iff_is_integral] at L_alg A_alg ⊢,
  exact is_integral_trans L_alg A_alg,
end

variables (K L)

/-- If A is an algebraic algebra over R, then A is algebraic over A when S is an extension of R,
  and the map from `R` to `S` is injective. -/
lemma is_algebraic_of_larger_base_of_injective (hinj : function.injective (algebra_map R S))
  (A_alg : is_algebraic R A) : is_algebraic S A :=
λ x, let ⟨p, hp₁, hp₂⟩ := A_alg x in
⟨p.map (algebra_map _ _),
  by rwa [ne.def, ← degree_eq_bot, degree_map' hinj, degree_eq_bot],
  by simpa⟩

/-- If A is an algebraic algebra over K, then A is algebraic over L when L is an extension of K -/
lemma is_algebraic_of_larger_base (A_alg : is_algebraic K A) : is_algebraic L A :=
is_algebraic_of_larger_base_of_injective (algebra_map K L).injective A_alg

variables {R S K L}

/-- A field extension is algebraic if it is finite. -/
lemma is_algebraic_of_finite [finite : finite_dimensional K L] : is_algebraic K L :=
λ x, (is_algebraic_iff_is_integral _).mpr (is_integral_of_submodule_noetherian ⊤
  (is_noetherian.iff_fg.2 infer_instance) x algebra.mem_top)

end algebra

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

lemma exists_integral_multiple [algebra R S] {z : S} (hz : is_algebraic R z)
  (inj : ∀ x, algebra_map R S x = 0 → x = 0) :
  ∃ (x : integral_closure R S) (y ≠ (0 : R)),
    z * algebra_map R S y = x :=
begin
  rcases hz with ⟨p, p_ne_zero, px⟩,
  set a := p.leading_coeff with a_def,
  have a_ne_zero : a ≠ 0 := mt polynomial.leading_coeff_eq_zero.mp p_ne_zero,
  have y_integral : is_integral R (algebra_map R S a) := is_integral_algebra_map,
  have x_integral : is_integral R (z * algebra_map R S a) :=
    ⟨p.integral_normalization,
     monic_integral_normalization p_ne_zero,
     integral_normalization_aeval_eq_zero px inj⟩,
  exact ⟨⟨_, x_integral⟩, a, a_ne_zero, rfl⟩
end

/-- A fraction `(a : S) / (b : S)` can be reduced to `(c : S) / (d : R)`,
if `S` is the integral closure of `R` in an algebraic extension `L` of `R`. -/
lemma is_integral_closure.exists_smul_eq_mul {L : Type*} [field L]
  [algebra R S] [algebra S L] [algebra R L] [is_scalar_tower R S L] [is_integral_closure S R L]
  (h : algebra.is_algebraic R L) (inj : function.injective (algebra_map R L))
  (a : S) {b : S} (hb : b ≠ 0) : ∃ (c : S) (d ≠ (0 : R)), d • a = b * c :=
begin
  obtain ⟨c, d, d_ne, hx⟩ := exists_integral_multiple
    (h (algebra_map _ L a / algebra_map _ L b))
    ((ring_hom.injective_iff _).mp inj),
  refine ⟨is_integral_closure.mk' S (c : L) c.2, d, d_ne,
    is_integral_closure.algebra_map_injective S R L _⟩,
  simp only [algebra.smul_def, ring_hom.map_mul, is_integral_closure.algebra_map_mk', ← hx,
    ← is_scalar_tower.algebra_map_apply],
  rw [← mul_assoc _ (_ / _), mul_div_cancel' (algebra_map S L a), mul_comm],
  exact mt ((ring_hom.injective_iff _).mp (is_integral_closure.algebra_map_injective S R L) _) hb
end

section field

variables {K L : Type*} [field K] [field L] [algebra K L] (A : subalgebra K L)

lemma inv_eq_of_aeval_div_X_ne_zero {x : L} {p : polynomial K}
  (aeval_ne : aeval x (div_X p) ≠ 0) :
  x⁻¹ = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)) :=
begin
  rw [inv_eq_iff, inv_div, div_eq_iff, sub_eq_iff_eq_add, mul_comm],
  conv_lhs { rw ← div_X_mul_X_add p },
  rw [alg_hom.map_add, alg_hom.map_mul, aeval_X, aeval_C],
  exact aeval_ne
end

lemma inv_eq_of_root_of_coeff_zero_ne_zero {x : L} {p : polynomial K}
  (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) :
  x⁻¹ = - (aeval x (div_X p) / algebra_map _ _ (p.coeff 0)) :=
begin
  convert inv_eq_of_aeval_div_X_ne_zero (mt (λ h, (algebra_map K L).injective _) coeff_zero_ne),
  { rw [aeval_eq, zero_sub, div_neg] },
  rw ring_hom.map_zero,
  convert aeval_eq,
  conv_rhs { rw ← div_X_mul_X_add p },
  rw [alg_hom.map_add, alg_hom.map_mul, h, zero_mul, zero_add, aeval_C]
end

lemma subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero {x : A} {p : polynomial K}
  (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) : (x⁻¹ : L) ∈ A :=
begin
  have : (x⁻¹ : L) = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)),
  { rw [aeval_eq, subalgebra.coe_zero, zero_sub, div_neg],
    convert inv_eq_of_root_of_coeff_zero_ne_zero _ coeff_zero_ne,
    { rw subalgebra.aeval_coe },
    { simpa using aeval_eq } },
  rw [this, div_eq_mul_inv, aeval_eq, subalgebra.coe_zero, zero_sub, ← ring_hom.map_neg,
      ← ring_hom.map_inv],
  exact A.mul_mem (aeval x p.div_X).2 (A.algebra_map_mem _),
end

lemma subalgebra.inv_mem_of_algebraic {x : A} (hx : is_algebraic K (x : L)) : (x⁻¹ : L) ∈ A :=
begin
  obtain ⟨p, ne_zero, aeval_eq⟩ := hx,
  rw [subalgebra.aeval_coe, subalgebra.coe_eq_zero] at aeval_eq,
  revert ne_zero aeval_eq,
  refine p.rec_on_horner _ _ _,
  { intro h,
    contradiction },
  { intros p a hp ha ih ne_zero aeval_eq,
    refine A.inv_mem_of_root_of_coeff_zero_ne_zero aeval_eq _,
    rwa [coeff_add, hp, zero_add, coeff_C, if_pos rfl] },
  { intros p hp ih ne_zero aeval_eq,
    rw [alg_hom.map_mul, aeval_X, mul_eq_zero] at aeval_eq,
    cases aeval_eq with aeval_eq x_eq,
    { exact ih hp aeval_eq },
    { rw [x_eq, subalgebra.coe_zero, inv_zero],
      exact A.zero_mem } }
end

/-- In an algebraic extension L/K, an intermediate subalgebra is a field. -/
lemma subalgebra.is_field_of_algebraic (hKL : algebra.is_algebraic K L) : is_field A :=
{ mul_inv_cancel := λ a ha, ⟨
        ⟨a⁻¹, A.inv_mem_of_algebraic (hKL a)⟩,
        subtype.ext (mul_inv_cancel (mt (subalgebra.coe_eq_zero _).mp ha))⟩,
  .. show nontrivial A, by apply_instance,
  .. subalgebra.to_comm_ring A }

end field