/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/

import data.mv_polynomial.monad
import data.set.disjointed

/-!
# Degrees and variables of polynomials

This file establishes many results about the degree and variable sets of a multivariate polynomial.

The *variable set* of a polynomial $P \in R[X]$ is a `finset` containing each $x \in X$
that appears in a monomial in $P$.

The *degree set* of a polynomial $P \in R[X]$ is a `multiset` containing, for each $x$ in the
variable set, $n$ copies of $x$, where $n$ is the maximum number of copies of $x$ appearing in a
monomial of $P$.

## Main declarations

* `mv_polynomial.degrees p` : the multiset of variables representing the union of the multisets
  corresponding to each non-zero monomial in `p`.
  For example if `7 ≠ 0` in `R` and `p = x²y+7y³` then `degrees p = {x, x, y, y, y}`

* `mv_polynomial.vars p` : the finset of variables occurring in `p`.
  For example if `p = x⁴y+yz` then `vars p = {x, y, z}`

* `mv_polynomial.degree_of n p : ℕ` : the total degree of `p` with respect to the variable `n`.
  For example if `p = x⁴y+yz` then `degree_of y p = 1`.

* `mv_polynomial.total_degree p : ℕ` :
  the max of the sizes of the multisets `s` whose monomials `X^s` occur in `p`.
  For example if `p = x⁴y+yz` then `total_degree p = 5`.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u v w
variables {R : Type u} {S : Type v}

namespace mv_polynomial
variables {σ τ : Type*} {r : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section comm_semiring
variables [comm_semiring R] {p q : mv_polynomial σ R}

section degrees

/-! ### `degrees` -/

/--
The maximal degrees of each variable in a multi-variable polynomial, expressed as a multiset.

(For example, `degrees (x^2 * y + y^3)` would be `{x, x, y, y, y}`.)
-/
def degrees (p : mv_polynomial σ R) : multiset σ :=
p.support.sup (λs:σ →₀ ℕ, s.to_multiset)

lemma degrees_monomial (s : σ →₀ ℕ) (a : R) : degrees (monomial s a) ≤ s.to_multiset :=
finset.sup_le $ assume t h,
begin
  have := finsupp.support_single_subset h,
  rw [finset.mem_singleton] at this,
  rw this
end

lemma degrees_monomial_eq (s : σ →₀ ℕ) (a : R) (ha : a ≠ 0) :
  degrees (monomial s a) = s.to_multiset :=
le_antisymm (degrees_monomial s a) $ finset.le_sup $
  by rw [support_monomial, if_neg ha, finset.mem_singleton]

lemma degrees_C (a : R) : degrees (C a : mv_polynomial σ R) = 0 :=
multiset.le_zero.1 $ degrees_monomial _ _

lemma degrees_X' (n : σ) : degrees (X n : mv_polynomial σ R) ≤ {n} :=
le_trans (degrees_monomial _ _) $ le_of_eq $ to_multiset_single _ _

@[simp] lemma degrees_X [nontrivial R] (n : σ) : degrees (X n : mv_polynomial σ R) = {n} :=
(degrees_monomial_eq _ _ one_ne_zero).trans (to_multiset_single _ _)

@[simp] lemma degrees_zero : degrees (0 : mv_polynomial σ R) = 0 :=
by { rw ← C_0, exact degrees_C 0 }

@[simp] lemma degrees_one : degrees (1 : mv_polynomial σ R) = 0 := degrees_C 1

lemma degrees_add (p q : mv_polynomial σ R) : (p + q).degrees ≤ p.degrees ⊔ q.degrees :=
begin
  refine finset.sup_le (assume b hb, _),
  have := finsupp.support_add hb, rw finset.mem_union at this,
  cases this,
  { exact le_sup_left_of_le (finset.le_sup this) },
  { exact le_sup_right_of_le (finset.le_sup this) },
end

lemma degrees_sum {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) :
  (∑ i in s, f i).degrees ≤ s.sup (λi, (f i).degrees) :=
begin
  refine s.induction _ _,
  { simp only [finset.sum_empty, finset.sup_empty, degrees_zero], exact le_refl _ },
  { assume i s his ih,
    rw [finset.sup_insert, finset.sum_insert his],
    exact le_trans (degrees_add _ _) (sup_le_sup_left ih _) }
end

lemma degrees_mul (p q : mv_polynomial σ R) : (p * q).degrees ≤ p.degrees + q.degrees :=
begin
  refine finset.sup_le (assume b hb, _),
  have := support_mul p q hb,
  simp only [finset.mem_bUnion, finset.mem_singleton] at this,
  rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩,
  rw [finsupp.to_multiset_add],
  exact add_le_add (finset.le_sup h₁) (finset.le_sup h₂)
end

lemma degrees_prod {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) :
  (∏ i in s, f i).degrees ≤ ∑ i in s, (f i).degrees :=
begin
  refine s.induction _ _,
  { simp only [finset.prod_empty, finset.sum_empty, degrees_one] },
  { assume i s his ih,
    rw [finset.prod_insert his, finset.sum_insert his],
    exact le_trans (degrees_mul _ _) (add_le_add_left ih _) }
end

lemma degrees_pow (p : mv_polynomial σ R) :
  ∀(n : ℕ), (p^n).degrees ≤ n • p.degrees
| 0       := begin rw [pow_zero, degrees_one], exact multiset.zero_le _ end
| (n + 1) := by { rw [pow_succ, add_smul, add_comm, one_smul],
    exact le_trans (degrees_mul _ _) (add_le_add_left (degrees_pow n) _) }

lemma mem_degrees {p : mv_polynomial σ R} {i : σ} :
  i ∈ p.degrees ↔ ∃ d, p.coeff d ≠ 0 ∧ i ∈ d.support :=
by simp only [degrees, multiset.mem_sup, ← mem_support_iff,
    finsupp.mem_to_multiset, exists_prop]

lemma le_degrees_add {p q : mv_polynomial σ R} (h : p.degrees.disjoint q.degrees) :
  p.degrees ≤ (p + q).degrees :=
begin
  apply finset.sup_le,
  intros d hd,
  rw multiset.disjoint_iff_ne at h,
  rw multiset.le_iff_count,
  intros i,
  rw [degrees, multiset.count_sup],
  simp only [finsupp.count_to_multiset],
  by_cases h0 : d = 0,
  { simp only [h0, zero_le, finsupp.zero_apply], },
  { refine @finset.le_sup _ _ _ (p + q).support _ d _,
    rw [mem_support_iff, coeff_add],
    suffices : q.coeff d = 0,
    { rwa [this, add_zero, coeff, ← finsupp.mem_support_iff], },
    rw [← finsupp.support_eq_empty, ← ne.def, ← finset.nonempty_iff_ne_empty] at h0,
    obtain ⟨j, hj⟩ := h0,
    contrapose! h,
    rw mem_support_iff at hd,
    refine ⟨j, _, j, _, rfl⟩,
    all_goals { rw mem_degrees, refine ⟨d, _, hj⟩, assumption } }
end

lemma degrees_add_of_disjoint
  {p q : mv_polynomial σ R} (h : multiset.disjoint p.degrees q.degrees) :
  (p + q).degrees = p.degrees ∪ q.degrees :=
begin
  apply le_antisymm,
  { apply degrees_add },
  { apply multiset.union_le,
    { apply le_degrees_add h },
    { rw add_comm, apply le_degrees_add h.symm } }
end

lemma degrees_map [comm_semiring S] (p : mv_polynomial σ R) (f : R →+* S) :
  (map f p).degrees ⊆ p.degrees :=
begin
  dsimp only [degrees],
  apply multiset.subset_of_le,
  apply finset.sup_mono,
  apply mv_polynomial.support_map_subset
end

lemma degrees_rename (f : σ → τ) (φ : mv_polynomial σ R) :
  (rename f φ).degrees ⊆ (φ.degrees.map f) :=
begin
  intros i,
  rw [mem_degrees, multiset.mem_map],
  rintro ⟨d, hd, hi⟩,
  obtain ⟨x, rfl, hx⟩ := coeff_rename_ne_zero _ _ _ hd,
  simp only [map_domain, finsupp.mem_support_iff] at hi,
  rw [sum_apply, finsupp.sum] at hi,
  contrapose! hi,
  rw [finset.sum_eq_zero],
  intros j hj,
  simp only [exists_prop, mem_degrees] at hi,
  specialize hi j ⟨x, hx, hj⟩,
  rw [single_apply, if_neg hi],
end

lemma degrees_map_of_injective [comm_semiring S] (p : mv_polynomial σ R)
  {f : R →+* S} (hf : injective f) : (map f p).degrees = p.degrees :=
by simp only [degrees, mv_polynomial.support_map_of_injective _ hf]

end degrees

section vars

/-! ### `vars` -/

/-- `vars p` is the set of variables appearing in the polynomial `p` -/
def vars (p : mv_polynomial σ R) : finset σ := p.degrees.to_finset

@[simp] lemma vars_0 : (0 : mv_polynomial σ R).vars = ∅ :=
by rw [vars, degrees_zero, multiset.to_finset_zero]

@[simp] lemma vars_monomial (h : r ≠ 0) : (monomial s r).vars = s.support :=
by rw [vars, degrees_monomial_eq _ _ h, finsupp.to_finset_to_multiset]

@[simp] lemma vars_C : (C r : mv_polynomial σ R).vars = ∅ :=
by rw [vars, degrees_C, multiset.to_finset_zero]

@[simp] lemma vars_X [nontrivial R] : (X n : mv_polynomial σ R).vars = {n} :=
by rw [X, vars_monomial (@one_ne_zero R _ _), finsupp.support_single_ne_zero (one_ne_zero : 1 ≠ 0)]

lemma mem_vars (i : σ) :
  i ∈ p.vars ↔ ∃ (d : σ →₀ ℕ) (H : d ∈ p.support), i ∈ d.support :=
by simp only [vars, multiset.mem_to_finset, mem_degrees, mem_support_iff,
  exists_prop]

lemma mem_support_not_mem_vars_zero
  {f : mv_polynomial σ R} {x : σ →₀ ℕ} (H : x ∈ f.support) {v : σ} (h : v ∉ vars f) :
  x v = 0 :=
begin
  rw [vars, multiset.mem_to_finset] at h,
  rw ← finsupp.not_mem_support_iff,
  contrapose! h,
  unfold degrees,
  rw (show f.support = insert x f.support, from eq.symm $ finset.insert_eq_of_mem H),
  rw finset.sup_insert,
  simp only [multiset.mem_union, multiset.sup_eq_union],
  left,
  rwa [←to_finset_to_multiset, multiset.mem_to_finset] at h,
end

lemma vars_add_subset (p q : mv_polynomial σ R) :
  (p + q).vars ⊆ p.vars ∪ q.vars :=
begin
  intros x hx,
  simp only [vars, finset.mem_union, multiset.mem_to_finset] at hx ⊢,
  simpa using multiset.mem_of_le (degrees_add _ _) hx,
end

section mul

lemma vars_mul (φ ψ : mv_polynomial σ R) : (φ * ψ).vars ⊆ φ.vars ∪ ψ.vars :=
begin
  intro i,
  simp only [mem_vars, finset.mem_union],
  rintro ⟨d, hd, hi⟩,
  rw [mem_support_iff, coeff_mul] at hd,
  contrapose! hd, cases hd,
  rw finset.sum_eq_zero,
  rintro ⟨d₁, d₂⟩ H,
  rw finsupp.mem_antidiagonal_support at H,
  subst H,
  obtain H|H : i ∈ d₁.support ∨ i ∈ d₂.support,
  { simpa only [finset.mem_union] using finsupp.support_add hi, },
  { suffices : coeff d₁ φ = 0, by simp [this],
    rw [coeff, ← finsupp.not_mem_support_iff], intro, solve_by_elim, },
  { suffices : coeff d₂ ψ = 0, by simp [this],
    rw [coeff, ← finsupp.not_mem_support_iff], intro, solve_by_elim, },
end

@[simp] lemma vars_one : (1 : mv_polynomial σ R).vars = ∅ :=
vars_C

lemma vars_pow (φ : mv_polynomial σ R) (n : ℕ) : (φ ^ n).vars ⊆ φ.vars :=
begin
  induction n with n ih,
  { simp },
  { rw pow_succ,
    apply finset.subset.trans (vars_mul _ _),
    exact finset.union_subset (finset.subset.refl _) ih }
end

/--
The variables of the product of a family of polynomials
are a subset of the union of the sets of variables of each polynomial.
-/
lemma vars_prod {ι : Type*} {s : finset ι} (f : ι → mv_polynomial σ R) :
  (∏ i in s, f i).vars ⊆ s.bUnion (λ i, (f i).vars) :=
begin
  apply s.induction_on,
  { simp },
  { intros a s hs hsub,
    simp only [hs, finset.bUnion_insert, finset.prod_insert, not_false_iff],
    apply finset.subset.trans (vars_mul _ _),
    exact finset.union_subset_union (finset.subset.refl _) hsub }
end

section integral_domain
variables {A : Type*} [integral_domain A]

lemma vars_C_mul (a : A) (ha : a ≠ 0) (φ : mv_polynomial σ A) : (C a * φ).vars = φ.vars :=
begin
  ext1 i,
  simp only [mem_vars, exists_prop, mem_support_iff],
  apply exists_congr,
  intro d,
  apply and_congr _ iff.rfl,
  rw [coeff_C_mul, mul_ne_zero_iff, eq_true_intro ha, true_and],
end

end integral_domain

end mul

section sum

variables {ι : Type*} (t : finset ι) (φ : ι → mv_polynomial σ R)

lemma vars_sum_subset :
  (∑ i in t, φ i).vars ⊆ finset.bUnion t (λ i, (φ i).vars) :=
begin
  apply t.induction_on,
  { simp },
  { intros a s has hsum,
    rw [finset.bUnion_insert, finset.sum_insert has],
    refine finset.subset.trans (vars_add_subset _ _)
      (finset.union_subset_union (finset.subset.refl _) _),
    assumption }
end

lemma vars_sum_of_disjoint (h : pairwise $ disjoint on (λ i, (φ i).vars)) :
  (∑ i in t, φ i).vars = finset.bUnion t (λ i, (φ i).vars) :=
begin
  apply t.induction_on,
  { simp },
  { intros a s has hsum,
    rw [finset.bUnion_insert, finset.sum_insert has, vars_add_of_disjoint, hsum],
    unfold pairwise on_fun at h,
    rw hsum,
    simp only [finset.disjoint_iff_ne] at h ⊢,
    intros v hv v2 hv2,
    rw finset.mem_bUnion at hv2,
    rcases hv2 with ⟨i, his, hi⟩,
    refine h a i _ _ hv _ hi,
    rintro rfl,
    contradiction }
end

end sum

section map

variables [comm_semiring S] (f : R →+* S)
variable (p)

lemma vars_map : (map f p).vars ⊆ p.vars :=
by simp [vars, degrees_map]

variable {f}
lemma vars_map_of_injective (hf : injective f) :
  (map f p).vars = p.vars :=
by simp [vars, degrees_map_of_injective _ hf]

lemma vars_monomial_single (i : σ) {e : ℕ} {r : R} (he : e ≠ 0) (hr : r ≠ 0) :
  (monomial (finsupp.single i e) r).vars = {i} :=
by rw [vars_monomial hr, finsupp.support_single_ne_zero he]

lemma vars_eq_support_bUnion_support : p.vars = p.support.bUnion finsupp.support :=
by { ext i, rw [mem_vars, finset.mem_bUnion] }

end map

end vars

section degree_of

/-! ### `degree_of` -/

/-- `degree_of n p` gives the highest power of X_n that appears in `p` -/
def degree_of (n : σ) (p : mv_polynomial σ R) : ℕ := p.degrees.count n

end degree_of

section total_degree

/-! ### `total_degree` -/

/-- `total_degree p` gives the maximum |s| over the monomials X^s in `p` -/
def total_degree (p : mv_polynomial σ R) : ℕ := p.support.sup (λs, s.sum $ λn e, e)

lemma total_degree_eq (p : mv_polynomial σ R) :
  p.total_degree = p.support.sup (λm, m.to_multiset.card) :=
begin
  rw [total_degree],
  congr, funext m,
  exact (finsupp.card_to_multiset _).symm
end

lemma total_degree_le_degrees_card (p : mv_polynomial σ R) :
  p.total_degree ≤ p.degrees.card :=
begin
  rw [total_degree_eq],
  exact finset.sup_le (assume s hs, multiset.card_le_of_le $ finset.le_sup hs)
end

@[simp] lemma total_degree_C (a : R) : (C a : mv_polynomial σ R).total_degree = 0 :=
nat.eq_zero_of_le_zero $ finset.sup_le $ assume n hn,
  have _ := finsupp.support_single_subset hn,
  begin
    rw [finset.mem_singleton] at this,
    subst this,
    exact le_refl _
  end

@[simp] lemma total_degree_zero : (0 : mv_polynomial σ R).total_degree = 0 :=
by rw [← C_0]; exact total_degree_C (0 : R)

@[simp] lemma total_degree_one : (1 : mv_polynomial σ R).total_degree = 0 :=
total_degree_C (1 : R)

@[simp] lemma total_degree_X {R} [comm_semiring R] [nontrivial R] (s : σ) :
  (X s : mv_polynomial σ R).total_degree = 1 :=
begin
  rw [total_degree, support_X],
  simp only [finset.sup, sum_single_index, finset.fold_singleton, sup_bot_eq],
end

lemma total_degree_add (a b : mv_polynomial σ R) :
  (a + b).total_degree ≤ max a.total_degree b.total_degree :=
finset.sup_le $ assume n hn,
  have _ := finsupp.support_add hn,
  begin
    rw finset.mem_union at this,
    cases this,
    { exact le_max_left_of_le (finset.le_sup this) },
    { exact le_max_right_of_le (finset.le_sup this) }
  end

lemma total_degree_mul (a b : mv_polynomial σ R) :
  (a * b).total_degree ≤ a.total_degree + b.total_degree :=
finset.sup_le $ assume n hn,
  have _ := add_monoid_algebra.support_mul a b hn,
  begin
    simp only [finset.mem_bUnion, finset.mem_singleton] at this,
    rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩,
    rw [finsupp.sum_add_index],
    { exact add_le_add (finset.le_sup h₁) (finset.le_sup h₂) },
    { assume a, refl },
    { assume a b₁ b₂, refl }
  end

lemma total_degree_pow (a : mv_polynomial σ R) (n : ℕ) :
  (a ^ n).total_degree ≤ n * a.total_degree :=
begin
  induction n with n ih,
  { simp only [nat.nat_zero_eq_zero, zero_mul, pow_zero, total_degree_one] },
  rw pow_succ,
  calc total_degree (a * a ^ n) ≤ a.total_degree + (a^n).total_degree : total_degree_mul _ _
    ... ≤ a.total_degree + n * a.total_degree : add_le_add_left ih _
    ... = (n+1) * a.total_degree : by rw [add_mul, one_mul, add_comm]
end

lemma total_degree_list_prod :
  ∀(s : list (mv_polynomial σ R)), s.prod.total_degree ≤ (s.map mv_polynomial.total_degree).sum
| []        := by rw [@list.prod_nil (mv_polynomial σ R) _, total_degree_one]; refl
| (p :: ps) :=
  begin
    rw [@list.prod_cons (mv_polynomial σ R) _, list.map, list.sum_cons],
    exact le_trans (total_degree_mul _ _) (add_le_add_left (total_degree_list_prod ps) _)
  end

lemma total_degree_multiset_prod (s : multiset (mv_polynomial σ R)) :
  s.prod.total_degree ≤ (s.map mv_polynomial.total_degree).sum :=
begin
  refine quotient.induction_on s (assume l, _),
  rw [multiset.quot_mk_to_coe, multiset.coe_prod, multiset.coe_map, multiset.coe_sum],
  exact total_degree_list_prod l
end

lemma total_degree_finset_prod {ι : Type*}
  (s : finset ι) (f : ι → mv_polynomial σ R) :
  (s.prod f).total_degree ≤ ∑ i in s, (f i).total_degree :=
begin
  refine le_trans (total_degree_multiset_prod _) _,
  rw [multiset.map_map],
  refl
end

lemma exists_degree_lt [fintype σ] (f : mv_polynomial σ R) (n : ℕ)
  (h : f.total_degree < n * fintype.card σ) {d : σ →₀ ℕ} (hd : d ∈ f.support) :
  ∃ i, d i < n :=
begin
  contrapose! h,
  calc n * fintype.card σ
        = ∑ s:σ, n         : by rw [finset.sum_const, nat.nsmul_eq_mul, mul_comm, finset.card_univ]
    ... ≤ ∑ s, d s         : finset.sum_le_sum (λ s _, h s)
    ... ≤ d.sum (λ i e, e) : by { rw [finsupp.sum_fintype], intros, refl }
    ... ≤ f.total_degree   : finset.le_sup hd,
end

lemma coeff_eq_zero_of_total_degree_lt {f : mv_polynomial σ R} {d : σ →₀ ℕ}
  (h : f.total_degree < ∑ i in d.support, d i) :
  coeff d f = 0 :=
begin
  classical,
  rw [total_degree, finset.sup_lt_iff] at h,
  { specialize h d, rw mem_support_iff at h,
    refine not_not.mp (mt h _), exact lt_irrefl _, },
  { exact lt_of_le_of_lt (nat.zero_le _) h, }
end

lemma total_degree_rename_le (f : σ → τ) (p : mv_polynomial σ R) :
  (rename f p).total_degree ≤ p.total_degree :=
finset.sup_le $ assume b,
begin
  assume h,
  rw rename_eq at h,
  have h' := finsupp.map_domain_support h,
  rw finset.mem_image at h',
  rcases h' with ⟨s, hs, rfl⟩,
  rw finsupp.sum_map_domain_index,
  exact le_trans (le_refl _) (finset.le_sup hs),
  exact assume _, rfl,
  exact assume _ _ _, rfl
end

end total_degree

section eval_vars

/-! ### `vars` and `eval` -/

variables [comm_semiring S]

lemma eval₂_hom_eq_constant_coeff_of_vars (f : R →+* S) {g : σ → S}
  {p : mv_polynomial σ R} (hp : ∀ i ∈ p.vars, g i = 0) :
  eval₂_hom f g p = f (constant_coeff p) :=
begin
  conv_lhs { rw p.as_sum },
  simp only [ring_hom.map_sum, eval₂_hom_monomial],
  by_cases h0 : constant_coeff p = 0,
  work_on_goal 0
  { rw [h0, f.map_zero, finset.sum_eq_zero],
    intros d hd },
  work_on_goal 1
  { rw [finset.sum_eq_single (0 : σ →₀ ℕ)],
    { rw [finsupp.prod_zero_index, mul_one],
      refl },
    intros d hd hd0, },
  repeat
  { obtain ⟨i, hi⟩ : d.support.nonempty,
    { rw [constant_coeff_eq, coeff, ← finsupp.not_mem_support_iff] at h0,
      rw [finset.nonempty_iff_ne_empty, ne.def, finsupp.support_eq_empty],
      rintro rfl, contradiction },
    rw [finsupp.prod, finset.prod_eq_zero hi, mul_zero],
    rw [hp, zero_pow (nat.pos_of_ne_zero $ finsupp.mem_support_iff.mp hi)],
    rw [mem_vars],
    exact ⟨d, hd, hi⟩ },
  { rw [constant_coeff_eq, coeff, ← ne.def, ← finsupp.mem_support_iff] at h0,
    intro, contradiction }
end

lemma aeval_eq_constant_coeff_of_vars [algebra R S] {g : σ → S}
  {p : mv_polynomial σ R} (hp : ∀ i ∈ p.vars, g i = 0) :
  aeval g p = algebra_map _ _ (constant_coeff p) :=
eval₂_hom_eq_constant_coeff_of_vars _ hp

lemma eval₂_hom_congr' {f₁ f₂ : R →+* S} {g₁ g₂ : σ → S} {p₁ p₂ : mv_polynomial σ R} :
  f₁ = f₂ → (∀ i, i ∈ p₁.vars → i ∈ p₂.vars → g₁ i = g₂ i) → p₁ = p₂ →
   eval₂_hom f₁ g₁ p₁ = eval₂_hom f₂ g₂ p₂ :=
begin
  rintro rfl h rfl,
  rename [p₁ p, f₁ f],
  rw p.as_sum,
  simp only [ring_hom.map_sum, eval₂_hom_monomial],
  apply finset.sum_congr rfl,
  intros d hd,
  congr' 1,
  simp only [finsupp.prod],
  apply finset.prod_congr rfl,
  intros i hi,
  have : i ∈ p.vars, { rw mem_vars, exact ⟨d, hd, hi⟩ },
  rw h i this this,
end

lemma vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
  (bind₁ f φ).vars ⊆ φ.vars.bUnion (λ i, (f i).vars) :=
begin
  calc (bind₁ f φ).vars
      = (φ.support.sum (λ (x : σ →₀ ℕ), (bind₁ f) (monomial x (coeff x φ)))).vars :
        by { rw [← alg_hom.map_sum, ← φ.as_sum], }
  ... ≤ φ.support.bUnion (λ (i : σ →₀ ℕ), ((bind₁ f) (monomial i (coeff i φ))).vars) :
        vars_sum_subset _ _
  ... = φ.support.bUnion (λ (d : σ →₀ ℕ), (C (coeff d φ) * ∏ i in d.support, f i ^ d i).vars) :
        by simp only [bind₁_monomial]
  ... ≤ φ.support.bUnion (λ (d : σ →₀ ℕ), d.support.bUnion (λ i, (f i).vars)) : _ -- proof below
  ... ≤ φ.vars.bUnion (λ (i : σ), (f i).vars) : _, -- proof below
  { apply finset.bUnion_mono,
    intros d hd,
    calc (C (coeff d φ) * ∏ (i : σ) in d.support, f i ^ d i).vars
        ≤ (C (coeff d φ)).vars ∪ (∏ (i : σ) in d.support, f i ^ d i).vars : vars_mul _ _
    ... ≤ (∏ (i : σ) in d.support, f i ^ d i).vars :
      by simp only [finset.empty_union, vars_C, finset.le_iff_subset, finset.subset.refl]
    ... ≤ d.support.bUnion (λ (i : σ), (f i ^ d i).vars) : vars_prod _
    ... ≤ d.support.bUnion (λ (i : σ), (f i).vars) : _,
    apply finset.bUnion_mono,
    intros i hi,
    apply vars_pow, },
  { intro j,
    simp_rw finset.mem_bUnion,
    rintro ⟨d, hd, ⟨i, hi, hj⟩⟩,
    exact ⟨i, (mem_vars _).mpr ⟨d, hd, hi⟩, hj⟩ }
end

lemma mem_vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) {j : τ}
  (h : j ∈ (bind₁ f φ).vars) :
  ∃ (i : σ), i ∈ φ.vars ∧ j ∈ (f i).vars :=
by simpa only [exists_prop, finset.mem_bUnion, mem_support_iff, ne.def] using vars_bind₁ f φ h

lemma vars_rename (f : σ → τ) (φ : mv_polynomial σ R) :
  (rename f φ).vars ⊆ (φ.vars.image f) :=
begin
  intros i hi,
  simp only [vars, exists_prop, multiset.mem_to_finset, finset.mem_image] at hi ⊢,
  simpa only [multiset.mem_map] using degrees_rename _ _ hi
end

lemma mem_vars_rename (f : σ → τ) (φ : mv_polynomial σ R) {j : τ} (h : j ∈ (rename f φ).vars) :
  ∃ (i : σ), i ∈ φ.vars ∧ f i = j :=
by simpa only [exists_prop, finset.mem_image] using vars_rename f φ h

end eval_vars

end comm_semiring

end mv_polynomial


/-
# References

1. Avigad, Jeremy. ‘Theorem Proving in Lean’, n.d.
-/

-- Exercise 1
--
-- Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as you
-- can now with tactic proofs, using also `rw` and `simp` as appropriate.
namespace ex1

-- Exercises 3.1

section ex3_1

variable (p q r : Prop)

-- Commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by
  apply Iff.intro
  · intro ⟨hp, hq⟩
    exact ⟨hq, hp⟩
  · intro ⟨hq, hp⟩
    exact ⟨hp, hq⟩

example : p ∨ q ↔ q ∨ p := by
  apply Iff.intro
  · intro
    | Or.inl hp => exact Or.inr hp
    | Or.inr hq => exact Or.inl hq
  · intro
    | Or.inl hq => exact Or.inr hq
    | Or.inr hp => exact Or.inl hp

-- Associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  apply Iff.intro
  · intro ⟨⟨hp, hq⟩, hr⟩
    exact ⟨hp, hq, hr⟩
  · intro ⟨hp, hq, hr⟩
    exact ⟨⟨hp, hq⟩, hr⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by
  apply Iff.intro
  · intro
    | Or.inl (Or.inl hp) => exact Or.inl hp
    | Or.inl (Or.inr hq) => exact Or.inr (Or.inl hq)
    | Or.inr         hr  => exact Or.inr (Or.inr hr)
  · intro
    | Or.inl         hp  => exact Or.inl (Or.inl hp)
    | Or.inr (Or.inl hq) => exact Or.inl (Or.inr hq)
    | Or.inr (Or.inr hr) => exact Or.inr hr

-- Distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  apply Iff.intro
  · intro
    | ⟨hp, Or.inl hq⟩ => exact Or.inl ⟨hp, hq⟩
    | ⟨hp, Or.inr hr⟩ => exact Or.inr ⟨hp, hr⟩
  · intro
    | Or.inl ⟨hp, hq⟩ => exact ⟨hp, Or.inl hq⟩
    | Or.inr ⟨hp, hr⟩ => exact ⟨hp, Or.inr hr⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by
  apply Iff.intro
  · intro
    | Or.inl      hp  => exact ⟨Or.inl hp, Or.inl hp⟩
    | Or.inr ⟨hq, hr⟩ => exact ⟨Or.inr hq, Or.inr hr⟩
  · intro
    | ⟨Or.inl hp,         _⟩ => exact Or.inl hp
    | ⟨Or.inr  _, Or.inl hp⟩ => exact Or.inl hp
    | ⟨Or.inr hq, Or.inr hr⟩ => exact Or.inr ⟨hq, hr⟩

-- Other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by
  apply Iff.intro
  · intro h ⟨hp, hq⟩
    exact h hp hq
  · intro h hp hq
    exact h ⟨hp, hq⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by
  apply Iff.intro
  · intro h
    apply And.intro
    · intro hp
      exact h (Or.inl hp)
    · intro hq
      exact h (Or.inr hq)
  · intro ⟨hpr, hqr⟩ h
    apply Or.elim h
    · intro hp
      exact hpr hp
    · intro hq
      exact hqr hq

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by
  apply Iff.intro
  · intro h
    apply And.intro
    · intro hp
      exact h (Or.inl hp)
    · intro hq
      exact h (Or.inr hq)
  · intro ⟨np, nq⟩
    intro
    | Or.inl hp => exact absurd hp np
    | Or.inr hq => exact absurd hq nq

example : ¬p ∨ ¬q → ¬(p ∧ q) := by
  intro
  | Or.inl np => intro h; exact absurd h.left np
  | Or.inr nq => intro h; exact absurd h.right nq

example : ¬(p ∧ ¬p) := by
  intro ⟨hp, np⟩
  exact absurd hp np

example : p ∧ ¬q → ¬(p → q) := by
  intro ⟨hp, nq⟩ h
  exact absurd (h hp) nq

example : ¬p → (p → q) := by
  intro np hp
  exact absurd hp np

example : (¬p ∨ q) → (p → q) := by
  intro
  | Or.inl np => intro hp; exact absurd hp np
  | Or.inr hq => exact fun _ => hq

example : p ∨ False ↔ p := by
  apply Iff.intro
  · intro
    | Or.inl hp => exact hp
    | Or.inr ff => exact False.elim ff
  · intro hp
    exact Or.inl hp

example : p ∧ False ↔ False := by
  apply Iff.intro
  · intro ⟨_, ff⟩
    exact ff
  · intro ff
    exact False.elim ff

example : (p → q) → (¬q → ¬p) := by
  intro hpq nq hp
  exact absurd (hpq hp) nq

end ex3_1

-- Exercises 3.2

section ex3_2

open Classical

variable (p q r s : Prop)

example (hp : p) : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by
  intro h
  apply (h hp).elim
  · intro hr
    exact Or.inl (fun _ => hr)
  · intro hs
    exact Or.inr (fun _ => hs)

example : ¬(p ∧ q) → ¬p ∨ ¬q := by
  intro h
  apply (em p).elim
  · intro hp
    apply (em q).elim
    · intro hq
      exact False.elim (h ⟨hp, hq⟩)
    · intro nq
      exact Or.inr nq
  · intro np
    exact Or.inl np

example : ¬(p → q) → p ∧ ¬q := by
  intro h
  apply And.intro
  · apply byContradiction
    intro np
    apply h
    intro hp
    exact absurd hp np
  · intro hq
    apply h
    intro _
    exact hq

example : (p → q) → (¬p ∨ q) := by
  intro hpq
  apply (em p).elim
  · intro hp
    exact Or.inr (hpq hp)
  · intro np
    exact Or.inl np

example : (¬q → ¬p) → (p → q) := by
  intro hqp hp
  apply byContradiction
  intro nq
  exact absurd hp (hqp nq)

example : p ∨ ¬p := by apply em

example : (((p → q) → p) → p) := by
  intro h
  apply (em p).elim
  · intro hp
    exact hp
  · intro np
    apply h
    intro hp
    exact absurd hp np

end ex3_2

-- Exercises 3.3

section ex3_3

variable (p : Prop)

example (hp : p) : ¬(p ↔ ¬p) := by
  intro h
  exact absurd hp (h.mp hp)

end ex3_3

-- Exercises 4.1

section ex4_1

variable (α : Type _)
variable (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) := by
  apply Iff.intro
  · intro h
    apply And.intro
    · intro hx; exact And.left (h hx)
    · intro hx; exact And.right (h hx)
  · intro h hx
    have lhs : ∀ (x : α), p x := And.left h
    have rhs : ∀ (x : α), q x := And.right h
    exact ⟨lhs hx, rhs hx⟩

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := by
  intro h₁ h₂ hx
  exact h₁ hx (h₂ hx)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := by
  intro
  | Or.inl h => intro hx; exact Or.inl (h hx)
  | Or.inr h => intro hx; exact Or.inr (h hx)

end ex4_1

-- Exercises 4.2

section ex4_2

variable (α : Type _)
variable (p q : α → Prop)
variable (r : Prop)

example : α → ((∀ _ : α, r) ↔ r) := by
  intro ha
  apply Iff.intro
  · intro har
    apply har
    exact ha
  · intro hr _
    exact hr

section

open Classical

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := by
  apply Iff.intro
  · intro h
    apply (em r).elim
    · intro hr
      exact Or.inr hr
    · intro nr
      apply Or.inl
      · intro hx
        apply (h hx).elim
        · exact id
        · intro hr
          exact absurd hr nr
  · intro h₁ hx
    apply h₁.elim
    · intro h₂
      exact Or.inl (h₂ hx)
    · intro hr
      exact Or.inr hr

end

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := by
  apply Iff.intro
  · intro h hr hx
    exact h hx hr
  · intro h hx hr
    exact h hr hx

end ex4_2

-- Exercises 4.3

section ex4_3

open Classical

variable (men : Type _)
variable (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False := by
  apply (em (shaves barber barber)).elim
  · intro hb
    exact absurd hb ((h barber).mp hb)
  · intro nb
    exact absurd ((h barber).mpr nb) nb

end ex4_3

-- Exercises 4.5

section ex4_5

open Classical

variable (α : Type _)
variable (p q : α → Prop)
variable (r s : Prop)

example : (∃ _ : α, r) → r := by
  intro ⟨_, hr⟩
  exact hr

example (a : α) : r → (∃ _ : α, r) := by
  intro hr
  exact ⟨a, hr⟩

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by
  apply Iff.intro
  · intro ⟨hx, hp, hr⟩
    exact ⟨⟨hx, hp⟩, hr⟩
  · intro ⟨⟨hx, hp⟩, hr⟩
    exact ⟨hx, hp, hr⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) := by
  apply Iff.intro
  · intro
    | ⟨hx, Or.inl hp⟩ => exact Or.inl ⟨hx, hp⟩
    | ⟨hx, Or.inr hq⟩ => exact Or.inr ⟨hx, hq⟩
  · intro
    | Or.inl ⟨hx, hp⟩ => exact ⟨hx, Or.inl hp⟩
    | Or.inr ⟨hx, hq⟩ => exact ⟨hx, Or.inr hq⟩

example : (∀ x, p x) ↔ ¬(∃ x, ¬p x) := by
  apply Iff.intro
  · intro ha ⟨hx, np⟩
    exact absurd (ha hx) np
  · intro he hx
    apply byContradiction
    intro np
    exact he ⟨hx, np⟩

example : (∃ x, p x) ↔ ¬(∀ x, ¬p x) := by
  apply Iff.intro
  · intro ⟨hx, hp⟩ h
    exact absurd hp (h hx)
  · intro h₁
    apply byContradiction
    intro h₂
    apply h₁
    intro hx hp
    exact h₂ ⟨hx, hp⟩

example : (¬∃ x, p x) ↔ (∀ x, ¬p x) := by
  apply Iff.intro
  · intro h hx hp
    exact h ⟨hx, hp⟩
  · intro h ⟨hx, hp⟩
    exact absurd hp (h hx)

theorem forall_negation : (¬∀ x, p x) ↔ (∃ x, ¬p x) := by
  apply Iff.intro
  · intro h₁
    apply byContradiction
    intro h₂
    exact h₁ (fun (x : α) => by
      apply byContradiction
      intro np
      exact h₂ ⟨x, np⟩)
  · intro ⟨hx, np⟩ h
    exact absurd (h hx) np

example : (¬∀ x, p x) ↔ (∃ x, ¬p x) := forall_negation α p

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by
  apply Iff.intro
  · intro h ⟨hx, hp⟩
    exact h hx hp
  · intro h hx hp
    exact h ⟨hx, hp⟩

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r := by
  apply Iff.intro
  · intro ⟨hx, hp⟩ h
    apply hp
    exact h hx
  · intro h₁
    apply (em (∀ x, p x)).elim
    · intro h₂
      exact ⟨a, fun _ => h₁ h₂⟩
    · intro h₂
      have ⟨hx, np⟩ : (∃ x, ¬p x) := (forall_negation α p).mp h₂
      exact ⟨hx, fun hp => absurd hp np⟩

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := by
  apply Iff.intro
  · intro ⟨hx, h⟩ hr
    exact ⟨hx, h hr⟩
  · intro h
    apply (em r).elim
    · intro hr
      have ⟨hx, hp⟩ := h hr
      exact ⟨hx, fun _ => hp⟩
    · intro nr
      exact ⟨a, fun hr => absurd hr nr⟩

end ex4_5

end ex1

-- Exercise 2
--
-- Use tactic combinators to obtain a one line proof of the following:
namespace ex2

example (p q r : Prop) (hp : p) : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by simp [*]

end ex2


/-
Copyright (c) 2020 Mathieu Guay-Paquet. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mathieu Guay-Paquet
-/
import order.ideal

/-!
# Order filters

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections
require more structure, such as a bottom element, a top element, or
a join-semilattice structure.

- `order.pfilter P`: The type of nonempty, downward directed, upward closed
               subsets of `P`. This is dual to `order.ideal`, so it
               simply wraps `order.ideal Pᵒᵈ`.
- `order.is_pfilter P`: a predicate for when a `set P` is a filter.

Note the relation between `order/filter` and `order/pfilter`: for any
type `α`, `filter α` represents the same mathematical object as
`pfilter (set α)`.

## References

- <https://en.wikipedia.org/wiki/Filter_(mathematics)>

## Tags

pfilter, filter, ideal, dual

-/

namespace order

variables {P : Type*}

/-- A filter on a preorder `P` is a subset of `P` that is
  - nonempty
  - downward directed
  - upward closed. -/
structure pfilter (P) [preorder P] :=
(dual : ideal Pᵒᵈ)

/-- A predicate for when a subset of `P` is a filter. -/
def is_pfilter [preorder P] (F : set P) : Prop :=
@is_ideal Pᵒᵈ _ F

/-- Create an element of type `order.pfilter` from a set satisfying the predicate
`order.is_pfilter`. -/
def is_pfilter.to_pfilter [preorder P] {F : set P} (h : is_pfilter F) : pfilter P :=
⟨h.to_ideal⟩

namespace pfilter

section preorder
variables [preorder P] {x y : P} (F s t : pfilter P)

instance [inhabited P] : inhabited (pfilter P) := ⟨⟨default⟩⟩

/-- A filter on `P` is a subset of `P`. -/
instance : has_coe (pfilter P) (set P) := ⟨λ F, F.dual.carrier⟩

/-- For the notation `x ∈ F`. -/
instance : has_mem P (pfilter P) := ⟨λ x F, x ∈ (F : set P)⟩

@[simp] lemma mem_coe : x ∈ (F : set P) ↔ x ∈ F := iff_of_eq rfl

lemma is_pfilter : is_pfilter (F : set P) :=
F.dual.is_ideal

lemma nonempty : (F : set P).nonempty := F.dual.nonempty

lemma directed : directed_on (≥) (F : set P) := F.dual.directed

lemma mem_of_le {F : pfilter P} : x ≤ y → x ∈ F → y ∈ F := λ h, F.dual.lower h

/-- Two filters are equal when their underlying sets are equal. -/
@[ext] lemma ext (h : (s : set P) = t) : s = t :=
by { cases s, cases t, exact congr_arg _ (ideal.ext h) }

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (pfilter P) := partial_order.lift coe ext

@[trans] lemma mem_of_mem_of_le {F G : pfilter P} : x ∈ F → F ≤ G → x ∈ G :=
ideal.mem_of_mem_of_le

/-- The smallest filter containing a given element. -/
def principal (p : P) : pfilter P := ⟨ideal.principal p⟩

@[simp] lemma mem_def (x : P) (I : ideal Pᵒᵈ) :
  x ∈ (⟨I⟩ : pfilter P) ↔ order_dual.to_dual x ∈ I :=
iff.rfl

@[simp] lemma principal_le_iff {F : pfilter P} : principal x ≤ F ↔ x ∈ F :=
ideal.principal_le_iff

@[simp] lemma mem_principal : x ∈ principal y ↔ y ≤ x :=
ideal.mem_principal -- defeq abuse

lemma antitone_principal : antitone (principal : P → pfilter P) := by delta antitone; simp

lemma principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q :=
by simp

end preorder

section order_top
variables [preorder P] [order_top P] {F : pfilter P}

/-- A specific witness of `pfilter.nonempty` when `P` has a top element. -/
@[simp] lemma top_mem : ⊤ ∈ F := ideal.bot_mem _

/-- There is a bottom filter when `P` has a top element. -/
instance : order_bot (pfilter P) :=
{ bot := ⟨⊥⟩,
  bot_le := λ F, (bot_le : ⊥ ≤ F.dual) }

end order_top

/-- There is a top filter when `P` has a bottom element. -/
instance {P} [preorder P] [order_bot P] : order_top (pfilter P) :=
{ top := ⟨⊤⟩,
  le_top := λ F, (le_top : F.dual ≤ ⊤) }

section semilattice_inf
variables [semilattice_inf P] {x y : P} {F : pfilter P}

/-- A specific witness of `pfilter.directed` when `P` has meets. -/
lemma inf_mem (hx : x ∈ F) (hy : y ∈ F) : x ⊓ y ∈ F := ideal.sup_mem hx hy

@[simp] lemma inf_mem_iff : x ⊓ y ∈ F ↔ x ∈ F ∧ y ∈ F :=
ideal.sup_mem_iff

end semilattice_inf

section complete_semilattice_Inf

variables [complete_semilattice_Inf P] {F : pfilter P}

lemma Inf_gc : galois_connection (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
λ x F, by { simp, refl }

/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
def Inf_gi : galois_coinsertion (λ x, order_dual.to_dual (principal x))
  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
{ choice := λ F _, Inf (id F : pfilter P),
  gc := Inf_gc,
  u_l_le := λ s, Inf_le $ mem_principal.2 $ le_refl s,
  choice_eq := λ _ _, rfl }

end complete_semilattice_Inf

end pfilter

end order


import game.limits.L01defs
import game.limits.seq_lim_add

namespace xena -- hide

notation `|` x `|` := abs x -- hide

/-
A basic result for working with sequences.
-/

/- Lemma
If $\lim_{n \to \infty} a_n = \alpha$ and $c \in \mathbb{R}$, then
 $\lim_{n \to \infty} (c \cdot a_n) = c \cdot \alpha$
-/
lemma lim_times_const (a : ℕ → ℝ) (α c : ℝ) (hL : is_limit a α) :
    is_limit (λ n, c * (a n)) (c*α) :=
begin
  rcases lt_trichotomy c 0 with hc | hc | hc,
  {
    intros ε hε,
    set e := ε / |c| with he,
    have cnz : c ≠ 0, linarith,
    have habsc := abs_pos_iff.mpr cnz,
    have he_pos := div_pos hε habsc,
    cases hL e he_pos with M hM,
    use M, intros n hn, rw he at hM, simp,
    have H := hM n hn,
    have G := (lt_div_iff' habsc).mp H,
    have F := abs_mul c,
    set b := a n - α with hb,
    have E := F b,
    rw hb at E,
    have D := mul_sub c (a n) α,
    rw D at E,
    rw ← hb at E,
    linarith,
  },
  {
    intros ε hε,
    cases hL ε hε with M hM,
    use M, intros n hn, simp,
    have H : c * (a n) = 0, norm_num, left, exact hc, rw H,
    have G : c * α = 0, norm_num, left, exact hc, rw G,
    norm_num, exact hε,
  },
  { -- this can be merged with first case
    intros ε hε,
    set e := ε / c with he,
    have he_pos := div_pos hε hc,
    cases hL e he_pos with M hM,
    use M, intros n hn, rw he at hM, simp,
    have H := hM n hn,
    have G := (lt_div_iff' hc).mp H,
    have F := abs_mul c,
    set b := a n - α with hb,
    have E := F b,
    have D : |c| = c, exact abs_of_pos hc,
    rw D at E, rw hb at E,
    have C := mul_sub c (a n) α,
    rw C at E,
    rw ← hb at E,
    linarith,
  },
  done
end

end xena -- hide


/-
COMP2009-ACE

Exercise 05 (Natural numbers)

    This exercise has 2 parts both count for 50%.

    In the first part the goal is to complete the proof that the
    natural numbers with addition and multiplication form a
    semiring. I include the proof the addition forms a commutative
    monoid (which we have done in the lecture.

    You are not supposed to use the ring tactic for the first part
    (otherwise it would be no challenge).

    Yes, you may need some additional lemmas.

    In the 2nd part you should show that ≤ is anti-symmetric. I
    include the proofs (from the lecture) that it is reflexive and
    transitive. You are allowed to use the ring tactic for this part.
    (but note that you have to create a lean project to access the
    tactic library).

    You create a lean project using
    leanproject new my_project
    which creates a folder my_project. You need to stire the exercise
    in my_project/src
    See https://leanprover-community.github.io/install/project.html
    for details.

    However, if you work with the web interface you don't need to
    create a project - ity should work out of the box.

    Please only submit the lean file not the whole project directory.

-/
import tactic -- will fail if you haven't created a project.
set_option pp.structure_projections false

namespace ex05_01

open nat

-- definition of addition:
def add : ℕ → ℕ → ℕ
| n zero     := n
| n (succ m) := succ (add n m)

local notation m + n := add m n

-- have shown that it is a commutative monoid

theorem add_rneutr : ∀ n : ℕ, n + 0 = n :=
begin
  assume n,
  reflexivity,
end

theorem add_lneutr : ∀ n : ℕ, 0 + n  = n :=
begin
  assume n,
  induction n with n' ih,
  reflexivity,
  dsimp [(+),add],
  rewrite ih,
end

theorem add_assoc : ∀ l m n : ℕ , (l + m) + n = l + (m + n) :=
begin
  assume l m n,
  induction n with n' ih,
  reflexivity,
  dsimp [(+),add],
  rewrite ih,
end

lemma add_succ_lem : ∀ m n : ℕ, succ m + n = succ (m + n) :=
begin
  assume m n,
  induction n with n' ih,
  reflexivity,
  apply congr_arg succ,
  exact ih,
end

theorem add_comm : ∀ m n : ℕ , m + n = n + m :=
begin
  assume m n,
  induction m with m' ih,
  apply add_lneutr,
  calc
    succ m' + n = succ (m' + n) : by apply add_succ_lem
    ... = succ (n + m') : by apply congr_arg succ; exact ih
    ... = n + succ m' : by reflexivity,
end

-- now we define addition

 def mul : ℕ → ℕ → ℕ
 | m 0     := 0
 | m (succ n) := (mul m n) + m

 local notation m * n := mul m n

-- and your task is to show that it is a commutative semiring, i.e.

theorem mult_rneutr : ∀ n : ℕ, n * 1 = n :=
begin
  assume n,
  induction n with n' ih,
  reflexivity,
  dsimp[(*), mul],
  apply add_lneutr,
end

theorem mult_lneutr : ∀ n : ℕ, 1 * n  = n :=
begin
  assume n,
  induction n with n' ih,
  reflexivity,
  apply (congr_arg succ),
  rewrite ih,
  reflexivity,
end

theorem mult_zero_l : ∀ n : ℕ , 0 * n = 0 :=
begin
  assume n,
  induction n with n' ih,
  reflexivity,
  dsimp[(*), mul],
  rewrite ih,
  reflexivity,
end

theorem mult_zero_r : ∀ n : ℕ , n * 0 = 0 :=
begin
  assume n,
  induction n with n' ih,
  reflexivity,
  dsimp[(*),mul],
  reflexivity,
end

theorem mult_distr_r :  ∀ l m n : ℕ , l * (m + n) = l * m + l * n :=
begin
  assume l m n,
  induction n with n' ih,
  dsimp [(+),add],
  apply congr_arg,
  reflexivity,

  induction l with l' ih2,
  rewrite mult_zero_l,
  rewrite mult_zero_l,
  rewrite mult_zero_l,
  reflexivity,

  apply (congr_arg succ),
  rewrite ih,
  rewrite add_assoc,
end

theorem mult_distr_l :  ∀ l m n : ℕ , (m + n) * l = m * l + n * l :=
begin
  assume l m n,
  induction l with l' ih3,
  reflexivity,

  dsimp[(*),mul],
  rewrite ih3,

  rewrite add_assoc,
  rewrite (add_comm (n * l') (m + n)),
  rewrite ← add_assoc,
  rewrite ← add_assoc,
  rewrite (add_comm (n * l') n),
  rewrite ← add_assoc,
end

theorem mult_assoc : ∀ l m n : ℕ , (l * m) * n = l * (m * n) :=
begin
  assume l m n,
  induction n with n' ih2,
  reflexivity,

  induction l with l' ih,
  rewrite mult_zero_l,
  rewrite mult_zero_l,
  rewrite mult_zero_l,

  dsimp[(*), mul],
  rewrite ih2,
  rewrite mult_distr_r,
end

lemma helper : ∀ m n :ℕ , succ n * m = n * m + m  :=
begin
  assume m n,
  induction m with m' ih,
  reflexivity,
  dsimp[(*),mul],
  apply congr_arg succ,
  rewrite ih,
  rewrite (add_comm  (n * m') m' ),
  rewrite (add_comm (n * m' + n) m'),
  rewrite ← add_assoc,
end

theorem mult_comm :  ∀ m n : ℕ , m * n = n * m :=
begin
  assume m n,
  induction n with n' ih,
  dsimp[(*),mul],
  rewrite mult_zero_l,
  dsimp[(*),mul],
  rewrite ih,
  rewrite helper,
end

end ex05_01

namespace ex05_2
-- part 2
-- we define ≤ as follows
open nat

def le(m n : ℕ) : Prop :=
  ∃ k : ℕ , k + m = n

local notation x ≤ y := le x y
local notation x ≥ y := le y x

-- and we have shown that it is a preorder, i.e. reflexive and transitive:
-- note that we have used the ring tactic to do all the equational reasoning:
example : ∀ m n : nat, succ m = succ n → m = n :=
begin
  assume m n h,
  injection h,
end

theorem le_refl : ∀ x : ℕ , x ≤ x :=
begin
  assume x,
  existsi 0,
  ring,
end

theorem le_trans : ∀ x y z : ℕ , x ≤ y → y ≤ z → x ≤ z :=
begin
  assume x y z xy yz,
  cases xy with k p,
  cases yz with l q,
  existsi (k+l),
  rewrite← q,
  rewrite← p,
  ring,
end

-- Your task is to show that ≤ is antisymmetric, and hence a *partial order*
-- you are allowed to use the ring tactic.
-- Yes, you may need some lemmas!
axiom add_succ_lem : ∀ m n : ℕ, succ m + n = succ (m + n)

lemma leq_meaning : ∀ x  y :ℕ , x ≤ y → x =y ∨ succ x ≤  y :=
begin
  assume x y yx,
  dsimp[le]at yx,
  cases yx with a h,
  induction a with a' ih,
  left,
  rewrite ← h,
  ring,

  right,
  dsimp[le],
  existsi a',
  calc
    a' + succ x = succ (a'+ x) : by reflexivity
    ... = succ a' + x: by rewrite add_succ_lem
    ... = y : by exact h,
end

lemma leq_absurd : ∀ x:ℕ , ¬ (succ x ≤ x) :=
begin
  assume x,
  assume h,
  cases h with a g,
  induction x with x' ih,
  contradiction,
  apply ih,
  injection g,
end

theorem anti_sym : ∀ x y : ℕ , x ≤ y → y ≤ x → x = y :=
begin
  assume x y xy yx,
  have aux : x =y ∨ succ x ≤  y,
  apply leq_meaning,
  exact xy,

  cases aux,
  exact aux,

  have p : succ x ≤ x,
  apply le_trans,
  exact aux,
  exact yx,
  have np : ¬ (succ x ≤ x),
  apply leq_absurd,
  contradiction,
end

end ex05_2


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

! This file was ported from Lean 3 source module data.fintype.fin
! leanprover-community/mathlib commit 759575657f189ccb424b990164c8b1fa9f55cdfe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fin.Interval

/-!
# The structure of `Fintype (Fin n)`

This file contains some basic results about the `Fintype` instance for `Fin`,
especially properties of `Finset.univ : Finset (Fin n)`.
-/

open Finset

open Fintype

namespace Fin

variable {α β : Type _} {n : ℕ}

theorem map_valEmbedding_univ : (Finset.univ : Finset (Fin n)).map Fin.valEmbedding = Iio n := by
  ext
  simp [orderIsoSubtype.symm.surjective.exists, OrderIso.symm]
#align fin.map_subtype_embedding_univ Fin.map_valEmbedding_univ

@[simp]

@[simp]
theorem Iio_last_eq_map : Iio (Fin.last n) = Finset.univ.map Fin.castSucc.toEmbedding := by
  apply Finset.map_injective Fin.valEmbedding
  rw [Finset.map_map, Fin.map_valEmbedding_Iio, Fin.val_last]
  exact map_valEmbedding_univ.symm
#align fin.Iio_last_eq_map Fin.Iio_last_eq_map

@[simp]
theorem Ioi_succ (i : Fin n) : Ioi i.succ = (Ioi i).map (Fin.succEmbedding _).toEmbedding := by
  ext i
  simp only [mem_filter, mem_Ioi, mem_map, mem_univ, true_and_iff, Function.Embedding.coeFn_mk,
    exists_true_left]
  constructor
  · refine' cases _ _ i
    · rintro ⟨⟨⟩⟩
    · intro i hi
      refine' ⟨i, succ_lt_succ_iff.mp hi, rfl⟩
  · rintro ⟨i, hi, rfl⟩
    simpa
#align fin.Ioi_succ Fin.Ioi_succ

@[simp]
theorem Iio_castSucc (i : Fin n) : Iio (castSucc i) = (Iio i).map Fin.castSucc.toEmbedding := by
  apply Finset.map_injective Fin.valEmbedding
  rw [Finset.map_map, Fin.map_valEmbedding_Iio]
  exact (Fin.map_valEmbedding_Iio i).symm
#align fin.Iio_cast_succ Fin.Iio_castSucc

theorem card_filter_univ_succ' (p : Fin (n + 1) → Prop) [DecidablePred p] :
    (univ.filter p).card = ite (p 0) 1 0 + (univ.filter (p ∘ Fin.succ)).card := by
  rw [Fin.univ_succ, filter_cons, card_disjUnion, filter_map, card_map]
  split_ifs <;> simp
#align fin.card_filter_univ_succ' Fin.card_filter_univ_succ'

theorem card_filter_univ_succ (p : Fin (n + 1) → Prop) [DecidablePred p] :
    (univ.filter p).card =
    if p 0 then (univ.filter (p ∘ Fin.succ)).card + 1 else (univ.filter (p ∘ Fin.succ)).card :=
  (card_filter_univ_succ' p).trans (by split_ifs <;> simp [add_comm 1])
#align fin.card_filter_univ_succ Fin.card_filter_univ_succ

theorem card_filter_univ_eq_vector_get_eq_count [DecidableEq α] (a : α) (v : Vector α n) :
    (univ.filter fun i => a = v.get i).card = v.toList.count a := by
  induction' v using Vector.inductionOn with n x xs hxs
  · simp
  · simp_rw [card_filter_univ_succ', Vector.get_cons_zero, Vector.toList_cons, Function.comp,
      Vector.get_cons_succ, hxs, List.count_cons', add_comm (ite (a = x) 1 0)]
#align fin.card_filter_univ_eq_vector_nth_eq_count Fin.card_filter_univ_eq_vector_get_eq_count

end Fin


/-
0. Read the class notes through Section
3.7, Implication. It is important that
you do this before classes next week, as
we will move somewhat quickly through a
few of these chapters.

To complete the rest of this homework,
solve the problems given as specified,
then save and submit this file.
-/

/-
1.

Show that if you're given proofs
of a = b and c = b you can construct
a proof of a = c. Do it by completing
the following function. Note that we
can use parenthesis to enclose terms
that appear within larger terms. This
is often necessary to make sure that
Lean understands how you want to group
things.
-/

theorem eq_snart { T : Type}
             { a b c: T }
             (ab: a = b)
             (cb: c = b) :
             a = c :=
eq.trans
    ab
    (eq.symm cb)

/-
Now, given the following assumptions, apply
your newly proved inference rule, eq.snart,
to show that Harry = Bob. Yes: Once you've
proved a theorem, you can apply it as if it
were a function, to arguments of the right
types, to get a proof that you need. Try it.
-/

axiom Person : Type
axioms Harry Bob Jose: Person
axioms (hj : Harry = Bob) (jb : Jose = Bob)
example : Harry = Jose := eq_snart hj jb

/-
2. Use example to assert and then prove that if
a, b, c, and d are nats, and if you have proofs
of a = b, b = c, and c = d, you can construct a
proof of a = d. Put the proof in the placeholder
below.

Hint: Equality propositions are types. Think of
the problem here as one of producing a function
of the specific type. Use lambdas. We've gotten
you started. The first lambda "assumes" that a,
b, c, and d are natural numbers. What's left to
do is to prove a function (yes, start with lambda)
that takes three arguments of the specified kinds
(use lambda to give them names) and that finally
produces a result of the type at the end of the
chain.
-/

theorem transit :
∀ a b c d : ℕ,
    (a = b) → (b = c) → (c = d) → (a = d)
:=
    λ a b c d,
        λ (ab: a = b),
            λ (bc: b = c),
                λ (cd: c = d),
                    eq.trans (eq.trans ab bc) cd

/-
3. In the context of the axioms in the following
namespace, write an exact proof term to prove
that Yuanfang is friendly. Hint #1: Just apply
the relevant inference rule as a function to the
right arguments. Hint #2: The direction in which
an equality is written matters. If, for example,
you have a proof of x = y and you want to apply
an inference rule that requires a proof of y = x,
then you need to find a way to get what you need
from what you have to work with in your context.
-/

axioms Mary Yuanfang : Person
axiom Friendly : Person → Prop
axiom mf : Friendly Mary
axiom yeqm : Yuanfang = Mary
example : Friendly Yuanfang :=
    eq.subst (eq.symm yeqm) mf

/-
4. The subtitution rule for equality lets
you rewrite proof goals by substituting one
term for another, in a goal, as long as you
already have a proof that the two  terms
are equal. The reasoning is that replacing
one term with another makes no difference to
the truth of a proposition if the two terms
are equal.

Suppose for example that you have a proof,
h, of y = x (yes we can and do give names
to proofs, as we consider them to be values),
and a proof, y1, of y = 1, and that your
goal is to prove (x = 1). You can justify
rewriting this goal as (y = 1), for which
you already have a proof, because you know
that y = x; so making this substitution
doesn't change the truth of the proposition.

In the tactic scripting libraries that Lean
provides, there is a tactic for rewriting a
goal in this way. If h is a proof of x = y,
then the tactic, "rw h" ("rw" is short for
"rewrite") replaces all occurrences of x (the
left side of h) with y (it's right side).

Here's an example.
-/

def foo (x y : ℕ) (y1 : y = 1) (h: x = y) : (x = 1) :=
begin
rewrite h,
exact y1,
end

/-
Use what you just learned to state and prove
the proposition that for any type, T, and for
any objects, a, b, and c, of this type, if
(a = b) and (b = c) then (c = a). Do this by
finishing off the tactic script that follows.
Note that to apply an inference rule within a
tactic script you use the "apply" tactic. Read
the further explanation and hint that follow
before attempting to solve this problem.
-/

def ac (T : Type) (a b c : T)
       (ab : a = b) (bc : b = c)
    : (c = a) :=
begin
rewrite ab,
exact eq.symm bc
end

/-
Note that the "foralls" in the natural language
statement are represented in this code *not* by
using  ∀ but by declaring them to be arguments
to our function. If you can write a function of
the specified type then you have in effect proven
that for *any* T and any a, b, c, of type T, if
if you also have a proof of a=b and a proof of
b=c, then a value of type c=a can be constructed
and returned. The reason this is true is that in
Lean all functions are total, as you now recall!

Key hint: The tactic application "rw h" changes
all occurrences of the left side of the equality
h, in the goal, into what's on its right side.
If you want the rewriting to go from right to
left, use "rw<-h". When you're just about done,
don't be surprised if the rewrite tactic applies
rfl automatically.
-/


-- Si_es_menor_o_igual_entonces_la_diferencia_es_positiva.lean
-- Si R es un anillo ordenado, entonces ∀ a b ∈ R, a ≤ b → 0 ≤ b - a
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 26-octubre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo ordenado y a, b ∈ R, entonces
--    a ≤ b → 0 ≤ b - a
-- ----------------------------------------------------------------------

import algebra.order.ring
variables {R : Type*} [ordered_ring R]
variables a b : R

-- 1ª demostración
-- ===============

example : a ≤ b → 0 ≤ b - a :=
begin
  intro h,
  calc
    0   = a - a : (sub_self a).symm
    ... ≤ b - a : sub_le_sub_right h a
end

-- 2ª demostración
-- ===============

example : a ≤ b → 0 ≤ b - a :=
-- by library_search
sub_nonneg.mpr

-- 3ª demostración
-- ===============

example : a ≤ b → 0 ≤ b - a :=
-- by hint
by simp


/-
Copyright (c) 2021 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import linear_algebra.determinant

/-!
# Orientations of modules and rays in modules

This file defines rays in modules and orientations of modules.

## Main definitions

* `module.ray` is a type for the equivalence class of nonzero vectors in a module with some
common positive multiple.

* `orientation` is a type synonym for `module.ray` for the case where the module is that of
alternating maps from a module to its underlying ring.  An orientation may be associated with an
alternating map or with a basis.

* `module.oriented` is a type class for a choice of orientation of a module that is considered
the positive orientation.

## Implementation notes

`orientation` is defined for an arbitrary index type, but the main intended use case is when
that index type is a `fintype` and there exists a basis of the same cardinality.

## References

* https://en.wikipedia.org/wiki/Orientation_(vector_space)

-/

noncomputable theory

section ordered_comm_semiring

variables (R : Type*) [ordered_comm_semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables (ι : Type*) [decidable_eq ι]

/-- Two vectors are in the same ray if some positive multiples of them are equal (in the typical
case over a field, this means each is a positive multiple of the other).  Over a field, this
is equivalent to `mul_action.orbit_rel`. -/
def same_ray (v₁ v₂ : M) : Prop :=
∃ (r₁ r₂ : R), 0 < r₁ ∧ 0 < r₂ ∧ r₁ • v₁ = r₂ • v₂

variables (M)

/-- `same_ray` is symmetric. -/
lemma symmetric_same_ray : symmetric (same_ray R : M → M → Prop) :=
λ _ _ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₂, r₁, hr₂, hr₁, h.symm⟩

/-- `same_ray` is transitive. -/
lemma transitive_same_ray :
  transitive (same_ray R : M → M → Prop) :=
λ _ _ _ ⟨r₁, r₂, hr₁, hr₂, h₁⟩ ⟨r₃, r₄, hr₃, hr₄, h₂⟩,
  ⟨r₃ * r₁, r₂ * r₄, mul_pos hr₃ hr₁, mul_pos hr₂ hr₄,
   by rw [mul_smul, mul_smul, h₁, ←h₂, smul_comm]⟩

/-- `same_ray` is reflexive. -/
lemma reflexive_same_ray [nontrivial R] :
  reflexive (same_ray R : M → M → Prop) :=
λ _, ⟨1, 1, zero_lt_one, zero_lt_one, rfl⟩

/-- `same_ray` is an equivalence relation. -/
lemma equivalence_same_ray [nontrivial R] :
  equivalence (same_ray R : M → M → Prop) :=
⟨reflexive_same_ray R M, symmetric_same_ray R M, transitive_same_ray R M⟩

variables {R M}

/-- A vector is in the same ray as a positive multiple of itself. -/
lemma same_ray_pos_smul_right (v : M) {r : R} (h : 0 < r) : same_ray R v (r • v) :=
⟨r, 1, h, let f := nontrivial_of_lt _ _ h in by exactI zero_lt_one, (one_smul _ _).symm⟩

/-- A vector is in the same ray as a positive multiple of one it is in the same ray as. -/
lemma same_ray.pos_smul_right {v₁ v₂ : M} {r : R} (h : same_ray R v₁ v₂) (hr : 0 < r) :
  same_ray R v₁ (r • v₂) :=
transitive_same_ray R M h (same_ray_pos_smul_right v₂ hr)

/-- A positive multiple of a vector is in the same ray as that vector. -/
lemma same_ray_pos_smul_left (v : M) {r : R} (h : 0 < r) : same_ray R (r • v) v :=
⟨1, r, let f := nontrivial_of_lt _ _ h in by exactI zero_lt_one, h, one_smul _ _⟩

/-- A positive multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma same_ray.pos_smul_left {v₁ v₂ : M} {r : R} (h : same_ray R v₁ v₂) (hr : 0 < r) :
  same_ray R (r • v₁) v₂ :=
transitive_same_ray R M (same_ray_pos_smul_left v₁ hr) h

variables (R M)

/-- The setoid of the `same_ray` relation for elements of a module. -/
def same_ray_setoid [nontrivial R] : setoid M :=
{ r := λ v₁ v₂, same_ray R v₁ v₂, iseqv := equivalence_same_ray R M }

/-- Nonzero vectors, as used to define rays. -/
@[reducible] def ray_vector := {v : M // v ≠ 0}

/-- The setoid of the `same_ray` relation for the subtype of nonzero vectors. -/
def ray_vector.same_ray_setoid [nontrivial R] : setoid (ray_vector M) :=
(same_ray_setoid R M).comap coe

local attribute [instance] ray_vector.same_ray_setoid

variables {R M}

/-- Equivalence of nonzero vectors, in terms of same_ray. -/
lemma equiv_iff_same_ray [nontrivial R] (v₁ v₂ : ray_vector M) :
  v₁ ≈ v₂ ↔ same_ray R (v₁ : M) v₂ :=
iff.rfl

variables (R M)

/-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
@[nolint has_inhabited_instance]
def module.ray [nontrivial R] := quotient (ray_vector.same_ray_setoid R M)

/-- An orientation of a module, intended to be used when `ι` is a `fintype` with the same
cardinality as a basis. -/
abbreviation orientation [nontrivial R] := module.ray R (alternating_map R M R ι)

/-- A type class fixing an orientation of a module. -/
class module.oriented [nontrivial R] :=
(positive_orientation : orientation R M ι)

variables {M}

/-- The ray given by a nonzero vector. -/
protected def ray_of_ne_zero [nontrivial R] (v : M) (h : v ≠ 0) : module.ray R M :=
⟦⟨v, h⟩⟧

/-- An induction principle for `module.ray`, used as `induction x using module.ray.ind`. -/
lemma module.ray.ind [nontrivial R] {C : module.ray R M → Prop}
  (h : Π v (hv : v ≠ 0), C (ray_of_ne_zero R v hv)) (x : module.ray R M) : C x :=
quotient.ind (subtype.rec $ by exact h) x

/-- The rays given by two nonzero vectors are equal if and only if those vectors
satisfy `same_ray`. -/
lemma ray_eq_iff [nontrivial R] {v₁ v₂ : M} (hv₁ : v₁ ≠ 0) (hv₂ : v₂ ≠ 0) :
  ray_of_ne_zero R _ hv₁ = ray_of_ne_zero R _ hv₂ ↔ same_ray R v₁ v₂ :=
quotient.eq

variables {R}

/-- The ray given by a positive multiple of a nonzero vector. -/
@[simp] lemma ray_pos_smul [nontrivial R] {v : M} (h : v ≠ 0) {r : R} (hr : 0 < r)
  (hrv : r • v ≠ 0) : ray_of_ne_zero R _ hrv = ray_of_ne_zero R _ h :=
begin
  rw ray_eq_iff,
  exact same_ray_pos_smul_left v hr
end

namespace module.ray

/-- An arbitrary `ray_vector` giving a ray. -/
def some_ray_vector [nontrivial R] (x : module.ray R M) : ray_vector M :=
quotient.out x

/-- The ray of `some_ray_vector`. -/
@[simp] lemma some_ray_vector_ray [nontrivial R] (x : module.ray R M) :
  (⟦x.some_ray_vector⟧ : module.ray R M) = x :=
quotient.out_eq _

/-- An arbitrary nonzero vector giving a ray. -/
def some_vector [nontrivial R] (x : module.ray R M) : M :=
x.some_ray_vector

/-- `some_vector` is nonzero. -/
@[simp] lemma some_vector_ne_zero [nontrivial R] (x : module.ray R M) : x.some_vector ≠ 0 :=
x.some_ray_vector.property

/-- The ray of `some_vector`. -/
@[simp] lemma some_vector_ray [nontrivial R] (x : module.ray R M) :
  ray_of_ne_zero R _ x.some_vector_ne_zero = x :=
(congr_arg _ (subtype.coe_eta _ _) : _).trans x.out_eq

end module.ray

end ordered_comm_semiring

section ordered_comm_ring

local attribute [instance] ray_vector.same_ray_setoid

variables {R : Type*} [ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]

/-- If two vectors are in the same ray, so are their negations. -/
lemma same_ray.neg {v₁ v₂ : M} : same_ray R v₁ v₂ → same_ray R (-v₁) (-v₂) :=
λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rwa [smul_neg, smul_neg, neg_inj]⟩

/-- `same_ray.neg` as an `iff`. -/
@[simp] lemma same_ray_neg_iff {v₁ v₂ : M} : same_ray R (-v₁) (-v₂) ↔ same_ray R v₁ v₂ :=
⟨λ h, by simpa only [neg_neg] using h.neg, same_ray.neg⟩

lemma same_ray_neg_swap {v₁ v₂ : M} : same_ray R (-v₁) v₂ ↔ same_ray R v₁ (-v₂) :=
⟨λ h, by simpa only [neg_neg] using h.neg, λ h, by simpa only [neg_neg] using h.neg⟩

/-- If a vector is in the same ray as its negation, that vector is zero. -/
lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] {v₁ : M} (h : same_ray R v₁ (-v₁)) :
  v₁ = 0 :=
begin
  rcases h with ⟨r₁, r₂, hr₁, hr₂, h⟩,
  rw [smul_neg, ←neg_smul, ←sub_eq_zero, ←sub_smul, sub_neg_eq_add, smul_eq_zero] at h,
  exact h.resolve_left (add_pos hr₁ hr₂).ne',
end

namespace ray_vector

variables {R}

/-- Negating a nonzero vector. -/
instance : has_neg (ray_vector M) := ⟨λ v, ⟨-v, neg_ne_zero.2 v.prop⟩⟩

/-- Negating a nonzero vector commutes with coercion to the underlying module. -/
@[simp, norm_cast] lemma coe_neg (v : ray_vector M) : ↑(-v) = -(v : M) := rfl

/-- Negating a nonzero vector twice produces the original vector. -/
@[simp] protected lemma neg_neg (v : ray_vector M) : -(-v) = v :=
by rw [subtype.ext_iff, coe_neg, coe_neg, neg_neg]

variables (R)

/-- If two nonzero vectors are equivalent, so are their negations. -/
@[simp] lemma equiv_neg_iff [nontrivial R] (v₁ v₂ : ray_vector M) : -v₁ ≈ -v₂ ↔ v₁ ≈ v₂ :=
by rw [equiv_iff_same_ray, equiv_iff_same_ray, coe_neg, coe_neg, same_ray_neg_iff]

end ray_vector

variables (R)

/-- Negating a ray. -/
instance [nontrivial R] : has_neg (module.ray R M) :=
⟨quotient.map (λ v, -v) (λ v₁ v₂, (ray_vector.equiv_neg_iff R v₁ v₂).2)⟩

/-- The ray given by the negation of a nonzero vector. -/
lemma ray_neg [nontrivial R] (v : M) (h : v ≠ 0) :
  ray_of_ne_zero R _ (show -v ≠ 0, by rw neg_ne_zero; exact h) = -(ray_of_ne_zero R _ h) :=
rfl

namespace module.ray

variables {R}

/-- Negating a ray twice produces the original ray. -/
@[simp] protected lemma neg_neg [nontrivial R] (x : module.ray R M) : -(-x) = x :=
quotient.ind (λ a, congr_arg quotient.mk $ ray_vector.neg_neg _) x

/-- A ray does not equal its own negation. -/
lemma ne_neg_self [nontrivial R] [no_zero_smul_divisors R M] (x : module.ray R M) : x ≠ -x :=
begin
  intro h,
  induction x using module.ray.ind,
  rw [←ray_neg, ray_eq_iff] at h,
  exact x_hv (eq_zero_of_same_ray_self_neg h)
end

end module.ray

namespace basis

variables {R} {ι : Type*} [fintype ι] [decidable_eq ι]

/-- The orientation given by a basis. -/
protected def orientation [nontrivial R] (e : basis ι R M) : orientation R M ι :=
ray_of_ne_zero R _ e.det_ne_zero

end basis

end ordered_comm_ring

section linear_ordered_comm_ring

variables {R : Type*} [linear_ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {ι : Type*} [decidable_eq ι]

/-- `same_ray` follows from membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_of_mem_orbit {v₁ v₂ : M} (h : v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂) :
  same_ray R v₁ v₂ :=
begin
  rcases h with ⟨⟨r, hr⟩, (rfl : r • v₂ = v₁)⟩,
  exact same_ray_pos_smul_left _ hr,
end

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
@[simp] lemma same_ray_smul_right_iff [no_zero_smul_divisors R M] {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R v (r • v) ↔ 0 < r :=
begin
  split,
  { rintros ⟨r₁, r₂, hr₁, hr₂, h⟩,
    rw [smul_smul, ←sub_eq_zero, ←sub_smul, sub_eq_add_neg, neg_mul_eq_mul_neg] at h,
    by_contradiction hr,
    rw [not_lt, ←neg_le_neg_iff, neg_zero] at hr,
    have hzzz := ne_of_gt (add_pos_of_pos_of_nonneg hr₁ (mul_nonneg hr₂.le hr)),
    simpa [ne_of_gt (add_pos_of_pos_of_nonneg hr₁ (mul_nonneg hr₂.le hr)),
           -mul_neg_eq_neg_mul_symm] using h },
  { exact λ h, same_ray_pos_smul_right v h }
end

/-- A multiple of a nonzero vector is in the same ray as that vector if and only if that multiple
is positive. -/
@[simp] lemma same_ray_smul_left_iff [no_zero_smul_divisors R M] {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R (r • v) v ↔ 0 < r :=
begin
  rw (symmetric_same_ray R M).iff,
  exact same_ray_smul_right_iff hv r
end

/-- The negation of a nonzero vector is in the same ray as a multiple of that vector if and
only if that multiple is negative. -/
@[simp] lemma same_ray_neg_smul_right_iff [no_zero_smul_divisors R M] {v : M} (hv : v ≠ 0)
  (r : R) : same_ray R (-v) (r • v) ↔ r < 0 :=
begin
  rw [←same_ray_neg_iff, neg_neg, ←neg_smul, same_ray_smul_right_iff hv (-r)],
  exact right.neg_pos_iff
end

/-- A multiple of a nonzero vector is in the same ray as the negation of that vector if and
only if that multiple is negative. -/
@[simp] lemma same_ray_neg_smul_left_iff [no_zero_smul_divisors R M] {v : M} (hv : v ≠ 0)
  (r : R) : same_ray R (r • v) (-v) ↔ r < 0 :=
begin
  rw [←same_ray_neg_iff, neg_neg, ←neg_smul, same_ray_smul_left_iff hv (-r)],
  exact left.neg_pos_iff
end

namespace basis

variables [fintype ι]

/-- The orientations given by two bases are equal if and only if the determinant of one basis
with respect to the other is positive. -/
lemma orientation_eq_iff_det_pos (e₁ e₂ : basis ι R M) :
  e₁.orientation = e₂.orientation ↔ 0 < e₁.det e₂ :=
by rw [basis.orientation, basis.orientation, ray_eq_iff,
       e₁.det.eq_smul_basis_det e₂, alternating_map.smul_apply, basis.det_self, smul_eq_mul,
       mul_one, same_ray_smul_left_iff e₂.det_ne_zero (_ : R)]

/-- Given a basis, any orientation equals the orientation given by that basis or its negation. -/
lemma orientation_eq_or_eq_neg (e : basis ι R M) (x : orientation R M ι) :
  x = e.orientation ∨ x = -e.orientation :=
begin
  rw [basis.orientation, ←x.some_vector_ray, ray_eq_iff, ←ray_neg, ray_eq_iff,
      x.some_vector.eq_smul_basis_det e],
  rcases lt_trichotomy (x.some_vector e) 0 with h|h|h,
  { right,
    exact (same_ray_neg_smul_left_iff e.det_ne_zero (_ : R)).2 h },
  { simpa [h] using x.some_vector.eq_smul_basis_det e },
  { left,
    exact (same_ray_smul_left_iff e.det_ne_zero (_ : R)).2 h }
end

end basis

end linear_ordered_comm_ring

section linear_ordered_field

variables (R : Type*) [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {ι : Type*} [decidable_eq ι]

/-- `same_ray` is equivalent to membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_iff_mem_orbit (v₁ v₂ : M) :
  same_ray R v₁ v₂ ↔ v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂ :=
begin
  split,
  { rintros ⟨r₁, r₂, hr₁, hr₂, h⟩,
    rw mul_action.mem_orbit_iff,
    have h' : (r₁⁻¹ * r₂) • v₂ = v₁,
    { rw [mul_smul, ←h, ←mul_smul, inv_mul_cancel (ne_of_lt hr₁).symm, one_smul] },
    have hr' : 0 < (r₁⁻¹ * r₂) := mul_pos (inv_pos.2 hr₁) hr₂,
    change (⟨units.mk0 (r₁⁻¹ * r₂) (ne_of_lt hr').symm, hr'⟩ : units.pos_subgroup R) • v₂ = v₁
      at h',
    exact ⟨_, h'⟩ },
  { exact same_ray_of_mem_orbit }
end

/-- `same_ray_setoid` equals `mul_action.orbit_rel` for the `units.pos_subgroup`. -/
lemma same_ray_setoid_eq_orbit_rel :
  same_ray_setoid R M = mul_action.orbit_rel (units.pos_subgroup R) M :=
setoid.ext' $ same_ray_iff_mem_orbit R

variables {R}

namespace orientation

variables [fintype ι] [finite_dimensional R M]

open finite_dimensional

/-- If the index type has cardinality equal to the finite dimension, any two orientations are
equal or negations. -/
lemma eq_or_eq_neg (x₁ x₂ : orientation R M ι) (h : fintype.card ι = finrank R M) :
  x₁ = x₂ ∨ x₁ = -x₂ :=
begin
  have e := (fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm,
  rcases e.orientation_eq_or_eq_neg x₁ with h₁|h₁;
    rcases e.orientation_eq_or_eq_neg x₂ with h₂|h₂;
    simp [h₁, h₂]
end

end orientation

end linear_ordered_field


variables p q r s : Prop
theorem t1 : p → q → p := λ hp, λ hq, hp

theorem t2 : ∀ (p q : Prop), p → q → p := λ (p q), λ hp, λ hq, hp

theorem t3 (h₁ : q → r) (h₂ : p → q) : p → r := λ hp, h₁ (h₂ hp)

example (h : p ∧ q) : p := and.elim_left h

variables  (hp : p) (hq : q)

#check (⟨hp, hq⟩ : p ∧ q)

example (h : p ∧ q) : q ∧ p ∧ q := ⟨h.right, h.left, h.right⟩

example (hp : p) : p ∨ q := or.intro_left q hp

example (hq : q) : p ∨ q := or.intro_right p hq

example (h : p ∨ q) : q ∨ p := or.elim h (λ hp, or.inr hp) (λ hq, or.inl hq)

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

theorem and_swap : p ∧ q ↔ q ∧ p := iff.intro
(λ hpq, and.intro (and.right hpq) (and.left hpq))
(λ hqp, and.intro (and.right hqp) (and.left hqp))

example (h : p ∧ q) : q ∧ p :=
have hp : p, from and.left h,
have hq : q, from and.right h,
show q ∧ p, from and.intro hq hp

example (h : p ∧ q) : q ∧ p :=
(λ (hp : p), (λ (hq : q), and.intro hq hp) (and.right h)) (and.left h)

open classical

example (h : ¬¬p) : p :=
by_cases
  (assume h1 : p, h1)
  (assume h1 : ¬p, absurd h1 h)

example (h : ¬¬p) : p :=
by_cases (λ hp : p, hp) (λ hnp : ¬p, absurd hnp h)

example (h : ¬¬p) : p :=
by_contradiction
  (assume h1 : ¬p,
    show false, from h h1)

example (h : ¬¬p) : p :=
by_contradiction (λ hnp : ¬p, absurd hnp h)

example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
or.elim (em p)
(λ hp : p, or.inr (λ hq : q, h ⟨hp, hq⟩))
(λ hnp : ¬p, or.inl hnp)

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
(λ h, or.elim h.right (λ hq, or.inl ⟨h.left, hq⟩) (λ hr, or.inr ⟨h.left, hr⟩))
(λ h, or.elim h (λ h0, ⟨h0.left, or.inl h0.right⟩) (λ h0, ⟨h0.left, or.inr h0.right⟩))

example : ¬(p ∧ ¬q) → (p → q) := λ h hp,
or.elim (em q) (λ hq, hq) (λ hnq, absurd (and.intro hp hnq) h)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
iff.intro (λ h, ⟨h.right, h.left⟩) (λ h, ⟨h.right, h.left⟩)
example : p ∨ q ↔ q ∨ p :=
iff.intro (λ h, or.elim h or.inr or.inl)
(λ h, or.elim h or.inr or.inl)

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro (λ h, ⟨h.left.left, ⟨h.left.right, h.right⟩⟩)
(λ h, ⟨⟨h.left, h.right.left⟩, h.right.right⟩)
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro (λ h, or.elim h
(λ h, or.elim h or.inl (λ hq, or.inr (or.inl hq)))
(λ h, or.inr (or.inr h)))
(λ h, or.elim h
(λ hp, or.inl (or.inl hp))
(λ h, or.elim h (λ hq, or.inl (or.inr hq)) or.inr))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := iff.intro
(λ h, or.elim h.right (λ hq, or.inl ⟨h.left, hq⟩) (λ hr, or.inr ⟨h.left, hr⟩))
(λ h, or.elim h (λ h0, ⟨h0.left, or.inl h0.right⟩) (λ h0, ⟨h0.left, or.inr h0.right⟩))
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := iff.intro
(λ h, or.elim h (λ hp, ⟨or.intro_left q hp, or.intro_left r hp⟩)
(λ h, ⟨or.intro_right p h.left, or.intro_right p h.right⟩))
(λ h, or.elim (em p) or.inl
(λ hnp, or.elim h.left (λ hp, absurd hp hnp)
(λ hq, or.elim h.right (λ hp, absurd hp hnp) (λ hr, or.inr ⟨hq, hr⟩))))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := iff.intro (λ hpqr hpq, (hpqr hpq.left hpq.right))
(λ hpqr hp hq, hpqr ⟨hp, hq⟩)
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := iff.intro (λ h,
⟨(λ hp, h (@or.intro_left p q hp)), (λ hq, h (@or.intro_right p q hq))⟩)
(λ h hpq, or.elim hpq (λ hp, h.left hp) (λ hq, h.right hq))
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := iff.intro
(λ h, ⟨(λ hp, h ((or.intro_left q) hp)), (λ hq, h ((or.intro_right p) hq))⟩)
(λ h hpq, hpq.elim h.left h.right)
example : ¬p ∨ ¬q → ¬(p ∧ q) := λ h hpq, or.elim h (λ hnp, absurd hpq.left hnp)
(λ hnq, absurd hpq.right hnq)
example : ¬(p ∧ ¬p) := λ h, h.right h.left
example : p ∧ ¬q → ¬(p → q) := λ h hpq, h.right (hpq h.left)
example : ¬p → (p → q) := λ hnp hp, absurd hp hnp
example : (¬p ∨ q) → (p → q) := λ h hp, or.elim h (absurd hp) (λ hq, hq)
example : p ∨ false ↔ p := iff.intro (λ h, or.elim h (λ hp, hp) false.elim)
(λ hp, or.intro_left false hp)
example : p ∧ false ↔ false := iff.intro (λ h, h.right.elim) false.elim
example : ¬(p ↔ ¬p) := λ h, (λ (hnp : ¬p), hnp (h.elim_right hnp)) (λ hp, h.elim_left hp hp)
example : (p → q) → (¬q → ¬p) := λ hpq hnq hp, hnq (hpq hp)

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := λ h, (em p).elim
(λ hp, (h hp).elim (λ hr, or.inl (λ hp, hr)) (λ hs, or.inr (λ hp, hs)))
(λ hnp, or.inl (λ hp, absurd hp hnp))
example : ¬(p ∧ q) → ¬p ∨ ¬q := λ h, (em p).elim (λ hp, (em q).elim
(λ hq, absurd (and.intro hp hq) h) or.inr) or.inl
example : ¬(p → q) → p ∧ ¬q := λ h, and.intro ((em p).elim id (λ hnp, absurd
(λ hp : p, false.elim (hnp hp)) h)) ((em q).elim (λ hq, absurd (λ hp : p, hq) h) id)
example : (p → q) → (¬p ∨ q) := λ h, or.elim (em p) (λ hp, or.inr (h hp)) or.inl
example : (¬q → ¬p) → (p → q) := λ h hp, by_contradiction (λ hnq, absurd hp (h hnq))
example : p ∨ ¬p := em p
example : ((p → q) → p) → p := λ h, or.elim (em p) id
(λ hnp, by_contradiction (λ hnp, hnp (h (λ hp, absurd hp hnp))))


-- CS_de_y_le_x.lean
-- Pruebas de "(∀ ε > 0, y ≤ x + ε) →  y ≤ x"
-- José A. Alonso Jiménez
-- Sevilla, 15 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Sean x, y ∈ ℝ. Demostrar que
--    (∀ ε > 0, y ≤ x + ε) →  y ≤ x
-- ----------------------------------------------------------------------

import data.real.basic

variables {x y : ℝ}

-- 1ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split,
  { apply half_pos,
    exact sub_pos.mpr h, },
  { calc x + (y - x) / 2
         = (x + y) / 2   : by ring_nf
     ... < (y + y) / 2   : div_lt_div_of_lt zero_lt_two (add_lt_add_right h y)
     ... = (2 * y) / 2   : congr_arg2 (/) (two_mul y).symm rfl
     ... = y             : by ring_nf, },
end

-- 2ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split,
  { exact half_pos (sub_pos.mpr h), },
  { calc x + (y - x) / 2
         = (x + y) / 2   : by ring_nf
     ... < (y + y) / 2   : by linarith
     ... = (2 * y) / 2   : by ring_nf
     ... = y             : by ring_nf, },
end

-- 3ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split,
  { linarith },
  { linarith },
end

-- 4ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

-- 5ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  intro h1,
  by_contradiction h2,
  replace h2 : x < y := not_le.mp h2,
  rcases (exists_between h2) with ⟨z, h3, h4⟩,
  replace h3 : 0 < z - x := sub_pos.mpr h3,
  replace h1 : y ≤ x + (z - x) := h1 (z - x) h3,
  replace h1 : y ≤ z := by finish,
  have h4 : y < y := gt_of_gt_of_ge h4 h1,
  exact absurd h4 (irrefl y),
end

-- 6ª demostración
example :
  (∀ ε > 0, y ≤ x + ε) → y ≤ x :=
begin
  intro h1,
  by_contradiction h2,
  replace h2 : x < y := not_le.mp h2,
  rcases (exists_between h2) with ⟨z, hxz, hzy⟩,
  apply lt_irrefl y,
  calc y ≤ x + (z - x) : h1 (z - x) (sub_pos.mpr hxz)
     ... = z           : by ring
     ... < y           : hzy,
end