/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/

import algebra.algebra.basic
import linear_algebra.prod
import algebra.hom.non_unital_alg

/-!
# Unitization of a non-unital algebra

Given a non-unital `R`-algebra `A` (given via the type classes
`[non_unital_ring A] [module R A] [smul_comm_class R A A] [is_scalar_tower R A A]`) we construct
the minimal unital `R`-algebra containing `A` as an ideal. This object `algebra.unitization R A` is
a type synonym for `R × A` on which we place a different multiplicative structure, namely,
`(r₁, a₁) * (r₂, a₂) = (r₁ * r₂, r₁ • a₂ + r₂ • a₁ + a₁ * a₂)` where the multiplicative identity
is `(1, 0)`.

Note, when `A` is a *unital* `R`-algebra, then `unitization R A` constructs a new multiplicative
identity different from the old one, and so in general `unitization R A` and `A` will not be
isomorphic even in the unital case. This approach actually has nice functorial properties.

There is a natural coercion from `A` to `unitization R A` given by `λ a, (0, a)`, the image
of which is a proper ideal (TODO), and when `R` is a field this ideal is maximal. Moreover,
this ideal is always an essential ideal (it has nontrivial intersection with every other nontrivial
ideal).

Every non-unital algebra homomorphism from `A` into a *unital* `R`-algebra `B` has a unique
extension to a (unital) algebra homomorphism from `unitization R A` to `B`.

## Main definitions

* `unitization R A`: the unitization of a non-unital `R`-algebra `A`.
* `unitization.algebra`: the unitization of `A` as a (unital) `R`-algebra.
* `unitization.coe_non_unital_alg_hom`: coercion as a non-unital algebra homomorphism.
* `non_unital_alg_hom.to_alg_hom φ`: the extension of a non-unital algebra homomorphism `φ : A → B`
  into a unital `R`-algebra `B` to an algebra homomorphism `unitization R A →ₐ[R] B`.

## Main results

* `non_unital_alg_hom.to_alg_hom_unique`: the extension is unique

## TODO

* prove the unitization operation is a functor between the appropriate categories
* prove the image of the coercion is an essential ideal, maximal if scalars are a field.
-/

/-- The minimal unitization of a non-unital `R`-algebra `A`. This is just a type synonym for
`R × A`.-/
def unitization (R A : Type*) := R × A

namespace unitization

section basic

variables {R A : Type*}

/-- The canonical inclusion `R → unitization R A`. -/
def inl [has_zero A] (r : R) : unitization R A :=
(r, 0)

/-- The canonical inclusion `A → unitization R A`. -/
instance [has_zero R] : has_coe_t A (unitization R A) := { coe := λ a, (0, a) }

/-- The canonical projection `unitization R A → R`. -/
def fst (x : unitization R A) : R :=
x.1

/-- The canonical projection `unitization R A → A`. -/
def snd (x : unitization R A) : A :=
x.2

@[ext] lemma ext {x y : unitization R A} (h1 : x.fst = y.fst) (h2 : x.snd = y.snd) : x = y :=
prod.ext h1 h2

section
variables (A)
@[simp] lemma fst_inl [has_zero A] (r : R) : (inl r : unitization R A).fst = r := rfl
@[simp] lemma snd_inl [has_zero A] (r : R) : (inl r : unitization R A).snd = 0 := rfl
end

section
variables (R)
@[simp] lemma fst_coe [has_zero R] (a : A) : (a : unitization R A).fst = 0 := rfl
@[simp] lemma snd_coe [has_zero R] (a : A) : (a : unitization R A).snd = a := rfl
end

lemma inl_injective [has_zero A] : function.injective (inl : R → unitization R A) :=
function.left_inverse.injective $ fst_inl _

lemma coe_injective [has_zero R] : function.injective (coe : A → unitization R A) :=
function.left_inverse.injective $ snd_coe _

end basic

/-! ### Structures inherited from `prod`

Additive operators and scalar multiplication operate elementwise. -/

section additive

variables {T : Type*} {S : Type*} {R : Type*} {A : Type*}

instance [inhabited R] [inhabited A] : inhabited (unitization R A) :=
prod.inhabited

instance [has_zero R] [has_zero A] : has_zero (unitization R A) :=
prod.has_zero

instance [has_add R] [has_add A] : has_add (unitization R A) :=
prod.has_add

instance [has_neg R] [has_neg A] : has_neg (unitization R A) :=
prod.has_neg

instance [add_semigroup R] [add_semigroup A] : add_semigroup (unitization R A) :=
prod.add_semigroup

instance [add_zero_class R] [add_zero_class A] : add_zero_class (unitization R A) :=
prod.add_zero_class

instance [add_monoid R] [add_monoid A] : add_monoid (unitization R A) :=
prod.add_monoid

instance [add_group R] [add_group A] : add_group (unitization R A) :=
prod.add_group

instance [add_comm_semigroup R] [add_comm_semigroup A] : add_comm_semigroup (unitization R A) :=
prod.add_comm_semigroup

instance [add_comm_monoid R] [add_comm_monoid A] : add_comm_monoid (unitization R A) :=
prod.add_comm_monoid

instance [add_comm_group R] [add_comm_group A] : add_comm_group (unitization R A) :=
prod.add_comm_group

instance [has_scalar S R] [has_scalar S A] : has_scalar S (unitization R A) :=
prod.has_scalar

instance [has_scalar T R] [has_scalar T A] [has_scalar S R] [has_scalar S A] [has_scalar T S]
  [is_scalar_tower T S R] [is_scalar_tower T S A] : is_scalar_tower T S (unitization R A) :=
prod.is_scalar_tower

instance [has_scalar T R] [has_scalar T A] [has_scalar S R] [has_scalar S A]
  [smul_comm_class T S R] [smul_comm_class T S A] : smul_comm_class T S (unitization R A) :=
prod.smul_comm_class

instance [has_scalar S R] [has_scalar S A] [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ A]
  [is_central_scalar S R] [is_central_scalar S A] : is_central_scalar S (unitization R A) :=
prod.is_central_scalar

instance [monoid S] [mul_action S R] [mul_action S A] : mul_action S (unitization R A) :=
prod.mul_action

instance [monoid S] [add_monoid R] [add_monoid A]
  [distrib_mul_action S R] [distrib_mul_action S A] : distrib_mul_action S (unitization R A) :=
prod.distrib_mul_action

instance [semiring S] [add_comm_monoid R] [add_comm_monoid A]
  [module S R] [module S A] : module S (unitization R A) :=
prod.module

@[simp] lemma fst_zero [has_zero R] [has_zero A] : (0 : unitization R A).fst = 0 := rfl
@[simp] lemma snd_zero [has_zero R] [has_zero A] : (0 : unitization R A).snd = 0 := rfl

@[simp] lemma fst_add [has_add R] [has_add A] (x₁ x₂ : unitization R A) :
  (x₁ + x₂).fst = x₁.fst + x₂.fst := rfl
@[simp] lemma snd_add [has_add R] [has_add A] (x₁ x₂ : unitization R A) :
  (x₁ + x₂).snd = x₁.snd + x₂.snd := rfl

@[simp] lemma fst_neg [has_neg R] [has_neg A] (x : unitization R A) : (-x).fst = -x.fst := rfl
@[simp] lemma snd_neg [has_neg R] [has_neg A] (x : unitization R A) : (-x).snd = -x.snd := rfl

@[simp] lemma fst_smul [has_scalar S R] [has_scalar S A] (s : S) (x : unitization R A) :
  (s • x).fst = s • x.fst := rfl
@[simp] lemma snd_smul [has_scalar S R] [has_scalar S A] (s : S) (x : unitization R A) :
  (s • x).snd = s • x.snd := rfl

section
variables (A)

@[simp] lemma inl_zero [has_zero R] [has_zero A] : (inl 0 : unitization R A) = 0 := rfl

@[simp] lemma inl_add [has_add R] [add_zero_class A] (r₁ r₂ : R) :
  (inl (r₁ + r₂) : unitization R A) = inl r₁ + inl r₂ :=
ext rfl (add_zero 0).symm

@[simp] lemma inl_neg [has_neg R] [add_group A] (r : R) :
  (inl (-r) : unitization R A) = -inl r :=
ext rfl neg_zero.symm

@[simp] lemma inl_smul [monoid S] [add_monoid A] [has_scalar S R] [distrib_mul_action S A]
  (s : S) (r : R) : (inl (s • r) : unitization R A) = s • inl r :=
ext rfl (smul_zero s).symm

end

section
variables (R)

@[simp] lemma coe_zero [has_zero R] [has_zero A] : ↑(0 : A) = (0 : unitization R A) := rfl

@[simp] lemma coe_add [add_zero_class R] [add_zero_class A] (m₁ m₂ : A) :
  (↑(m₁ + m₂) : unitization R A)  = m₁ + m₂ :=
ext (add_zero 0).symm rfl

@[simp] lemma coe_neg [add_group R] [has_neg A] (m : A) :
  (↑(-m) : unitization R A) = -m :=
ext neg_zero.symm rfl

@[simp] lemma coe_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_scalar S A]
  (r : S) (m : A) : (↑(r • m) : unitization R A) = r • m :=
ext (smul_zero' _ _).symm rfl

end

lemma inl_fst_add_coe_snd_eq [add_zero_class R] [add_zero_class A] (x : unitization R A) :
  inl x.fst + ↑x.snd = x :=
ext (add_zero x.1) (zero_add x.2)

/-- To show a property hold on all `unitization R A` it suffices to show it holds
on terms of the form `inl r + a`.

This can be used as `induction x using unitization.ind`. -/
lemma ind {R A} [add_zero_class R] [add_zero_class A] {P : unitization R A → Prop}
  (h : ∀ (r : R) (a : A), P (inl r + a)) (x) : P x :=
inl_fst_add_coe_snd_eq x ▸ h x.1 x.2

/-- This cannot be marked `@[ext]` as it ends up being used instead of `linear_map.prod_ext` when
working with `R × A`. -/
lemma linear_map_ext {N} [semiring S] [add_comm_monoid R] [add_comm_monoid A] [add_comm_monoid N]
  [module S R] [module S A] [module S N] ⦃f g : unitization R A →ₗ[S] N⦄
  (hl : ∀ r, f (inl r) = g (inl r)) (hr : ∀ a : A, f a = g a) :
  f = g :=
linear_map.prod_ext (linear_map.ext hl) (linear_map.ext hr)

variables (R A)

/-- The canonical `R`-linear inclusion `A → unitization R A`. -/
@[simps apply]
def coe_hom [semiring R] [add_comm_monoid A] [module R A] : A →ₗ[R] unitization R A :=
{ to_fun := coe, ..linear_map.inr R R A }

/-- The canonical `R`-linear projection `unitization R A → A`. -/
@[simps apply]
def snd_hom [semiring R] [add_comm_monoid A] [module R A] : unitization R A →ₗ[R] A :=
{ to_fun := snd, ..linear_map.snd _ _ _ }

end additive

/-! ### Multiplicative structure -/

section mul
variables {R A : Type*}

instance [has_one R] [has_zero A] : has_one (unitization R A) :=
⟨(1, 0)⟩

instance [has_mul R] [has_add A] [has_mul A] [has_scalar R A] : has_mul (unitization R A) :=
⟨λ x y, (x.1 * y.1, x.1 • y.2 + y.1 • x.2 + x.2 * y.2)⟩

@[simp] lemma fst_one [has_one R] [has_zero A] : (1 : unitization R A).fst = 1 := rfl
@[simp] lemma snd_one [has_one R] [has_zero A] : (1 : unitization R A).snd = 0 := rfl

@[simp] lemma fst_mul [has_mul R] [has_add A] [has_mul A] [has_scalar R A]
  (x₁ x₂ : unitization R A) : (x₁ * x₂).fst = x₁.fst * x₂.fst := rfl
@[simp] lemma snd_mul [has_mul R] [has_add A] [has_mul A] [has_scalar R A]
  (x₁ x₂ : unitization R A) : (x₁ * x₂).snd = x₁.fst • x₂.snd + x₂.fst • x₁.snd + x₁.snd * x₂.snd :=
rfl

section
variables (A)

@[simp] lemma inl_one [has_one R] [has_zero A] : (inl 1 : unitization R A) = 1 := rfl

@[simp] lemma inl_mul [monoid R] [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
  (r₁ r₂ : R) : (inl (r₁ * r₂) : unitization R A) = inl r₁ * inl r₂ :=
ext rfl $ show (0 : A) = r₁ • (0 : A) + r₂ • 0 + 0 * 0, by simp only [smul_zero, add_zero, mul_zero]

lemma inl_mul_inl [monoid R] [non_unital_non_assoc_semiring A] [distrib_mul_action R A]
  (r₁ r₂ : R) : (inl r₁ * inl r₂ : unitization R A) = inl (r₁ * r₂) :=
(inl_mul A r₁ r₂).symm

end

section
variables (R)

@[simp]

end

lemma inl_mul_coe [semiring R] [non_unital_non_assoc_semiring A] [module R A] (r : R) (a : A) :
  (inl r * a : unitization R A) = ↑(r • a) :=
ext (mul_zero r) $ show r • a + (0 : R) • 0 + 0 * a = r • a,
  by rw [smul_zero, add_zero, zero_mul, add_zero]

lemma coe_mul_inl [semiring R] [non_unital_non_assoc_semiring A] [module R A] (r : R) (a : A) :
  (a * inl r : unitization R A) = ↑(r • a) :=
ext (zero_mul r) $ show (0 : R) • 0 + r • a + a * 0 = r • a,
  by rw [smul_zero, zero_add, mul_zero, add_zero]

instance mul_one_class [monoid R] [non_unital_non_assoc_semiring A] [distrib_mul_action R A] :
  mul_one_class (unitization R A) :=
{ one_mul := λ x, ext (one_mul x.1) $ show (1 : R) • x.2 + x.1 • 0 + 0 * x.2 = x.2,
    by rw [one_smul, smul_zero, add_zero, zero_mul, add_zero],
  mul_one := λ x, ext (mul_one x.1) $ show (x.1 • 0 : A) + (1 : R) • x.2 + x.2 * 0 = x.2,
    by rw [smul_zero, zero_add, one_smul, mul_zero, add_zero],
  .. unitization.has_one,
  .. unitization.has_mul }

instance [semiring R] [non_unital_non_assoc_semiring A] [module R A] :
  non_assoc_semiring (unitization R A) :=
{ zero_mul := λ x, ext (zero_mul x.1) $ show (0 : R) • x.2 + x.1 • 0 + 0 * x.2 = 0,
    by rw [zero_smul, zero_add, smul_zero, zero_mul, add_zero],
  mul_zero := λ x, ext (mul_zero x.1) $ show (x.1 • 0 : A) + (0 : R) • x.2 + x.2 * 0 = 0,
    by rw [smul_zero, zero_add, zero_smul, mul_zero, add_zero],
  left_distrib := λ x₁ x₂ x₃, ext (mul_add x₁.1 x₂.1 x₃.1) $
    show x₁.1 • (x₂.2 + x₃.2) + (x₂.1 + x₃.1) • x₁.2 + x₁.2 * (x₂.2 + x₃.2) =
      x₁.1 • x₂.2 + x₂.1 • x₁.2 + x₁.2 * x₂.2 + (x₁.1 • x₃.2 + x₃.1 • x₁.2 + x₁.2 * x₃.2),
    by { simp only [smul_add, add_smul, mul_add], abel },
  right_distrib := λ x₁ x₂ x₃, ext (add_mul x₁.1 x₂.1 x₃.1) $
    show (x₁.1 + x₂.1) • x₃.2 + x₃.1 • (x₁.2 + x₂.2) + (x₁.2 + x₂.2) * x₃.2 =
      x₁.1 • x₃.2 + x₃.1 • x₁.2 + x₁.2 * x₃.2 + (x₂.1 • x₃.2 + x₃.1 • x₂.2 + x₂.2 * x₃.2),
    by { simp only [add_smul, smul_add, add_mul], abel },
  .. unitization.mul_one_class,
  .. unitization.add_comm_monoid }

instance [comm_monoid R] [non_unital_semiring A] [distrib_mul_action R A] [is_scalar_tower R A A]
  [smul_comm_class R A A] : monoid (unitization R A) :=
{ mul_assoc := λ x y z, ext (mul_assoc x.1 y.1 z.1) $
    show (x.1 * y.1) • z.2 + z.1 • (x.1 • y.2 + y.1 • x.2 + x.2 * y.2) +
      (x.1 • y.2 + y.1 • x.2 + x.2 * y.2) * z.2 =
      x.1 • (y.1 • z.2 + z.1 • y.2 + y.2 * z.2) + (y.1 * z.1) • x.2 +
      x.2 * (y.1 • z.2 + z.1 • y.2 + y.2 * z.2),
    { simp only [smul_add, mul_add, add_mul, smul_smul, smul_mul_assoc, mul_smul_comm, mul_assoc],
      nth_rewrite 1 mul_comm,
      nth_rewrite 2 mul_comm,
      abel },
  ..unitization.mul_one_class }

-- This should work for `non_unital_comm_semiring`s, but we don't seem to have those
instance [comm_monoid R] [comm_semiring A] [distrib_mul_action R A] [is_scalar_tower R A A]
  [smul_comm_class R A A] : comm_monoid (unitization R A) :=
{ mul_comm := λ x₁ x₂, ext (mul_comm x₁.1 x₂.1) $
    show x₁.1 • x₂.2 + x₂.1 • x₁.2 + x₁.2 * x₂.2 = x₂.1 • x₁.2 + x₁.1 • x₂.2 + x₂.2 * x₁.2,
    by rw [add_comm (x₁.1 • x₂.2), mul_comm],
  ..unitization.monoid }

instance [comm_semiring R] [non_unital_semiring A] [module R A] [is_scalar_tower R A A]
  [smul_comm_class R A A] : semiring (unitization R A) :=
{ ..unitization.monoid,
  ..unitization.non_assoc_semiring }

-- This should work for `non_unital_comm_semiring`s, but we don't seem to have those
instance [comm_semiring R] [comm_semiring A] [module R A] [is_scalar_tower R A A]
  [smul_comm_class R A A] : comm_semiring (unitization R A) :=
{ ..unitization.comm_monoid,
  ..unitization.non_assoc_semiring }

variables (R A)

/-- The canonical inclusion of rings `R →+* unitization R A`. -/
@[simps apply]
def inl_ring_hom [semiring R] [non_unital_semiring A] [module R A] : R →+* unitization R A :=
{ to_fun := inl,
  map_one' := inl_one A,
  map_mul' := inl_mul A,
  map_zero' := inl_zero A,
  map_add' := inl_add A }

end mul

/-! ### Star structure -/

section star

variables {R A : Type*}

instance [has_star R] [has_star A] : has_star (unitization R A) :=
⟨λ ra, (star ra.fst, star ra.snd)⟩

@[simp] lemma fst_star [has_star R] [has_star A] (x : unitization R A) :
  (star x).fst = star x.fst := rfl

@[simp] lemma snd_star [has_star R] [has_star A] (x : unitization R A) :
  (star x).snd = star x.snd := rfl

@[simp] lemma inl_star [has_star R] [add_monoid A] [star_add_monoid A] (r : R) :
  inl (star r) = star (inl r : unitization R A) :=
ext rfl (by simp only [snd_star, star_zero, snd_inl])

@[simp] lemma coe_star [add_monoid R] [star_add_monoid R] [has_star A] (a : A) :
  ↑(star a) = star (a : unitization R A) :=
ext (by simp only [fst_star, star_zero, fst_coe]) rfl

instance [add_monoid R] [add_monoid A] [star_add_monoid R] [star_add_monoid A] :
  star_add_monoid (unitization R A) :=
{ star_involutive := λ x, ext (star_star x.fst) (star_star x.snd),
  star_add := λ x y, ext (star_add x.fst y.fst) (star_add x.snd y.snd) }

instance [comm_semiring R] [star_ring R] [add_comm_monoid A] [star_add_monoid A]
  [module R A] [star_module R A] : star_module R (unitization R A) :=
{ star_smul := λ r x, ext (by simp) (by simp) }

instance [comm_semiring R] [star_ring R] [non_unital_semiring A] [star_ring A]
  [module R A] [is_scalar_tower R A A] [smul_comm_class R A A] [star_module R A] :
  star_ring (unitization R A) :=
{ star_mul := λ x y, ext (by simp [star_mul])
    (by simp [star_mul, add_comm (star x.fst • star y.snd)]),
  ..unitization.star_add_monoid }

end star

/-! ### Algebra structure -/

section algebra
variables (S R A : Type*)
[comm_semiring S] [comm_semiring R] [non_unital_semiring A]
[module R A] [is_scalar_tower R A A] [smul_comm_class R A A]
[algebra S R] [distrib_mul_action S A] [is_scalar_tower S R A]

instance algebra : algebra S (unitization R A) :=
{ commutes' := λ r x,
  begin
    induction x using unitization.ind,
    simp only [mul_add, add_mul, ring_hom.to_fun_eq_coe, ring_hom.coe_comp, function.comp_app,
      inl_ring_hom_apply, inl_mul_inl],
    rw [inl_mul_coe, coe_mul_inl, mul_comm]
  end,
  smul_def' := λ s x,
  begin
    induction x using unitization.ind,
    simp only [mul_add, smul_add, ring_hom.to_fun_eq_coe, ring_hom.coe_comp, function.comp_app,
      inl_ring_hom_apply, algebra.algebra_map_eq_smul_one],
    rw [inl_mul_inl, inl_mul_coe, smul_one_mul, inl_smul, coe_smul, smul_one_smul]
  end,
  ..(unitization.inl_ring_hom R A).comp (algebra_map S R) }

lemma algebra_map_eq_inl_comp : ⇑(algebra_map S (unitization R A)) = inl ∘ algebra_map S R := rfl
lemma algebra_map_eq_inl_ring_hom_comp :
  algebra_map S (unitization R A) = (inl_ring_hom R A).comp (algebra_map S R) := rfl
lemma algebra_map_eq_inl : ⇑(algebra_map R (unitization R A)) = inl := rfl
lemma algebra_map_eq_inl_hom : algebra_map R (unitization R A) = inl_ring_hom R A := rfl

/-- The canonical `R`-algebra projection `unitization R A → R`. -/
@[simps]
def fst_hom : unitization R A →ₐ[R] R :=
{ to_fun := fst,
  map_one' := fst_one,
  map_mul' := fst_mul,
  map_zero' := fst_zero,
  map_add' := fst_add,
  commutes' := fst_inl A }

end algebra

section coe

/-- The coercion from a non-unital `R`-algebra `A` to its unitization `unitization R A`
realized as a non-unital algebra homomorphism. -/
@[simps]
def coe_non_unital_alg_hom (R A : Type*) [comm_semiring R] [non_unital_semiring A] [module R A] :
  non_unital_alg_hom R A (unitization R A) :=
{ to_fun := coe,
  map_smul' := coe_smul R,
  map_zero' := coe_zero R,
  map_add' := coe_add R,
  map_mul' := coe_mul R }

end coe

section alg_hom

variables {S R A : Type*}
  [comm_semiring S] [comm_semiring R] [non_unital_semiring A]
  [module R A] [smul_comm_class R A A] [is_scalar_tower R A A]
  {B : Type*} [ring B] [algebra S B]
  [algebra S R] [distrib_mul_action S A] [is_scalar_tower S R A]
  {C : Type*} [ring C] [algebra R C]

lemma alg_hom_ext {φ ψ : unitization R A →ₐ[S] B} (h : ∀ a : A, φ a = ψ a)
  (h' : ∀ r, φ (algebra_map R (unitization R A) r) = ψ (algebra_map R (unitization R A) r)) :
  φ = ψ :=
begin
  ext,
  induction x using unitization.ind,
  simp only [map_add, ←algebra_map_eq_inl, h, h'],
end

/-- See note [partially-applied ext lemmas] -/
@[ext]
lemma alg_hom_ext' {φ ψ : unitization R A →ₐ[R] C}
  (h : φ.to_non_unital_alg_hom.comp (coe_non_unital_alg_hom R A) =
    ψ.to_non_unital_alg_hom.comp (coe_non_unital_alg_hom R A)) :
  φ = ψ :=
alg_hom_ext (non_unital_alg_hom.congr_fun h) (by simp [alg_hom.commutes])

/-- Non-unital algebra homomorphisms from `A` into a unital `R`-algebra `C` lift uniquely to
`unitization R A →ₐ[R] C`. This is the universal property of the unitization. -/
@[simps apply_apply]
def lift : non_unital_alg_hom R A C ≃ (unitization R A →ₐ[R] C) :=
{ to_fun := λ φ,
  { to_fun := λ x, algebra_map R C x.fst + φ x.snd,
    map_one' := by simp only [fst_one, map_one, snd_one, φ.map_zero, add_zero],
    map_mul' := λ x y,
    begin
      induction x using unitization.ind,
      induction y using unitization.ind,
      simp only [mul_add, add_mul, coe_mul, fst_add, fst_mul, fst_inl, fst_coe, mul_zero,
        add_zero, zero_mul, map_mul, snd_add, snd_mul, snd_inl, smul_zero, snd_coe, zero_add,
        φ.map_add, φ.map_smul, φ.map_mul, zero_smul, zero_add],
      rw ←algebra.commutes _ (φ x_a),
      simp only [algebra.algebra_map_eq_smul_one, smul_one_mul, add_assoc],
    end,
    map_zero' := by simp only [fst_zero, map_zero, snd_zero, φ.map_zero, add_zero],
    map_add' := λ x y,
    begin
      induction x using unitization.ind,
      induction y using unitization.ind,
      simp only [fst_add, fst_inl, fst_coe, add_zero, map_add, snd_add, snd_inl, snd_coe, zero_add,
        φ.map_add],
      rw add_add_add_comm,
    end,
    commutes' := λ r, by simp only [algebra_map_eq_inl, fst_inl, snd_inl, φ.map_zero, add_zero] },
  inv_fun := λ φ, φ.to_non_unital_alg_hom.comp (coe_non_unital_alg_hom R A),
  left_inv := λ φ, by { ext, simp, },
  right_inv := λ φ, unitization.alg_hom_ext' (by { ext, simp }), }

lemma lift_symm_apply (φ : unitization R A →ₐ[R] C) (a : A) :
  unitization.lift.symm φ a = φ a := rfl

end alg_hom

end unitization


-- copyright 2017/18 Ellen Arlt
-- August 2018, Proved module R (matrix R n m) by Blair Shi

import algebra.big_operators data.set.finite
import algebra.module

definition matrix (R: Type) (n m : nat)[ring R] :=  fin n →( fin m → R )

namespace matrix

definition add ( R : Type) [ring R] {n m: nat }(A:matrix R m n) ( B : matrix R m n): (matrix R m n):=
λ I J, A I J + B I J

definition neg ( R : Type) [ring R] {n m: nat } (A:matrix R m n) : (matrix R m n):=
λ I J, - A I J

definition zero ( R : Type) [ring R] {m n: nat }: (matrix R m n):=
λ  I J , 0

definition sub ( R : Type) [ring R] {n m: nat }(A:matrix R m n) ( B : matrix R m n): (matrix R m n):=
λ I J, A I J - B I J

theorem add_assoc1 ( R : Type) [ring R] {m n: nat }(A:matrix R m n) ( B : matrix R m n) ( C : matrix R m n) :
 add R A (add R  B C) = add R (add R A B) C :=
begin
apply funext,
intro,
apply funext,
intro y,
unfold add,
show A x y + (B x y + C x y) = ( A x y + B x y) + C x y,
rw [add_assoc],
end

theorem add_assoc2 ( R : Type) [ring R] {m n: nat }(A:matrix R m n) ( B : matrix R m n) ( C : matrix R m n) :
 add R (add R A B) C = add R A (add R  B C)  :=
begin
apply funext,
intro,
apply funext,
intro y,
show  ( A x y + B x y) + C x y = A x y + (B x y + C x y) ,
rw[add_assoc],
end

theorem zero_add   ( R : Type) [ring R] {m n: nat }(A:matrix R m n):
add R (zero R) A = A:=
begin
apply funext,
intro,
apply funext,
intro y,
show 0 + A x y = A x y,
rw[zero_add]
end

theorem add_zero (R : Type) [ring R] {m n: nat }(A:matrix R m n):
add R A (zero R) = A:=
begin
apply funext,
intro,
apply funext,
intro y,
show  A x y + 0 = A x y,
rw[add_zero]
end

theorem add_left_neg (R : Type) [ring R] {m n: nat }(A:matrix R m n) :
add R ( neg R A) A = zero R :=
begin
apply funext,
intro,
apply funext,
intro y,
show  - A x y + A x y = 0 ,
rw[add_left_neg]
end

theorem add_comm (R : Type) [ring R] {m n: nat }(A:matrix R m n)( B : matrix R m n):
add R A B = add R B A :=
begin
apply funext,
intro,
apply funext,
intro y,
show  A x y + B x y = B x y + A x y ,
rw [add_comm]
end

instance matrices_add_comm_group ( R : Type) [ring R] {m n: nat }: add_comm_group (matrix R m n):={
add:= matrix.add R ,
add_assoc := @matrix.add_assoc2 R _ m n,
zero := matrix.zero R ,
neg := matrix.neg R,
zero_add := @matrix.zero_add R _ m n,
add_zero := @matrix.add_zero R _ m n,
add_left_neg := @matrix.add_left_neg R _ m n,
add_comm := @matrix.add_comm R _ m n
}

definition mul ( R : Type) [ring R] {n m l: nat }(A:matrix R m n) ( B : matrix R n l): (matrix R m l ):=
λ I J, finset.sum finset.univ (λ K, A I K * B K J)

theorem mul_assoc ( R : Type) [ring R] {m n l o: nat }(A:matrix R m n) ( B : matrix R n l) ( C : matrix R l o) :
mul R A (mul R B C) = mul R (mul R A B) C :=
begin
unfold mul,
apply funext,
intro x,
apply funext,
intro y,
-- This next line just rewrites the goal so that the variables we're summing over
-- are the same on both sides.

show finset.sum finset.univ (λ (K : fin n), A x K * finset.sum finset.univ (λ (J : fin l), B K J * C J y)) =
     finset.sum finset.univ (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J) * C J y),
-- So the key things we now need to use are:

-- finset.mul_sum (which says c * sum_n a_n = sum_n (c*a_n))
-- finset.sum_mul (which says the same but multiplication on the right)
-- and finset.sum_comm (which says that two finite sums can be commuted).

-- However, rw finset.sum_mul doesn't work
-- and neither does rw finset.mul_sum,
-- and until we apply these we can't commute the sums.
-- I think the reasons they don't work are that C J y, which we need to move, depends on J,
-- which is not one of our variables.

-- So here's a trick. We prove an intermediate lemma which says we can
-- move C J y into the sum, by checking the things we're summing over are the same.

have H2 : (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J) * C J y)
        = (λ (J : fin l), finset.sum finset.univ (λ (K : fin n), A x K * B K J * C J y)),
{ apply funext,
  intro J,
  exact finset.sum_mul,
},

-- Now we can commute the sums after using this lemma.

rw [H2],
clear H2,
rw [finset.sum_comm],

-- Now I just rewrite the goal to show that both things are a sum over K in fin n.

show finset.sum finset.univ (λ (K : fin n), A x K * finset.sum finset.univ (λ (K_1 : fin l), B K K_1 * C K_1 y)) =
    finset.sum finset.univ (λ (K : fin n), finset.sum finset.univ (λ (x_1 : fin l), A x K * B K x_1 * C x_1 y)),

-- Now we can cancel the first sum and it's all downhill from here.

apply congr_arg _,
apply funext,
intro z,
rw finset.mul_sum, -- c*sum a_n = sum c*a_n

apply congr_arg,
apply funext,

intro w,
rw mul_assoc,
end

theorem left_distrib (R:Type) [ring R] {m n l  : nat} (A : matrix R m n) (B : matrix R n l) (C : matrix R n l ) :
mul R A (add R B C) = add R (mul R A B) (mul R A C) :=
begin
unfold mul,
unfold add,
apply funext,
intro x,
apply funext,
intro y,

have H3 :     finset.sum finset.univ (λ (K : fin n), A x K * B K y) + finset.sum finset.univ (λ (K : fin n), A x K * C K y)
            = finset.sum finset.univ (λ (K : fin n), A x K * B K y + A x K * C K y),
{simp[finset.sum_add_distrib]},

rw[H3],
clear H3,

apply congr_arg _,
apply funext,
intro z,
rw [left_distrib]
end

theorem right_distrib (R:Type) [ring R] {m n l  : nat} (A : matrix R m n) (B : matrix R m n) (C : matrix R n l ) :
mul R (add R A B) C  = add R (mul R A C) (mul R B C) :=
begin
unfold mul,
unfold add,
apply funext,
intro x,
apply funext,
intro y,

have H4 :     finset.sum finset.univ (λ (K : fin n), A x K * C K y) + finset.sum finset.univ (λ (K : fin n), B x K * C K y)
            = finset.sum finset.univ (λ (K : fin n), A x K * C K y + B x K * C K y),
{simp[finset.sum_add_distrib]},

rw[H4],
clear H4,

apply congr_arg _,
apply funext,
intro z,
rw [right_distrib]
end

theorem mul_sub_mul {R : Type} [comm_ring R] (a b c : ℕ) :
∀ (A B: matrix R a b), ∀ C : matrix R b c,
matrix.sub R (matrix.mul R A C) (matrix.mul R B C) = matrix.mul R (matrix.sub R A B) C :=
begin
intros A B C,
unfold matrix.sub,
unfold matrix.mul,
funext,
conv in ((A _ _ - B _ _) * C _ _)
begin
  rw [sub_mul],
end,
{simp[finset.sum_add_distrib]},
end

definition identity_matrix ( R : Type) [ring R] { n: nat }: (matrix R n n):=
λ  I J ,
if I=J then 1
else 0

--set_option pp.all true
--set_option pp.notation false
theorem one_mul ( R : Type) [ring R] {n: nat }(A:matrix R n n):
mul R (identity_matrix R) A = A:=
begin
unfold mul,
unfold identity_matrix,
apply funext,
intro x,
apply funext,
intro y,
let xfinset : finset (fin n) := finset.singleton x,
suffices : finset.sum finset.univ (λ (K : fin n), ite (x = K) 1 0 * A K y)
            = finset.sum xfinset (λ t, A t y),
  simp [this],
--  exact finset.sum_singleton,
  apply eq.symm,
  have H1 : finset.sum xfinset (λ (t : fin n), A t y) = finset.sum xfinset (λ (K : fin n), ite (x = K) 1 0 * A K y),
    rw finset.sum_singleton,
    rw finset.sum_singleton,
    simp,
  rw H1,
  refine (finset.sum_subset (_ : xfinset ⊆ finset.univ) _),
  exact finset.subset_univ xfinset,
  intros K H H2,
  have H3 : ¬ (x = K),
    intro H4,
    apply H2,
    rw ←H4,
    apply finset.mem_singleton.2,
    refl,
  simp [H3],

end
--#check @finset.sum_subset
--finset.sum_subset :
--  ∀ {α : Type u_1} {β : Type u_2} {s₁ s₂ : finset α} {f : α → β} [_inst_1 : add_comm_monoid β],
--    s₁ ⊆ s₂ → (∀ (x : α), x ∈ s₂ → x ∉ s₁ → f x = 0) → finset.sum s₁ f = finset.sum s₂ f

theorem mul_one ( R : Type) [ring R] {n: nat }(A:matrix R n n):
mul R A (identity_matrix R) = A:=
begin
unfold mul,
unfold identity_matrix,
apply funext,
intro x,
apply funext,
intro y,
let yfinset : finset (fin n) := finset.singleton y,
suffices : finset.sum finset.univ (λ (K : fin n), A x K * ite (K = y) 1 0 )
           = finset.sum yfinset (λ t, A x t),
simp [this],
apply eq.symm,
have H1 : finset.sum yfinset (λ (t : fin n), A x t) = finset.sum yfinset (λ (K : fin n), A x K * ite (K = y) 1 0 ),
         rw finset.sum_singleton,
         rw finset.sum_singleton,
         simp,
rw H1,
refine (finset.sum_subset (_ : yfinset ⊆ finset.univ) _),
exact finset.subset_univ yfinset,
intros K H H2,
have H3 : ¬ (K = y),
         intro H4,
         apply H2,
         rw H4,
         apply finset.mem_singleton.2,
         refl,
simp[H3],
end

instance ring ( R : Type) [ring R] { n: nat }: ring (matrix R n n):={
add:= matrix.add R ,
add_assoc := @matrix.add_assoc2 R _ n n,
zero := matrix.zero R ,
neg := matrix.neg R,
zero_add := @matrix.zero_add R _ n n,
add_zero := @matrix.add_zero R _ n n,
add_left_neg := @matrix.add_left_neg R _ n n,
add_comm := @matrix.add_comm R _ n n,
mul := matrix.mul R,
mul_assoc := λ A B C, eq.symm $ @matrix.mul_assoc R _ n n n n A B C,
mul_one := @matrix.mul_one R _ n ,
one := matrix.identity_matrix R,
one_mul := @matrix.one_mul R _ n ,
left_distrib := @matrix.left_distrib R _ n n n,
right_distrib := @matrix.right_distrib R _ n n n
}

end matrix

namespace M_module

def smul_M {F : Type} {n m : ℕ} [ring F] (a : F) (M : matrix F n m) :
matrix F n m := λ I, λ J, a * (M I J)

instance (F : Type) [ring F] (n m : ℕ) : has_scalar F (matrix F n m) :=
{
    smul := smul_M
}

theorem smul_add' {F : Type} {n m : ℕ} [ring F] (s : F) (m1 m2 : matrix F n m) :
  smul_M s (matrix.add F m1 m2) = matrix.add F (smul_M s m1) (smul_M s m2) :=
begin
unfold smul_M,
funext,
unfold matrix.add,
rw [mul_add],
end

theorem add_smul' {F : Type} {n m : ℕ} [ring F] (s t : F) (M : matrix F n m) :
smul_M (s + t) M = (smul_M s M) + (smul_M t M) :=
begin
unfold smul_M,
simp only [add_mul],
funext,
congr,
end

theorem mul_smul' {F : Type} {n m : ℕ} [ring F] (s t : F) (M : matrix F n m) :
smul_M (s * t) M = smul_M s (smul_M t M) :=
begin
unfold smul_M,
funext,
rw [mul_assoc],
end

theorem one_smul' {F : Type} {n m : ℕ} [ring F] (M : matrix F n m) :
smul_M (1 : F) M = M :=
begin
  unfold smul_M,
  funext,
  rw [one_mul],
end

instance {R : Type} {n m : ℕ} [ring R] : module R (matrix R n m) :=
{
  smul_add := smul_add',
  add_smul := add_smul',
  mul_smul := mul_smul',
  one_smul := one_smul',
}
end M_module
/-

dec_trivial
finset.range
I.val
-/


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable (G : Type*) [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  assume h1 : two_colorable G,
  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
  have h2 : ∃ A B : set G, ∀ v : G, v ∈ A ∨ v ∈ B, from by auto [h1],
  -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
  have h3 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge a b, from by auto [h1],
  have h4 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge a b, from by auto [h1],
  -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
  have h5 : ∀ a b : G, edge a b → (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A), from by auto [h1],
  show bipartite G, from by auto [h2, h3, h4, h5],

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  assume h1 : bipartite G,
  -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
  have h2 : ∃ A B : set G, ∀ v : G, v ∈ A ∨ v ∈ B, from by auto [h1],
  have h3 : ∀ a b : G, a ∈ A ∧ b ∈ A → ¬ edge a b, from by auto [h1],
  have h4 : ∀ a b : G, a ∈ B ∧ b ∈ B → ¬ edge a b, from by auto [h1],
  have h5 : ∀ a b : G, edge a b → (a ∈ A ∧ b ∈ B) ∨ (a ∈ B ∧ b ∈ A), from by auto [h1],
  show two_colorable G, from by auto [h2, h3, h4, h5],
end

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import tactic -- hide
open nat -- hide

/-
## The `use` tactic

The following tactic works on goals of the form "There exists $x$ such that...". So if the goal starts
with `∃`, to prove it you need to supply a value for $x$ and then prove that this value works. The first
part will be done with the `use x` (replace `x` with an actual value) and then the goal will
change into proving the required property of `x`.
-/

/- Symbol:
∃ : \exists
-/
/- Lemma : no-side-bar
There is a solution to $x^2+5 = 14$ in $\mathbb{N}$.
-/
lemma use0 : ∃ (x : ℕ), x^2 + 5 = 14 :=
begin
  use 3,
  ring,

end


-- Negation and Falsity

variables p q r : Prop

example (hpq : p → q) (hnq : ¬ q) : ¬ p :=
assume hp : p,
show false, from hnq (hpq hp)

example (hp : p) (hnp : ¬ p) : q := false.elim (hnp hp)

example (hp : p) (hnp : ¬ p) : q := absurd hp hnp

example (hnp : ¬ p) (hq : q) (hqp : q → p) : r :=
absurd (hqp hq) hnp


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

import algebra.field.basic
import data.rat.basic
import ring_theory.algebraic
import ring_theory.dedekind_domain
import ring_theory.integral_closure
import ring_theory.polynomial.rational_root

/-!
# Number fields
This file defines a number field and the ring of integers corresponding to it.

## Main definitions
 - `number_field` defines a number field as a field which has characteristic zero and is finite
    dimensional over ℚ.
 - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
    as the integral closure of ℤ in the number field.

## Implementation notes
The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice.

## References
* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]

## Tags
number field, ring of integers
-/

/-- A number field is a field which has characteristic zero and is finite
dimensional over ℚ. -/
class number_field (K : Type*) [field K] : Prop :=
[to_char_zero : char_zero K]
[to_finite_dimensional : finite_dimensional ℚ K]

open function
open_locale classical big_operators

namespace number_field
variables (K : Type*) [field K] [nf : number_field K]

include nf

-- See note [lower instance priority]
attribute [priority 100, instance] number_field.to_char_zero number_field.to_finite_dimensional

protected lemma is_algebraic : algebra.is_algebraic ℚ K := algebra.is_algebraic_of_finite

omit nf

/-- The ring of integers (or number ring) corresponding to a number field
is the integral closure of ℤ in the number field. -/
def ring_of_integers := integral_closure ℤ K

namespace ring_of_integers

variables {K}

instance [number_field K] : is_fraction_ring (ring_of_integers K) K :=
integral_closure.is_fraction_ring_of_finite_extension ℚ _

instance : is_integral_closure (ring_of_integers K) ℤ K :=
integral_closure.is_integral_closure _ _

instance [number_field K] : is_integrally_closed (ring_of_integers K) :=
integral_closure.is_integrally_closed_of_finite_extension ℚ

lemma is_integral_coe (x : ring_of_integers K) : is_integral ℤ (x : K) :=
x.2

/-- The ring of integers of `K` are equivalent to any integral closure of `ℤ` in `K` -/
protected noncomputable def equiv (R : Type*) [comm_ring R] [algebra R K]
  [is_integral_closure R ℤ K] : ring_of_integers K ≃+* R :=
(is_integral_closure.equiv ℤ R K _).symm.to_ring_equiv

variables (K)

instance [number_field K] : char_zero (ring_of_integers K) := char_zero.of_module _ K

instance [number_field K] : is_dedekind_domain (ring_of_integers K) :=
is_integral_closure.is_dedekind_domain ℤ ℚ K _

end ring_of_integers

end number_field

namespace rat

open number_field

instance rat.number_field : number_field ℚ :=
{ to_char_zero := infer_instance,
  to_finite_dimensional := by { convert (infer_instance : finite_dimensional ℚ ℚ),
             -- The vector space structure of `ℚ` over itself can arise in multiple ways:
             -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
             -- all char 0 fields have a canonical embedding of `ℚ` (used in `number_field`).
             -- Show that these coincide:
             ext, simp [algebra.smul_def] } }

/-- The ring of integers of `ℚ` as a number field is just `ℤ`. -/
noncomputable def ring_of_integers_equiv : ring_of_integers ℚ ≃+* ℤ :=
ring_of_integers.equiv ℤ

end rat


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module combinatorics.additive.ruzsa_covering
! leanprover-community/mathlib commit b363547b3113d350d053abdf2884e9850a56b205
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Pointwise

/-!
# Ruzsa's covering lemma

This file proves the Ruzsa covering lemma. This says that, for `s`, `t` finsets, we can cover `s`
with at most `(s + t).card / t.card` copies of `t - t`.

## TODO

Merge this file with other prerequisites to Freiman's theorem once we have them.
-/

open Pointwise

namespace Finset

variable {α : Type _} [DecidableEq α] [CommGroup α] (s : Finset α) {t : Finset α}

/-- **Ruzsa's covering lemma**. -/
@[to_additive "**Ruzsa's covering lemma**"]
theorem exists_subset_mul_div (ht : t.Nonempty) :
    ∃ u : Finset α, u.card * t.card ≤ (s * t).card ∧ s ⊆ u * t / t := by
  haveI : ∀ u, Decidable ((u : Set α).PairwiseDisjoint (· • t)) := fun u ↦ Classical.dec _
  set C := s.powerset.filter fun u ↦ u.toSet.PairwiseDisjoint (· • t)
  obtain ⟨u, hu, hCmax⟩ := C.exists_maximal (filter_nonempty_iff.2
    ⟨∅, empty_mem_powerset _, by rw [coe_empty]; exact Set.pairwiseDisjoint_empty⟩)
  rw [mem_filter, mem_powerset] at hu
  refine' ⟨u,
    (card_mul_iff.2 <| pairwiseDisjoint_smul_iff.1 hu.2).ge.trans
      (card_le_of_subset <| mul_subset_mul_right hu.1),
    fun a ha ↦ _⟩
  rw [mul_div_assoc]
  by_cases hau : a ∈ u
  · exact subset_mul_left _ ht.one_mem_div hau
  by_cases H : ∀ b ∈ u, Disjoint (a • t) (b • t)
  · refine' (hCmax _ _ <| ssubset_insert hau).elim
    rw [mem_filter, mem_powerset, insert_subset, coe_insert]
    exact ⟨⟨ha, hu.1⟩, hu.2.insert fun _ hb _ ↦ H _ hb⟩
  push_neg at H
  simp_rw [not_disjoint_iff, ← inv_smul_mem_iff] at H
  obtain ⟨b, hb, c, hc₁, hc₂⟩ := H
  refine' mem_mul.2 ⟨b, a / b, hb, _, by simp⟩
  exact mem_div.2 ⟨_, _, hc₂, hc₁, by simp [div_eq_mul_inv a b, mul_comm]⟩
#align finset.exists_subset_mul_div Finset.exists_subset_mul_div
#align finset.exists_subset_add_sub Finset.exists_subset_add_sub

end Finset


import divisibility2
import data.nat.sqrt
import number_theory.quadratic_reciprocity

lemma qr_mod4 (a : ℕ ): (a^2%4)=0 ∨ (a^2%4)=1:=
begin
    rw nat.pow_two, rw nat.mul_mod,
    have h1:= nat.mod_lt a (show 4>0, by linarith), interval_cases a%4; rw h; tauto
end

lemma diff_of_squares_neq_2 (a b: ℕ ): a^2 +2 ≠ b^2:=
begin
    by_contra, push_neg at a_1, apply_fun (λ (u: ℕ ), u%4) at a_1, rw nat.add_mod at a_1,
    have h1:= qr_mod4 b, cases qr_mod4 a,
    {rw h at a_1, simp [(show 2%4 =2, from rfl)] at a_1,rw ← a_1 at h1, cc},
    {rw h at a_1, simp [(show (1+2)%4 = 3, from rfl)] at a_1, rw ← a_1 at h1,cc}
end

lemma is_contra (P:  Prop) : P ↔ (¬ P → false):=
begin
    cc,
end

lemma to_3_n_gt_n (n:ℕ ): n + 1 ≤ 3^n :=
begin
  induction n with d hd,
  {simp},
  {calc d.succ + 1 = (d + 1) + 1 : rfl
  ...             ≤ 3 ^ d + 1 : add_le_add_right' hd
  ...             ≤ 3 ^ d + 2 * 3 ^ d : add_le_add_left' _
  ... = 3 ^ d.succ : by rw [nat.pow_succ]; ring,
  show 0 < _,
  apply mul_pos, simp,
  apply nat.pow_pos, simp}
end

lemma max_pow_3 (n: ℕ ) (h0 : n>0): ∃ (r: ℕ ), 3^r ∣ n ∧ ¬ 3^(r+1)∣ n:=
begin
    rw is_contra ( ∃ (r : ℕ), 3 ^ r ∣ n ∧  ¬3 ^ (r + 1) ∣ n), rw  not_exists, intro p, push_neg at p,
    have h1: ∀ x: ℕ , 3 ^(x+1) ∣ n,
        {intro q, induction q with d hd,
        {cases p 0 with p1 p2, exfalso, simp at p1, assumption, assumption},
        {rw nat.succ_eq_add_one, cases p (d+1) with p1 p2,  contradiction, assumption}},
    have h3:= nat.le_of_dvd h0 (h1 n),
    have h4:= to_3_n_gt_n (n+1), linarith
end

lemma decomp_pow_3 (n: ℕ ) (h : n>0): ∃ (r k: ℕ ), n = 3^r *k ∧ ¬ 3 ∣ k:=
begin
    cases max_pow_3 n h with s h1, cases h1 with h1 h2, cases h1 with m h1, use s, use m,
    split,
    {assumption},
    {by_contra, cases a with b a, rw a at h1, rw ← mul_assoc at h1,
    have h3: 3^(s+1) ∣ n,
        {use b, rw nat.pow_add, simp [h1]},
    contradiction}
end

lemma non_res_3_mod_4 (d a: ℕ ) (h: d>0): (a^2: zmod d) = -1 → (d%4) ≠ 3:=
begin
    apply nat.strong_induction_on d, intros n h1 h2, cases classical.em (n.prime),
    {have h3: fact n.prime, {assumption},
    rw ← @zmod.exists_pow_two_eq_neg_one_iff_mod_four_ne_three n h3, use a, exact h2},
    {cases classical.em (n<2),
        {interval_cases n,
        {rw [show 0%4=0, from rfl], linarith},
        {rw [show 1%4=1, from rfl], linarith}},
    push_neg at h_2, cases nat.exists_dvd_of_not_prime2 h_2 h_1,
    rcases h_3 with ⟨ h3, h4, h5⟩, cases h3 with v h3, rw nat.succ_le_iff at h4,
    have h5': v>0,
        {by_contra, push_neg at a_1, interval_cases v, rotate, linarith},
    rw ←  lt_mul_iff_one_lt_left h5' at h4, rw ← h3 at h4,
    have h6: ((a^2:ℤ ): zmod n) = ((-1: ℤ ) : zmod n), {simp, exact h2},
    rw zmod.int_coe_eq_int_coe_iff at h6,
    have h7:= int.modeq.modeq_of_dvd_of_modeq (show (w: ℤ ) ∣ (n:ℤ  ), by simp[h3]) h6,
    have h8:= int.modeq.modeq_of_dvd_of_modeq (show (v:ℤ ) ∣ (n:ℤ ), by simp[h3]) h6,
    rw ← zmod.int_coe_eq_int_coe_iff at *,  simp at h7, simp at h8,
    have h9:= h1 v h4 h8,
    have h10:= h1 w h5 h7,
    rw h3, rw nat.mul_mod,
    have h11:= nat.mod_lt w (show 4>0, by linarith),
    have h12:= nat.mod_lt v (show 4>0, by linarith),
    interval_cases w%4; rw h_3; simp, {linarith}, {assumption},
    interval_cases v%4; rw h_4; simp [(show 2*2 =4, from rfl), (show 2%4=2, from rfl)]; linarith}
end

lemma squares_inv (a b n x: ℕ ) (h: nat.coprime a n) (h0: nat.coprime b n) (h1: (b*x^2 :zmod n) = -(b*a^2)) (h2:fact (0<n)):  ∃ (r: ℕ ),(r^2 : zmod n ) = -1:=
begin
    use ((x* a⁻¹ :zmod n).val), rw zmod.cast_val ((x* a⁻¹: zmod n)),
    have h3:= zmod.coe_mul_inv_eq_one a h,
    have h4:= zmod.coe_mul_inv_eq_one b h0,
    rw mul_comm at h1, nth_rewrite 1 mul_comm at h1, apply_fun (λ (a: zmod n), (a* b⁻¹ :zmod n) ) at h1, rw ← neg_one_mul at h1, repeat {rw mul_assoc at h1}, rw h4 at h1, rw mul_one at h1,
    rw [show (-1: zmod n)=-1*1, by simp],rw ← h3, rw mul_pow, rw h1, ring
end

lemma pow_3_odd (u :ℕ ): (3^u)%2=1:=
begin
    induction u with d hd,
    {ring},
    {rw nat.pow_succ, simp [nat.mul_mod, hd], ring}
end

lemma double_not_zero_mod3 (u: ℕ ) (h1: ¬ 3 ∣ u) : 2 ∣ 2*u ∧ (2*u)%3 ≠ 0:=
begin
    split, {simp},
    {by_contra, push_neg at a, rw ← nat.dvd_iff_mod_eq_zero at a,
    have a2:= nat.coprime.dvd_of_dvd_mul_left (show nat.coprime 3 2, by tauto) a, contradiction}
end

lemma fun_gen_add (a u n s q r x y: ℕ ) (f: ℕ → ℕ ) (h2: n =  x+4*a*s ) (h3: s =q+1 ) (h4: s=3^r*u ) (h5: ∀ (m: ℕ),y ∣ f(m+2*(2*a*u)) +f(m)): y ∣ f(n) + f(x):=
begin
    nth_rewrite 0 h2, rw ← one_mul (f x),
    have g8: 1  = (-1: ℤ )^(3^r *(0+1)-1),
        {have g9: 2 ∣ 3^r-1, {nth_rewrite 2 ← pow_3_odd r, apply nat.dvd_sub_mod},
        rw zero_add, rw mul_one, rw neg_1_pow_even _ g9},
    rw ← int.coe_nat_dvd, push_cast, rw g8, rw h4, rw [show (4*a)* (3 ^ r * u) = 3^r * (2*a*(2*u)), by ring],
    apply mod_fun_gen y (2*a*(2*u)) 0 (3^r) (x) (f) (nat.one_le_pow' r 2), rw [show (-1:ℤ )^0 =1, by ring], norm_cast, intro m, rw one_mul, rw [show 2*a*(2*u) = 2*(2*a*u), by ring], exact h5 m,
end

lemma res_mod_4' (n: ℕ ): n%2=0 ∨ n%4=1 ∨ n%4=3:=
begin
    have g1:= nat.mod_lt n (show 4>0, by linarith),
    have g2:= nat.mod_mul_left_mod n 2 2, rw (show 2*2 =4, from rfl) at g2,
    interval_cases n%4; rw h at g2; simp [*, (show 2%2=0, from rfl), (show 0%2=0, from rfl)] at *
end

theorem luc_square (n k: ℕ ) (h: luc n =k^2) :  n=1 ∨ n=3:=
begin
    cases res_mod_4' n with h0 h1', cases div_algo n 2 with  w h1, rw h0 at h1, rw add_zero at h1,
    {rw h1 at h, apply_fun (λ (a: ℕ ), (a + 2*(-1)^w : ℤ )) at h, rw fib_luc3 at h, cases even_or_odd w with v h3, cases h3 with h3 h4,
    {rw h3 at h,
    have h5:= neg_1_pow_even (2*v) (show 2 ∣ 2*v, by simp), rw h5 at h, rw mul_one at h, norm_cast at h,
    have h6:= diff_of_squares_neq_2 k (luc(2*v)), rw h at h6, contradiction},
    {rw h4 at h, rw neg_1_pow_odd at h, apply_fun (λ (a: ℤ ), a+2) at h,
    have h7:= diff_of_squares_neq_2 (luc(2*v+1)) k, ring at h, norm_cast at h}},

    {cases div_algo n 4 with s h2, cases nat_case_bash s 0 with g2 g3, swap,
    {cases g3 with q g3, rw add_zero q at g3, cases decomp_pow_3 s (show s>0, by linarith) with r g4, rcases g4 with ⟨ u, g4, g5 ⟩, rw add_comm at h2,
    have g6:=double_not_zero_mod3 u g5,
    have g7:=fun_gen_add 1 u n s q r (n%4) (luc(2*u)) (luc) h2 g3 g4 (mod_luc (2*1*u) g6), repeat{rw mul_one at g7},
    rw h at g7, rw ← zmod.nat_coe_zmod_eq_zero_iff_dvd at g7, apply_fun (λ (a: zmod (luc(2*u))), (a- luc(n%4))) at g7,
    have H: (k^2 : zmod (luc(2*u))) = -luc(n%4), {simp at g7, exact g7}, cases h1' with h_1 h_2,
    {rw h_1 at H, rw [show luc 1 =1, from rfl] at H, simp at H,
    have g10:= non_res_3_mod_4 _ _ (luc_pos (2*u)) H, rw luc_mod_4 (2*u) g6 at g10, contradiction},

    {rw h_2 at H, rw [show luc 3 =4, from rfl] at H,
    rw [show 4=1*2*2, by ring] at H, rw pow_two at H, nth_rewrite 0 ← one_mul (k) at H, repeat{rw nat.cast_mul at H}, repeat{rw mul_assoc at H}, repeat{rw ← pow_two at H},
    have g11:= squares_inv 2 1 (luc(2*u)) k (show nat.coprime 2 (luc(2*u)), from luc_coprime_2 _ (g6.2)) (nat.coprime_one_left (luc(2*u))) H (luc_pos(2*u)), cases g11 with r g11,
    have g12:= non_res_3_mod_4 _ _ (luc_pos (2*u)) g11, rw luc_mod_4 (2*u) g6 at g12, contradiction}},
    rw le_zero_iff_eq at g2, rw g2 at h2,
    have g3:= nat.mod_lt n (show 4>0, by linarith), interval_cases (n%4); rw h_1 at h2; simp[h2]; omega}
end


example (n : ℕ) : n + 1 = nat.succ n :=
begin
  show nat.succ n = nat.succ n,
  reflexivity
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  cases h with hp hq,
  split,
  show q, from hq,
  show p, from hp
end

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  cases h with hp hqr,
  show (p ∧ q) ∨ (p ∧ r),
  cases hqr with hq hr,
    have hpq : p ∧ q,
      from and.intro hp hq,
    left, exact hpq,
  have hpr : p ∧ r,
  from and.intro hp hr,
  right, exact hpr
end

example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  cases h with hp hqr,
  show (p ∧ q) ∨ (p ∧ r),
  cases hqr with hq hr,
    have hpq : p ∧ q,
      split, repeat {assumption},
    left, exact hpq,
  have hpr : p ∧ r,
    split, repeat {assumption},
  right, exact hpr
end

example : ∃ x, x + 2 = 8 :=
begin
  let a : ℕ := 3 * 2,
  existsi a,
  reflexivity
end


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.measure_space
import order.filter.ennreal

/-!
# Essential supremum and infimum
We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
`μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
almost everywhere.

TODO: The essential supremum of functions `α → ℝ≥0∞` is used in particular to define the norm in
the `L∞` space (see measure_theory/lp_space.lean).

There is a different quantity which is sometimes also called essential supremum: the least
upper-bound among measurable functions of a family of measurable functions (in an almost-everywhere
sense). We do not define that quantity here, which is simply the supremum of a map with values in
`α →ₘ[μ] β` (see measure_theory/ae_eq_fun.lean).

## Main definitions

* `ess_sup f μ := μ.ae.limsup f`
* `ess_inf f μ := μ.ae.liminf f`
-/

open measure_theory
open_locale ennreal

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

section conditionally_complete_lattice
variable [conditionally_complete_lattice β]

/-- Essential supremum of `f` with respect to measure `μ`: the smallest `c : β` such that
`f x ≤ c` a.e. -/
def ess_sup (f : α → β) (μ : measure α) := μ.ae.limsup f

/-- Essential infimum of `f` with respect to measure `μ`: the greatest `c : β` such that
`c ≤ f x` a.e. -/
def ess_inf (f : α → β) (μ : measure α) := μ.ae.liminf f

lemma ess_sup_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) : ess_sup f μ = ess_sup g μ :=
filter.limsup_congr hfg

lemma ess_inf_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) :  ess_inf f μ = ess_inf g μ :=
@ess_sup_congr_ae α (order_dual β) _ _ _ _ _ hfg

end conditionally_complete_lattice

section complete_lattice
variable [complete_lattice β]

@[simp] lemma ess_sup_measure_zero {f : α → β} : ess_sup f 0 = ⊥ :=
le_bot_iff.mp (Inf_le (by simp [set.mem_set_of_eq, filter.eventually_le, ae_iff]))

@[simp] lemma ess_inf_measure_zero {f : α → β} : ess_inf f 0 = ⊤ :=
@ess_sup_measure_zero α (order_dual β) _ _ _

lemma ess_sup_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_sup f μ ≤ ess_sup g μ :=
filter.limsup_le_limsup hfg

lemma ess_inf_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_inf f μ ≤ ess_inf g μ :=
filter.liminf_le_liminf hfg

lemma ess_sup_const (c : β) (hμ : μ ≠ 0) : ess_sup (λ x : α, c) μ = c :=
begin
  haveI hμ_ne_bot : μ.ae.ne_bot := by rwa [filter.ne_bot_iff, ne.def, ae_eq_bot],
  exact filter.limsup_const c,
end

lemma ess_inf_const (c : β) (hμ : μ ≠ 0) : ess_inf (λ x : α, c) μ = c :=
@ess_sup_const α (order_dual β) _ _ _ _ hμ

lemma ess_sup_const_bot : ess_sup (λ x : α, (⊥ : β)) μ = (⊥ : β) :=
filter.limsup_const_bot

lemma ess_inf_const_top : ess_inf (λ x : α, (⊤ : β)) μ = (⊤ : β) :=
filter.liminf_const_top

lemma order_iso.ess_sup_apply {γ} [complete_lattice γ] (f : α → β) (μ : measure α)
  (g : β ≃o γ) :
  g (ess_sup f μ) = ess_sup (λ x, g (f x)) μ :=
begin
  refine order_iso.limsup_apply g _ _ _ _,
  all_goals { by filter.is_bounded_default},
end

lemma order_iso.ess_inf_apply {γ} [complete_lattice γ] (f : α → β) (μ : measure α)
  (g : β ≃o γ) :
  g (ess_inf f μ) = ess_inf (λ x, g (f x)) μ :=
@order_iso.ess_sup_apply α (order_dual β) _ _  (order_dual γ) _ _ _ g.dual

end complete_lattice

section complete_linear_order
variable [complete_linear_order β]

lemma ae_lt_of_ess_sup_lt {f : α → β} {x : β} (hf : ess_sup f μ < x) : ∀ᵐ y ∂μ, f y < x :=
filter.eventually_lt_of_limsup_lt hf

lemma ae_lt_of_lt_ess_inf {f : α → β} {x : β} (hf : x < ess_inf f μ) : ∀ᵐ y ∂μ, x < f y :=
@ae_lt_of_ess_sup_lt α (order_dual β) _ _ _ _ _ hf

end complete_linear_order

namespace ennreal

lemma ae_le_ess_sup (f : α → ℝ≥0∞) : ∀ᵐ y ∂μ, f y ≤ ess_sup f μ :=
eventually_le_limsup f

@[simp] lemma ess_sup_eq_zero_iff {f : α → ℝ≥0∞} : ess_sup f μ = 0 ↔ f =ᵐ[μ] 0 :=
limsup_eq_zero_iff

lemma ess_sup_const_mul {f : α → ℝ≥0∞} {a : ℝ≥0∞} :
  ess_sup (λ (x : α), a * (f x)) μ = a * ess_sup f μ :=
limsup_const_mul

lemma ess_sup_add_le (f g : α → ℝ≥0∞) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
limsup_add_le f g

lemma ess_sup_liminf_le {ι} [encodable ι] [linear_order ι] (f : ι → α → ℝ≥0∞) :
  ess_sup (λ x, filter.at_top.liminf (λ n, f n x)) μ
    ≤ filter.at_top.liminf (λ n, ess_sup (λ x, f n x) μ) :=
by { simp_rw ess_sup, exact ennreal.limsup_liminf_le_liminf_limsup (λ a b, f b a), }

end ennreal


import ..lovelib

namespace LoVe
/- ## Fixpoints

A __fixpoint__ (or fixed point) of `f` is a solution for `X` in the equation

    `X = f X`

In general, fixpoints may not exist at all (e.g., `f := nat.succ`), or there may
be several fixpoints (e.g., `f := id`). But under some conditions on `f`, a
unique __least fixpoint__ and a unique __greatest fixpoint__ are guaranteed to
exist.

Consider this __fixpoint equation__:

    `X = (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m) X`
      `= (λn : ℕ, n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ X m)`

where `X : ℕ → Prop` and
`f := (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m)`.

The above example admits only one fixpoint. The fixpoint equation uniquely
specifies `X` as the set of even numbers.

In general, the least and greatest fixpoint may be different:

    `X = X`

Here, the least fixpoint is `(λ_, False)` and the greatest fixpoint is
`(λ_, True)`. Conventionally, `False < True`, and thus
`(λ_, False) < (λ_, True)`. Similarly, `∅ < @set.univ α` (assuming `α` is
inhabited).

For the semantics of programming languages:

* `X` will have type `set (state × state)` (which is isomorphic to
  `state → state → Prop`), representing relations between states;

* `f` will correspond to either taking one extra iteration of the loop (if the
  condition `b` is true) or the identity (if `b` is false).

Kleene's fixpoint theorem:

    `f^0(∅) ∪ f^1(∅) ∪ f^2(∅) ∪ ⋯ = lfp f`

The least fixpoint corresponds to finite executions of a program, which is all
we care about.

**Key observation**:

    Inductive predicates correspond to least fixpoints, but they are built into
    Lean's logic (the calculus of inductive constructions).

## Monotone Functions

Let `α` and `β` be types with partial order `≤`. A function `f : α → β` is
__monotone__ if

    `a₁ ≤ a₂ → f a₁ ≤ f a₂`   for all `a₁`, `a₂`

Many operations on sets (e.g., `∪`), relations (e.g., `◯`), and functions
(e.g., `λx, x`, `λ_, k`, `∘`) are monotone or preserve monotonicity.

All monotone functions `f : set α → set α` admit least and greatest fixpoints.

**Example of a nonmonotone function**:

    `f A = (if A = ∅ then set.univ else ∅)`

Assuming `α` is inhabited, we have `∅ ⊆ set.univ`, but
`f ∅ = set.univ ⊈ ∅ = f set.univ`. -/

def monotone {α β : Type} [partial_order α] [partial_order β]
  (f : α → β) : Prop :=
∀a₁ a₂, a₁ ≤ a₂ → f a₁ ≤ f a₂

lemma monotone_id {α : Type} [partial_order α] :
  monotone (λa : α, a) :=
begin
  intros a₁ a₂ ha,
  exact ha
end

lemma monotone_const {α β : Type} [partial_order α]
    [partial_order β] (b : β) :
  monotone (λ_ : α, b) :=
begin
  intros a₁ a₂ ha,
  exact le_refl b
end

lemma monotone_union {α β : Type} [partial_order α]
    (f g : α → set β) (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ∪ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb,
  { exact or.intro_left _ (hf a₁ a₂ ha h) },
  { exact or.intro_right _ (hg a₁ a₂ ha h) }
end

/-! We will prove the following two lemmas in the exercise. -/

namespace sorry_lemmas

lemma monotone_comp {α β : Type} [partial_order α]
    (f g : α → set (β × β)) (hf : monotone f)
    (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

lemma monotone_restrict {α β : Type} [partial_order α]
    (f : α → set (β × β)) (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

end sorry_lemmas

/-! ## Complete Lattices

To define the least fixpoint on sets, we need `⊆` and `⋂`. Complete lattices
capture this concept abstractly. A __complete lattice__ is an ordered type `α`
for which each set of type `set α` has an infimum.

More precisely, A complete lattice consists of

* a partial order `≤ : α → α → Prop` (i.e., a reflexive, transitive, and
  antisymmetric binary predicate);

* an operator `Inf : set α → α`, called __infimum__.

Moreover, `Inf A` must satisfy these two properties:

* `Inf A` is a lower bound of `A`: `Inf A ≤ b` for all `b ∈ A`;

* `Inf A` is a greatest lower bound: `b ≤ Inf A` for all `b` such that
  `∀a, a ∈ A → b ≤ a`.

**Warning:** `Inf A` is not necessarily an element of `A`.

Examples:

* `set α` is an instance w.r.t. `⊆` and `⋂` for all `α`;
* `Prop` is an instance w.r.t. `→` and `∀` (`Inf A := ∀a ∈ A, a`);
* `enat := ℕ ∪ {∞}`;
* `ereal := ℝ ∪ {- ∞, ∞}`;
* `β → α` if `α` is a complete lattice;
* `α × β` if `α`, `β` are complete lattices.

Finite example (with apologies for the ASCII art):

                Z            Inf {}           = ?
              /   \          Inf {Z}          = ?
             A     B         Inf {A, B}       = ?
              \   /          Inf {Z, A}       = ?
                Y            Inf {Z, A, B, Y} = ?

Nonexamples:

* `ℕ`, `ℤ`, `ℚ`, `ℝ`: no infimum for `∅`, `Inf ℕ`, etc.
* `erat := ℚ ∪ {- ∞, ∞}`: `Inf {q | 2 < q * q} = sqrt 2` is not in `erat`. -/

@[class] structure complete_lattice (α : Type)
  extends partial_order α : Type :=
(Inf    : set α → α)
(Inf_le : ∀A b, b ∈ A → Inf A ≤ b)
(le_Inf : ∀A b, (∀a, a ∈ A → b ≤ a) → b ≤ Inf A)

/-! For sets: -/

@[instance] def set.complete_lattice {α : Type} :
  complete_lattice (set α) :=
{ le          := (⊆),
  le_refl     := by tautology,
  le_trans    := by tautology,
  le_antisymm :=
    begin
      intros A B hAB hBA,
      apply set.ext,
      tautology
    end,
  Inf         := λX, {a | ∀A, A ∈ X → a ∈ A},
  Inf_le      := by tautology,
  le_Inf      := by tautology }

/-! ## Least Fixpoint -/

def lfp {α : Type} [complete_lattice α] (f : α → α) : α :=
complete_lattice.Inf ({a | f a ≤ a})

lemma lfp_le {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : f a ≤ a) :
  lfp f ≤ a :=
complete_lattice.Inf_le _ _ h

lemma le_lfp {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : ∀a', f a' ≤ a' → a ≤ a') :
  a ≤ lfp f :=
complete_lattice.le_Inf _ _ h

/-! **Knaster-Tarski theorem:** For any monotone function `f`:

* `lfp f` is a fixpoint: `lfp f = f (lfp f)` (lemma `lfp_eq`);
* `lfp f` is smaller than any other fixpoint: `X = f X → lfp f ≤ X`. -/

lemma lfp_eq {α : Type} [complete_lattice α] (f : α → α)
    (hf : monotone f) :
  lfp f = f (lfp f) :=
begin
  have h : f (lfp f) ≤ lfp f :=
    begin
      apply le_lfp,
      intros a' ha',
      apply @le_trans _ _ _ (f a'),
      { apply hf,
        apply lfp_le,
        assumption },
      { assumption }
    end,
  apply le_antisymm,
  { apply lfp_le,
    apply hf,
    assumption },
  { assumption }
end
end LoVe


/-
Copyright (c) 2021 Peter Nelson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Peter Nelson, Yaël Dillies

! This file was ported from Lean 3 source module data.fintype.order
! leanprover-community/mathlib commit 63f84d91dd847f50bae04a01071f3a5491934e36
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Lattice
import Mathbin.Data.Finset.Order

/-!
# Order structures on finite types

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

This file provides order instances on fintypes.

## Computable instances

On a `fintype`, we can construct
* an `order_bot` from `semilattice_inf`.
* an `order_top` from `semilattice_sup`.
* a `bounded_order` from `lattice`.

Those are marked as `def` to avoid defeqness issues.

## Completion instances

Those instances are noncomputable because the definitions of `Sup` and `Inf` use `set.to_finset` and
set membership is undecidable in general.

On a `fintype`, we can promote:
* a `lattice` to a `complete_lattice`.
* a `distrib_lattice` to a `complete_distrib_lattice`.
* a `linear_order`  to a `complete_linear_order`.
* a `boolean_algebra` to a `complete_boolean_algebra`.

Those are marked as `def` to avoid typeclass loops.

## Concrete instances

We provide a few instances for concrete types:
* `fin.complete_linear_order`
* `bool.complete_linear_order`
* `bool.complete_boolean_algebra`
-/

open Finset

namespace Fintype

variable {ι α : Type _} [Fintype ι] [Fintype α]

section Nonempty

variable (α) [Nonempty α]

#print Fintype.toOrderBot /-
-- See note [reducible non-instances]
/-- Constructs the `⊥` of a finite nonempty `semilattice_inf`. -/
@[reducible]
def toOrderBot [SemilatticeInf α] : OrderBot α
    where
  bot := univ.inf' univ_nonempty id
  bot_le a := inf'_le _ <| mem_univ a
#align fintype.to_order_bot Fintype.toOrderBot
-/

#print Fintype.toOrderTop /-
-- See note [reducible non-instances]
/-- Constructs the `⊤` of a finite nonempty `semilattice_sup` -/
@[reducible]
def toOrderTop [SemilatticeSup α] : OrderTop α
    where
  top := univ.sup' univ_nonempty id
  le_top a := le_sup' _ <| mem_univ a
#align fintype.to_order_top Fintype.toOrderTop
-/

#print Fintype.toBoundedOrder /-
-- See note [reducible non-instances]
/-- Constructs the `⊤` and `⊥` of a finite nonempty `lattice`. -/
@[reducible]
def toBoundedOrder [Lattice α] : BoundedOrder α :=
  { toOrderBot α, toOrderTop α with }
#align fintype.to_bounded_order Fintype.toBoundedOrder
-/

end Nonempty

section BoundedOrder

variable (α)

open Classical

#print Fintype.toCompleteLattice /-
-- See note [reducible non-instances]
/-- A finite bounded lattice is complete. -/
@[reducible]
noncomputable def toCompleteLattice [Lattice α] [BoundedOrder α] : CompleteLattice α :=
  { ‹Lattice α›,
    ‹BoundedOrder α› with
    supₛ := fun s => s.toFinset.sup id
    infₛ := fun s => s.toFinset.inf id
    le_sup := fun _ _ ha => Finset.le_sup (Set.mem_toFinset.mpr ha)
    sup_le := fun s _ ha => Finset.sup_le fun b hb => ha _ <| Set.mem_toFinset.mp hb
    inf_le := fun _ _ ha => Finset.inf_le (Set.mem_toFinset.mpr ha)
    le_inf := fun s _ ha => Finset.le_inf fun b hb => ha _ <| Set.mem_toFinset.mp hb }
#align fintype.to_complete_lattice Fintype.toCompleteLattice
-/

#print Fintype.toCompleteDistribLattice /-
-- See note [reducible non-instances]
/-- A finite bounded distributive lattice is completely distributive. -/
@[reducible]
noncomputable def toCompleteDistribLattice [DistribLattice α] [BoundedOrder α] :
    CompleteDistribLattice α :=
  {
    toCompleteLattice
      α with
    infᵢ_sup_le_sup_inf := fun a s =>
      by
      convert(Finset.inf_sup_distrib_left _ _ _).ge
      convert(Finset.inf_eq_infᵢ _ _).symm
      simp_rw [Set.mem_toFinset]
      rfl
    inf_sup_le_supᵢ_inf := fun a s =>
      by
      convert(Finset.sup_inf_distrib_left _ _ _).le
      convert(Finset.sup_eq_supᵢ _ _).symm
      simp_rw [Set.mem_toFinset]
      rfl }
#align fintype.to_complete_distrib_lattice Fintype.toCompleteDistribLattice
-/

#print Fintype.toCompleteLinearOrder /-
-- See note [reducible non-instances]
/-- A finite bounded linear order is complete. -/
@[reducible]
noncomputable def toCompleteLinearOrder [LinearOrder α] [BoundedOrder α] : CompleteLinearOrder α :=
  { toCompleteLattice α, ‹LinearOrder α› with }
#align fintype.to_complete_linear_order Fintype.toCompleteLinearOrder
-/

#print Fintype.toCompleteBooleanAlgebra /-
-- See note [reducible non-instances]
/-- A finite boolean algebra is complete. -/
@[reducible]
noncomputable def toCompleteBooleanAlgebra [BooleanAlgebra α] : CompleteBooleanAlgebra α :=
  { Fintype.toCompleteDistribLattice α, ‹BooleanAlgebra α› with }
#align fintype.to_complete_boolean_algebra Fintype.toCompleteBooleanAlgebra
-/

end BoundedOrder

section Nonempty

variable (α) [Nonempty α]

#print Fintype.toCompleteLatticeOfNonempty /-
-- See note [reducible non-instances]
/-- A nonempty finite lattice is complete. If the lattice is already a `bounded_order`, then use
`fintype.to_complete_lattice` instead, as this gives definitional equality for `⊥` and `⊤`. -/
@[reducible]
noncomputable def toCompleteLatticeOfNonempty [Lattice α] : CompleteLattice α :=
  @toCompleteLattice _ _ _ <| @toBoundedOrder α _ ⟨Classical.arbitrary α⟩ _
#align fintype.to_complete_lattice_of_nonempty Fintype.toCompleteLatticeOfNonempty
-/

#print Fintype.toCompleteLinearOrderOfNonempty /-
-- See note [reducible non-instances]
/-- A nonempty finite linear order is complete. If the linear order is already a `bounded_order`,
then use `fintype.to_complete_linear_order` instead, as this gives definitional equality for `⊥` and
`⊤`. -/
@[reducible]
noncomputable def toCompleteLinearOrderOfNonempty [LinearOrder α] : CompleteLinearOrder α :=
  { toCompleteLatticeOfNonempty α, ‹LinearOrder α› with }
#align fintype.to_complete_linear_order_of_nonempty Fintype.toCompleteLinearOrderOfNonempty
-/

end Nonempty

end Fintype

/-! ### Concrete instances -/

noncomputable instance {n : ℕ} : CompleteLinearOrder (Fin (n + 1)) :=
  Fintype.toCompleteLinearOrder _

noncomputable instance : CompleteLinearOrder Bool :=
  Fintype.toCompleteLinearOrder _

noncomputable instance : CompleteBooleanAlgebra Bool :=
  Fintype.toCompleteBooleanAlgebra _

/-! ### Directed Orders -/

variable {α : Type _}

/- warning: directed.fintype_le -> Directed.fintype_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} [_inst_1 : IsTrans.{u1} α r] {β : Type.{u2}} {γ : Type.{u3}} [_inst_2 : Nonempty.{succ u3} γ] {f : γ -> α} [_inst_3 : Fintype.{u2} β], (Directed.{u1, succ u3} α γ r f) -> (forall (g : β -> γ), Exists.{succ u3} γ (fun (z : γ) => forall (i : β), r (f (g i)) (f z)))
but is expected to have type
  forall {α : Type.{u3}} {r : α -> α -> Prop} [_inst_1 : IsTrans.{u3} α r] {β : Type.{u2}} {γ : Type.{u1}} [_inst_2 : Nonempty.{succ u1} γ] {f : γ -> α} [_inst_3 : Fintype.{u2} β], (Directed.{u3, succ u1} α γ r f) -> (forall (g : β -> γ), Exists.{succ u1} γ (fun (z : γ) => forall (i : β), r (f (g i)) (f z)))
Case conversion may be inaccurate. Consider using '#align directed.fintype_le Directed.fintype_leₓ'. -/
theorem Directed.fintype_le {r : α → α → Prop} [IsTrans α r] {β γ : Type _} [Nonempty γ] {f : γ → α}
    [Fintype β] (D : Directed r f) (g : β → γ) : ∃ z, ∀ i, r (f (g i)) (f z) := by
  classical
    obtain ⟨z, hz⟩ := D.finset_le (Finset.image g Finset.univ)
    exact ⟨z, fun i => hz (g i) (Finset.mem_image_of_mem g (Finset.mem_univ i))⟩
#align directed.fintype_le Directed.fintype_le

/- warning: fintype.exists_le -> Fintype.exists_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Nonempty.{succ u1} α] [_inst_2 : Preorder.{u1} α] [_inst_3 : IsDirected.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_2))] {β : Type.{u2}} [_inst_4 : Fintype.{u2} β] (f : β -> α), Exists.{succ u1} α (fun (M : α) => forall (i : β), LE.le.{u1} α (Preorder.toLE.{u1} α _inst_2) (f i) M)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : Nonempty.{succ u2} α] [_inst_2 : Preorder.{u2} α] [_inst_3 : IsDirected.{u2} α (fun (x._@.Mathlib.Data.Fintype.Order._hyg.1052 : α) (x._@.Mathlib.Data.Fintype.Order._hyg.1054 : α) => LE.le.{u2} α (Preorder.toLE.{u2} α _inst_2) x._@.Mathlib.Data.Fintype.Order._hyg.1052 x._@.Mathlib.Data.Fintype.Order._hyg.1054)] {β : Type.{u1}} [_inst_4 : Fintype.{u1} β] (f : β -> α), Exists.{succ u2} α (fun (M : α) => forall (i : β), LE.le.{u2} α (Preorder.toLE.{u2} α _inst_2) (f i) M)
Case conversion may be inaccurate. Consider using '#align fintype.exists_le Fintype.exists_leₓ'. -/
theorem Fintype.exists_le [Nonempty α] [Preorder α] [IsDirected α (· ≤ ·)] {β : Type _} [Fintype β]
    (f : β → α) : ∃ M, ∀ i, f i ≤ M :=
  directed_id.fintype_le _
#align fintype.exists_le Fintype.exists_le

/- warning: fintype.bdd_above_range -> Fintype.bddAbove_range is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Nonempty.{succ u1} α] [_inst_2 : Preorder.{u1} α] [_inst_3 : IsDirected.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_2))] {β : Type.{u2}} [_inst_4 : Fintype.{u2} β] (f : β -> α), BddAbove.{u1} α _inst_2 (Set.range.{u1, succ u2} α β f)
but is expected to have type
  forall {α : Type.{u2}} [_inst_1 : Nonempty.{succ u2} α] [_inst_2 : Preorder.{u2} α] [_inst_3 : IsDirected.{u2} α (fun (x._@.Mathlib.Data.Fintype.Order._hyg.1107 : α) (x._@.Mathlib.Data.Fintype.Order._hyg.1109 : α) => LE.le.{u2} α (Preorder.toLE.{u2} α _inst_2) x._@.Mathlib.Data.Fintype.Order._hyg.1107 x._@.Mathlib.Data.Fintype.Order._hyg.1109)] {β : Type.{u1}} [_inst_4 : Fintype.{u1} β] (f : β -> α), BddAbove.{u2} α _inst_2 (Set.range.{u2, succ u1} α β f)
Case conversion may be inaccurate. Consider using '#align fintype.bdd_above_range Fintype.bddAbove_rangeₓ'. -/
theorem Fintype.bddAbove_range [Nonempty α] [Preorder α] [IsDirected α (· ≤ ·)] {β : Type _}
    [Fintype β] (f : β → α) : BddAbove (Set.range f) :=
  by
  obtain ⟨M, hM⟩ := Fintype.exists_le f
  refine' ⟨M, fun a ha => _⟩
  obtain ⟨b, rfl⟩ := ha
  exact hM b
#align fintype.bdd_above_range Fintype.bddAbove_range


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Devon Tuma

! This file was ported from Lean 3 source module analysis.special_functions.polynomials
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Asymptotics.AsymptoticEquivalent
import Mathbin.Analysis.Asymptotics.SpecificAsymptotics
import Mathbin.Data.Polynomial.RingDivision

/-!
# Limits related to polynomial and rational functions

This file proves basic facts about limits of polynomial and rationals functions.
The main result is `eval_is_equivalent_at_top_eval_lead`, which states that for
any polynomial `P` of degree `n` with leading coefficient `a`, the corresponding
polynomial function is equivalent to `a * x^n` as `x` goes to +∞.

We can then use this result to prove various limits for polynomial and rational
functions, depending on the degrees and leading coefficients of the considered
polynomials.
-/

open Filter Finset Asymptotics

open Asymptotics Polynomial Topology

namespace Polynomial

variable {𝕜 : Type _} [NormedLinearOrderedField 𝕜] (P Q : 𝕜[X])

theorem eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in atTop, ¬P.IsRoot x :=
  atTop_le_cofinite <| (finite_setOf_isRoot hP).compl_mem_cofinite
#align polynomial.eventually_no_roots Polynomial.eventually_no_roots

variable [OrderTopology 𝕜]

section PolynomialAtTop

theorem isEquivalent_atTop_lead :
    (fun x => eval x P) ~[atTop] fun x => P.leadingCoeff * x ^ P.natDegree :=
  by
  by_cases h : P = 0
  · simp [h]
  · simp only [Polynomial.eval_eq_sum_range, sum_range_succ]
    exact
      is_o.add_is_equivalent
        (is_o.sum fun i hi =>
          is_o.const_mul_left
            ((is_o.const_mul_right fun hz => h <| leading_coeff_eq_zero.mp hz) <|
              is_o_pow_pow_at_top_of_lt (mem_range.mp hi))
            _)
        is_equivalent.refl
#align polynomial.is_equivalent_at_top_lead Polynomial.isEquivalent_atTop_lead

theorem tendsto_atTop_of_leadingCoeff_nonneg (hdeg : 0 < P.degree) (hnng : 0 ≤ P.leadingCoeff) :
    Tendsto (fun x => eval x P) atTop atTop :=
  P.isEquivalent_atTop_lead.symm.tendsto_atTop <|
    tendsto_const_mul_pow_atTop (natDegree_pos_iff_degree_pos.2 hdeg).ne' <|
      hnng.lt_of_ne' <| leadingCoeff_ne_zero.mpr <| ne_zero_of_degree_gt hdeg
#align polynomial.tendsto_at_top_of_leading_coeff_nonneg Polynomial.tendsto_atTop_of_leadingCoeff_nonneg

theorem tendsto_atTop_iff_leadingCoeff_nonneg :
    Tendsto (fun x => eval x P) atTop atTop ↔ 0 < P.degree ∧ 0 ≤ P.leadingCoeff :=
  by
  refine' ⟨fun h => _, fun h => tendsto_at_top_of_leading_coeff_nonneg P h.1 h.2⟩
  have : tendsto (fun x => P.leading_coeff * x ^ P.nat_degree) at_top at_top :=
    (is_equivalent_at_top_lead P).tendsto_atTop h
  rw [tendsto_const_mul_pow_at_top_iff, ← pos_iff_ne_zero, nat_degree_pos_iff_degree_pos] at this
  exact ⟨this.1, this.2.le⟩
#align polynomial.tendsto_at_top_iff_leading_coeff_nonneg Polynomial.tendsto_atTop_iff_leadingCoeff_nonneg

theorem tendsto_atBot_iff_leadingCoeff_nonpos :
    Tendsto (fun x => eval x P) atTop atBot ↔ 0 < P.degree ∧ P.leadingCoeff ≤ 0 := by
  simp only [← tendsto_neg_at_top_iff, ← eval_neg, tendsto_at_top_iff_leading_coeff_nonneg,
    degree_neg, leading_coeff_neg, neg_nonneg]
#align polynomial.tendsto_at_bot_iff_leading_coeff_nonpos Polynomial.tendsto_atBot_iff_leadingCoeff_nonpos

theorem tendsto_atBot_of_leadingCoeff_nonpos (hdeg : 0 < P.degree) (hnps : P.leadingCoeff ≤ 0) :
    Tendsto (fun x => eval x P) atTop atBot :=
  P.tendsto_atBot_iff_leadingCoeff_nonpos.2 ⟨hdeg, hnps⟩
#align polynomial.tendsto_at_bot_of_leading_coeff_nonpos Polynomial.tendsto_atBot_of_leadingCoeff_nonpos

theorem abs_tendsto_atTop (hdeg : 0 < P.degree) : Tendsto (fun x => abs <| eval x P) atTop atTop :=
  by
  cases' le_total 0 P.leading_coeff with hP hP
  · exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP)
  · exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP)
#align polynomial.abs_tendsto_at_top Polynomial.abs_tendsto_atTop

theorem abs_isBoundedUnder_iff :
    (IsBoundedUnder (· ≤ ·) atTop fun x => |eval x P|) ↔ P.degree ≤ 0 :=
  by
  refine'
    ⟨fun h => _, fun h =>
      ⟨|P.coeff 0|,
        eventually_map.mpr
          (eventually_of_forall
            (forall_imp (fun _ => le_of_eq) fun x =>
              congr_arg abs <| trans (congr_arg (eval x) (eq_C_of_degree_le_zero h)) eval_C))⟩⟩
  contrapose! h
  exact not_is_bounded_under_of_tendsto_at_top (abs_tendsto_at_top P h)
#align polynomial.abs_is_bounded_under_iff Polynomial.abs_isBoundedUnder_iff

theorem abs_tendsto_atTop_iff : Tendsto (fun x => abs <| eval x P) atTop atTop ↔ 0 < P.degree :=
  ⟨fun h => not_le.mp (mt (abs_isBoundedUnder_iff P).mpr (not_isBoundedUnder_of_tendsto_atTop h)),
    abs_tendsto_atTop P⟩
#align polynomial.abs_tendsto_at_top_iff Polynomial.abs_tendsto_atTop_iff

theorem tendsto_nhds_iff {c : 𝕜} :
    Tendsto (fun x => eval x P) atTop (𝓝 c) ↔ P.leadingCoeff = c ∧ P.degree ≤ 0 :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · have := P.is_equivalent_at_top_lead.tendsto_nhds h
    by_cases hP : P.leading_coeff = 0
    · simp only [hP, MulZeroClass.zero_mul, tendsto_const_nhds_iff] at this
      refine' ⟨trans hP this, by simp [leading_coeff_eq_zero.1 hP]⟩
    · rw [tendsto_const_mul_pow_nhds_iff hP, nat_degree_eq_zero_iff_degree_le_zero] at this
      exact this.symm
  · refine' P.is_equivalent_at_top_lead.symm.tendsto_nhds _
    have : P.nat_degree = 0 := nat_degree_eq_zero_iff_degree_le_zero.2 h.2
    simp only [h.1, this, pow_zero, mul_one]
    exact tendsto_const_nhds
#align polynomial.tendsto_nhds_iff Polynomial.tendsto_nhds_iff

end PolynomialAtTop

section PolynomialDivAtTop

theorem isEquivalent_atTop_div :
    (fun x => eval x P / eval x Q) ~[atTop] fun x =>
      P.leadingCoeff / Q.leadingCoeff * x ^ (P.natDegree - Q.natDegree : ℤ) :=
  by
  by_cases hP : P = 0
  · simp [hP]
  by_cases hQ : Q = 0
  · simp [hQ]
  refine'
    (P.is_equivalent_at_top_lead.symm.div Q.is_equivalent_at_top_lead.symm).symm.trans
      (eventually_eq.is_equivalent ((eventually_gt_at_top 0).mono fun x hx => _))
  simp [← div_mul_div_comm, hP, hQ, zpow_sub₀ hx.ne.symm]
#align polynomial.is_equivalent_at_top_div Polynomial.isEquivalent_atTop_div

theorem div_tendsto_zero_of_degree_lt (hdeg : P.degree < Q.degree) :
    Tendsto (fun x => eval x P / eval x Q) atTop (𝓝 0) :=
  by
  by_cases hP : P = 0
  · simp [hP, tendsto_const_nhds]
  rw [← nat_degree_lt_nat_degree_iff hP] at hdeg
  refine' (is_equivalent_at_top_div P Q).symm.tendsto_nhds _
  rw [← MulZeroClass.mul_zero]
  refine' (tendsto_zpow_atTop_zero _).const_mul _
  linarith
#align polynomial.div_tendsto_zero_of_degree_lt Polynomial.div_tendsto_zero_of_degree_lt

theorem div_tendsto_zero_iff_degree_lt (hQ : Q ≠ 0) :
    Tendsto (fun x => eval x P / eval x Q) atTop (𝓝 0) ↔ P.degree < Q.degree :=
  by
  refine' ⟨fun h => _, div_tendsto_zero_of_degree_lt P Q⟩
  by_cases hPQ : P.leading_coeff / Q.leading_coeff = 0
  · simp only [div_eq_mul_inv, inv_eq_zero, mul_eq_zero] at hPQ
    cases' hPQ with hP0 hQ0
    · rw [leading_coeff_eq_zero.1 hP0, degree_zero]
      exact bot_lt_iff_ne_bot.2 fun hQ' => hQ (degree_eq_bot.1 hQ')
    · exact absurd (leading_coeff_eq_zero.1 hQ0) hQ
  · have := (is_equivalent_at_top_div P Q).tendsto_nhds h
    rw [tendsto_const_mul_zpow_atTop_nhds_iff hPQ] at this
    cases' this with h h
    · exact absurd h.2 hPQ
    · rw [sub_lt_iff_lt_add, zero_add, Int.ofNat_lt] at h
      exact degree_lt_degree h.1
#align polynomial.div_tendsto_zero_iff_degree_lt Polynomial.div_tendsto_zero_iff_degree_lt

theorem div_tendsto_leadingCoeff_div_of_degree_eq (hdeg : P.degree = Q.degree) :
    Tendsto (fun x => eval x P / eval x Q) atTop (𝓝 <| P.leadingCoeff / Q.leadingCoeff) :=
  by
  refine' (is_equivalent_at_top_div P Q).symm.tendsto_nhds _
  rw [show (P.nat_degree : ℤ) = Q.nat_degree by simp [hdeg, nat_degree]]
  simp [tendsto_const_nhds]
#align polynomial.div_tendsto_leading_coeff_div_of_degree_eq Polynomial.div_tendsto_leadingCoeff_div_of_degree_eq

theorem div_tendsto_atTop_of_degree_gt' (hdeg : Q.degree < P.degree)
    (hpos : 0 < P.leadingCoeff / Q.leadingCoeff) :
    Tendsto (fun x => eval x P / eval x Q) atTop atTop :=
  by
  have hQ : Q ≠ 0 := fun h =>
    by
    simp only [h, div_zero, leading_coeff_zero] at hpos
    linarith
  rw [← nat_degree_lt_nat_degree_iff hQ] at hdeg
  refine' (is_equivalent_at_top_div P Q).symm.tendsto_atTop _
  apply tendsto.const_mul_at_top hpos
  apply tendsto_zpow_atTop_atTop
  linarith
#align polynomial.div_tendsto_at_top_of_degree_gt' Polynomial.div_tendsto_atTop_of_degree_gt'

theorem div_tendsto_atTop_of_degree_gt (hdeg : Q.degree < P.degree) (hQ : Q ≠ 0)
    (hnng : 0 ≤ P.leadingCoeff / Q.leadingCoeff) :
    Tendsto (fun x => eval x P / eval x Q) atTop atTop :=
  have ratio_pos : 0 < P.leadingCoeff / Q.leadingCoeff :=
    lt_of_le_of_ne hnng
      (div_ne_zero (fun h => ne_zero_of_degree_gt hdeg <| leadingCoeff_eq_zero.mp h) fun h =>
          hQ <| leadingCoeff_eq_zero.mp h).symm
  div_tendsto_atTop_of_degree_gt' P Q hdeg ratio_pos
#align polynomial.div_tendsto_at_top_of_degree_gt Polynomial.div_tendsto_atTop_of_degree_gt

theorem div_tendsto_atBot_of_degree_gt' (hdeg : Q.degree < P.degree)
    (hneg : P.leadingCoeff / Q.leadingCoeff < 0) :
    Tendsto (fun x => eval x P / eval x Q) atTop atBot :=
  by
  have hQ : Q ≠ 0 := fun h =>
    by
    simp only [h, div_zero, leading_coeff_zero] at hneg
    linarith
  rw [← nat_degree_lt_nat_degree_iff hQ] at hdeg
  refine' (is_equivalent_at_top_div P Q).symm.tendsto_atBot _
  apply tendsto.neg_const_mul_at_top hneg
  apply tendsto_zpow_atTop_atTop
  linarith
#align polynomial.div_tendsto_at_bot_of_degree_gt' Polynomial.div_tendsto_atBot_of_degree_gt'

theorem div_tendsto_atBot_of_degree_gt (hdeg : Q.degree < P.degree) (hQ : Q ≠ 0)
    (hnps : P.leadingCoeff / Q.leadingCoeff ≤ 0) :
    Tendsto (fun x => eval x P / eval x Q) atTop atBot :=
  have ratio_neg : P.leadingCoeff / Q.leadingCoeff < 0 :=
    lt_of_le_of_ne hnps
      (div_ne_zero (fun h => ne_zero_of_degree_gt hdeg <| leadingCoeff_eq_zero.mp h) fun h =>
        hQ <| leadingCoeff_eq_zero.mp h)
  div_tendsto_atBot_of_degree_gt' P Q hdeg ratio_neg
#align polynomial.div_tendsto_at_bot_of_degree_gt Polynomial.div_tendsto_atBot_of_degree_gt

theorem abs_div_tendsto_atTop_of_degree_gt (hdeg : Q.degree < P.degree) (hQ : Q ≠ 0) :
    Tendsto (fun x => |eval x P / eval x Q|) atTop atTop :=
  by
  by_cases h : 0 ≤ P.leading_coeff / Q.leading_coeff
  · exact tendsto_abs_at_top_at_top.comp (P.div_tendsto_at_top_of_degree_gt Q hdeg hQ h)
  · push_neg  at h
    exact tendsto_abs_at_bot_at_top.comp (P.div_tendsto_at_bot_of_degree_gt Q hdeg hQ h.le)
#align polynomial.abs_div_tendsto_at_top_of_degree_gt Polynomial.abs_div_tendsto_atTop_of_degree_gt

end PolynomialDivAtTop

theorem isO_of_degree_le (h : P.degree ≤ Q.degree) :
    (fun x => eval x P) =O[atTop] fun x => eval x Q :=
  by
  by_cases hp : P = 0
  · simpa [hp] using is_O_zero (fun x => eval x Q) at_top
  · have hq : Q ≠ 0 := ne_zero_of_degree_ge_degree h hp
    have hPQ : ∀ᶠ x : 𝕜 in at_top, eval x Q = 0 → eval x P = 0 :=
      Filter.mem_of_superset (Polynomial.eventually_no_roots Q hq) fun x h h' => absurd h' h
    cases' le_iff_lt_or_eq.mp h with h h
    · exact is_O_of_div_tendsto_nhds hPQ 0 (div_tendsto_zero_of_degree_lt P Q h)
    · exact is_O_of_div_tendsto_nhds hPQ _ (div_tendsto_leading_coeff_div_of_degree_eq P Q h)
#align polynomial.is_O_of_degree_le Polynomial.isO_of_degree_le

end Polynomial


axiom P : Prop
axiom Q : Prop
axiom R : Prop

-->> def true_intro : pExp := pTrue
#check true       -- a type
#check true.intro -- a constructor (value)
#print true

-- true is a proposition
-- in Lean represented as a type
-- intro is defined to be a proof of it (a value)
-- because there is proof, we judge the proposition to be true
-- a proof is necessary and sufficient *evidence* of truth

-- *** FALSE ***

-- false
#check false
#print false
-- there is no proof of the proposition false
-- this is by definition of false as a type with no values
-- so we judge the proposition, false, to be false (untrue)

-->> def false_elim := pFalse >> P
#check @false.elim

-- def true_imp := pTrue >> P
-- oops, this is not a valid law

def true_imp : ∀ (P : Prop), true → P :=
λ P t, _

-- *** AND ***

#check and
#print and

-->> def and_intro := P >> Q >> P ∧ Q
#check @and.intro -- constructor

-->> def and_elim_left := P ∧ Q >> P
#check @and.elim_left
#print and.elim_left

-->> def and_elim_right := P ∧ Q >> Q
#check @and.elim_right
#print and.elim_right

-- *** OR ***

-->> def or_intro_left := P >> P ∨ Q
#check @or.intro_left

-->> def or_intro_right := Q >> P ∨ Q
#check @or.intro_right

-->> def or_elim := P ∨ Q >> (P >> R) >> (Q >> R) >> R
#check @or.elim

-- *** IFF ***

#check iff
#print iff

-- def iff_intro := (P >> Q) >> (Q >> P) >> (P ↔ Q)
#check @iff.intro

-- def iff_elim_left := (P ↔ Q) >> (P >> Q)
#check @iff.elim_left
#check @iff.mp

-- def iff_elim_right := (P ↔ Q) >> (Q >> P)
#check @iff.elim_right
#check @iff.mpr

-- *** ARROW ***

-- introduction rule:
-- if you show that given any (p : P) you can derive
-- a value (q : Q), then you've proven P → Q. To prove
-- P → Q, define any function of this type. The totality
-- of functions in Lean is essential here: to the "any".

-- def arrow_elim := (P >> Q) >> P >> Q
-- if you're given a function of type P → Q and
-- any value of type P, you can derive one of type Q

axiom p : P
axiom pf : P → Q
#check (pf p)

-- *** RESOLUTION ***
--def resolution := (P ∨ Q) >> (¬ Q ∨ R) >> (P ∨ R)
--def unit_resolution := (P ∨ Q) >> ¬ Q >> P

-- The resolution rules are used in some automated
-- theorem provers. We won't study them in this class
-- That said, they are clearly valid reasoning rules.

-- *** NEGATION

-- def neg_intro := (P >> pFalse) >> (¬ P)
#print not

-- def neg_elim := (¬¬P) >> P -- "proof by contradiction"

#check classical.em

-- *** THEOREMS ***

-- def syllogism := (P >> Q) >> (Q >> R) >> (P >> R)
def syllogism : ∀ {P Q R : Prop}, (P → Q) → (Q → R) → (P → R) :=
  λ (P Q R : Prop) (pq : P → Q) (qr : Q → R),
    qr ∘ pq

--def modus_tollens := (P >> Q) >> (¬ Q >> ¬ P)
theorem modus_tollens : ∀ {P Q : Prop}, (P → Q) → ¬ Q → ¬ P :=
λ P Q pq nq, syllogism pq nq

-- *** AXIOMS ***

-- def excluded_middle := P ∨ (¬ P)
#check classical.em

-- *** NON-THEOREMS (FALSEHOODS) ***
--def affirm_consequence := (P >> Q) >> (Q >> P)

theorem affirm_consequence : ∀ {P Q : Prop}, (P → Q) → Q → P :=
λ P Q pq q, _                             -- sTuCK!

--def affirm_disjunct := (P ∨ Q) >> (P >> ¬ Q)
theorem  affirm_disjunct : ∀ {P Q : Prop }, (P ∨ Q) → P → ¬ Q :=
λ (P Q : Prop) (pq : P ∨ Q) (p : P), _    -- sTuCK!

--def deny_antecedent := (P >> Q) >> (¬ P >> ¬ Q)
theorem deny_antecedent : ∀ {P Q : Prop }, (P → Q) → (¬P → ¬Q) :=
λ P Q pq np, _


section
variables (P Q : Prop)

theorem my_theorem : P ∧ Q → Q ∧ P :=
assume h : P ∧ Q,
have P, from and.left h,
have Q, from and.right h,
show Q ∧ P, from and.intro ‹Q› ‹P›

end


/-
aluno:
 - Lucas Emanuel Resck Domingues
 -/

open set

-- ex 1

section
    variable U : Type
    variables A B C : set U

    example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
        assume x,
        show x ∈ A ∩ C → x ∈ A ∪ B, from
            assume h1 : x ∈ A ∩ C,
            show x ∈ A ∪ B, from or.inl h1.left

    example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
        assume x,
        show x ∈ -(A ∪ B) → x ∈ -A, from
            assume h1 : x ∈ -(A ∪ B),
            show x ∈ -A, from
                assume h2 : x ∈ A,
                show false, from h1 $ or.inl h2
end

-- ex 2

section
    variable {U : Type}

    /- defining "disjoint" -/

    def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

    example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) :
    disj A B :=
        assume x,
            assume h1 : x ∈ A,
                assume h2 : x ∈ B,
                have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
                show false, from h x h3

    -- notice that we do not have to mention x when applying
    --   h : disj A B
    example (A B : set U) (h1 : disj A B) (x : U)
        (h2 : x ∈ A) (h3 : x ∈ B) :
    false :=
        h1 h2 h3

    -- the same is true of ⊆
    example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) :
    x ∈ B :=
        h h1

    example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A)
        (h3 : D ⊆ B) :
    disj C D :=
        assume x,
        show x ∈ C → x ∈ D → false, from
            assume h4 : x ∈ C,
            show x ∈ D → false, from
                assume h5 : x ∈ D,
                show false, from h1 (h2 h4) (h3 h5)
end

-- ex 3

section
    variables {I U : Type}
    variables {A B : I → set U}

    def Union (A : I → set U) : set U := { x | ∃ i : I, x ∈ A i }
    def Inter (A : I → set U) : set U := { x | ∀ i : I, x ∈ A i }

    notation `⋃` binders `, ` r:(scoped f, Union f) := r
    notation `⋂` binders `, ` r:(scoped f, Inter f) := r

    theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
    by simp; assumption

    @[elab_simple]
    theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
    by simp at h; apply h

    theorem Union.intro {x : U} (i : I) (h : x ∈ A i) : x ∈ ⋃ i, A i :=
    by {simp, existsi i, exact h}

    theorem Union.elim {b : Prop} {x : U}
    (h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → b) : b :=
    by {simp at h₁, cases h₁ with i h, exact h₂ i h}
end

section
    variables {I U : Type}

    variables (A : I → set U) (B : I → set U) (C : set U)

    example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
        assume x,
        show x ∈ (⋂ i, A i) ∩ (⋂ i, B i) → x ∈ (⋂ i, A i ∩ B i), from
            assume h1 : x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
            have h2 : x ∈ (⋂ i, A i), from h1.left,
            have h3 : x ∈ (⋂ i, B i), from h1.right,
            show x ∈ (⋂ i, A i ∩ B i), from Inter.intro $
                assume i,
                have h4 : x ∈ A i, from Inter.elim h2 i,
                have h5 : x ∈ B i, from Inter.elim h3 i,
                show x ∈ A i ∩ B i, from and.intro h4 h5

    example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
        assume x,
        show x ∈ C ∩ (⋃i, A i) → x ∈ ⋃i, C ∩ A i, from
            assume h1 : x ∈ C ∩ (⋃i, A i),
            have h2 : x ∈ ⋃i, A i, from h1.right,
            have h5 : x ∈ C, from h1.left,
            show x ∈ ⋃i, C ∩ A i, from Union.elim h2 $
                assume i,
                show x ∈ A i →  x ∈ ⋃j, C ∩ A j, from
                    assume h3 : x ∈ A i,
                    have h4 : x ∈ C ∩ A i, from and.intro h5 h3,
                    show x ∈ ⋃j, C ∩ A j, from Union.intro i h4
end

-- ex 4

section
    variable  {U : Type}
    variables A B C : set U
    universes u v w x

    theorem subset.refl (A : set U) : A ⊆ A :=
        assume x,
        show x ∈ A → x ∈ A, from
            assume h : x ∈ A,
            show x ∈ A, from h

    theorem subset.trans {A B C : set U} (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
        assume x,
        show x ∈ A → x ∈ C, from
            assume h3 : x ∈ A,
            have h4 : x ∈ B, from h1 h3,
            show x ∈ C, from h2 h4

    -- For this exercise these two facts are useful
    example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
    subset.trans h1 h2

    example : A ⊆ A :=
    subset.refl A

    example (h : A ⊆ B) : powerset A ⊆ powerset B :=
        assume X : set U,
        show X ∈ powerset A → X ∈ powerset B, from
            assume h1 : X ∈ powerset A,
            have h2 : X ⊆ A, from h1,
            have h3 : X ⊆ B, from subset.trans h2 h,
            show X ∈ powerset B, from h3

    example (h : powerset A ⊆ powerset B) : A ⊆ B :=
        assume x,
        show x ∈ A → x ∈ B, from
            assume h1 : x ∈ A,
            have h2 : ∀ X, X ⊆ A → X ⊆ B, from h,
            have h3 : A ⊆ A, from subset.refl A,
            have h4 : A ⊆ B, from h2 A h3,
            show x ∈ B, from h4 h1
end