/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.natural_isomorphism
import category_theory.full_subcategory

/-!
# Essential image of a functor

The essential image `ess_image` of a functor consists of the objects in the target category which
are isomorphic to an object in the image of the object function.
This, for instance, allows us to talk about objects belonging to a subcategory expressed as a
functor rather than a subtype, preserving the principle of equivalence. For example this lets us
define exponential ideals.

The essential image can also be seen as a subcategory of the target category, and witnesses that
a functor decomposes into a essentially surjective functor and a fully faithful functor.
(TODO: show that this decomposition forms an orthogonal factorisation system).
-/
universes v₁ v₂ u₁ u₂

noncomputable theory

namespace category_theory

variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] {F : C ⥤ D}

namespace functor

/--
The essential image of a functor `F` consists of those objects in the target category which are
isomorphic to an object in the image of the function `F.obj`. In other words, this is the closure
under isomorphism of the function `F.obj`.
This is the "non-evil" way of describing the image of a functor.
-/
def ess_image (F : C ⥤ D) : set D := λ Y, ∃ (X : C), nonempty (F.obj X ≅ Y)

/-- Get the witnessing object that `Y` is in the subcategory given by `F`. -/
def ess_image.witness {Y : D} (h : Y ∈ F.ess_image) : C := h.some

/-- Extract the isomorphism between `F.obj h.witness` and `Y` itself. -/
def ess_image.get_iso {Y : D} (h : Y ∈ F.ess_image) : F.obj h.witness ≅ Y :=
classical.choice h.some_spec

/-- Being in the essential image is a "hygenic" property: it is preserved under isomorphism. -/
lemma ess_image.of_iso {Y Y' : D} (h : Y ≅ Y') (hY : Y ∈ ess_image F) :
  Y' ∈ ess_image F :=
hY.imp (λ B, nonempty.map (≪≫ h))

/--
If `Y` is in the essential image of `F` then it is in the essential image of `F'` as long as
`F ≅ F'`.
-/
lemma ess_image.of_nat_iso {F' : C ⥤ D} (h : F ≅ F') {Y : D} (hY : Y ∈ ess_image F) :
  Y ∈ ess_image F' :=
hY.imp (λ X, nonempty.map (λ t, h.symm.app X ≪≫ t))

/-- Isomorphic functors have equal essential images. -/
lemma ess_image_eq_of_nat_iso {F' : C ⥤ D} (h : F ≅ F') :
  ess_image F = ess_image F' :=
set.ext $ λ A, ⟨ess_image.of_nat_iso h, ess_image.of_nat_iso h.symm⟩

/-- An object in the image is in the essential image. -/
lemma obj_mem_ess_image (F : D ⥤ C) (Y : D) : F.obj Y ∈ ess_image F := ⟨Y, ⟨iso.refl _⟩⟩

instance : category F.ess_image := category_theory.full_subcategory _

/-- The essential image as a subcategory has a fully faithful inclusion into the target category. -/
@[derive [full, faithful], simps]
def ess_image_inclusion (F : C ⥤ D) : F.ess_image ⥤ D :=
full_subcategory_inclusion _

/--
Given a functor `F : C ⥤ D`, we have an (essentially surjective) functor from `C` to the essential
image of `F`.
-/
@[simps]
def to_ess_image (F : C ⥤ D) : C ⥤ F.ess_image :=
{ obj := λ X, ⟨_, obj_mem_ess_image _ X⟩,
  map := λ X Y f, (ess_image_inclusion F).preimage (F.map f) }

/--
The functor `F` factorises through its essential image, where the first functor is essentially
surjective and the second is fully faithful.
-/
@[simps]
def to_ess_image_comp_essential_image_inclusion :
  F.to_ess_image ⋙ F.ess_image_inclusion ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by tidy)

end functor

/--
A functor `F : C ⥤ D` is essentially surjective if every object of `D` is in the essential image
of `F`. In other words, for every `Y : D`, there is some `X : C` with `F.obj X ≅ Y`.

See https://stacks.math.columbia.edu/tag/001C.
-/
class ess_surj (F : C ⥤ D) : Prop :=
(mem_ess_image [] (Y : D) : Y ∈ F.ess_image)

instance : ess_surj F.to_ess_image :=
{ mem_ess_image := λ ⟨Y, hY⟩, ⟨_, ⟨⟨_, _, hY.get_iso.hom_inv_id, hY.get_iso.inv_hom_id⟩⟩⟩ }

variables (F) [ess_surj F]

/-- Given an essentially surjective functor, we can find a preimage for every object `Y` in the
    codomain. Applying the functor to this preimage will yield an object isomorphic to `Y`, see
    `obj_obj_preimage_iso`. -/
def functor.obj_preimage (Y : D) : C := (ess_surj.mem_ess_image F Y).witness
/-- Applying an essentially surjective functor to a preimage of `Y` yields an object that is
    isomorphic to `Y`. -/
def functor.obj_obj_preimage_iso (Y : D) : F.obj (F.obj_preimage Y) ≅ Y :=
(ess_surj.mem_ess_image F Y).get_iso

end category_theory


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.induction
import Mathlib.data.polynomial.degree.definitions
import Mathlib.deprecated.ring
import Mathlib.PostPort

universes u v u_1 u_2 w y

namespace Mathlib

/-!
# Theory of univariate polynomials

The main defs here are `eval₂`, `eval`, and `map`.
We give several lemmas about their interaction with each other and with module operations.
-/

namespace polynomial

/-- Evaluate a polynomial `p` given a ring hom `f` from the scalar ring
  to the target and a value `x` for the variable in the target -/
def eval₂ {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S)
    (p : polynomial R) : S :=
  finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e

theorem eval₂_eq_sum {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    {f : R →+* S} {x : S} : eval₂ f x p = finsupp.sum p fun (e : ℕ) (a : R) => coe_fn f a * x ^ e :=
  rfl

theorem eval₂_eq_lift_nc {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {x : S} :
    eval₂ f x = ⇑(add_monoid_algebra.lift_nc (↑f) (coe_fn (powers_hom S) x)) :=
  rfl

theorem eval₂_congr {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] {f : R →+* S}
    {g : R →+* S} {s : S} {t : S} {φ : polynomial R} {ψ : polynomial R} :
    f = g → s = t → φ = ψ → eval₂ f s φ = eval₂ g t ψ :=
  fun (ᾰ : f = g) (ᾰ_1 : s = t) (ᾰ_2 : φ = ψ) =>
    Eq._oldrec (Eq._oldrec (Eq._oldrec (Eq.refl (eval₂ f s φ)) ᾰ_2) ᾰ_1) ᾰ

@[simp] theorem eval₂_zero {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) : eval₂ f x 0 = 0 :=
  finsupp.sum_zero_index

@[simp] theorem eval₂_C {R : Type u} {S : Type v} {a : R} [semiring R] [semiring S] (f : R →+* S)
    (x : S) : eval₂ f x (coe_fn C a) = coe_fn f a :=
  sorry

@[simp] theorem eval₂_X {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S) :
    eval₂ f x X = x :=
  sorry

@[simp] theorem eval₂_monomial {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) {n : ℕ} {r : R} : eval₂ f x (coe_fn (monomial n) r) = coe_fn f r * x ^ n :=
  sorry

@[simp] theorem eval₂_X_pow {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) {n : ℕ} : eval₂ f x (X ^ n) = x ^ n :=
  sorry

@[simp] theorem eval₂_add {R : Type u} {S : Type v} [semiring R] {p : polynomial R}
    {q : polynomial R} [semiring S] (f : R →+* S) (x : S) :
    eval₂ f x (p + q) = eval₂ f x p + eval₂ f x q :=
  sorry

@[simp] theorem eval₂_one {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) : eval₂ f x 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x 1 = 1)) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (coe_fn C 1) = 1)) (eval₂_C f x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f 1 = 1)) (ring_hom.map_one f))) (Eq.refl 1)))

@[simp] theorem eval₂_bit0 {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) : eval₂ f x (bit0 p) = bit0 (eval₂ f x p) :=
  sorry

@[simp] theorem eval₂_bit1 {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) : eval₂ f x (bit1 p) = bit1 (eval₂ f x p) :=
  sorry

@[simp] theorem eval₂_smul {R : Type u} {S : Type v} [semiring R] [semiring S] (g : R →+* S)
    (p : polynomial R) (x : S) {s : R} : eval₂ g x (s • p) = coe_fn g s • eval₂ g x p :=
  sorry

@[simp] theorem eval₂_C_X {R : Type u} [semiring R] {p : polynomial R} : eval₂ C X p = p := sorry

protected instance eval₂.is_add_monoid_hom {R : Type u} {S : Type v} [semiring R] [semiring S]
    (f : R →+* S) (x : S) : is_add_monoid_hom (eval₂ f x) :=
  is_add_monoid_hom.mk (eval₂_zero f x)

@[simp] theorem eval₂_nat_cast {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) (n : ℕ) : eval₂ f x ↑n = ↑n :=
  sorry

theorem eval₂_sum {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] (f : R →+* S)
    [semiring T] (p : polynomial T) (g : ℕ → T → polynomial R) (x : S) :
    eval₂ f x (finsupp.sum p g) = finsupp.sum p fun (n : ℕ) (a : T) => eval₂ f x (g n a) :=
  sorry

theorem eval₂_finset_sum {R : Type u} {S : Type v} {ι : Type y} [semiring R] [semiring S]
    (f : R →+* S) (s : finset ι) (g : ι → polynomial R) (x : S) :
    eval₂ f x (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => eval₂ f x (g i) :=
  sorry

theorem eval₂_mul_noncomm {R : Type u} {S : Type v} [semiring R] {p : polynomial R}
    {q : polynomial R} [semiring S] (f : R →+* S) (x : S)
    (hf : ∀ (k : ℕ), commute (coe_fn f (coeff q k)) x) :
    eval₂ f x (p * q) = eval₂ f x p * eval₂ f x q :=
  sorry

@[simp] theorem eval₂_mul_X {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) : eval₂ f x (p * X) = eval₂ f x p * x :=
  sorry

@[simp] theorem eval₂_X_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) : eval₂ f x (X * p) = eval₂ f x p * x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (X * p) = eval₂ f x p * x)) X_mul))
    (eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * X) = eval₂ f x p * x)) (eval₂_mul_X f x)))
      (Eq.refl (eval₂ f x p * x)))

theorem eval₂_mul_C' {R : Type u} {S : Type v} {a : R} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) (h : commute (coe_fn f a) x) :
    eval₂ f x (p * coe_fn C a) = eval₂ f x p * coe_fn f a :=
  sorry

theorem eval₂_list_prod_noncomm {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (x : S) (ps : List (polynomial R))
    (hf : ∀ (p : polynomial R), p ∈ ps → ∀ (k : ℕ), commute (coe_fn f (coeff p k)) x) :
    eval₂ f x (list.prod ps) = list.prod (list.map (eval₂ f x) ps) :=
  sorry

/-- `eval₂` as a `ring_hom` for noncommutative rings -/
def eval₂_ring_hom' {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : S)
    (hf : ∀ (a : R), commute (coe_fn f a) x) : polynomial R →+* S :=
  ring_hom.mk (eval₂ f x) (eval₂_one f x) sorry (eval₂_zero f x) sorry

/-!
We next prove that eval₂ is multiplicative
as long as target ring is commutative
(even if the source ring is not).
-/

@[simp] theorem eval₂_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R}
    {q : polynomial R} [comm_semiring S] (f : R →+* S) (x : S) :
    eval₂ f x (p * q) = eval₂ f x p * eval₂ f x q :=
  eval₂_mul_noncomm f x fun (k : ℕ) => commute.all (coe_fn f (coeff q k)) x

theorem eval₂_mul_eq_zero_of_left {R : Type u} {S : Type v} [semiring R] {p : polynomial R}
    [comm_semiring S] (f : R →+* S) (x : S) (q : polynomial R) (hp : eval₂ f x p = 0) :
    eval₂ f x (p * q) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * q) = 0)) (eval₂_mul f x)))
    (mul_eq_zero_of_left hp (eval₂ f x q))

theorem eval₂_mul_eq_zero_of_right {R : Type u} {S : Type v} [semiring R] {q : polynomial R}
    [comm_semiring S] (f : R →+* S) (x : S) (p : polynomial R) (hq : eval₂ f x q = 0) :
    eval₂ f x (p * q) = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (eval₂ f x (p * q) = 0)) (eval₂_mul f x)))
    (mul_eq_zero_of_right (eval₂ f x p) hq)

protected instance eval₂.is_semiring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S]
    (f : R →+* S) (x : S) : is_semiring_hom (eval₂ f x) :=
  is_semiring_hom.mk (eval₂_zero f x) (eval₂_one f x)
    (fun (_x _x_1 : polynomial R) => eval₂_add f x) fun (_x _x_1 : polynomial R) => eval₂_mul f x

/-- `eval₂` as a `ring_hom` -/
def eval₂_ring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S) (x : S) :
    polynomial R →+* S :=
  ring_hom.of (eval₂ f x)

@[simp] theorem coe_eval₂_ring_hom {R : Type u} {S : Type v} [semiring R] [comm_semiring S]
    (f : R →+* S) (x : S) : ⇑(eval₂_ring_hom f x) = eval₂ f x :=
  rfl

theorem eval₂_pow {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [comm_semiring S]
    (f : R →+* S) (x : S) (n : ℕ) : eval₂ f x (p ^ n) = eval₂ f x p ^ n :=
  ring_hom.map_pow (eval₂_ring_hom f x) p n

theorem eval₂_eq_sum_range {R : Type u} {S : Type v} [semiring R] {p : polynomial R}
    [comm_semiring S] (f : R →+* S) (x : S) :
    eval₂ f x p =
        finset.sum (finset.range (nat_degree p + 1)) fun (i : ℕ) => coe_fn f (coeff p i) * x ^ i :=
  sorry

theorem eval₂_eq_sum_range' {R : Type u} {S : Type v} [semiring R] [comm_semiring S] (f : R →+* S)
    {p : polynomial R} {n : ℕ} (hn : nat_degree p < n) (x : S) :
    eval₂ f x p = finset.sum (finset.range n) fun (i : ℕ) => coe_fn f (coeff p i) * x ^ i :=
  sorry

/-- `eval x p` is the evaluation of the polynomial `p` at `x` -/
def eval {R : Type u} [semiring R] : R → polynomial R → R := eval₂ (ring_hom.id R)

theorem eval_eq_sum {R : Type u} [semiring R] {p : polynomial R} {x : R} :
    eval x p = finsupp.sum p fun (e : ℕ) (a : R) => a * x ^ e :=
  rfl

@[simp] theorem eval_C {R : Type u} {a : R} [semiring R] {x : R} : eval x (coe_fn C a) = a :=
  eval₂_C (ring_hom.id R) x

@[simp] theorem eval_nat_cast {R : Type u} [semiring R] {x : R} {n : ℕ} : eval x ↑n = ↑n := sorry

@[simp] theorem eval_X {R : Type u} [semiring R] {x : R} : eval x X = x := eval₂_X (ring_hom.id R) x

@[simp] theorem eval_monomial {R : Type u} [semiring R] {x : R} {n : ℕ} {a : R} :
    eval x (coe_fn (monomial n) a) = a * x ^ n :=
  eval₂_monomial (ring_hom.id R) x

@[simp] theorem eval_zero {R : Type u} [semiring R] {x : R} : eval x 0 = 0 :=
  eval₂_zero (ring_hom.id R) x

@[simp] theorem eval_add {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} {x : R} :
    eval x (p + q) = eval x p + eval x q :=
  eval₂_add (ring_hom.id R) x

@[simp] theorem eval_one {R : Type u} [semiring R] {x : R} : eval x 1 = 1 :=
  eval₂_one (ring_hom.id R) x

@[simp] theorem eval_bit0 {R : Type u} [semiring R] {p : polynomial R} {x : R} :
    eval x (bit0 p) = bit0 (eval x p) :=
  eval₂_bit0 (ring_hom.id R) x

@[simp] theorem eval_bit1 {R : Type u} [semiring R] {p : polynomial R} {x : R} :
    eval x (bit1 p) = bit1 (eval x p) :=
  eval₂_bit1 (ring_hom.id R) x

@[simp] theorem eval_smul {R : Type u} [semiring R] (p : polynomial R) (x : R) {s : R} :
    eval x (s • p) = s • eval x p :=
  eval₂_smul (ring_hom.id R) p x

theorem eval_sum {R : Type u} [semiring R] (p : polynomial R) (f : ℕ → R → polynomial R) (x : R) :
    eval x (finsupp.sum p f) = finsupp.sum p fun (n : ℕ) (a : R) => eval x (f n a) :=
  eval₂_sum (ring_hom.id R) p f x

theorem eval_finset_sum {R : Type u} {ι : Type y} [semiring R] (s : finset ι) (g : ι → polynomial R)
    (x : R) : eval x (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => eval x (g i) :=
  eval₂_finset_sum (ring_hom.id R) s (fun (i : ι) => g i) x

/-- `is_root p x` implies `x` is a root of `p`. The evaluation of `p` at `x` is zero -/
def is_root {R : Type u} [semiring R] (p : polynomial R) (a : R) := eval a p = 0

protected instance is_root.decidable {R : Type u} {a : R} [semiring R] {p : polynomial R}
    [DecidableEq R] : Decidable (is_root p a) :=
  eq.mpr sorry (_inst_2 (eval a p) 0)

@[simp] theorem is_root.def {R : Type u} {a : R} [semiring R] {p : polynomial R} :
    is_root p a ↔ eval a p = 0 :=
  iff.rfl

theorem coeff_zero_eq_eval_zero {R : Type u} [semiring R] (p : polynomial R) :
    coeff p 0 = eval 0 p :=
  sorry

theorem zero_is_root_of_coeff_zero_eq_zero {R : Type u} [semiring R] {p : polynomial R}
    (hp : coeff p 0 = 0) : is_root p 0 :=
  eq.mp (Eq._oldrec (Eq.refl (coeff p 0 = 0)) (coeff_zero_eq_eval_zero p)) hp

/-- The composition of polynomials as a polynomial. -/
def comp {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R) : polynomial R :=
  eval₂ C q p

theorem comp_eq_sum_left {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    comp p q = finsupp.sum p fun (e : ℕ) (a : R) => coe_fn C a * q ^ e :=
  rfl

@[simp] theorem comp_X {R : Type u} [semiring R] {p : polynomial R} : comp p X = p := sorry

@[simp] theorem X_comp {R : Type u} [semiring R] {p : polynomial R} : comp X p = p := eval₂_X C p

@[simp] theorem comp_C {R : Type u} {a : R} [semiring R] {p : polynomial R} :
    comp p (coe_fn C a) = coe_fn C (eval a p) :=
  sorry

@[simp] theorem C_comp {R : Type u} {a : R} [semiring R] {p : polynomial R} :
    comp (coe_fn C a) p = coe_fn C a :=
  eval₂_C C p

@[simp] theorem comp_zero {R : Type u} [semiring R] {p : polynomial R} :
    comp p 0 = coe_fn C (eval 0 p) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp p 0 = coe_fn C (eval 0 p))) (Eq.symm C_0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp p (coe_fn C 0) = coe_fn C (eval 0 p))) comp_C))
      (Eq.refl (coe_fn C (eval 0 p))))

@[simp] theorem zero_comp {R : Type u} [semiring R] {p : polynomial R} : comp 0 p = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp 0 p = 0)) (Eq.symm C_0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp (coe_fn C 0) p = coe_fn C 0)) C_comp))
      (Eq.refl (coe_fn C 0)))

@[simp] theorem comp_one {R : Type u} [semiring R] {p : polynomial R} :
    comp p 1 = coe_fn C (eval 1 p) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp p 1 = coe_fn C (eval 1 p))) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp p (coe_fn C 1) = coe_fn C (eval 1 p))) comp_C))
      (Eq.refl (coe_fn C (eval 1 p))))

@[simp] theorem one_comp {R : Type u} [semiring R] {p : polynomial R} : comp 1 p = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (comp 1 p = 1)) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (comp (coe_fn C 1) p = coe_fn C 1)) C_comp))
      (Eq.refl (coe_fn C 1)))

@[simp] theorem add_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R}
    {r : polynomial R} : comp (p + q) r = comp p r + comp q r :=
  eval₂_add C r

@[simp] theorem mul_comp {R : Type u_1} [comm_semiring R] (p : polynomial R) (q : polynomial R)
    (r : polynomial R) : comp (p * q) r = comp p r * comp q r :=
  eval₂_mul C r

@[simp] theorem bit0_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    comp (bit0 p) q = bit0 (comp p q) :=
  sorry

@[simp] theorem bit1_comp {R : Type u} [semiring R] {p : polynomial R} {q : polynomial R} :
    comp (bit1 p) q = bit1 (comp p q) :=
  sorry

theorem comp_assoc {R : Type u_1} [comm_semiring R] (φ : polynomial R) (ψ : polynomial R)
    (χ : polynomial R) : comp (comp φ ψ) χ = comp φ (comp ψ χ) :=
  sorry

/-- `map f p` maps a polynomial `p` across a ring hom `f` -/
def map {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    polynomial R → polynomial S :=
  eval₂ (ring_hom.comp C f) X

protected instance is_semiring_hom_C_f {R : Type u} {S : Type v} [semiring R] [semiring S]
    (f : R →+* S) : is_semiring_hom (⇑C ∘ ⇑f) :=
  is_semiring_hom.comp ⇑f ⇑C

@[simp] theorem map_C {R : Type u} {S : Type v} {a : R} [semiring R] [semiring S] (f : R →+* S) :
    map f (coe_fn C a) = coe_fn C (coe_fn f a) :=
  eval₂_C (ring_hom.comp C f) X

@[simp] theorem map_X {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    map f X = X :=
  eval₂_X (ring_hom.comp C f) X

@[simp] theorem map_monomial {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    {n : ℕ} {a : R} : map f (coe_fn (monomial n) a) = coe_fn (monomial n) (coe_fn f a) :=
  sorry

@[simp] theorem map_zero {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    map f 0 = 0 :=
  eval₂_zero (ring_hom.comp C f) X

@[simp] theorem map_add {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R}
    [semiring S] (f : R →+* S) : map f (p + q) = map f p + map f q :=
  eval₂_add (ring_hom.comp C f) X

@[simp] theorem map_one {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    map f 1 = 1 :=
  eval₂_one (ring_hom.comp C f) X

@[simp] theorem map_nat_cast {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (n : ℕ) : map f ↑n = ↑n :=
  sorry

@[simp] theorem coeff_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (n : ℕ) : coeff (map f p) n = coe_fn f (coeff p n) :=
  sorry

theorem map_map {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] (f : R →+* S)
    [semiring T] (g : S →+* T) (p : polynomial R) : map g (map f p) = map (ring_hom.comp g f) p :=
  sorry

@[simp] theorem map_id {R : Type u} [semiring R] {p : polynomial R} : map (ring_hom.id R) p = p :=
  sorry

theorem eval₂_eq_eval_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) {x : S} : eval₂ f x p = eval x (map f p) :=
  sorry

theorem map_injective {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (hf : function.injective ⇑f) : function.injective (map f) :=
  sorry

theorem map_surjective {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (hf : function.surjective ⇑f) : function.surjective (map f) :=
  sorry

theorem map_monic_eq_zero_iff {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    {f : R →+* S} (hp : monic p) : map f p = 0 ↔ ∀ (x : R), coe_fn f x = 0 :=
  sorry

theorem map_monic_ne_zero {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    {f : R →+* S} (hp : monic p) [nontrivial S] : map f p ≠ 0 :=
  fun (h : map f p = 0) => ring_hom.map_one_ne_zero f (iff.mp (map_monic_eq_zero_iff hp) h 1)

-- If the rings were commutative, we could prove this just using `eval₂_mul`.

-- TODO this proof is just a hack job on the proof of `eval₂_mul`,

-- using that `X` is central. It should probably be golfed!

@[simp] theorem map_mul {R : Type u} {S : Type v} [semiring R] {p : polynomial R} {q : polynomial R}
    [semiring S] (f : R →+* S) : map f (p * q) = map f p * map f q :=
  sorry

protected instance map.is_semiring_hom {R : Type u} {S : Type v} [semiring R] [semiring S]
    (f : R →+* S) : is_semiring_hom (map f) :=
  is_semiring_hom.mk (eval₂_zero (ring_hom.comp C f) X) (eval₂_one (ring_hom.comp C f) X)
    (fun (_x _x_1 : polynomial R) => eval₂_add (ring_hom.comp C f) X)
    fun (_x _x_1 : polynomial R) => map_mul f

/-- `polynomial.map` as a `ring_hom` -/
def map_ring_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    polynomial R →+* polynomial S :=
  ring_hom.mk (map f) sorry sorry sorry sorry

@[simp] theorem coe_map_ring_hom {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) :
    ⇑(map_ring_hom f) = map f :=
  rfl

theorem map_list_prod {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    (L : List (polynomial R)) : map f (list.prod L) = list.prod (list.map (map f) L) :=
  Eq.symm (list.prod_hom L (monoid_hom.of (map f)))

@[simp] theorem map_pow {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (n : ℕ) : map f (p ^ n) = map f p ^ n :=
  is_monoid_hom.map_pow (map f) p n

theorem mem_map_range {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S)
    {p : polynomial S} : p ∈ set.range (map f) ↔ ∀ (n : ℕ), coeff p n ∈ set.range ⇑f :=
  sorry

theorem eval₂_map {R : Type u} {S : Type v} {T : Type w} [semiring R] {p : polynomial R}
    [semiring S] (f : R →+* S) [semiring T] (g : S →+* T) (x : T) :
    eval₂ g x (map f p) = eval₂ (ring_hom.comp g f) x p :=
  sorry

theorem eval_map {R : Type u} {S : Type v} [semiring R] {p : polynomial R} [semiring S]
    (f : R →+* S) (x : S) : eval x (map f p) = eval₂ f x p :=
  eval₂_map f (ring_hom.id S) x

theorem map_sum {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) {ι : Type u_1}
    (g : ι → polynomial R) (s : finset ι) :
    map f (finset.sum s fun (i : ι) => g i) = finset.sum s fun (i : ι) => map f (g i) :=
  Eq.symm (finset.sum_hom s (map f))

/-!
After having set up the basic theory of `eval₂`, `eval`, `comp`, and `map`,
we make `eval₂` irreducible.

Perhaps we can make the others irreducible too?
-/

-- TODO: Here we need commutativity in both `S` and `T`?

theorem hom_eval₂ {R : Type u} {S : Type v} {T : Type w} [semiring R] (p : polynomial R)
    [comm_semiring S] [comm_semiring T] (f : R →+* S) (g : S →+* T) (x : S) :
    coe_fn g (eval₂ f x p) = eval₂ (ring_hom.comp g f) (coe_fn g x) p :=
  sorry

@[simp] theorem eval_mul {R : Type u} [comm_semiring R] {p : polynomial R} {q : polynomial R}
    {x : R} : eval x (p * q) = eval x p * eval x q :=
  eval₂_mul (ring_hom.id R) x

protected instance eval.is_semiring_hom {R : Type u} [comm_semiring R] {x : R} :
    is_semiring_hom (eval x) :=
  eval₂.is_semiring_hom (ring_hom.id R) x

@[simp] theorem eval_pow {R : Type u} [comm_semiring R] {p : polynomial R} {x : R} (n : ℕ) :
    eval x (p ^ n) = eval x p ^ n :=
  eval₂_pow (ring_hom.id R) x n

theorem eval₂_hom {R : Type u} {S : Type v} [comm_semiring R] {p : polynomial R} [comm_semiring S]
    (f : R →+* S) (x : R) : eval₂ f (coe_fn f x) p = coe_fn f (eval x p) :=
  ring_hom.comp_id f ▸ Eq.symm (hom_eval₂ p (ring_hom.id R) f x)

theorem root_mul_left_of_is_root {R : Type u} {a : R} [comm_semiring R] (p : polynomial R)
    {q : polynomial R} : is_root q a → is_root (p * q) a :=
  sorry

theorem root_mul_right_of_is_root {R : Type u} {a : R} [comm_semiring R] {p : polynomial R}
    (q : polynomial R) : is_root p a → is_root (p * q) a :=
  sorry

/--
Polynomial evaluation commutes with finset.prod
-/
theorem eval_prod {R : Type u} [comm_semiring R] {ι : Type u_1} (s : finset ι)
    (p : ι → polynomial R) (x : R) :
    eval x (finset.prod s fun (j : ι) => p j) = finset.prod s fun (j : ι) => eval x (p j) :=
  sorry

theorem map_multiset_prod {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S]
    (f : R →+* S) (m : multiset (polynomial R)) :
    map f (multiset.prod m) = multiset.prod (multiset.map (map f) m) :=
  Eq.symm (multiset.prod_hom m (monoid_hom.of (map f)))

theorem map_prod {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S)
    {ι : Type u_1} (g : ι → polynomial R) (s : finset ι) :
    map f (finset.prod s fun (i : ι) => g i) = finset.prod s fun (i : ι) => map f (g i) :=
  Eq.symm (finset.prod_hom s (map f))

theorem support_map_subset {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S]
    (f : R →+* S) (p : polynomial R) : finsupp.support (map f p) ⊆ finsupp.support p :=
  sorry

theorem map_comp {R : Type u} {S : Type v} [comm_semiring R] [comm_semiring S] (f : R →+* S)
    (p : polynomial R) (q : polynomial R) : map f (comp p q) = comp (map f p) (map f q) :=
  sorry

-- @[simp]

-- lemma C_eq_int_cast (n : ℤ) : C ↑n = (n : polynomial R) :=

-- (C : R →+* _).map_int_cast n

theorem C_neg {R : Type u} {a : R} [ring R] : coe_fn C (-a) = -coe_fn C a := ring_hom.map_neg C a

theorem C_sub {R : Type u} {a : R} {b : R} [ring R] : coe_fn C (a - b) = coe_fn C a - coe_fn C b :=
  ring_hom.map_sub C a b

protected instance map.is_ring_hom {R : Type u} [ring R] {S : Type u_1} [ring S] (f : R →+* S) :
    is_ring_hom (map f) :=
  is_ring_hom.of_semiring (map f)

@[simp] theorem map_sub {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} {S : Type u_1}
    [ring S] (f : R →+* S) : map f (p - q) = map f p - map f q :=
  is_ring_hom.map_sub (map f)

@[simp] theorem map_neg {R : Type u} [ring R] {p : polynomial R} {S : Type u_1} [ring S]
    (f : R →+* S) : map f (-p) = -map f p :=
  is_ring_hom.map_neg (map f)

@[simp] theorem map_int_cast {R : Type u} [ring R] {S : Type u_1} [ring S] (f : R →+* S) (n : ℤ) :
    map f ↑n = ↑n :=
  ring_hom.map_int_cast (ring_hom.of (map f)) n

@[simp] theorem eval_int_cast {R : Type u} [ring R] {n : ℤ} {x : R} : eval x ↑n = ↑n := sorry

@[simp] theorem eval₂_neg {R : Type u} [ring R] {p : polynomial R} {S : Type u_1} [ring S]
    (f : R →+* S) {x : S} : eval₂ f x (-p) = -eval₂ f x p :=
  sorry

@[simp] theorem eval₂_sub {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} {S : Type u_1}
    [ring S] (f : R →+* S) {x : S} : eval₂ f x (p - q) = eval₂ f x p - eval₂ f x q :=
  sorry

@[simp] theorem eval_neg {R : Type u} [ring R] (p : polynomial R) (x : R) :
    eval x (-p) = -eval x p :=
  eval₂_neg (ring_hom.id R)

@[simp] theorem eval_sub {R : Type u} [ring R] (p : polynomial R) (q : polynomial R) (x : R) :
    eval x (p - q) = eval x p - eval x q :=
  eval₂_sub (ring_hom.id R)

theorem root_X_sub_C {R : Type u} {a : R} {b : R} [ring R] : is_root (X - coe_fn C a) b ↔ a = b :=
  sorry

@[simp] theorem neg_comp {R : Type u} [ring R] {p : polynomial R} {q : polynomial R} :
    comp (-p) q = -comp p q :=
  eval₂_neg C

@[simp] theorem sub_comp {R : Type u} [ring R] {p : polynomial R} {q : polynomial R}
    {r : polynomial R} : comp (p - q) r = comp p r - comp q r :=
  eval₂_sub C

protected instance eval₂.is_ring_hom {R : Type u} [comm_ring R] {S : Type u_1} [comm_ring S]
    (f : R →+* S) {x : S} : is_ring_hom (eval₂ f x) :=
  is_ring_hom.of_semiring (eval₂ f x)

protected instance eval.is_ring_hom {R : Type u} [comm_ring R] {x : R} : is_ring_hom (eval x) :=
  eval₂.is_ring_hom (ring_hom.id R)

end Mathlib


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam, Mario Carneiro

Proving equalities in commutative rings, building on:

1. https://github.com/leanprover-community/mathlib/blob/master/src/tactic/ring2.lean
2. Grégoire, B. and Mahboubi, A., 2005, August. Proving equalities in a commutative ring done right in Coq.
-/
import Init.Data.Nat
import Init.Data.Int
import Init.Data.Array
import Init.Control.EState
import Geo.Util

namespace Arith

universe u

class CRing (α : Type u)
extends HasOfNat α, HasAdd α, HasMul α, HasSub α, HasNeg α, HasPow α Nat :=
(add0        : ∀ (x : α), x + 0 = x)
(addC        : ∀ (x y : α), x + y = y + x)
(addA        : ∀ (x y z : α), (x + y) + z = x + (y + z))
(mul0        : ∀ (x : α), x * 0 = 0)
(mul1        : ∀ (x : α), x * 1 = x)
(mulC        : ∀ (x y : α), x * y = y * x)
(mulA        : ∀ (x y z : α), (x * y) * z = x * (y * z))
(distribL    : ∀ (x y z : α), x * (y + z) = x * y + x * z)
(negMul      : ∀ (x y : α), - (x * y) = (- x) * y)
(negAdd      : ∀ (x y : α), - (x + y) = (- x) + (- y))
(subDef      : ∀ (x y : α), x - y = x + (- y))
(pow0        : ∀ (x : α), x^0 = 1)
(powS        : ∀ (x : α) (n : Nat), x^(n + 1) = x * x^n)

inductive CRExpr : Type
| atom : Nat → CRExpr
| nat  : Nat → CRExpr
| add  : CRExpr → CRExpr → CRExpr
| mul  : CRExpr → CRExpr → CRExpr
| sub  : CRExpr → CRExpr → CRExpr
| neg  : CRExpr → CRExpr
| pow  : CRExpr → Nat → CRExpr

namespace CRExpr

def hasBeq : CRExpr → CRExpr → Bool
| atom x₁,   atom x₂   => x₁ == x₂
| nat n₁,    nat n₂    => n₁ == n₂
| add x₁ y₁, add x₂ y₂ => hasBeq x₁ x₂ && hasBeq y₁ y₂
| mul x₁ y₁, mul x₂ y₂ => hasBeq x₁ x₂ && hasBeq y₁ y₂
| sub x₁ y₁, sub x₂ y₂ => hasBeq x₁ x₂ && hasBeq y₁ y₂
| neg x₁,    neg x₂    => hasBeq x₁ x₂
| pow x₁ k₁, pow x₂ k₂ => hasBeq x₁ x₂ && k₁ == k₂
| _,         _         => false

instance : HasBeq CRExpr := ⟨hasBeq⟩

def hasToString : CRExpr → String
| atom x => "#" ++ toString x
| nat n  => toString n
| add e₁ e₂ => "(add " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| mul e₁ e₂ => "(mul " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| sub e₁ e₂ => "(sub " ++ hasToString e₁ ++ " " ++ hasToString e₂ ++ ")"
| neg e     => "(neg " ++ hasToString e ++ ")"
| pow e k   => "(pow " ++ hasToString e ++ " " ++ toString k ++ ")"

instance : HasToString CRExpr := ⟨hasToString⟩
instance : HasRepr CRExpr := ⟨hasToString⟩
instance : HasOfNat CRExpr   := ⟨nat⟩
instance : HasAdd CRExpr     := ⟨add⟩
instance : HasMul CRExpr     := ⟨mul⟩
instance : HasSub CRExpr     := ⟨sub⟩
instance : HasPow CRExpr Nat := ⟨pow⟩
instance : HasNeg CRExpr     := ⟨neg⟩

def denote {α : Type u} [CRing α] (xs : Array α) : CRExpr → α
| atom x  => xs.get! x
| nat n   => ofNat α n
| add x y => denote x + denote y
| mul x y => denote x * denote y
| sub x y => denote x - denote y
| pow x k => (denote x)^k
| neg x   => - (denote x)

-- TODO: consistent naming
def denotationsEq (e₁ e₂ : CRExpr) : Prop :=
∀ {α : Type u} [CRing α] (xs : Array α), e₁.denote xs = e₂.denote xs

end CRExpr

abbrev Atom := Nat
abbrev Power := Nat

-- Horner expressions
-- Note: care must be taken to maintain "canonical forms"
inductive HExpr : Type
| int       : Int → HExpr
| hornerAux : ∀ (a : HExpr) (x : Atom) (k : Power) (b : HExpr), HExpr -- a[x]^k + b

namespace HExpr

def hasToString : HExpr → String
| int k => "!" ++ toString k
| hornerAux a x k b => "(h " ++ hasToString a ++ " " ++ toString x ++ " " ++ toString k ++ " " ++ hasToString b ++ ")"

instance : HasToString HExpr := ⟨hasToString⟩
instance : HasRepr HExpr := ⟨hasToString⟩

instance : HasOfNat HExpr  := ⟨λ n => int n⟩

def hasBeq : HExpr → HExpr → Bool
| int n₁, int n₂ => n₁ == n₂
| hornerAux a₁ x₁ k₁ b₁, hornerAux a₂ x₂ k₂ b₂ => hasBeq a₁ a₂ && x₁ == x₂ && k₁ == k₂ && hasBeq b₁ b₂
| _, _ => false

instance : HasBeq HExpr := ⟨hasBeq⟩

def atom (x : Atom) : HExpr := hornerAux 1 x 1 0

-- Constructor that maintains canonical form.
def horner (a : HExpr) (x : Atom) (k : Power) (b : HExpr) : HExpr :=
match a with
| int c                 =>
  if c = 0 then b else hornerAux a x k b
| hornerAux a₁ x₁ k₁ b₁ =>
  if x₁ = x ∧ b₁ == 0 then hornerAux a₁ x (k₁ + k) b else hornerAux a x k b

/-
-- The "correct" version, but the compiler can't find "recOn"
def addConst (c₁ : Int) (e₂ : HExpr) : HExpr :=
if c₁ == 0 then e₂ else
  @HExpr.recOn (λ _ => HExpr) e₂
             (λ (c₂ : Int) => int (c₁ + c₂))
             (λ a₂ x₂ k₂ b₂ _ B₂ => hornerAux a₂ x₂ k₂ B₂)
-/
def addConstCore (c₁ : Int) : Nat → HExpr → HExpr
| 0, e₂ => panic! "addConstCore out of fuel"
| fuel+1, e₂ =>
  if c₁ == 0 then e₂ else
    match e₂ with
    | int c₂ => int (c₁ + c₂)
    | hornerAux a₂ x₂ k₂ b₂ => hornerAux a₂ x₂ k₂ (addConstCore fuel b₂)

def addConst (c₁ : Int) (e₂ : HExpr) : HExpr :=
addConstCore c₁ 10000 e₂

def addAux (a₁ : HExpr) (addA₁ : HExpr → HExpr) (x₁ : Atom) : HExpr → Power → HExpr → (HExpr → HExpr) → HExpr
| int c₂,                     k₁, b₁, ϕ =>
  addConst c₂ (hornerAux a₁ x₁ k₁ b₁)
| e₂@(hornerAux a₂ x₂ k₂ b₂), k₁, b₁, ϕ =>
  if x₁ < x₂ then hornerAux a₁ x₁ k₁ (ϕ e₂)
  else if x₂ < x₁ then hornerAux a₂ x₂ k₂ (addAux b₂ k₁ b₁ ϕ)
  else if k₁ < k₂ then hornerAux (addA₁ $ hornerAux a₂ x₁ (k₂ - k₁) 0) x₁ k₁ (ϕ b₂)
  else if k₂ < k₁ then hornerAux (addAux a₂ (k₁ - k₂) 0 id) x₁ k₂ (ϕ b₂)
  else horner (addA₁ a₂) x₁ k₁ (ϕ b₂)

def add : HExpr → HExpr → HExpr
| int c₁,                e₂ => addConst c₁ e₂
| hornerAux a₁ x₁ k₁ b₁, e₂ => addAux a₁ (add a₁) x₁ e₂ k₁ b₁ (add b₁)

instance : HasAdd HExpr := ⟨add⟩

def neg : HExpr → HExpr
| int n => int (-n)
| hornerAux a x k b => hornerAux (neg a) x k (neg b)

instance : HasNeg HExpr := ⟨neg⟩

/-
The "correct" version. See `addConst` above for context.
def mulConst (c₁ : Int) (e₂ : HExpr) : HExpr :=
if c₁ == 0 then 0
else if c₁ == 1 then e₂
else @HExpr.recOn (λ _ => HExpr) e₂
             (λ (c₂ : Int) => int (c₁ * c₂))
             (λ a₂ x₂ k₂ b₂ A₂ B₂ => hornerAux A₂ x₂ k₂ B₂)
-/

def mulConstCore (c₁ : Int) : Nat → HExpr → HExpr
| 0, e₂ => panic! "mulConstCore out of fuel"
| fuel+1, e₂ =>
  if c₁ == 0 then 0
  else if c₁ == 1 then e₂
  else match e₂ with
       | int c₂ => int (c₁ * c₂)
       | hornerAux a₂ x₂ k₂ b₂ => hornerAux (mulConstCore fuel a₂) x₂ k₂ (mulConstCore fuel b₂)

def mulConst (c₁ : Int) (e₂ : HExpr) : HExpr :=
mulConstCore c₁ 10000 e₂

def mulAux (a₁ : HExpr) (x₁ : Atom) (k₁ : Power) (b₁ : HExpr) (mulA₁ mulB₁ : HExpr → HExpr) : HExpr → HExpr
| int k₂ => mulConst k₂ (horner a₁ x₁ k₁ b₁)
| e₂@(hornerAux a₂ x₂ k₂ b₂) =>
  if x₁ < x₂ then horner (mulA₁ e₂) x₁ k₁ (mulB₁ e₂)
  else if x₂ < x₁ then horner (mulAux a₂) x₂ k₂ (mulAux b₂)
  else
    let t : HExpr := horner (mulAux a₂) x₁ k₂ 0;
    if b₂ == 0 then t else t + horner (mulA₁ b₂) x₁ k₁ (mulB₁ b₂)

def mul : HExpr → HExpr → HExpr
| int k₁                => mulConst k₁
| hornerAux a₁ x₁ k₁ b₁ => mulAux a₁ x₁ k₁ b₁ (mul a₁) (mul b₁)

instance : HasMul HExpr := ⟨mul⟩

def pow (t : HExpr) : Nat → HExpr
| 0 => 1
| 1 => t
| k+1 => t * pow k

instance : HasPow HExpr Nat := ⟨pow⟩

end HExpr

namespace CRExpr

def toHExpr : CRExpr → HExpr
| atom x => HExpr.atom x
| nat n  => HExpr.int n
| add x y => x.toHExpr + y.toHExpr
| sub x y => x.toHExpr + - y.toHExpr
| mul x y => x.toHExpr * y.toHExpr
| neg x   => - x.toHExpr
| pow x k => x.toHExpr ^ k

end CRExpr

namespace HExpr

def denote {α : Type u} [CRing α] (xs : Array α) : HExpr → α
| HExpr.int n                 => if n ≥ 0 then ofNat α n.natAbs else - (ofNat α $ n.natAbs)
| HExpr.hornerAux a x k b => a.denote * (xs.get! x)^k + b.denote

-- TODO: this theorem is not true until we either restore primitive recursion
-- or switch to returning an Option.
axiom denoteCommutes {α : Type u} [CRing α] (xs : Array α) :
  ∀ (r : CRExpr), r.denote xs = r.toHExpr.denote xs

end HExpr

theorem CRingCorrect (r₁ r₂ : CRExpr) : r₁.toHExpr = r₂.toHExpr → CRExpr.denotationsEq r₁ r₂ :=
WIP

end Arith


import logic.basic

universe variables u u' u₀ u₁ u₂ v
variables  {α α' : Sort u} {β : Sort u'}

lemma forall_imp_forall {p q : α → Prop}
   (h : ∀ a, (p a → q a))
   (p : ∀ a, p a) : ∀ a, q a :=
  assume a, h _ (p a)

lemma forall_imp_forall'
   {p : α → Prop}
   {q : β → Prop}
   (f : β → α)
   (h : ∀ a, (p (f a) → q a))
   (P : ∀ a, p a) : ∀ a, q a :=
begin
  intro a,
  apply h, apply P
end

lemma exists_or
   {p q : α → Prop}
: (∃ i, p i ∨ q i) ↔ (∃ i, p i) ∨ (∃ i, q i) :=
begin
  split ; intro h,
  { cases h with i h,
    apply or.imp _ _ h
    ; apply exists.intro },
  { cases h with h h
    ; revert h
    ; apply exists_imp_exists
    ; intro,
    { apply or.intro_left },
    { apply or.intro_right }, },
end

lemma exists_imp_exists''
   {p : α → Prop}
   {q : β → Prop}
   (f : ∀ x: α, p x → β)
   (h : ∀ a (h : p a), q (f a h))
   (P : ∃ a, p a) : ∃ a, q a :=
begin
  cases P with a P,
  existsi f a P,
  apply h _ P,
end

lemma exists_imp_exists_simpl
   {p : β → Prop}
   (f : α → β)
   (P : ∃ a, p (f a)) : ∃ a, p a :=
begin
  cases P with a P,
  existsi f a,
  assumption,
end

lemma exists_imp_exists_prop {h₀ h₁ : Prop}
   {p : h₀ → Prop}
   {q : h₁ → Prop}
   (a : h₀)
   (f : h₀ → h₁)
   (h : p a → q (f a))
   (P : ∃ a, p a) : ∃ a, q a :=
begin
  apply @exists_imp_exists' _ _ p q f _ P,
  intro, apply h
end

lemma exists_imp_iff_forall_imp
  (p : α → Prop) (q : Prop)
: (∃ x, p x) → q ↔ (∀ x, p x → q) :=
begin
  split ; intros H,
  { intros x H',
    apply H _,
    exact ⟨_, H'⟩ },
  { intros H',
    cases H' with x H',
    apply H _ H', },
end

lemma and_exists
   (P : Prop)
   (Q : α → Prop)
: P ∧ (∃ x, Q x) ↔ (∃ x, P ∧ Q x) :=
begin
  split
  ; intros H
  ; cases H with x H
  ; cases H with y H
  ; exact ⟨y,x,H⟩
end

lemma exists_and
   (P : α → Prop)
   (Q : Prop)
: (∃ x, P x) ∧ Q ↔ (∃ x, P x ∧ Q) :=
by simp

lemma mem_set_of {α : Type u} (x : α) (P : α → Prop) : x ∈ set_of P ↔ P x :=
by refl

lemma imp_mono {p p' q q' : Prop}
   (hp : p' → p)
   (hq : q  → q')
   (h' : p → q) : (p' → q') := hq ∘ h' ∘ hp

lemma imp_imp_imp_left {p q r : Prop} (h : p → q)
   (h' : q → r) : (p → r) :=
assume h'', h' (h h'')

lemma imp_imp_imp_right {p q r : Prop} (h : p → q)
   (h' : r → p) : (r → q) :=
assume h'', h (h' h'')

lemma imp_imp_imp_right' {p q r : Prop} (h : r → p → q)
   (h' : r → p) : (r → q) :=
assume h'', h h'' (h' h'')

variables {a b c : Prop}

lemma distrib_left_or : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) :=
begin
  split,
  { intro h,
    cases h with ha hb,
    { split, apply or.inl ha^.left, apply or.inl ha^.right },
    { split, apply or.inr hb, apply or.inr hb, } },
  { intro h,
    cases h with hb hc,
    cases hb with hb ha,
    cases hc with hc ha,
    { apply or.inl (⟨hb,hc⟩ : a ∧ b) },
    apply or.inr ha,
    apply or.inr ha, }
end

lemma iff_of_not_iff_not {p q : Prop} (h : ¬ p ↔ ¬ q)
: p ↔ q :=
begin
  split ; intro h₀ ; apply classical.by_contradiction,
  { rw ← h, intro h₁, apply h₁ h₀ },
  { rw h, intro h₁, apply h₁ h₀ },
end

lemma not_iff_not_iff {p q : Prop}
: (¬ p ↔ ¬ q) ↔ (p ↔ q) :=
⟨ iff_of_not_iff_not, not_congr ⟩

lemma distrib_right_or
: c ∨ (a ∧ b) ↔ (c ∨ a) ∧ (c ∨ b) :=
by { rw [or_comm,distrib_left_or], simp [or_comm], }

lemma or_not_and (p q : Prop)
: p ∨ (¬ p ∧ q) ↔ p ∨ q :=
by simp [distrib_right_or,iff_true_intro (classical.em p)]

lemma not_or_iff_not_and_not {p q : Prop} : ¬ (p ∨ q) ↔ ¬ p ∧ ¬ q :=
not_or_distrib

lemma and.mono_right
  (h : a → (b → c))
: a ∧ b → a ∧ c :=
assume ⟨ha,hb⟩, ⟨ha, h ha hb⟩

lemma and.mono_left
  (h : a → (b → c))
: b ∧ a → c ∧ a :=
assume ⟨ha,hb⟩, ⟨h hb ha, hb⟩

namespace classical

local attribute [instance] prop_decidable

lemma or.mono_right
  (h : ¬ a → (b → c))
: a ∨ b → a ∨ c :=
or.rec or.inl $
assume h' : b,
if ha : a
then or.inl ha
else or.inr (h ha h')

lemma or.mono_left
  (h : ¬ a → (b → c))
: b ∨ a → c ∨ a :=
assume h' : b ∨ a,
or.symm $ or.mono_right h h'.symm

lemma not_and_iff_not_or_not {p q : Prop} : ¬ (p ∧ q) ↔ ¬ p ∨ ¬ q :=
not_and_distrib

end classical

lemma not_not_iff_self {p : Prop} : ¬ ¬ p ↔ p :=
begin
  split ,
  { intro hnnp,
    cases classical.em p with h h,
    apply h, cases hnnp h },
  exact not_not_intro
end

lemma and_iff_imp (p q : Prop)
  (h : p)
: p ∧ q ↔ p → q :=
by { split ; intros
     ; cases_matching* _ ∧ _
     ; try { split }
     ; try { assumption },
     exact a h }

lemma and_shunting (p q r : Prop)
: (p ∧ q → r) ↔ (p → q → r) :=
begin
  split ; intro h,
  { intros hp hq,
    apply h ⟨hp,hq⟩ },
  { intro h', cases h' with hp hq,
    apply h hp hq }
end

lemma assume_neg {p : Prop} : (¬ p → p) → p :=
begin
  intro h,
  cases classical.em p with h' h',
  { apply h' },
  { apply h h' },
end

lemma not_forall_iff_exists_not {t : Type u} (P : t → Prop)
: ¬ (∀ x, P x) ↔ (∃ x, ¬ P x) :=
begin
  split,
  { intro h, apply classical.by_contradiction, intros h',
    apply h, intro i,
    have h'' := forall_not_of_not_exists h' i,
    rw not_not_iff_self at h'',
    apply h'' },
  { intros h₀ h₁,
    cases h₀ with i h₀,
    apply h₀, apply h₁ },
end

lemma not_exists_iff_forall_not {t : Type u} (P : t → Prop)
: ¬ (∃ x, P x) ↔ (∀ x, ¬ P x) :=
begin
  split,
  { intros h x h',
    apply h,
    existsi x, apply h' },
  { intros h₀ h₁,
    cases h₁ with i h₁,
    apply h₀, apply h₁ },
end

lemma forall_or {t : Type u} (P Q R : t → Prop)
: (∀ x, P x ∨ Q x → R x) ↔ (∀ x, P x → R x) ∧ (∀ x, Q x → R x) :=
begin
  split ; intro h,
  split,
  all_goals { intros x h' },
  any_goals { cases h with h₀ h₁, cases h' with h₂ h₂ },
  { apply h, left, apply h' },
  { apply h, right, apply h'  },
  { apply h₀, apply h₂ },
  { apply h₁, apply h₂ },
end

lemma exists_option {t : Type u} (P : option t → Prop)
: (∃ x : option t, P x) ↔ P none ∨ ∃ x', P (some x') :=
begin
  split ; intro h,
  { cases h with x h,
    cases x with x,
    { left, assumption },
    { right, exact ⟨_,h⟩ } },
  { cases h with h h
    ; try { cases h with h h }
    ; exact ⟨_,h⟩ }
end

@[simp]
lemma exists_true (P : true → Prop)
: (∃ x : true, P x) ↔ P trivial :=
begin
  split ; intro h,
  { cases h with x h,
    cases x, apply h },
  { exact ⟨_,h⟩ }
end

lemma true_imp (p : Prop)
: true → p ↔ p :=
by { split ; intro h ; intros ; apply h ; trivial }

lemma exists_of_nonempty {t} (p : t → Prop)
: Π [nonempty t], (∀ x, p x) → ∃ x, p x
 | ⟨ x ⟩ H := ⟨x,H x⟩

lemma distrib_left_and (p q r : Prop)
: p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  cases classical.em p with h h,
  { simp [eq_true_intro h] },
  { simp [eq_false_intro h] },
end

lemma distrib_or_over_exists_left {t} [nonempty t] (p : t → Prop) (q : Prop)
: q ∨ (∃ x, p x) ↔ (∃ x, q ∨ p x) :=
begin
  split ; intro h,
  cases h with h h,
  { apply exists_of_nonempty,
    intro, left, apply h },
  { apply exists_imp_exists _ h,
    intro, apply or.intro_right },
  cases h with x h,
  { apply or.imp_right _ h,
    apply Exists.intro },
end

lemma or_iff_not_imp (p q : Prop)
: p ∨ q ↔ ¬ p → q :=
begin
  cases classical.em p with hp hnp,
  { rw [eq_true_intro hp,true_or,not_true,false_implies_iff], },
  { rw [eq_false_intro hnp,false_or,not_false_iff,true_imp], }
end

lemma not_imp_iff_and_not (p q : Prop)
: ¬ (p → q) ↔ p ∧ ¬ q :=
by { apply @not_imp _ _ _, apply classical.prop_decidable }

open function
lemma exists_one_point_of_right_inverse
  {f : β → α} {g : α → β} (h₀ : right_inverse g f)
  (y : α) {p : α → Prop}
  (h₁ : ∀ x, p (f x) → f x = y)
: (∃ x, p (f x)) ↔ p y :=
begin
  split ; intro h,
  { cases h with x h',
    rw [ ← h₁ _ h' ],
    apply h' },
  { existsi g y,
    rw h₀,
    exact h }
end

lemma exists_one_point (y : α) {p : α → Prop}
  (h : ∀ x, p x → x = y)
: (∃ x, p x) ↔ p y :=
by { refine exists_one_point_of_right_inverse _ y h,
     exact id, intro, refl }

@[simp]
lemma exists_one_point_iff_true (y : α)
: (∃ x, x = y) ↔ true :=
iff_true_intro ⟨y,rfl⟩

@[simp]
lemma exists_one_point_right (p : α → Prop) (y : α)
: (∃ x, p x ∧ x = y) ↔ p y :=
by { rw exists_one_point y ; simp }

@[simp]
lemma exists_one_point_right' (p : α → Prop) (y : α)
: (∃ x, p x ∧ y = x) ↔ p y :=
by { rw exists_one_point y ; simp, intros, subst x, }

@[simp]
lemma exists_one_point_left (p : α → Prop) (y : α)
: (∃ x, x = y ∧ p x) ↔ p y :=
by { rw exists_one_point y ; simp }

@[simp]
lemma exists_one_point_left' (p : α → Prop) (y : α)
: (∃ x, y = x ∧ p x) ↔ p y :=
by { rw exists_one_point y ; simp, }

lemma exists_variable_change'
  (p : α → Prop) (q : β → Prop)
  (f : ∀ x : α, p x → β) (g : ∀ x : β, q x → α)
  (Hf : ∀ x (h: p x), q (f x h))
  (Hg : ∀ x (h: q x), p (g x h))
: (∃ i, p i) ↔ (∃ j, q j) :=
begin
  split,
  { apply exists_imp_exists'' f Hf, },
  { apply exists_imp_exists'' g Hg, },
end

lemma exists_variable_change
  (p : α → Prop) (q : β → Prop)
  (f : α → β) (g : β → α)
  (Hf : ∀ x, p x → q (f x))
  (Hg : ∀ x, q x → p (g x))
: (∃ i, p i) ↔ (∃ j, q j) :=
begin
  apply exists_variable_change' p q (λ x (h : p x), f x)  (λ x (h : q x), g x),
  apply Hf,
  apply Hg,
end

@[simp]
lemma exists_range_subtype {α : Sort u}
  (p : α → Prop) (q : α → Prop)
: (∃ j : subtype p, q j.val) ↔ (∃ i, p i ∧ q i) :=
begin
  let f := λ (x : α) (h : p x ∧ q x), subtype.mk x h.left,
  let g := λ (x : subtype p) (h : q (x.val)), x.val,
  apply exists_variable_change' _ _ g f,
  { intros x h, exact ⟨x.property, h⟩  },
  { intros x h, apply h.right },
end

lemma forall_eq_iff_iff_eq {a b : α}
: (∀ c, a = c ↔ c = b) ↔ a = b :=
by { split ; intro h ; rw h, cc, }

lemma forall_eq_implies_iff_eq {a b : α}
: (∀ c, a = c → c = b) ↔ a = b :=
by { split ; intro h, apply h, refl, intros, cc }

lemma or_of_ite {c t f : Prop} [decidable c]
  (h : ite c t f)
: (c ∧ t) ∨ (¬ c ∧ f) :=
begin
  cases decidable.em c with hc hnc,
  { left,
    rw [if_pos hc] at h,
    exact ⟨hc,h⟩ },
  { right,
    rw [if_neg hnc] at h,
    exact ⟨hnc,h⟩ },
end

lemma or_of_ite' {c t f : Prop} [decidable c]
  (h : ite c t f)
: t ∨ f :=
begin
  apply or.imp _ _ (or_of_ite h)
  ; apply and.right
end

def rtc {α : Type u} (r : α → α → Prop) (x y : α) := x = y ∨ tc r x y

def rtc_refl {α : Type u} {r : α → α → Prop} {x : α}
: rtc r x x :=
begin
  unfold rtc,
  left, refl
end

def rtc_trans {α : Type u} {r : α → α → Prop} {x : α} (y : α) {z : α}
  (h₀ : rtc r x y)
  (h₁ : rtc r y z)
: rtc r x z :=
begin
  unfold rtc at h₀,
  cases h₀ with h₀ h₀,
  { subst y, apply h₁ },
  unfold rtc at h₁,
  cases h₁ with h₁ h₁,
  { subst z, apply or.intro_right _ h₀ },
  { apply or.intro_right,
    apply tc.trans _ _ _ h₀ h₁, }
end

instance : is_associative _ (∨) := ⟨ by simp [or_assoc] ⟩
instance : is_associative _ (∧) := ⟨ by simp [and_assoc] ⟩
instance : is_commutative _ (∨) := ⟨ by simp [or_comm] ⟩
instance : is_commutative _ (∧) := ⟨ by simp [and_comm] ⟩


/-
Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Junyan Xu

! This file was ported from Lean 3 source module data.mv_polynomial.cardinal
! leanprover-community/mathlib commit 3cd7b577c6acf365f59a6376c5867533124eff6b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Fintype
import Mathbin.Data.MvPolynomial.Equiv
import Mathbin.SetTheory.Cardinal.Ordinal

/-!
# Cardinality of Multivariate Polynomial Ring

The main result in this file is `mv_polynomial.cardinal_mk_le_max`, which says that
the cardinality of `mv_polynomial σ R` is bounded above by the maximum of `#R`, `#σ`
and `ℵ₀`.
-/

universe u v

open Cardinal

open Cardinal

namespace MvPolynomial

section TwoUniverses

variable {σ : Type u} {R : Type v} [CommSemiring R]

/- warning: mv_polynomial.cardinal_mk_eq_max_lift -> MvPolynomial.cardinal_mk_eq_max_lift is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {R : Type.{u2}} [_inst_1 : CommSemiring.{u2} R] [_inst_2 : Nonempty.{succ u1} σ] [_inst_3 : Nontrivial.{u2} R], Eq.{succ (succ (max u1 u2))} Cardinal.{max u1 u2} (Cardinal.mk.{max u1 u2} (MvPolynomial.{u1, u2} σ R _inst_1)) (LinearOrder.max.{succ (max u1 u2)} Cardinal.{max u1 u2} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ (max u1 u2)} Cardinal.{max u1 u2} Cardinal.canonicallyLinearOrderedAddMonoid.{max u1 u2}) (LinearOrder.max.{succ (max u1 u2)} Cardinal.{max u1 u2} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ (max u1 u2)} Cardinal.{max u1 u2} Cardinal.canonicallyLinearOrderedAddMonoid.{max u1 u2}) (Cardinal.lift.{u1, u2} (Cardinal.mk.{u2} R)) (Cardinal.lift.{u2, u1} (Cardinal.mk.{u1} σ))) Cardinal.aleph0.{max u1 u2})
but is expected to have type
  forall {σ : Type.{u1}} {R : Type.{u2}} [_inst_1 : CommSemiring.{u2} R] [_inst_2 : Nonempty.{succ u1} σ] [_inst_3 : Nontrivial.{u2} R], Eq.{max (succ (succ u1)) (succ (succ u2))} Cardinal.{max u2 u1} (Cardinal.mk.{max u2 u1} (MvPolynomial.{u1, u2} σ R _inst_1)) (Max.max.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} (CanonicallyLinearOrderedAddMonoid.toMax.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{max u1 u2}) (Max.max.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} (CanonicallyLinearOrderedAddMonoid.toMax.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{max u1 u2}) (Cardinal.lift.{u1, u2} (Cardinal.mk.{u2} R)) (Cardinal.lift.{u2, u1} (Cardinal.mk.{u1} σ))) Cardinal.aleph0.{max u1 u2})
Case conversion may be inaccurate. Consider using '#align mv_polynomial.cardinal_mk_eq_max_lift MvPolynomial.cardinal_mk_eq_max_liftₓ'. -/
@[simp]
theorem cardinal_mk_eq_max_lift [Nonempty σ] [Nontrivial R] :
    (#MvPolynomial σ R) = max (max (Cardinal.lift.{u} <| (#R)) <| Cardinal.lift.{v} <| (#σ)) ℵ₀ :=
  (mk_finsupp_lift_of_infinite _ R).trans <| by
    rw [mk_finsupp_nat, max_assoc, lift_max, lift_aleph_0, max_comm]
#align mv_polynomial.cardinal_mk_eq_max_lift MvPolynomial.cardinal_mk_eq_max_lift

#print MvPolynomial.cardinal_mk_eq_lift /-
@[simp]
theorem cardinal_mk_eq_lift [IsEmpty σ] : (#MvPolynomial σ R) = Cardinal.lift.{u} (#R) :=
  ((isEmptyRingEquiv R σ).toEquiv.trans Equiv.ulift.{u}.symm).cardinal_eq
#align mv_polynomial.cardinal_mk_eq_lift MvPolynomial.cardinal_mk_eq_lift
-/

/- warning: mv_polynomial.cardinal_lift_mk_le_max -> MvPolynomial.cardinal_lift_mk_le_max is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {R : Type.{u2}} [_inst_2 : CommSemiring.{u2} R], LE.le.{succ (max u1 u2)} Cardinal.{max u1 u2} Cardinal.hasLe.{max u1 u2} (Cardinal.mk.{max u1 u2} (MvPolynomial.{u1, u2} σ R _inst_2)) (LinearOrder.max.{succ (max u1 u2)} Cardinal.{max u1 u2} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ (max u1 u2)} Cardinal.{max u1 u2} Cardinal.canonicallyLinearOrderedAddMonoid.{max u1 u2}) (LinearOrder.max.{succ (max u1 u2)} Cardinal.{max u1 u2} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ (max u1 u2)} Cardinal.{max u1 u2} Cardinal.canonicallyLinearOrderedAddMonoid.{max u1 u2}) (Cardinal.lift.{u1, u2} (Cardinal.mk.{u2} R)) (Cardinal.lift.{u2, u1} (Cardinal.mk.{u1} σ))) Cardinal.aleph0.{max u1 u2})
but is expected to have type
  forall {σ : Type.{u1}} {R : Type.{u2}} [_inst_2 : CommSemiring.{u2} R], LE.le.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} Cardinal.instLECardinal.{max u1 u2} (Cardinal.mk.{max u2 u1} (MvPolynomial.{u1, u2} σ R _inst_2)) (Max.max.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} (CanonicallyLinearOrderedAddMonoid.toMax.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{max u1 u2}) (Max.max.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} (CanonicallyLinearOrderedAddMonoid.toMax.{max (succ u1) (succ u2)} Cardinal.{max u2 u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{max u1 u2}) (Cardinal.lift.{u1, u2} (Cardinal.mk.{u2} R)) (Cardinal.lift.{u2, u1} (Cardinal.mk.{u1} σ))) Cardinal.aleph0.{max u1 u2})
Case conversion may be inaccurate. Consider using '#align mv_polynomial.cardinal_lift_mk_le_max MvPolynomial.cardinal_lift_mk_le_maxₓ'. -/
theorem cardinal_lift_mk_le_max {σ : Type u} {R : Type v} [CommSemiring R] :
    (#MvPolynomial σ R) ≤ max (max (Cardinal.lift.{u} <| (#R)) <| Cardinal.lift.{v} <| (#σ)) ℵ₀ :=
  by
  cases subsingleton_or_nontrivial R
  · exact (mk_eq_one _).trans_le (le_max_of_le_right one_le_aleph_0)
  cases isEmpty_or_nonempty σ
  · exact cardinal_mk_eq_lift.trans_le (le_max_of_le_left <| le_max_left _ _)
  · exact cardinal_mk_eq_max_lift.le
#align mv_polynomial.cardinal_lift_mk_le_max MvPolynomial.cardinal_lift_mk_le_max

end TwoUniverses

variable {σ R : Type u} [CommSemiring R]

/- warning: mv_polynomial.cardinal_mk_eq_max -> MvPolynomial.cardinal_mk_eq_max is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R] [_inst_2 : Nonempty.{succ u1} σ] [_inst_3 : Nontrivial.{u1} R], Eq.{succ (succ u1)} Cardinal.{u1} (Cardinal.mk.{u1} (MvPolynomial.{u1, u1} σ R _inst_1)) (LinearOrder.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ u1} Cardinal.{u1} Cardinal.canonicallyLinearOrderedAddMonoid.{u1}) (LinearOrder.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ u1} Cardinal.{u1} Cardinal.canonicallyLinearOrderedAddMonoid.{u1}) (Cardinal.mk.{u1} R) (Cardinal.mk.{u1} σ)) Cardinal.aleph0.{u1})
but is expected to have type
  forall {σ : Type.{u1}} {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R] [_inst_2 : Nonempty.{succ u1} σ] [_inst_3 : Nontrivial.{u1} R], Eq.{succ (succ u1)} Cardinal.{u1} (Cardinal.mk.{u1} (MvPolynomial.{u1, u1} σ R _inst_1)) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Cardinal.mk.{u1} R) (Cardinal.mk.{u1} σ)) Cardinal.aleph0.{u1})
Case conversion may be inaccurate. Consider using '#align mv_polynomial.cardinal_mk_eq_max MvPolynomial.cardinal_mk_eq_maxₓ'. -/
theorem cardinal_mk_eq_max [Nonempty σ] [Nontrivial R] :
    (#MvPolynomial σ R) = max (max (#R) (#σ)) ℵ₀ := by simp
#align mv_polynomial.cardinal_mk_eq_max MvPolynomial.cardinal_mk_eq_max

/- warning: mv_polynomial.cardinal_mk_le_max -> MvPolynomial.cardinal_mk_le_max is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R], LE.le.{succ u1} Cardinal.{u1} Cardinal.hasLe.{u1} (Cardinal.mk.{u1} (MvPolynomial.{u1, u1} σ R _inst_1)) (LinearOrder.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ u1} Cardinal.{u1} Cardinal.canonicallyLinearOrderedAddMonoid.{u1}) (LinearOrder.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{succ u1} Cardinal.{u1} Cardinal.canonicallyLinearOrderedAddMonoid.{u1}) (Cardinal.mk.{u1} R) (Cardinal.mk.{u1} σ)) Cardinal.aleph0.{u1})
but is expected to have type
  forall {σ : Type.{u1}} {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R], LE.le.{succ u1} Cardinal.{u1} Cardinal.instLECardinal.{u1} (Cardinal.mk.{u1} (MvPolynomial.{u1, u1} σ R _inst_1)) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Max.max.{succ u1} Cardinal.{u1} (CanonicallyLinearOrderedAddMonoid.toMax.{succ u1} Cardinal.{u1} Cardinal.instCanonicallyLinearOrderedAddMonoidCardinal.{u1}) (Cardinal.mk.{u1} R) (Cardinal.mk.{u1} σ)) Cardinal.aleph0.{u1})
Case conversion may be inaccurate. Consider using '#align mv_polynomial.cardinal_mk_le_max MvPolynomial.cardinal_mk_le_maxₓ'. -/
/-- The cardinality of the multivariate polynomial ring, `mv_polynomial σ R` is at most the maximum
of `#R`, `#σ` and `ℵ₀` -/
theorem cardinal_mk_le_max : (#MvPolynomial σ R) ≤ max (max (#R) (#σ)) ℵ₀ :=
  cardinal_lift_mk_le_max.trans <| by rw [lift_id, lift_id]
#align mv_polynomial.cardinal_mk_le_max MvPolynomial.cardinal_mk_le_max

end MvPolynomial


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Mario Carneiro

Tests for norm_num
-/

import tactic.norm_num
import data.complex.basic
import data.nat.prime

-- constant real : Type
-- notation `ℝ` := real
-- @[instance] constant real.linear_ordered_ring : linear_ordered_field ℝ

-- constant complex : Type
-- notation `ℂ` := complex
-- @[instance] constant complex.field : field ℂ
-- @[instance] constant complex.char_zero : char_zero ℂ

example : 374 + (32 - (2 * 8123) : ℤ) - 61 * 50 = 86 + 32 * 32 - 4 * 5000
      ∧ 43 ≤ 74 + (33 : ℤ) := by norm_num

example : ¬ (7-2)/(2*3) ≥ (1:ℝ) + 2/(3^2) := by norm_num
example : (6:real) + 9 = 15 := by norm_num
example : (2:real)/4 + 4 = 3*3/2 := by norm_num
example : (((3:real)/4)-12)<6 := by norm_num
example : (5:real) ≠ 8 := by norm_num
example : (10:real) > 7 := by norm_num
example : (2:real) * 2 + 3 = 7 := by norm_num
example : (6:real) < 10 := by norm_num
example : (7:real)/2 > 3 := by norm_num
example : (4:real)⁻¹ < 1 := by norm_num
example : ((1:real) / 2)⁻¹ = 2 := by norm_num
example : 2 ^ 17 - 1 = 131071 :=
by {norm_num, tactic.try_for 200 (tactic.result >>= tactic.type_check)}

example : (1:complex) ≠ 2 := by norm_num
example : (1:complex) / 3 ≠ 2 / 7 := by norm_num

example {α} [semiring α] [char_zero α] : (1:α) ≠ 2 := by norm_num
example {α} [ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
example {α} [division_ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
example {α} [division_ring α] [char_zero α] : (1:α) / 3 ≠ 2 / 7 := by norm_num
example {α} [division_ring α] [char_zero α] : (1:α) / 3 ≠ 0 := by norm_num

example : (5 / 2:ℕ) = 2 := by norm_num
example : (5 / -2:ℤ) < -1 := by norm_num
example : (0 + 1) / 2 < 0 + 1 := by norm_num
example : nat.succ (nat.succ (2 ^ 3)) = 10 := by norm_num
example : 10 = (-1 : ℤ) % 11 := by norm_num
example : (12321 - 2 : ℤ) = 12319 := by norm_num

example (x : ℤ) (h : 1000 + 2000 < x) : 100 * 30 < x :=
by norm_num at *; try_for 100 {exact h}

example : (1103 : ℤ) ≤ (2102 : ℤ) := by norm_num
example : (110474 : ℤ) ≤ (210485 : ℤ) := by norm_num
example : (11047462383473829263 : ℤ) ≤ (21048574677772382462 : ℤ) := by norm_num
example : (210485742382937847263 : ℤ) ≤ (1104857462382937847262 : ℤ) := by norm_num
example : (210485987642382937847263 : ℕ) ≤ (11048512347462382937847262 : ℕ) := by norm_num
example : (210485987642382937847263 : ℚ) ≤ (11048512347462382937847262 : ℚ) := by norm_num
example : (2 * 12868 + 25705) * 11621 ^ 2 ≤ 23235 ^ 2 * 12868 := by norm_num

example (x : ℕ) : ℕ := begin
  let n : ℕ, {apply_normed (2^32 - 71)},
  exact n
end

example (a : ℚ) (h : 3⁻¹ * a = a) : true :=
begin
  norm_num at h,
  guard_hyp h : 1 / 3 * a = a,
  trivial
end

example : nat.prime 1277 := by norm_num
example : nat.min_fac 221 = 13 := by norm_num

example (h : (5 : ℤ) ∣ 2) : false := by norm_num at h
example (h : false) : false := by norm_num at h
example : true := by norm_num
example : true ∧ true := by { split, norm_num, norm_num }

example : 10 + 2 = 1 + 11 := by norm_num

example : 10 - 1 = 9 := by norm_num
example : 12 - 5 = 3 + 4 := by norm_num
example : 5 - 20 = 0 := by norm_num
example : 0 - 2 = 0 := by norm_num
example : 4 - (5 - 10) = 2 + (3 - 1) := by norm_num
example : 0 - 0 = 0 := by norm_num
example : 100 - 100 = 0 := by norm_num
example : 5 * (2 - 3) = 0 := by norm_num
example : 10 - 5 * 5 + (7 - 3) * 6 = 27 - 3 := by norm_num

def foo : ℕ := 1

@[norm_num] meta def eval_foo : expr → tactic (expr × expr)
| `(foo) := pure (`(1:ℕ), `(eq.refl 1))
| _ := tactic.failed

example : foo = 1 := by norm_num

-- ordered field examples

variable {α : Type}
variable [linear_ordered_field α]

example : (-1 :α) * 1 = -1 := by norm_num
example : (-2 :α) * 1 = -2 := by norm_num
example : (-2 :α) * -1 = 2 := by norm_num
example : (-2 :α) * -2 = 4 := by norm_num
example : (1 : α) * 0 = 0 := by norm_num

example : ((1 : α) + 1) * 5 = 6 + 4 := by norm_num

example : (1 : α) = 0 + 1 := by norm_num
example : (1 : α) = 1 + 0 := by norm_num
example : (2 : α) = 1 + 1 := by norm_num
example : (2 : α) = 0 + 2 := by norm_num
example : (3 : α) = 1 + 2 := by norm_num
example : (3 : α) = 2 + 1 := by norm_num
example : (4 : α) = 3 + 1 := by norm_num
example : (4 : α) = 2 + 2 := by norm_num
example : (5 : α) = 4 + 1 := by norm_num
example : (5 : α) = 3 + 2 := by norm_num
example : (5 : α) = 2 + 3 := by norm_num
example : (6 : α) = 0 + 6 := by norm_num
example : (6 : α) = 3 + 3 := by norm_num
example : (6 : α) = 4 + 2 := by norm_num
example : (6 : α) = 5 + 1 := by norm_num
example : (7 : α) = 4 + 3 := by norm_num
example : (7 : α) = 1 + 6 := by norm_num
example : (7 : α) = 6 + 1 := by norm_num
example : 33 = 5 + (28 : α) := by norm_num

example : (12 : α) = 0 + (2 + 3) + 7 := by norm_num
example : (105 : α) = 70 + (33 + 2) := by norm_num

example : (45000000000 : α) = 23000000000 + 22000000000 := by norm_num

example : (0 : α) - 3 = -3 := by norm_num
example : (0 : α) - 2 = -2 := by norm_num
example : (1 : α) - 3 = -2 := by norm_num
example : (1 : α) - 1 = 0 := by norm_num
example : (0 : α) - 3 = -3 := by norm_num
example : (0 : α) - 3 = -3 := by norm_num

example : (12 : α) - 4 - (5 + -2) = 5 := by norm_num
example : (12 : α) - 4 - (5 + -2) - 20 = -15 := by norm_num

example : (0 : α) * 0 = 0 := by norm_num
example : (0 : α) * 1 = 0 := by norm_num
example : (0 : α) * 2 = 0 := by norm_num
example : (2 : α) * 0 = 0 := by norm_num
example : (1 : α) * 0 = 0 := by norm_num
example : (1 : α) * 1 = 1 := by norm_num
example : (2 : α) * 1 = 2 := by norm_num
example : (1 : α) * 2 = 2 := by norm_num
example : (2 : α) * 2 = 4 := by norm_num
example : (3 : α) * 2 = 6 := by norm_num
example : (2 : α) * 3 = 6 := by norm_num
example : (4 : α) * 1 = 4 := by norm_num
example : (1 : α) * 4 = 4 := by norm_num
example : (3 : α) * 3 = 9 := by norm_num
example : (3 : α) * 4 = 12 := by norm_num
example : (4 : α) * 4 = 16 := by norm_num
example : (11 : α) * 2 = 22 := by norm_num
example : (15 : α) * 6 = 90 := by norm_num
example : (123456 : α) * 123456 = 15241383936 := by norm_num

example : (4 : α) / 2 = 2 := by norm_num
example : (4 : α) / 1 = 4 := by norm_num
example : (4 : α) / 3 = 4 / 3 := by norm_num
example : (50 : α) / 5 = 10 := by norm_num
example : (1056 : α) / 1 = 1056 := by norm_num
example : (6 : α) / 4 = 3/2 := by norm_num
example : (0 : α) / 3 = 0 := by norm_num
example : (3 : α) / 0 = 0 := by norm_num
example : (9 * 9 * 9) * (12 : α) / 27 = 81 * (2 + 2) := by norm_num
example : (-2 : α) * 4 / 3 = -8 / 3 := by norm_num
example : - (-4 / 3) = 1 / (3 / (4 : α)) := by norm_num

-- auto gen tests
example : ((25 * (1 / 1)) + (30 - 16)) = (39 : α) := by norm_num
example : ((19 * (- 2 - 3)) / 6) = (-95/6 : α) := by norm_num
example : - (3 * 28) = (-84 : α) := by norm_num
example : - - (16 / ((11 / (- - (6 * 19) + 12)) * 21)) = (96/11 : α) := by norm_num
example : (- (- 21 + 24) - - (- - (28 + (- 21 / - (16 / ((1 * 26) * ((0 * - 11) + 13))))) * 21)) =
  (79209/8 : α) := by norm_num
example : (27 * (((16 + - (12 + 4)) + (22 - - 19)) - 23)) = (486 : α) := by norm_num
example : - (13 * (- 30 / ((7 / 24) + - 7))) = (-9360/161 : α) := by norm_num
example : - (0 + 20) = (-20 : α) := by norm_num
example : (- 2 - (27 + (((2 / 14) - (7 + 21)) + (16 - - - 14)))) = (-22/7 : α) := by norm_num
example : (25 + ((8 - 2) + 16)) = (47 : α) := by norm_num
example : (- - 26 / 27) = (26/27 : α) := by norm_num
example : ((((16 * (22 / 14)) - 18) / 11) + 30) = (2360/77 : α) := by norm_num
example : (((- 28 * 28) / (29 - 24)) * 24) = (-18816/5 : α) := by norm_num
example : ((- (18 - ((- - (10 + - 2) - - (23 / 5)) / 5)) - (21 * 22)) -
  (((20 / - ((((19 + 18) + 15) + 3) + - 22)) + 14) / 17)) = (-394571/825 : α) := by norm_num
example : ((3 + 25) - - 4) = (32 : α) := by norm_num
example : ((1 - 0) - 22) = (-21 : α) := by norm_num
example : (((- (8 / 7) / 14) + 20) + 22) = (2054/49 : α) := by norm_num
example : ((21 / 20) - 29) = (-559/20 : α) := by norm_num
example : - - 20 = (20 : α) := by norm_num
example : (24 - (- 9 / 4)) = (105/4 : α) := by norm_num
example : (((7 / ((23 * 19) + (27 * 10))) - ((28 - - 15) * 24)) + (9 / - (10 * - 3))) =
  (-1042007/1010 : α) := by norm_num
example : (26 - (- 29 + (12 / 25))) = (1363/25 : α) := by norm_num
example : ((11 * 27) / (4 - 5)) = (-297 : α) := by norm_num
example : (24 - (9 + 15)) = (0 : α) := by norm_num
example : (- 9 - - 0) = (-9 : α) := by norm_num
example : (- 10 / (30 + 10)) = (-1/4 : α) := by norm_num
example : (22 - (6 * (28 * - 8))) = (1366 : α) := by norm_num
example : ((- - 2 * (9 * - 3)) + (22 / 30)) = (-799/15 : α) := by norm_num
example : - (26 / ((3 + 7) / - (27 * (12 / - 16)))) = (-1053/20 : α) := by norm_num
example : ((- 29 / 1) + 28) = (-1 : α) := by norm_num
example : ((21 * ((10 - (((17 + 28) - - 0) + 20)) + 26)) + ((17 + - 16) * 7)) = (-602 : α) :=
by norm_num
example : (((- 5 - ((24 + - - 8) + 3)) + 20) + - 23) = (-43 : α) := by norm_num
example : ((- ((14 - 15) * (14 + 8)) + ((- (18 - 27) - 0) + 12)) - 11) = (32 : α) := by norm_num
example : (((15 / 17) * (26 / 27)) + 28) = (4414/153 : α) := by norm_num
example : (14 - ((- 16 - 3) * - (20 * 19))) = (-7206 : α) := by norm_num
example : (21 - - - (28 - (12 * 11))) = (125 : α) := by norm_num
example : ((0 + (7 + (25 + 8))) * - (11 * 27)) = (-11880 : α) := by norm_num
example : (19 * - 5) = (-95 : α) := by norm_num
example : (29 * - 8) = (-232 : α) := by norm_num
example : ((22 / 9) - 29) = (-239/9 : α) := by norm_num
example : (3 + (19 / 12)) = (55/12 : α) := by norm_num
example : - (13 + 30) = (-43 : α) := by norm_num
example : - - - (((21 * - - ((- 25 - (- (30 - 5) / (- 5 - 5))) /
  (((6 + ((25 * - 13) + 22)) - 3) / 2))) / (- 3 / 10)) * (- 8 - 0)) = (-308/3 : α) := by norm_num
example : - (2 * - (- 24 * 22)) = (-1056 : α) := by norm_num
example : - - (((28 / - ((- 13 * - 5) / - (((7 - 30) / 16) + 6))) * 0) - 24) = (-24 : α) :=
by norm_num
example : ((13 + 24) - (27 / (21 * 13))) = (3358/91 : α) := by norm_num
example : ((3 / - 21) * 25) = (-25/7 : α) := by norm_num
example : (17 - (29 - 18)) = (6 : α) := by norm_num
example : ((28 / 20) * 15) = (21 : α) := by norm_num
example : ((((26 * (- (23 - 13) - 3)) / 20) / (14 - (10 + 20))) / ((16 / 6) / (16 * - (3 / 28)))) =
(-1521/2240 : α) := by norm_num

example : (46 / (- ((- 17 * 28) - 77) + 87)) = (23/320 : α) := by norm_num
example : (73 * - (67 - (74 * - - 11))) = (54531 : α) := by norm_num
example : ((8 * (25 / 9)) + 59) = (731/9 : α) := by norm_num
example : - ((59 + 85) * - 70) = (10080 : α) := by norm_num
example : (66 + (70 * 58)) = (4126 : α) := by norm_num
example : (- - 49 * 0) = (0 : α) := by norm_num
example : ((- 78 - 69) * 9) = (-1323 : α) := by norm_num
example : - - (7 - - (50 * 79)) = (3957 : α) := by norm_num
example : - (85 * (((4 * 93) * 19) * - 31)) = (18624180 : α) := by norm_num
example : (21 + (- 5 / ((74 * 85) / 45))) = (26373/1258 : α) := by norm_num
example : (42 - ((27 + 64) + 26)) = (-75 : α) := by norm_num
example : (- ((38 - - 17) + 86) - (74 + 58)) = (-273 : α) := by norm_num
example : ((29 * - (75 + - 68)) + (- 41 / 28)) = (-5725/28 : α) := by norm_num
example : (- - (40 - 11) - (68 * 86)) = (-5819 : α) := by norm_num
example : (6 + ((65 - 14) + - 89)) = (-32 : α) := by norm_num
example : (97 * - (29 * 35)) = (-98455 : α) := by norm_num
example : - (66 / 33) = (-2 : α) := by norm_num
example : - ((94 * 89) + (79 - (23 - (((- 1 / 55) + 95) * (28 - (54 / - - - 22)))))) =
(-1369070/121 : α) := by norm_num
example : (- 23 + 61) = (38 : α) := by norm_num
example : - (93 / 69) = (-31/23 : α) := by norm_num
example : (- - ((68 / (39 + (((45 * - (59 - (37 + 35))) / (53 - 75)) -
 - (100 + - (50 / (- 30 - 59)))))) - (69 - (23 * 30))) / (57 + 17)) = (137496481/16368578 : α) :=
by norm_num
example : (- 19 * - - (75 * - - 41)) = (-58425 : α) := by norm_num
example : ((3 / ((- 28 * 45) * (19 + ((- (- 88 - (- (- 1 + 90) + 8)) + 87) * 48)))) + 1) =
  (1903019/1903020 : α) := by norm_num
example : ((- - (28 + 48) / 75) + ((- 59 - 14) - 0)) = (-5399/75 : α) := by norm_num
example : (- ((- (((66 - 86) - 36) / 94) - 3) / - - (77 / (56 - - - 79))) + 87) =
  (312254/3619 : α) := by norm_num


import analysis.normed.group.quotient
import linear_algebra.free_module.pid
import linear_algebra.free_module.finite.basic

import polyhedral_lattice.topology

/-!
# Quotients of polyhedral lattices
-/

noncomputable theory

open_locale big_operators

namespace polyhedral_lattice

variables {Λ : Type*} [polyhedral_lattice Λ] (L : add_subgroup Λ)

instance : is_closed (L : set Λ) :=
is_closed_discrete _

instance : normed_group (Λ ⧸ L) :=
add_subgroup.normed_group_quotient _

lemma π_apply_eq_zero_iff (x) : L.normed_mk x = 0 ↔ x ∈ L :=
quotient_add_group.eq_zero_iff _

lemma π_is_quotient : L.normed_mk.is_quotient :=
normed_group_hom.is_quotient_quotient _

instance [H : fact L.saturated] : no_zero_smul_divisors ℤ (Λ ⧸ L) :=
{ eq_zero_or_eq_zero_of_smul_eq_zero :=
  begin
    intros n x h,
    obtain ⟨x, rfl⟩ : ∃ y, L.normed_mk y = x := quotient.surjective_quotient_mk' x,
    have : L.normed_mk (n • x) = n • L.normed_mk x := L.normed_mk.to_add_monoid_hom.map_zsmul x n,
    simp only [← this, π_apply_eq_zero_iff] at h ⊢,
    exact add_subgroup.saturated_iff_zsmul.mp H.1 _ _ h,
  end }

instance quotient_finite : module.finite ℤ (Λ ⧸ L) :=
begin
  apply module.finite.of_surjective (L.normed_mk).to_add_monoid_hom.to_int_linear_map,
  exact quotient.surjective_quotient_mk'
end

instance quotient_free [H : fact L.saturated] : module.free ℤ (Λ ⧸ L) :=
begin
  let φ := L.normed_mk.to_add_monoid_hom.to_int_linear_map,
  suffices : submodule.span ℤ (set.range (φ ∘ (module.free.choose_basis ℤ Λ))) = ⊤,
  { obtain ⟨n, b⟩ := module.free_of_finite_type_torsion_free this,
    exact module.free.of_basis b, },
  rw [set.range_comp, ← submodule.map_span, basis.span_eq,
    submodule.map_top, linear_map.range_eq_top],
  exact quotient.surjective_quotient_mk'
end

open pseudo_normed_group

lemma norm_lift (y : Λ ⧸ L) :
  ∃ x, L.normed_mk x = y ∧ ∥x∥ = ∥y∥ :=
begin
  have hq : L.normed_mk.is_quotient := normed_group_hom.is_quotient_quotient _,
  let s := λ ε, {x | L.normed_mk x = y ∧ ∥x∥₊ ≤ ∥y∥₊ + ε },
  have hs : ∀ ε, (s ε).finite,
  { intro ε,
    apply (filtration_finite Λ (∥y∥₊ + ε)).subset,
    rintro x ⟨h1, h2⟩,
    simpa only [semi_normed_group.mem_filtration_iff] using h2 },
  let t := λ ε, (hs ε).to_finset,
  have ht : ∀ ε, 0 < ε → (t ε).nonempty,
  { intros ε hε,
    obtain ⟨x, h1, h2⟩ := hq.norm_lift hε y,
    refine ⟨x, _⟩, simp only [set.finite.mem_to_finset], exact ⟨h1, h2.le⟩ },
  let r := ((t 1).image nnnorm).min' ((ht _ zero_lt_one).image _),
  have aux := finset.min'_mem ((t 1).image nnnorm) ((ht _ zero_lt_one).image _),
  simp only [finset.mem_image] at aux,
  obtain ⟨x, hx, H⟩ := aux,
  simp only [set.finite.mem_to_finset, set.mem_set_of_eq] at hx,
  suffices hr : r = ∥y∥₊,
  { refine ⟨x, hx.1, _⟩,
    simp only [← coe_nnnorm, nnreal.coe_injective.eq_iff],
    exact H.trans hr },
  refine ((lt_or_eq_of_le _).resolve_left _).symm,
  { rw ← hx.1, exact (hq.norm_le x).trans H.le },
  { intro hyr,
    let ε := (r - ∥y∥₊) / 2,
    have hε' : (ε : ℝ) = (r - ∥y∥₊) / 2,
    { dsimp only [ε], rw [nnreal.coe_div, nnreal.coe_sub hyr.le, nnreal.coe_bit0, nnreal.coe_one] },
    have hε : 0 < ε,
    { rw [← nnreal.coe_lt_coe, nnreal.coe_zero, hε'],
      exact div_pos (sub_pos.mpr $ nnreal.coe_lt_coe.mpr hyr) zero_lt_two },
    have key : ∥y∥₊ + ε < r,
    { rw [← nnreal.coe_lt_coe, nnreal.coe_add, hε'],
      exact add_sub_div_two_lt (nnreal.coe_lt_coe.mpr hyr), },
    refine not_le_of_lt key _,
    obtain ⟨x₀, hx₀⟩ := ht ε hε,
    simp only [exists_prop, set.finite.mem_to_finset, finset.mem_image, set.mem_set_of_eq] at hx₀,
    refine (finset.min'_le _ _ _).trans hx₀.2,
    simp only [exists_prop, set.finite.mem_to_finset, finset.mem_image, set.mem_set_of_eq],
    exact ⟨x₀, ⟨hx₀.1, (hx₀.2.trans key.le).trans (H.ge.trans hx.2)⟩, rfl⟩, }
end

instance [H : fact L.saturated] : polyhedral_lattice (Λ ⧸ L) :=
{ polyhedral' :=
  begin
    obtain ⟨ι, _inst_ι, l, hl, hl'⟩ := polyhedral_lattice.polyhedral Λ, resetI,
    refine ⟨ι, _inst_ι, (λ i, L.normed_mk (l i)), _⟩,
    intros y,
    obtain ⟨x, rfl, hx⟩ := norm_lift _ y,
    obtain ⟨c, H1, H2⟩ := hl x,
    have key : _ := _,
    refine ⟨c, key, _⟩, swap,
    { show L.normed_mk x = _,
      rw [H1, normed_group_hom.map_sum, fintype.sum_congr],
      intro, exact L.normed_mk.to_add_monoid_hom.map_nsmul _ _ },
    { apply le_antisymm,
      { rw key,
        exact (norm_sum_le _ _).trans (finset.sum_le_sum $ λ i hi, norm_nsmul_le _ _) },
      { simp only [← hx, H2],
        apply finset.sum_le_sum,
        rintro i -,
        have hq : L.normed_mk.is_quotient := normed_group_hom.is_quotient_quotient _,
        exact mul_le_mul le_rfl (hq.norm_le _) (norm_nonneg _) (nat.cast_nonneg _) } },
  end }

end polyhedral_lattice