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

/-!
# Multiplication and division of submodules of an algebra.

An interface for multiplication and division of sub-R-modules of an R-algebra A is developed.

## Main definitions

Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra.

* `1 : submodule R A`       : the R-submodule R of the R-algebra A
* `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be
                              the smallest submodule containing all the products `m * n`.
* `has_div (submodule R A)` : `I / J` is defined to be the submodule consisting of all `a : A` such
                              that `a • J ⊆ I`

It is proved that `submodule R A` is a semiring, and also an algebra over `set A`.

## Tags

multiplication of submodules, division of subodules, submodule semiring
-/

universes uι u v

open algebra set
open_locale big_operators
open_locale pointwise

namespace submodule

variables {ι : Sort uι}
variables {R : Type u} [comm_semiring R]

section ring

variables {A : Type v} [semiring A] [algebra R A]
variables (S T : set A) {M N P Q : submodule R A} {m n : A}

/-- `1 : submodule R A` is the submodule R of A. -/
instance : has_one (submodule R A) :=
⟨(algebra.linear_map R A).range⟩

theorem one_eq_range :
  (1 : submodule R A) = (algebra.linear_map R A).range := rfl

lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : submodule R A) :=
linear_map.mem_range_self _ _

@[simp] lemma mem_one {x : A} : x ∈ (1 : submodule R A) ↔ ∃ y, algebra_map R A y = x :=
by simp only [one_eq_range, linear_map.mem_range, algebra.linear_map_apply]

theorem one_eq_span : (1 : submodule R A) = R ∙ 1 :=
begin
  apply submodule.ext,
  intro a,
  simp only [mem_one, mem_span_singleton, algebra.smul_def, mul_one]
end

theorem one_le : (1 : submodule R A) ≤ P ↔ (1 : A) ∈ P :=
by simpa only [one_eq_span, span_le, set.singleton_subset_iff]

/-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the
smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/
instance : has_mul (submodule R A) :=
⟨λ M N, ⨆ s : M, N.map $ algebra.lmul R A s.1⟩

theorem mul_mem_mul (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N :=
(le_supr _ ⟨m, hm⟩ : _ ≤ M * N) ⟨n, hn, rfl⟩

theorem mul_le : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P :=
⟨λ H m hm n hn, H $ mul_mem_mul hm hn,
λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩

@[elab_as_eliminator] protected theorem mul_induction_on
  {C : A → Prop} {r : A} (hr : r ∈ M * N)
  (hm : ∀ (m ∈ M) (n ∈ N), C (m * n))
  (h0 : C 0) (ha : ∀ x y, C x → C y → C (x + y))
  (hs : ∀ (r : R) x, C x → C (r • x)) : C r :=
(@mul_le _ _ _ _ _ _ _ ⟨C, h0, ha, hs⟩).2 hm hr

variables R
theorem span_mul_span : span R S * span R T = span R (S * T) :=
begin
  apply le_antisymm,
  { rw mul_le, intros a ha b hb,
    apply span_induction ha,
    work_on_goal 0 { intros, apply span_induction hb,
      work_on_goal 0 { intros, exact subset_span ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
    all_goals { intros, simp only [mul_zero, zero_mul, zero_mem,
        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc],
      try {apply add_mem _ _ _}, try {apply smul_mem _ _ _} }, assumption' },
  { rw span_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
    exact mul_mem_mul (subset_span ha) (subset_span hb) }
end
variables {R}

variables (M N P Q)
protected theorem mul_assoc : (M * N) * P = M * (N * P) :=
le_antisymm (mul_le.2 $ λ mn hmn p hp,
  suffices M * N ≤ (M * (N * P)).comap (algebra.lmul_right R p), from this hmn,
  mul_le.2 $ λ m hm n hn, show m * n * p ∈ M * (N * P), from
  (mul_assoc m n p).symm ▸ mul_mem_mul hm (mul_mem_mul hn hp))
(mul_le.2 $ λ m hm np hnp,
  suffices N * P ≤ (M * N * P).comap (algebra.lmul_left R m), from this hnp,
  mul_le.2 $ λ n hn p hp, show m * (n * p) ∈ M * N * P, from
  mul_assoc m n p ▸ mul_mem_mul (mul_mem_mul hm hn) hp)

@[simp] theorem mul_bot : M * ⊥ = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hn ⊢; rw [hn, mul_zero]

@[simp] theorem bot_mul : ⊥ * M = ⊥ :=
eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hm ⊢; rw [hm, zero_mul]

@[simp] protected theorem one_mul : (1 : submodule R A) * M = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, one_mul, span_eq] }

@[simp] protected theorem mul_one : M * 1 = M :=
by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, mul_one, span_eq] }

variables {M N P Q}

@[mono] theorem mul_le_mul (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q :=
mul_le.2 $ λ m hm n hn, mul_mem_mul (hmp hm) (hnq hn)

theorem mul_le_mul_left (h : M ≤ N) : M * P ≤ N * P :=
mul_le_mul h (le_refl P)

theorem mul_le_mul_right (h : N ≤ P) : M * N ≤ M * P :=
mul_le_mul (le_refl M) h

variables (M N P)

theorem sup_mul : (M ⊔ N) * P = M * P ⊔ N * P :=
le_antisymm (mul_le.2 $ λ mn hmn p hp, let ⟨m, hm, n, hn, hmn⟩ := mem_sup.1 hmn in
  mem_sup.2 ⟨_, mul_mem_mul hm hp, _, mul_mem_mul hn hp, hmn ▸ (add_mul m n p).symm⟩)
(sup_le (mul_le_mul_left le_sup_left) (mul_le_mul_left le_sup_right))

lemma mul_subset_mul : (↑M : set A) * (↑N : set A) ⊆ (↑(M * N) : set A) :=
by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj }

lemma map_mul {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') :
  map f.to_linear_map (M * N) = map f.to_linear_map M * map f.to_linear_map N :=
calc map f.to_linear_map (M * N)
    = ⨆ (i : M), (N.map (lmul R A i)).map f.to_linear_map : map_supr _ _
... = map f.to_linear_map M * map f.to_linear_map N  :
  begin
    apply congr_arg Sup,
    ext S,
    split; rintros ⟨y, hy⟩,
    { use [f y, mem_map.mpr ⟨y.1, y.2, rfl⟩],
      refine trans _ hy,
      ext,
      simp },
    { obtain ⟨y', hy', fy_eq⟩ := mem_map.mp y.2,
      use [y', hy'],
      refine trans _ hy,
      rw f.to_linear_map_apply at fy_eq,
      ext,
      simp [fy_eq] }
end

section decidable_eq

open_locale classical

lemma mem_span_mul_finite_of_mem_span_mul {S : set A} {S' : set A} {x : A}
  (hx : x ∈ span R (S * S')) :
  ∃ (T T' : finset A), ↑T ⊆ S ∧ ↑T' ⊆ S' ∧ x ∈ span R (T * T' : set A) :=
begin
  obtain ⟨U, h, hU⟩ := mem_span_finite_of_mem_span hx,
  obtain ⟨T, T', hS, hS', h⟩ := finset.subset_mul h,
  use [T, T', hS, hS'],
  have h' : (U : set A) ⊆ T * T', { assumption_mod_cast, },
  have h'' := span_mono h' hU,
  assumption,
end

end decidable_eq

lemma mul_eq_span_mul_set (s t : submodule R A) : s * t = span R ((s : set A) * (t : set A)) :=
by rw [← span_mul_span, span_eq, span_eq]

lemma supr_mul (s : ι → submodule R A) (t : submodule R A) : (⨆ i, s i) * t = ⨆ i, s i * t :=
begin
  suffices : (⨆ i, span R (s i : set A)) * span R t = (⨆ i, span R (s i) * span R t),
  { simpa only [span_eq] using this },
  simp_rw [span_mul_span, ← span_Union, span_mul_span, set.Union_mul],
end

lemma mul_supr (t : submodule R A) (s : ι → submodule R A) : t * (⨆ i, s i) = ⨆ i, t * s i :=
begin
  suffices : span R (t : set A) * (⨆ i, span R (s i)) = (⨆ i, span R t * span R (s i)),
  { simpa only [span_eq] using this },
  simp_rw [span_mul_span, ← span_Union, span_mul_span, set.mul_Union],
end

lemma mem_span_mul_finite_of_mem_mul {P Q : submodule R A} {x : A} (hx : x ∈ P * Q) :
  ∃ (T T' : finset A), (T : set A) ⊆ P ∧ (T' : set A) ⊆ Q ∧ x ∈ span R (T * T' : set A) :=
submodule.mem_span_mul_finite_of_mem_span_mul
  (by rwa [← submodule.span_eq P, ← submodule.span_eq Q, submodule.span_mul_span] at hx)

variables {M N P}

/-- Sub-R-modules of an R-algebra form a semiring. -/
instance : semiring (submodule R A) :=
{ one_mul       := submodule.one_mul,
  mul_one       := submodule.mul_one,
  mul_assoc     := submodule.mul_assoc,
  zero_mul      := bot_mul,
  mul_zero      := mul_bot,
  left_distrib  := mul_sup,
  right_distrib := sup_mul,
  ..submodule.pointwise_add_comm_monoid,
  ..submodule.has_one,
  ..submodule.has_mul }

variables (M)

lemma pow_subset_pow {n : ℕ} : (↑M : set A)^n ⊆ ↑(M^n : submodule R A) :=
begin
  induction n with n ih,
  { erw [pow_zero, pow_zero, set.singleton_subset_iff],
    rw [set_like.mem_coe, ← one_le],
    exact le_refl _ },
  { rw [pow_succ, pow_succ],
    refine set.subset.trans (set.mul_subset_mul (subset.refl _) ih) _,
    apply mul_subset_mul }
end

/-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets
on either side). -/
def span.ring_hom : set_semiring A →+* submodule R A :=
{ to_fun := submodule.span R,
  map_zero' := span_empty,
  map_one' := one_eq_span.symm,
  map_add' := span_union,
  map_mul' := λ s t, by erw [span_mul_span, ← image_mul_prod] }

end ring

section comm_ring

variables {A : Type v} [comm_semiring A] [algebra R A]
variables {M N : submodule R A} {m n : A}

theorem mul_mem_mul_rev (hm : m ∈ M) (hn : n ∈ N) : n * m ∈ M * N :=
mul_comm m n ▸ mul_mem_mul hm hn

variables (M N)
protected theorem mul_comm : M * N = N * M :=
le_antisymm (mul_le.2 $ λ r hrm s hsn, mul_mem_mul_rev hsn hrm)
(mul_le.2 $ λ r hrn s hsm, mul_mem_mul_rev hsm hrn)

/-- Sub-R-modules of an R-algebra A form a semiring. -/
instance : comm_semiring (submodule R A) :=
{ mul_comm := submodule.mul_comm,
  .. submodule.semiring }

lemma prod_span {ι : Type*} (s : finset ι) (M : ι → set A) :
  (∏ i in s, submodule.span R (M i)) = submodule.span R (∏ i in s, M i) :=
begin
  letI := classical.dec_eq ι,
  refine finset.induction_on s _ _,
  { simp [one_eq_span, set.singleton_one] },
  { intros _ _ H ih,
    rw [finset.prod_insert H, finset.prod_insert H, ih, span_mul_span] }
end

lemma prod_span_singleton {ι : Type*} (s : finset ι) (x : ι → A) :
  (∏ i in s, span R ({x i} : set A)) = span R {∏ i in s, x i} :=
by rw [prod_span, set.finset_prod_singleton]

variables (R A)

/-- R-submodules of the R-algebra A are a module over `set A`. -/
instance module_set : module (set_semiring A) (submodule R A) :=
{ smul := λ s P, span R s * P,
  smul_add := λ _ _ _, mul_add _ _ _,
  add_smul := λ s t P, show span R (s ⊔ t) * P = _, by { erw [span_union, right_distrib] },
  mul_smul := λ s t P, show _ = _ * (_ * _),
    by { rw [← mul_assoc, span_mul_span, ← image_mul_prod] },
  one_smul := λ P, show span R {(1 : A)} * P = _,
    by { conv_lhs {erw ← span_eq P}, erw [span_mul_span, one_mul, span_eq] },
  zero_smul := λ P, show span R ∅ * P = ⊥, by erw [span_empty, bot_mul],
  smul_zero := λ _, mul_bot _ }

variables {R A}

lemma smul_def {s : set_semiring A} {P : submodule R A} : s • P = span R s * P := rfl

lemma smul_le_smul {s t : set_semiring A} {M N : submodule R A} (h₁ : s.down ≤ t.down)
  (h₂ : M ≤ N) : s • M ≤ t • N :=
mul_le_mul (span_mono h₁) h₂

lemma smul_singleton (a : A) (M : submodule R A) :
  ({a} : set A).up • M = M.map (lmul_left _ a) :=
begin
  conv_lhs {rw ← span_eq M},
  change span _ _ * span _ _ = _,
  rw [span_mul_span],
  apply le_antisymm,
  { rw span_le,
    rintros _ ⟨b, m, hb, hm, rfl⟩,
    rw [set_like.mem_coe, mem_map, set.mem_singleton_iff.mp hb],
    exact ⟨m, hm, rfl⟩ },
  { rintros _ ⟨m, hm, rfl⟩, exact subset_span ⟨a, m, set.mem_singleton a, hm, rfl⟩ }
end

section quotient

/-- The elements of `I / J` are the `x` such that `x • J ⊆ I`.

In fact, we define `x ∈ I / J` to be `∀ y ∈ J, x * y ∈ I` (see `mem_div_iff_forall_mul_mem`),
which is equivalent to `x • J ⊆ I` (see `mem_div_iff_smul_subset`), but nicer to use in proofs.

This is the general form of the ideal quotient, traditionally written $I : J$.
-/
instance : has_div (submodule R A) :=
⟨ λ I J,
{ carrier   := { x | ∀ y ∈ J, x * y ∈ I },
  zero_mem' := λ y hy, by { rw zero_mul, apply submodule.zero_mem },
  add_mem'  := λ a b ha hb y hy, by { rw add_mul, exact submodule.add_mem _ (ha _ hy) (hb _ hy) },
  smul_mem' := λ r x hx y hy, by { rw algebra.smul_mul_assoc,
    exact submodule.smul_mem _ _ (hx _ hy) } } ⟩

lemma mem_div_iff_forall_mul_mem {x : A} {I J : submodule R A} :
  x ∈ I / J ↔ ∀ y ∈ J, x * y ∈ I :=
iff.refl _

lemma mem_div_iff_smul_subset {x : A} {I J : submodule R A} : x ∈ I / J ↔ x • (J : set A) ⊆ I :=
⟨ λ h y ⟨y', hy', xy'_eq_y⟩, by { rw ← xy'_eq_y, apply h, assumption },
  λ h y hy, h (set.smul_mem_smul_set hy) ⟩

lemma le_div_iff {I J K : submodule R A} : I ≤ J / K ↔ ∀ (x ∈ I) (z ∈ K), x * z ∈ J := iff.refl _

lemma le_div_iff_mul_le {I J K : submodule R A} : I ≤ J / K ↔ I * K ≤ J :=
by rw [le_div_iff, mul_le]

@[simp] lemma one_le_one_div {I : submodule R A} :
  1 ≤ 1 / I ↔ I ≤ 1 :=
begin
  split, all_goals {intro hI},
  {rwa [le_div_iff_mul_le, one_mul] at hI},
  {rwa [le_div_iff_mul_le, one_mul]},
end

lemma le_self_mul_one_div {I : submodule R A} (hI : I ≤ 1) :
  I ≤ I * (1 / I) :=
begin
  rw [← mul_one I] {occs := occurrences.pos [1]},
  apply mul_le_mul_right (one_le_one_div.mpr hI),
end

lemma mul_one_div_le_one {I : submodule R A} : I * (1 / I) ≤ 1 :=
begin
  rw submodule.mul_le,
  intros m hm n hn,
  rw [submodule.mem_div_iff_forall_mul_mem] at hn,
  rw mul_comm,
  exact hn m hm,
end

@[simp] lemma map_div {B : Type*} [comm_ring B] [algebra R B]
  (I J : submodule R A) (h : A ≃ₐ[R] B) :
  (I / J).map h.to_linear_map = I.map h.to_linear_map / J.map h.to_linear_map :=
begin
  ext x,
  simp only [mem_map, mem_div_iff_forall_mul_mem],
  split,
  { rintro ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩,
    exact ⟨x * y, hx _ hy, h.map_mul x y⟩ },
  { rintro hx,
    refine ⟨h.symm x, λ z hz, _, h.apply_symm_apply x⟩,
    obtain ⟨xz, xz_mem, hxz⟩ := hx (h z) ⟨z, hz, rfl⟩,
    convert xz_mem,
    apply h.injective,
    erw [h.map_mul, h.apply_symm_apply, hxz] }
end

end quotient

end comm_ring

end submodule


import data.polynomial ring_theory.associated

open finset

namespace polynomial

variables {α : Type*} [decidable_eq α]

theorem degree_add_eq_of_degree_gt [comm_semiring α]
  {f g : polynomial α} (H : degree g < degree f) :
  degree (f + g) = degree f :=
add_comm g f ▸ degree_add_eq_of_degree_lt H

theorem degree_sub_eq_of_degree_gt [comm_ring α]
  {f g : polynomial α} (H : degree g < degree f) :
  degree (f - g) = degree f :=
degree_add_eq_of_degree_gt ((degree_neg g).symm ▸ H)

theorem leading_coeff_add_of_degree_gt [comm_semiring α]
  {f g : polynomial α} (H : degree g < degree f) :
  leading_coeff (f + g) = leading_coeff f :=
add_comm g f ▸ leading_coeff_add_of_degree_lt H

theorem leading_coeff_sub_of_degree_gt [comm_ring α]
  {f g : polynomial α} (H : degree g < degree f) :
  leading_coeff (f - g) = leading_coeff f :=
leading_coeff_add_of_degree_gt ((degree_neg g).symm ▸ H)

theorem leading_coeff_X_sub_C [comm_ring α] {r : α} :
  leading_coeff (X - C r) = 1 :=
begin
  by_cases h : (0:α) = 1,
  { haveI := subsingleton_of_zero_eq_one _ h,
    apply subsingleton.elim, },
  letI : nonzero_comm_ring α := { zero_ne_one := h, .. (infer_instance : comm_ring α)},
  rw [leading_coeff_sub_of_degree_gt, leading_coeff_X],
  apply lt_of_le_of_lt degree_C_le,
  rw degree_X, exact dec_trivial
end

theorem leading_coeff_neg [comm_ring α] {p : polynomial α} :
  leading_coeff (-p) = -leading_coeff p :=
by simp only [leading_coeff, nat_degree, degree_neg, coeff_neg]

section
variables [comm_semiring α] {ι : Type*} [decidable_eq ι] {f : ι → polynomial α} {s : finset ι}

theorem eval_prod {x : α} : eval x (s.prod f) = s.prod (λ i, eval x (f i)) :=
eq.symm $ prod_hom (eval x) eval_one (λ _ _, eval_mul)
end

section
variables [integral_domain α] {ι : Type*} [decidable_eq ι] {f : ι → polynomial α} {s : finset ι}

theorem degree_prod : degree (s.prod f) = s.sum (λ i, degree (f i)) :=
finset.induction_on s (by rw [prod_empty, degree_one, sum_empty]) $ λ a s has ih,
by rw [prod_insert has, degree_mul_eq, ih, sum_insert has]

theorem leading_coeff_prod : leading_coeff (s.prod f) = s.prod (λ i, leading_coeff (f i)) :=
eq.symm $ prod_hom leading_coeff leading_coeff_one leading_coeff_mul
end

end polynomial

namespace int

theorem mul_eq_neg_one {p q : ℤ} : p * q = -1 ↔ p = 1 ∧ q = -1 ∨ p = -1 ∧ q = 1 :=
begin
  split,
  { intro hpq,
    have : p.nat_abs ∣ 1,
    { existsi q.nat_abs, rw [← nat_abs_mul, hpq], refl },
    rw nat.dvd_one at this,
    replace this := congr_arg (coe : ℕ → ℤ) this,
    cases le_total p 0 with hp hp,
    { rw [of_nat_nat_abs_of_nonpos hp, neg_eq_iff_neg_eq] at this, subst p,
      rw [int.coe_nat_one, neg_one_mul, neg_inj'] at hpq, subst q,
      right, split; refl },
    { rw [nat_abs_of_nonneg hp] at this, subst p,
      rw [int.coe_nat_one, one_mul] at hpq, subst q,
      left, split; refl } },
  { rintro (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩); refl }
end

end int

@[simp] lemma with_bot.nat_cast (n : ℕ) : @eq (with_bot ℕ) (@coe _ _ (@coe_to_lift _ _ (@coe_base _ _ nat.cast_coe)) n) n :=
nat.rec_on n rfl (λ n (ih : nat.cast _ = _), show _ + _ = _, by rw ih; refl)

@[simp] lemma with_bot_zero : (0 : with_bot ℕ) = (0:ℕ) := rfl
@[simp] lemma with_bot_one : (1 : with_bot ℕ) = (1:ℕ) := rfl
@[simp] lemma with_bot_bit0 (n:ℕ) : bit0 (n : with_bot ℕ) = (bit0 n : ℕ) := rfl
@[simp] lemma with_bot_bit1 (n:ℕ) : bit1 (n : with_bot ℕ) = (bit1 n : ℕ) := rfl

open polynomial

theorem q5 (s : finset ℤ) (hs : s ≠ ∅) : irreducible (s.prod (λ n, X - C n) - 1 : polynomial ℤ) :=
begin
  have deg_prod : degree (s.prod (λ n, X - C n)) = card s,
  { simp only [degree_prod, degree_X_sub_C, sum_const,
      add_monoid.smul_one, with_bot.nat_cast] },
  have deg_lt : degree (1 : polynomial ℤ) < degree (s.prod (λ n, X - C n)),
  { rwa [deg_prod, degree_one, with_bot_zero, with_bot.coe_lt_coe, card_pos] },
  split,
  { show ¬is_unit (s.prod (λ n, X - C n) - 1),
    assume h : is_unit (s.prod (λ n, X - C n) - 1),
    rcases h with ⟨⟨f, g, hfg, hgf⟩, hf⟩,
    change s.prod (λ n, X - C n) - 1 = f at hf, subst f,
    replace hfg := congr_arg degree hfg,
    rw [degree_mul_eq, degree_sub_eq_of_degree_gt deg_lt] at hfg,
    rw [deg_prod, degree_one, with_bot_zero] at hfg,
    cases degree g with dg,
    case option.none { cases hfg },
    case option.some {
      change some (s.card + dg) = some 0 at hfg,
      rw [option.some_inj, add_eq_zero_iff, card_eq_zero] at hfg,
      exact hs hfg.1 } },
  { show ∀ p q, s.prod (λ n, X - C n) - 1 = p * q → is_unit p ∨ is_unit q,
    assume p q : polynomial ℤ,
    assume hpq : s.prod (λ n, X - C n) - 1 = p * q,
    have hpq0 : p + q ≠ 0,
    { assume h : p + q = 0,
      rw add_eq_zero_iff_neg_eq at h, subst q,
      rw mul_neg_eq_neg_mul_symm at hpq,
      replace hpq := congr_arg leading_coeff hpq,
      rw [leading_coeff_sub_of_degree_gt deg_lt] at hpq,
      rw [leading_coeff_prod, leading_coeff_neg, leading_coeff_mul] at hpq,
      simp only [leading_coeff_X_sub_C, prod_const_one] at hpq,
      refine absurd hpq (ne_of_gt (lt_of_le_of_lt (neg_nonpos.2 _) _)),
      { exact mul_self_nonneg _ },
      { exact dec_trivial } },
    have hp0 : p ≠ 0,
    { assume h : p = 0, subst p,
      replace hpq := congr_arg degree hpq,
      rw [degree_sub_eq_of_degree_gt deg_lt, deg_prod, zero_mul, degree_zero] at hpq,
      cases hpq },
    have hq0 : q ≠ 0,
    { assume h : q = 0, subst q,
      replace hpq := congr_arg degree hpq,
      rw [degree_sub_eq_of_degree_gt deg_lt, deg_prod, mul_zero, degree_zero] at hpq,
      cases hpq },
    have hroots : s ⊆ roots (p + q),
    { show ∀ x, x ∈ s → x ∈ roots (p + q),
      intros x hxs, rw [mem_roots hpq0, is_root.def, eval_add],
      replace hpq := congr_arg (eval x) hpq,
      rw [eval_sub, eval_one, eval_mul, eval_prod] at hpq,
      simp only [eval_sub, eval_X, eval_C] at hpq,
      rw [prod_eq_zero hxs (sub_self x), zero_sub, eq_comm, int.mul_eq_neg_one] at hpq,
      rcases hpq with ⟨hp, hq⟩ | ⟨hp, hq⟩; rw [hp, hq]; refl },
    have hdpmq : degree (p * q) = s.card,
    { rw [← hpq, degree_sub_eq_of_degree_gt deg_lt, deg_prod] },
    have hdpdq : degree p + degree q = s.card,
    { rw [← degree_mul_eq, hdpmq] },
    rw [degree_eq_nat_degree hp0, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_eq_coe] at hdpdq,
    have hdpq : degree (p + q) = s.card,
    { apply le_antisymm,
      { show degree (p + q) ≤ s.card,
        refine le_trans (degree_add_le _ _) (max_le _ _),
        { rw [degree_eq_nat_degree hp0, with_bot.coe_le_coe, ← hdpdq],
          exact nat.le_add_right _ _ },
        { rw [degree_eq_nat_degree hq0, with_bot.coe_le_coe, ← hdpdq],
          exact nat.le_add_left _ _ } },
      { show (s.card : with_bot ℕ) ≤ degree (p + q),
        refine le_trans _ (card_roots hpq0),
        rw [with_bot.coe_le_coe], exact card_le_of_subset hroots } },
    cases le_total (degree p) (degree q) with hdplq hdqlp,
    { have hdp0 : degree p ≤ 0,
      { rw [degree_eq_nat_degree hp0, with_bot_zero, with_bot.coe_le_coe],
        rw [← add_le_add_iff_right (nat_degree q), hdpdq, zero_add, ← with_bot.coe_le_coe],
        rw [← hdpq, ← degree_eq_nat_degree hq0],
        refine le_trans (degree_add_le _ _) (max_le hdplq (le_refl _)) },
      have : coeff p 0 = leading_coeff p,
      { rw leading_coeff, congr, rw [eq_C_of_degree_le_zero hdp0, nat_degree_C] },
      left, refine is_unit_of_mul_one _ (C (leading_coeff q)) _,
      rw [eq_C_of_degree_le_zero hdp0, this, ← C_mul, ← leading_coeff_mul, ← hpq],
      rw [leading_coeff_sub_of_degree_gt deg_lt, leading_coeff_prod],
      simp only [leading_coeff_X_sub_C, prod_const_one, C_1] },
    { have hdq0 : degree q ≤ 0,
      { rw [degree_eq_nat_degree hq0, with_bot_zero, with_bot.coe_le_coe],
        rw [← add_le_add_iff_left (nat_degree p), hdpdq, add_zero, ← with_bot.coe_le_coe],
        rw [← hdpq, ← degree_eq_nat_degree hp0],
        refine le_trans (degree_add_le _ _) (max_le (le_refl _) hdqlp) },
      have : coeff q 0 = leading_coeff q,
      { rw leading_coeff, congr, rw [eq_C_of_degree_le_zero hdq0, nat_degree_C] },
      right, refine is_unit_of_mul_one _ (C (leading_coeff p)) _,
      rw [eq_C_of_degree_le_zero hdq0, this, ← C_mul, ← leading_coeff_mul, mul_comm, ← hpq],
      rw [leading_coeff_sub_of_degree_gt deg_lt, leading_coeff_prod],
      simp only [leading_coeff_X_sub_C, prod_const_one, C_1] } }
end


--lean is working
import topology.basic
#check topological_space
#eval 1+1
theorem add_one_one : 1 + 1 = 2 := by refl

--EXAMPLE 1: transfering order from nat to custom nat (bijection)
namespace example1

-- a type N
def N : Type := sorry

-- a type nat
--nat is a type

-- order on N
def ordern : N → N → Prop := sorry

-- order on nat
--nat has an order

-- function nto
def nto : N → nat := sorry

-- function nof
def nof : nat → N := sorry

axiom ax1 : ∀ x : nat, nto(nof(x)) = x

axiom ax2 : ∀ x : N, nof(nto(x)) = x

axiom ax3 : ∀ x y : N, ordern x y → nto x <= nto y

axiom ax4 : ∀ x y : nat, x <= y → ordern (nof x) (nof y)

theorem thetheoremfornat : ∀ x y z : nat, x <= y → y <= z → x <= z := sorry

theorem thetheoremforN : ∀ x y z : N, ordern x y → ordern y z → ordern x z :=
begin
    intros,
    rw← ax2 x,
    rw← ax2 z,
    apply ax4,
    apply thetheoremfornat (nto x) (nto y) (nto z);
    finish using [ax3],
    --apply ax3,
    --assumption,
    --apply ax3,
    --assumption,
end

--TODO thetheoremfornatagain
end example1

--EXAMPLE 2: transfer the theorem that odd+odd=even from z to z mod 2 and back.
namespace example2

--even and odd on Z
definition even (n : int) : Prop := n % 2 = 0
--definition odd (n : int) : Prop := n % 2 = 1

--type Z/2Z
inductive Z2 : Type
| zero : Z2
| one : Z2

def Z2.add : Z2 → Z2 → Z2
| Z2.zero y := y
| Z2.one Z2.zero := Z2.one
| Z2.one Z2.one := Z2.zero

open Z2

--even on z/2z
inductive evenZ2 : Z2 → Prop
| zeroiseven : evenZ2 zero

--transfer function (mod 2)
def ztoz2 : int → Z2 := λ n, if n % 2 = 0 then zero else one

--transfer respects add
axiom transfer_add : ∀ m n : int, (ztoz2 m).add (ztoz2 n) = ztoz2(m + n)

--DIRECTION Z to Z2
axiom eventransfertoz2 : ∀ n : int, even n → evenZ2 (ztoz2 n)

--DIRECTION Z2 to Z
axiom eventransferfromz2  : ∀ x : Z2, ∀ y : int, evenZ2 x → ztoz2 y = x → even y

-- axiom transfer_add_2 : ∀ x y : Z2, ∀ m n : int, ztoz2 m = x → ztoz2 n = y → x.add y = ztoz2 (m + n)

axiom ztoz2surj : function.surjective ztoz2

--theorem about even numbers
theorem thetheoremforint : ∀ m n : int, ¬ even m → ¬ even n → even (m + n) := sorry

--theorem about even numbers in z2, using only axioms, the proven theorem in int, and assumptions
theorem thetheoremforZ2 : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
    intros,
    --pick numbers such that m % 2 = x, n % 2 = y
    --rw transfer_add_2,
    --apply eventransfertoz2,
    --apply thetheoremforint,
    let m := classical.some (ztoz2surj x),
    let n := classical.some (ztoz2surj y),
    have mx : ztoz2 m = x := classical.some_spec(ztoz2surj x),
    have ny : ztoz2 n = y := classical.some_spec(ztoz2surj y),

    rw← mx,
    rw← ny,

    rw transfer_add,
    apply eventransfertoz2,
    apply thetheoremforint,

   -- have : ¬ even m,
   { finish using [eventransfertoz2] },
   -- have : ¬ even n,
   { finish using [eventransfertoz2] },

   -- assumption,
   -- assumption,
   -- assumption,
    --have test: ¬ even 1 := sorry,
    --apply test,
    --have test: ¬ even 1 := sorry,
    --apply test,
  --  sorry --  WIP
end

theorem thetheoremforZ2_2 : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
    intros,
    have surj : function.surjective ztoz2 := sorry,

    rw [← classical.some_spec (surj x)] at *,
    rw [← classical.some_spec (surj y)] at *,
    rw transfer_add,
    apply eventransfertoz2,
    apply thetheoremforint;

    finish using [eventransfertoz2],
end

    --adding two odd numbers in Z2, so one.add one
    --*any number* that % 2 equals one is odd, --map is surjective so the numbers exist
    --odd plus odd = even
    --even number % 2 is even too
    --this result is equal to adding in Z2

    --classical.some to pick one of the ints

theorem thetheoremforZ2again : ∀ x y : Z2, ¬ evenZ2 x → ¬ evenZ2 y → evenZ2 (add x y) :=
begin
  --practice proof
  intros,
  cases x,
  { apply false.elim,
    apply a,
    apply evenZ2.zeroiseven},
  { cases y,
      { apply false.elim,
        apply a_1,
       apply evenZ2.zeroiseven},
      { simp [Z2.add],
        apply evenZ2.zeroiseven}},
end

--proof using only the theorem in Z2, axioms, and assumptions
theorem thetheoremforintagain : ∀ x y : int, ¬ even x → ¬ even y → even (x + y) :=
begin
  intros,

  apply eventransferfromz2,

  have addinZ2iseven : evenZ2 ((ztoz2 x).add (ztoz2 y)) :=
      begin
        apply thetheoremforZ2again,

        intro bla2,
        apply a,
        apply eventransferfromz2,
        apply bla2,
        simp,

        intro bla2,
        apply a_1,
        apply eventransferfromz2,
        apply bla2,
        simp,
      end,

  apply addinZ2iseven,

  simp [transfer_add],
end

end example2

namespace example3
-- EXAMPLE 3: do an example with injection natural numbers to integers
-- even op natuurlijke getallen naar even op integers

--nat is a type
--int is a type

--even prop
definition even (n : nat) : Prop := n % 2 = 0
definition evenint (x : int) : Prop := x % 2 = 0

--transfer functions
def ntoi : nat → int := int.of_nat --implementations optional
def nofi : int → nat := int.nat_abs

axiom inverse1way : ∀ n : nat, nofi(ntoi n) = n

--transfer lemmas
--axiom transfer_add : ∀ m n : nat, ntoi m + ntoi n = ntoi (m + n)
axiom transfer_add2 : ∀ x y : int, nofi x + nofi y = nofi (x + y)

--axiom eventoint : ∀ (x : int), even (nofi x) → evenint x
--axiom eventoint : ∀ n : nat, even n → evenint (ntoi n) --verkeerd om
--axiom evenfromint : ∀ x : int, evenint x → even (nofi x)

--axiom eventoint' : ∀ x : int, even (nofi x) → evenint x
--lemma eventoint : ∀ n : nat, even n → evenint (ntoi n) :=
--λ n hn, eventoint' _ (inverse1way n ▸ hn)

--axiom evenfromint' : ∀ x : int, evenint x → even (nofi x)
--lemma evenfromint : ∀ n : nat, evenint (ntoi n) → even n :=
--λ n hn, inverse1way n ▸ evenfromint' _ hn

axiom eventoint': ∀ x : int, even (nofi x) → evenint x
lemma eventoint : ∀ n : nat, even n → evenint (ntoi n) :=
λ n hn, eventoint' _ (by { rw  ← inverse1way n, exact hn })

axiom evenfromint' : ∀ x : int, evenint x → even (nofi x)
lemma evenfromint : ∀ n : nat, evenint (ntoi n) → even n :=
λ n hn, by { rw ← inverse1way n, exact evenfromint' _ hn }

theorem thetheoremfornat : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) := sorry

theorem thetheoremforint : ∀ x y : int, ¬ evenint x → ¬ evenint y → evenint (x + y) :=
begin
  intros,
  apply eventoint',
  rw← transfer_add2,
  apply thetheoremfornat;
  finish using [eventoint'],

  --have addinnatiseven : even ((nofi x).add (nofi y)) :=
  --begin
  --  apply thetheoremfornat,

  --  intro bla2,
  --  apply a,
  --  apply eventoint',
  --  apply bla2,

  --  intro bla2,
  --  apply a_1,
  --  apply eventoint',
  --  apply bla2,
  --end,

--  rw ←transfer_add2,
  --apply addinnatiseven,
end

  --Cant do this:
  --let m be such that ntoi m = x
  --let n be such that ntoi n = y

  --let m = nofi x
  --let n = nofi y

  -- old
  --have test: even (nofi x + nofi y) :=
  --begin
  --  apply thetheoremfornat,

  --  intro b,
  --  apply a,
    --rw← inverse1way (nofi x) at *,

    --finish using [eventoint],
    --rw transfer_add2,
  --sorry, sorry
  --end,
--end

theorem thetheoremfornatagain : ∀ m n : nat, ¬ even m → ¬ even n → even (m + n) :=
begin
  intros,
  rw← inverse1way m at *,
  rw← inverse1way n at *,
  rw transfer_add2,
  apply evenfromint',
  apply thetheoremforint;
  finish using [evenfromint'],
end

end example3


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

! This file was ported from Lean 3 source module algebra.order.sub.canonical
! leanprover-community/mathlib commit 62a5626868683c104774de8d85b9855234ac807c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Monoid.Canonical.Defs
import Mathlib.Algebra.Order.Sub.Defs

/-!
# Lemmas about subtraction in canonically ordered monoids
-/

variable {α : Type _}

section ExistsAddOfLE

variable [AddCommSemigroup α] [PartialOrder α] [ExistsAddOfLE α]
  [CovariantClass α α (· + ·) (· ≤ ·)] [Sub α] [OrderedSub α] {a b c d : α}

@[simp]
theorem add_tsub_cancel_of_le (h : a ≤ b) : a + (b - a) = b := by
  refine' le_antisymm _ le_add_tsub
  obtain ⟨c, rfl⟩ := exists_add_of_le h
  exact add_le_add_left add_tsub_le_left a
#align add_tsub_cancel_of_le add_tsub_cancel_of_le

theorem tsub_add_cancel_of_le (h : a ≤ b) : b - a + a = b := by
  rw [add_comm]
  exact add_tsub_cancel_of_le h
#align tsub_add_cancel_of_le tsub_add_cancel_of_le

theorem add_le_of_le_tsub_right_of_le (h : b ≤ c) (h2 : a ≤ c - b) : a + b ≤ c :=
  (add_le_add_right h2 b).trans_eq <| tsub_add_cancel_of_le h
#align add_le_of_le_tsub_right_of_le add_le_of_le_tsub_right_of_le

theorem add_le_of_le_tsub_left_of_le (h : a ≤ c) (h2 : b ≤ c - a) : a + b ≤ c :=
  (add_le_add_left h2 a).trans_eq <| add_tsub_cancel_of_le h
#align add_le_of_le_tsub_left_of_le add_le_of_le_tsub_left_of_le

theorem tsub_le_tsub_iff_right (h : c ≤ b) : a - c ≤ b - c ↔ a ≤ b := by
  rw [tsub_le_iff_right, tsub_add_cancel_of_le h]
#align tsub_le_tsub_iff_right tsub_le_tsub_iff_right

theorem tsub_left_inj (h1 : c ≤ a) (h2 : c ≤ b) : a - c = b - c ↔ a = b := by
  simp_rw [le_antisymm_iff, tsub_le_tsub_iff_right h1, tsub_le_tsub_iff_right h2]
#align tsub_left_inj tsub_left_inj

theorem tsub_inj_left (h₁ : a ≤ b) (h₂ : a ≤ c) : b - a = c - a → b = c :=
  (tsub_left_inj h₁ h₂).1
#align tsub_inj_left tsub_inj_left

/-- See `lt_of_tsub_lt_tsub_right` for a stronger statement in a linear order. -/
theorem lt_of_tsub_lt_tsub_right_of_le (h : c ≤ b) (h2 : a - c < b - c) : a < b := by
  refine' ((tsub_le_tsub_iff_right h).mp h2.le).lt_of_ne _
  rintro rfl
  exact h2.false
#align lt_of_tsub_lt_tsub_right_of_le lt_of_tsub_lt_tsub_right_of_le

theorem tsub_add_tsub_cancel (hab : b ≤ a) (hcb : c ≤ b) : a - b + (b - c) = a - c := by
  convert tsub_add_cancel_of_le (tsub_le_tsub_right hab c) using 2
  rw [tsub_tsub, add_tsub_cancel_of_le hcb]
#align tsub_add_tsub_cancel tsub_add_tsub_cancel

theorem tsub_tsub_tsub_cancel_right (h : c ≤ b) : a - c - (b - c) = a - b := by
  rw [tsub_tsub, add_tsub_cancel_of_le h]
#align tsub_tsub_tsub_cancel_right tsub_tsub_tsub_cancel_right

/-! #### Lemmas that assume that an element is `AddLECancellable`. -/

namespace AddLECancellable

protected theorem eq_tsub_iff_add_eq_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a = b - c ↔ a + c = b :=
  ⟨by
    rintro rfl
    exact tsub_add_cancel_of_le h, hc.eq_tsub_of_add_eq⟩
#align add_le_cancellable.eq_tsub_iff_add_eq_of_le AddLECancellable.eq_tsub_iff_add_eq_of_le

protected theorem tsub_eq_iff_eq_add_of_le (hb : AddLECancellable b) (h : b ≤ a) :
    a - b = c ↔ a = c + b := by rw [eq_comm, hb.eq_tsub_iff_add_eq_of_le h, eq_comm]
#align add_le_cancellable.tsub_eq_iff_eq_add_of_le AddLECancellable.tsub_eq_iff_eq_add_of_le

protected theorem add_tsub_assoc_of_le (hc : AddLECancellable c) (h : c ≤ b) (a : α) :
    a + b - c = a + (b - c) := by
  conv_lhs => rw [← add_tsub_cancel_of_le h, add_comm c, ← add_assoc, hc.add_tsub_cancel_right]
#align add_le_cancellable.add_tsub_assoc_of_le AddLECancellable.add_tsub_assoc_of_le

protected theorem tsub_add_eq_add_tsub (hb : AddLECancellable b) (h : b ≤ a) :
    a - b + c = a + c - b := by rw [add_comm a, hb.add_tsub_assoc_of_le h, add_comm]
#align add_le_cancellable.tsub_add_eq_add_tsub AddLECancellable.tsub_add_eq_add_tsub

protected theorem tsub_tsub_assoc (hbc : AddLECancellable (b - c)) (h₁ : b ≤ a) (h₂ : c ≤ b) :
    a - (b - c) = a - b + c :=
  hbc.tsub_eq_of_eq_add <| by rw [add_assoc, add_tsub_cancel_of_le h₂, tsub_add_cancel_of_le h₁]
#align add_le_cancellable.tsub_tsub_assoc AddLECancellable.tsub_tsub_assoc

protected theorem tsub_add_tsub_comm (hb : AddLECancellable b) (hd : AddLECancellable d)
    (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := by
  rw [hb.tsub_add_eq_add_tsub hba, ← hd.add_tsub_assoc_of_le hdc, tsub_tsub, add_comm d]
#align add_le_cancellable.tsub_add_tsub_comm AddLECancellable.tsub_add_tsub_comm

protected theorem le_tsub_iff_left (ha : AddLECancellable a) (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
  ⟨add_le_of_le_tsub_left_of_le h, ha.le_tsub_of_add_le_left⟩
#align add_le_cancellable.le_tsub_iff_left AddLECancellable.le_tsub_iff_left

protected theorem le_tsub_iff_right (ha : AddLECancellable a) (h : a ≤ c) :
    b ≤ c - a ↔ b + a ≤ c := by
  rw [add_comm]
  exact ha.le_tsub_iff_left h
#align add_le_cancellable.le_tsub_iff_right AddLECancellable.le_tsub_iff_right

protected theorem tsub_lt_iff_left (hb : AddLECancellable b) (hba : b ≤ a) :
    a - b < c ↔ a < b + c := by
  refine' ⟨hb.lt_add_of_tsub_lt_left, _⟩
  intro h; refine' (tsub_le_iff_left.mpr h.le).lt_of_ne _
  rintro rfl; exact h.ne' (add_tsub_cancel_of_le hba)
#align add_le_cancellable.tsub_lt_iff_left AddLECancellable.tsub_lt_iff_left

protected theorem tsub_lt_iff_right (hb : AddLECancellable b) (hba : b ≤ a) :
    a - b < c ↔ a < c + b := by
  rw [add_comm]
  exact hb.tsub_lt_iff_left hba
#align add_le_cancellable.tsub_lt_iff_right AddLECancellable.tsub_lt_iff_right

protected theorem tsub_lt_iff_tsub_lt (hb : AddLECancellable b) (hc : AddLECancellable c)
    (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := by
  rw [hb.tsub_lt_iff_left h₁, hc.tsub_lt_iff_right h₂]
#align add_le_cancellable.tsub_lt_iff_tsub_lt AddLECancellable.tsub_lt_iff_tsub_lt

protected theorem le_tsub_iff_le_tsub (ha : AddLECancellable a) (hc : AddLECancellable c)
    (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := by
  rw [ha.le_tsub_iff_left h₁, hc.le_tsub_iff_right h₂]
#align add_le_cancellable.le_tsub_iff_le_tsub AddLECancellable.le_tsub_iff_le_tsub

protected theorem lt_tsub_iff_right_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a < b - c ↔ a + c < b := by
  refine' ⟨fun h' => (add_le_of_le_tsub_right_of_le h h'.le).lt_of_ne _, hc.lt_tsub_of_add_lt_right⟩
  rintro rfl
  exact h'.ne' hc.add_tsub_cancel_right
#align add_le_cancellable.lt_tsub_iff_right_of_le AddLECancellable.lt_tsub_iff_right_of_le

protected theorem lt_tsub_iff_left_of_le (hc : AddLECancellable c) (h : c ≤ b) :
    a < b - c ↔ c + a < b := by
  rw [add_comm]
  exact hc.lt_tsub_iff_right_of_le h
#align add_le_cancellable.lt_tsub_iff_left_of_le AddLECancellable.lt_tsub_iff_left_of_le

protected theorem tsub_inj_right (hab : AddLECancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a)
    (h₃ : a - b = a - c) : b = c := by
  rw [← hab.inj]
  rw [tsub_add_cancel_of_le h₁, h₃, tsub_add_cancel_of_le h₂]
#align add_le_cancellable.tsub_inj_right AddLECancellable.tsub_inj_right

protected theorem lt_of_tsub_lt_tsub_left_of_le [ContravariantClass α α (· + ·) (· < ·)]
    (hb : AddLECancellable b) (hca : c ≤ a) (h : a - b < a - c) : c < b := by
  conv_lhs at h => rw [← tsub_add_cancel_of_le hca]
  exact lt_of_add_lt_add_left (hb.lt_add_of_tsub_lt_right h)
#align add_le_cancellable.lt_of_tsub_lt_tsub_left_of_le AddLECancellable.lt_of_tsub_lt_tsub_left_of_le

protected theorem tsub_lt_tsub_left_of_le (hab : AddLECancellable (a - b)) (h₁ : b ≤ a)
    (h : c < b) : a - b < a - c :=
  (tsub_le_tsub_left h.le _).lt_of_ne fun h' => h.ne' <| hab.tsub_inj_right h₁ (h.le.trans h₁) h'
#align add_le_cancellable.tsub_lt_tsub_left_of_le AddLECancellable.tsub_lt_tsub_left_of_le

protected theorem tsub_lt_tsub_right_of_le (hc : AddLECancellable c) (h : c ≤ a) (h2 : a < b) :
    a - c < b - c := by
  apply hc.lt_tsub_of_add_lt_left
  rwa [add_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_lt_tsub_right_of_le AddLECancellable.tsub_lt_tsub_right_of_le

protected theorem tsub_lt_tsub_iff_left_of_le_of_le [ContravariantClass α α (· + ·) (· < ·)]
    (hb : AddLECancellable b) (hab : AddLECancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) :
    a - b < a - c ↔ c < b :=
  ⟨hb.lt_of_tsub_lt_tsub_left_of_le h₂, hab.tsub_lt_tsub_left_of_le h₁⟩
#align add_le_cancellable.tsub_lt_tsub_iff_left_of_le_of_le AddLECancellable.tsub_lt_tsub_iff_left_of_le_of_le

@[simp]
protected theorem add_tsub_tsub_cancel (hac : AddLECancellable (a - c)) (h : c ≤ a) :
    a + b - (a - c) = b + c :=
  hac.tsub_eq_of_eq_add <| by rw [add_assoc, add_tsub_cancel_of_le h, add_comm]
#align add_le_cancellable.add_tsub_tsub_cancel AddLECancellable.add_tsub_tsub_cancel

protected theorem tsub_tsub_cancel_of_le (hba : AddLECancellable (b - a)) (h : a ≤ b) :
    b - (b - a) = a :=
  hba.tsub_eq_of_eq_add (add_tsub_cancel_of_le h).symm
#align add_le_cancellable.tsub_tsub_cancel_of_le AddLECancellable.tsub_tsub_cancel_of_le

protected theorem tsub_tsub_tsub_cancel_left (hab : AddLECancellable (a - b)) (h : b ≤ a) :
    a - c - (a - b) = b - c := by rw [tsub_right_comm, hab.tsub_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_tsub_tsub_cancel_left AddLECancellable.tsub_tsub_tsub_cancel_left

end AddLECancellable

section Contra

/-! ### Lemmas where addition is order-reflecting. -/

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem eq_tsub_iff_add_eq_of_le (h : c ≤ b) : a = b - c ↔ a + c = b :=
  Contravariant.AddLECancellable.eq_tsub_iff_add_eq_of_le h
#align eq_tsub_iff_add_eq_of_le eq_tsub_iff_add_eq_of_le

theorem tsub_eq_iff_eq_add_of_le (h : b ≤ a) : a - b = c ↔ a = c + b :=
  Contravariant.AddLECancellable.tsub_eq_iff_eq_add_of_le h
#align tsub_eq_iff_eq_add_of_le tsub_eq_iff_eq_add_of_le

/-- See `add_tsub_le_assoc` for an inequality. -/
theorem add_tsub_assoc_of_le (h : c ≤ b) (a : α) : a + b - c = a + (b - c) :=
  Contravariant.AddLECancellable.add_tsub_assoc_of_le h a
#align add_tsub_assoc_of_le add_tsub_assoc_of_le

theorem tsub_add_eq_add_tsub (h : b ≤ a) : a - b + c = a + c - b :=
  Contravariant.AddLECancellable.tsub_add_eq_add_tsub h
#align tsub_add_eq_add_tsub tsub_add_eq_add_tsub

theorem tsub_tsub_assoc (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c :=
  Contravariant.AddLECancellable.tsub_tsub_assoc h₁ h₂
#align tsub_tsub_assoc tsub_tsub_assoc

theorem tsub_add_tsub_comm (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) :=
  Contravariant.AddLECancellable.tsub_add_tsub_comm Contravariant.AddLECancellable hba hdc
#align tsub_add_tsub_comm tsub_add_tsub_comm

theorem le_tsub_iff_left (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c :=
  Contravariant.AddLECancellable.le_tsub_iff_left h
#align le_tsub_iff_left le_tsub_iff_left

theorem le_tsub_iff_right (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c :=
  Contravariant.AddLECancellable.le_tsub_iff_right h
#align le_tsub_iff_right le_tsub_iff_right

theorem tsub_lt_iff_left (hbc : b ≤ a) : a - b < c ↔ a < b + c :=
  Contravariant.AddLECancellable.tsub_lt_iff_left hbc
#align tsub_lt_iff_left tsub_lt_iff_left

theorem tsub_lt_iff_right (hbc : b ≤ a) : a - b < c ↔ a < c + b :=
  Contravariant.AddLECancellable.tsub_lt_iff_right hbc
#align tsub_lt_iff_right tsub_lt_iff_right

theorem tsub_lt_iff_tsub_lt (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b :=
  Contravariant.AddLECancellable.tsub_lt_iff_tsub_lt Contravariant.AddLECancellable h₁ h₂
#align tsub_lt_iff_tsub_lt tsub_lt_iff_tsub_lt

theorem le_tsub_iff_le_tsub (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a :=
  Contravariant.AddLECancellable.le_tsub_iff_le_tsub Contravariant.AddLECancellable h₁ h₂
#align le_tsub_iff_le_tsub le_tsub_iff_le_tsub

/-- See `lt_tsub_iff_right` for a stronger statement in a linear order. -/
theorem lt_tsub_iff_right_of_le (h : c ≤ b) : a < b - c ↔ a + c < b :=
  Contravariant.AddLECancellable.lt_tsub_iff_right_of_le h
#align lt_tsub_iff_right_of_le lt_tsub_iff_right_of_le

/-- See `lt_tsub_iff_left` for a stronger statement in a linear order. -/
theorem lt_tsub_iff_left_of_le (h : c ≤ b) : a < b - c ↔ c + a < b :=
  Contravariant.AddLECancellable.lt_tsub_iff_left_of_le h
#align lt_tsub_iff_left_of_le lt_tsub_iff_left_of_le

/-- See `lt_of_tsub_lt_tsub_left` for a stronger statement in a linear order. -/
theorem lt_of_tsub_lt_tsub_left_of_le [ContravariantClass α α (· + ·) (· < ·)] (hca : c ≤ a)
    (h : a - b < a - c) : c < b :=
  Contravariant.AddLECancellable.lt_of_tsub_lt_tsub_left_of_le hca h
#align lt_of_tsub_lt_tsub_left_of_le lt_of_tsub_lt_tsub_left_of_le

theorem tsub_lt_tsub_left_of_le : b ≤ a → c < b → a - b < a - c :=
  Contravariant.AddLECancellable.tsub_lt_tsub_left_of_le
#align tsub_lt_tsub_left_of_le tsub_lt_tsub_left_of_le

theorem tsub_lt_tsub_right_of_le (h : c ≤ a) (h2 : a < b) : a - c < b - c :=
  Contravariant.AddLECancellable.tsub_lt_tsub_right_of_le h h2
#align tsub_lt_tsub_right_of_le tsub_lt_tsub_right_of_le

theorem tsub_inj_right (h₁ : b ≤ a) (h₂ : c ≤ a) (h₃ : a - b = a - c) : b = c :=
  Contravariant.AddLECancellable.tsub_inj_right h₁ h₂ h₃
#align tsub_inj_right tsub_inj_right

/-- See `tsub_lt_tsub_iff_left_of_le` for a stronger statement in a linear order. -/
theorem tsub_lt_tsub_iff_left_of_le_of_le [ContravariantClass α α (· + ·) (· < ·)] (h₁ : b ≤ a)
    (h₂ : c ≤ a) : a - b < a - c ↔ c < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_left_of_le_of_le Contravariant.AddLECancellable h₁
    h₂
#align tsub_lt_tsub_iff_left_of_le_of_le tsub_lt_tsub_iff_left_of_le_of_le

@[simp]
theorem add_tsub_tsub_cancel (h : c ≤ a) : a + b - (a - c) = b + c :=
  Contravariant.AddLECancellable.add_tsub_tsub_cancel h
#align add_tsub_tsub_cancel add_tsub_tsub_cancel

/-- See `tsub_tsub_le` for an inequality. -/
theorem tsub_tsub_cancel_of_le (h : a ≤ b) : b - (b - a) = a :=
  Contravariant.AddLECancellable.tsub_tsub_cancel_of_le h
#align tsub_tsub_cancel_of_le tsub_tsub_cancel_of_le

theorem tsub_tsub_tsub_cancel_left (h : b ≤ a) : a - c - (a - b) = b - c :=
  Contravariant.AddLECancellable.tsub_tsub_tsub_cancel_left h
#align tsub_tsub_tsub_cancel_left tsub_tsub_tsub_cancel_left

end Contra

end ExistsAddOfLE

/-! ### Lemmas in a canonically ordered monoid. -/

section CanonicallyOrderedAddMonoid

variable [CanonicallyOrderedAddMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

theorem add_tsub_cancel_iff_le : a + (b - a) = b ↔ a ≤ b :=
  ⟨fun h => le_iff_exists_add.mpr ⟨b - a, h.symm⟩, add_tsub_cancel_of_le⟩
#align add_tsub_cancel_iff_le add_tsub_cancel_iff_le

theorem tsub_add_cancel_iff_le : b - a + a = b ↔ a ≤ b := by
  rw [add_comm]
  exact add_tsub_cancel_iff_le
#align tsub_add_cancel_iff_le tsub_add_cancel_iff_le

@[simp]
theorem tsub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b := by
  rw [← nonpos_iff_eq_zero, tsub_le_iff_left, add_zero]
#align tsub_eq_zero_iff_le tsub_eq_zero_iff_le

alias tsub_eq_zero_iff_le ↔ _ tsub_eq_zero_of_le
#align tsub_eq_zero_of_le tsub_eq_zero_of_le

attribute [simp] tsub_eq_zero_of_le

theorem tsub_self (a : α) : a - a = 0 :=
  tsub_eq_zero_of_le le_rfl
#align tsub_self tsub_self

theorem tsub_le_self : a - b ≤ a :=
  tsub_le_iff_left.mpr <| le_add_left le_rfl
#align tsub_le_self tsub_le_self

theorem zero_tsub (a : α) : 0 - a = 0 :=
  tsub_eq_zero_of_le <| zero_le a
#align zero_tsub zero_tsub

theorem tsub_self_add (a b : α) : a - (a + b) = 0 :=
  tsub_eq_zero_of_le <| self_le_add_right _ _
#align tsub_self_add tsub_self_add

theorem tsub_pos_iff_not_le : 0 < a - b ↔ ¬a ≤ b := by
  rw [pos_iff_ne_zero, Ne.def, tsub_eq_zero_iff_le]
#align tsub_pos_iff_not_le tsub_pos_iff_not_le

theorem tsub_pos_of_lt (h : a < b) : 0 < b - a :=
  tsub_pos_iff_not_le.mpr h.not_le
#align tsub_pos_of_lt tsub_pos_of_lt

theorem tsub_lt_of_lt (h : a < b) : a - c < b :=
  lt_of_le_of_lt tsub_le_self h
#align tsub_lt_of_lt tsub_lt_of_lt

namespace AddLECancellable

protected theorem tsub_le_tsub_iff_left (ha : AddLECancellable a) (hc : AddLECancellable c)
    (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := by
  refine' ⟨_, fun h => tsub_le_tsub_left h a⟩
  rw [tsub_le_iff_left, ← hc.add_tsub_assoc_of_le h, hc.le_tsub_iff_right (h.trans le_add_self),
    add_comm b]
  apply ha
#align add_le_cancellable.tsub_le_tsub_iff_left AddLECancellable.tsub_le_tsub_iff_left

protected theorem tsub_right_inj (ha : AddLECancellable a) (hb : AddLECancellable b)
    (hc : AddLECancellable c) (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := by
  simp_rw [le_antisymm_iff, ha.tsub_le_tsub_iff_left hb hba, ha.tsub_le_tsub_iff_left hc hca,
    and_comm]
#align add_le_cancellable.tsub_right_inj AddLECancellable.tsub_right_inj

end AddLECancellable

/-! #### Lemmas where addition is order-reflecting. -/

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

theorem tsub_le_tsub_iff_left (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b :=
  Contravariant.AddLECancellable.tsub_le_tsub_iff_left Contravariant.AddLECancellable h
#align tsub_le_tsub_iff_left tsub_le_tsub_iff_left

theorem tsub_right_inj (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c :=
  Contravariant.AddLECancellable.tsub_right_inj Contravariant.AddLECancellable
    Contravariant.AddLECancellable hba hca
#align tsub_right_inj tsub_right_inj

variable (α)

/-- A `CanonicallyOrderedAddMonoid` with ordered subtraction and order-reflecting addition is
cancellative. This is not an instance at it would form a typeclass loop.

See note [reducible non-instances]. -/
@[reducible]
def CanonicallyOrderedAddMonoid.toAddCancelCommMonoid : AddCancelCommMonoid α :=
  { (by infer_instance : AddCommMonoid α) with
    add_left_cancel := fun a b c h => by
      simpa only [add_tsub_cancel_left] using congr_arg (fun x => x - a) h }
#align canonically_ordered_add_monoid.to_add_cancel_comm_monoid CanonicallyOrderedAddMonoid.toAddCancelCommMonoid

end Contra

end CanonicallyOrderedAddMonoid

/-! ### Lemmas in a linearly canonically ordered monoid. -/

section CanonicallyLinearOrderedAddMonoid

variable [CanonicallyLinearOrderedAddMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

@[simp]
theorem tsub_pos_iff_lt : 0 < a - b ↔ b < a := by rw [tsub_pos_iff_not_le, not_le]
#align tsub_pos_iff_lt tsub_pos_iff_lt

theorem tsub_eq_tsub_min (a b : α) : a - b = a - min a b := by
  cases' le_total a b with h h
  · rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h]
  · rw [min_eq_right h]
#align tsub_eq_tsub_min tsub_eq_tsub_min

namespace AddLECancellable

protected theorem lt_tsub_iff_right (hc : AddLECancellable c) : a < b - c ↔ a + c < b :=
  ⟨lt_imp_lt_of_le_imp_le tsub_le_iff_right.mpr, hc.lt_tsub_of_add_lt_right⟩
#align add_le_cancellable.lt_tsub_iff_right AddLECancellable.lt_tsub_iff_right

protected theorem lt_tsub_iff_left (hc : AddLECancellable c) : a < b - c ↔ c + a < b :=
  ⟨lt_imp_lt_of_le_imp_le tsub_le_iff_left.mpr, hc.lt_tsub_of_add_lt_left⟩
#align add_le_cancellable.lt_tsub_iff_left AddLECancellable.lt_tsub_iff_left

protected theorem tsub_lt_tsub_iff_right (hc : AddLECancellable c) (h : c ≤ a) :
    a - c < b - c ↔ a < b := by rw [hc.lt_tsub_iff_left, add_tsub_cancel_of_le h]
#align add_le_cancellable.tsub_lt_tsub_iff_right AddLECancellable.tsub_lt_tsub_iff_right

protected theorem tsub_lt_self (ha : AddLECancellable a) (h₁ : 0 < a) (h₂ : 0 < b) : a - b < a := by
  refine' tsub_le_self.lt_of_ne fun h => _
  rw [← h, tsub_pos_iff_lt] at h₁
  exact h₂.not_le (ha.add_le_iff_nonpos_left.1 <| add_le_of_le_tsub_left_of_le h₁.le h.ge)
#align add_le_cancellable.tsub_lt_self AddLECancellable.tsub_lt_self

protected theorem tsub_lt_self_iff (ha : AddLECancellable a) : a - b < a ↔ 0 < a ∧ 0 < b := by
  refine'
    ⟨fun h => ⟨(zero_le _).trans_lt h, (zero_le b).lt_of_ne _⟩, fun h => ha.tsub_lt_self h.1 h.2⟩
  rintro rfl
  rw [tsub_zero] at h
  exact h.false
#align add_le_cancellable.tsub_lt_self_iff AddLECancellable.tsub_lt_self_iff

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
protected theorem tsub_lt_tsub_iff_left_of_le (ha : AddLECancellable a) (hb : AddLECancellable b)
    (h : b ≤ a) : a - b < a - c ↔ c < b :=
  lt_iff_lt_of_le_iff_le <| ha.tsub_le_tsub_iff_left hb h
#align add_le_cancellable.tsub_lt_tsub_iff_left_of_le AddLECancellable.tsub_lt_tsub_iff_left_of_le

end AddLECancellable

section Contra

variable [ContravariantClass α α (· + ·) (· ≤ ·)]

/-- This lemma also holds for `ENNReal`, but we need a different proof for that. -/
theorem tsub_lt_tsub_iff_right (h : c ≤ a) : a - c < b - c ↔ a < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_right h
#align tsub_lt_tsub_iff_right tsub_lt_tsub_iff_right

theorem tsub_lt_self : 0 < a → 0 < b → a - b < a :=
  Contravariant.AddLECancellable.tsub_lt_self
#align tsub_lt_self tsub_lt_self

theorem tsub_lt_self_iff : a - b < a ↔ 0 < a ∧ 0 < b :=
  Contravariant.AddLECancellable.tsub_lt_self_iff
#align tsub_lt_self_iff tsub_lt_self_iff

/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/
theorem tsub_lt_tsub_iff_left_of_le (h : b ≤ a) : a - b < a - c ↔ c < b :=
  Contravariant.AddLECancellable.tsub_lt_tsub_iff_left_of_le Contravariant.AddLECancellable h
#align tsub_lt_tsub_iff_left_of_le tsub_lt_tsub_iff_left_of_le

end Contra

/-! ### Lemmas about `max` and `min`. -/

theorem tsub_add_eq_max : a - b + b = max a b := by
  cases' le_total a b with h h
  · rw [max_eq_right h, tsub_eq_zero_of_le h, zero_add]
  · rw [max_eq_left h, tsub_add_cancel_of_le h]
#align tsub_add_eq_max tsub_add_eq_max

theorem add_tsub_eq_max : a + (b - a) = max a b := by rw [add_comm, max_comm, tsub_add_eq_max]
#align add_tsub_eq_max add_tsub_eq_max

theorem tsub_min : a - min a b = a - b := by
  cases' le_total a b with h h
  · rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h]
  · rw [min_eq_right h]
#align tsub_min tsub_min

theorem tsub_add_min : a - b + min a b = a := by
  rw [← tsub_min, @tsub_add_cancel_of_le]
  apply min_le_left
#align tsub_add_min tsub_add_min

end CanonicallyLinearOrderedAddMonoid


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

import algebra.group_with_zero.power
import algebra.big_operators.order
import algebra.big_operators.ring
import algebra.big_operators.intervals

/-!
# Partial sums of geometric series

This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and
$\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof.

## Main definitions

* `geom_sum` defines for each $x$ in a semiring and each natural number $n$ the partial sum
  $\sum_{i=0}^{n-1} x^i$ of the geometric series.
* `geom_sum₂` defines for each $x,y$ in a semiring and each natural number $n$ the partial sum
  $\sum_{i=0}^{n-1} x^i y^{n-1-i}$ of the geometric series.

## Main statements

* `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring.
* `geom_sum₂_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-y^{n-m}x^m}{x-y}$ in a field.

Several variants are recorded, generalising in particular to the case of a noncommutative ring in
which `x` and `y` commute. Even versions not using division or subtraction, valid in each semiring,
are recorded.
-/

universe u
variable {α : Type u}

open finset opposite

open_locale big_operators

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i$. -/
def geom_sum [semiring α] (x : α) (n : ℕ) :=
∑ i in range n, x ^ i

theorem geom_sum_def [semiring α] (x : α) (n : ℕ) :
  geom_sum x n = ∑ i in range n, x ^ i := rfl

@[simp] theorem geom_sum_zero [semiring α] (x : α) :
  geom_sum x 0 = 0 := rfl

@[simp] theorem geom_sum_one [semiring α] (x : α) :
  geom_sum x 1 = 1 :=
by { rw [geom_sum_def, sum_range_one, pow_zero] }

@[simp] lemma op_geom_sum [ring α] (x : α) (n : ℕ) :
  op (geom_sum x n) = geom_sum (op x) n :=
by simp [geom_sum_def]

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i y^{n-1-i}$. -/
def geom_sum₂ [semiring α] (x y : α) (n : ℕ) :=
∑ i in range n, x ^ i * (y ^ (n - 1 - i))

theorem geom_sum₂_def [semiring α] (x y : α) (n : ℕ) :
  geom_sum₂ x y n = ∑ i in range n, x ^ i * y ^ (n - 1 - i) := rfl

@[simp] theorem geom_sum₂_zero [semiring α] (x y : α) :
  geom_sum₂ x y 0 = 0 := rfl

@[simp] theorem geom_sum₂_one [semiring α] (x y : α) :
  geom_sum₂ x y 1 = 1 :=
by { have : 1 - 1 - 0 = 0 := rfl,
     rw [geom_sum₂_def, sum_range_one, this, pow_zero, pow_zero, mul_one] }

@[simp] lemma op_geom_sum₂ [ring α] (x y : α) (n : ℕ) :
  op (geom_sum₂ x y n) = geom_sum₂ (op y) (op x) n :=
begin
  simp only [geom_sum₂_def, op_sum, op_mul, units.op_pow],
  rw ← sum_range_reflect,
  refine sum_congr rfl (λ j j_in, _),
  rw [mem_range, nat.lt_iff_add_one_le] at j_in,
  congr,
  apply nat.sub_sub_self,
  exact nat.le_sub_right_of_add_le j_in
end

@[simp] theorem geom_sum₂_with_one [semiring α] (x : α) (n : ℕ) :
  geom_sum₂ x 1 n = geom_sum x n :=
sum_congr rfl (λ i _, by { rw [one_pow, mul_one] })

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add [semiring α] {x y : α} (h : commute x y) (n : ℕ) :
  (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n :=
begin
  let f := λ (m i : ℕ), (x + y) ^ i * y ^ (m - 1 - i),
  change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n,
  induction n with n ih,
  { rw [range_zero, sum_empty, zero_mul, zero_add, pow_zero, pow_zero] },
  { have f_last : f (n + 1) n = (x + y) ^ n :=
     by { dsimp [f],
          rw [nat.sub_sub, nat.add_comm, nat.sub_self, pow_zero, mul_one] },
    have f_succ : ∀ i, i ∈ range n → f (n + 1) i = y * f n i :=
      λ i hi, by {
        dsimp [f],
        have : commute y ((x + y) ^ i) :=
         (h.symm.add_right (commute.refl y)).pow_right i,
        rw [← mul_assoc, this.eq, mul_assoc, ← pow_succ y (n - 1 - i)],
        congr' 2,
        rw [nat.add_sub_cancel, nat.sub_sub, add_comm 1 i],
        have : i + 1 + (n - (i + 1)) = n := nat.add_sub_of_le (mem_range.mp hi),
        rw [add_comm (i + 1)] at this,
        rw [← this, nat.add_sub_cancel, add_comm i 1, ← add_assoc,
            nat.add_sub_cancel] },
    rw [pow_succ (x + y), add_mul, sum_range_succ_comm, add_mul, f_last, add_assoc],
    rw (((commute.refl x).add_right h).pow_right n).eq,
    congr' 1,
    rw [sum_congr rfl f_succ, ← mul_sum, pow_succ y, mul_assoc, ← mul_add y, ih] }
end

theorem geom_sum₂_self {α : Type*} [comm_ring α] (x : α) (n : ℕ) :
  geom_sum₂ x x n = n * x ^ (n-1) :=
calc  ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i)
    = ∑ i in finset.range n, x ^ (i + (n - 1 - i)) : by simp_rw [← pow_add]
... = ∑ i in finset.range n, x ^ (n - 1) : finset.sum_congr rfl
  (λ i hi, congr_arg _ $ nat.add_sub_cancel' $ nat.le_pred_of_lt $ finset.mem_range.1 hi)
... = (finset.range n).card • (x ^ (n - 1)) : finset.sum_const _
... = n * x ^ (n - 1) : by rw [finset.card_range, nsmul_eq_mul]

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add [comm_semiring α] (x y : α) (n : ℕ) :
  (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n :=
(commute.all x y).geom_sum₂_mul_add n

theorem geom_sum_mul_add [semiring α] (x : α) (n : ℕ) :
  (geom_sum (x + 1) n) * x + 1 = (x + 1) ^ n :=
begin
  have := (commute.one_right x).geom_sum₂_mul_add n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

protected theorem commute.geom_sum₂_mul [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n :=
begin
  have := (h.sub_left (commute.refl y)).geom_sum₂_mul_add n,
  rw [sub_add_cancel] at this,
  rw [← this, add_sub_cancel]
end

lemma commute.mul_neg_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (y - x) * (geom_sum₂ x y n) = y ^ n - x ^ n :=
begin
  rw ← op_inj_iff,
  simp only [op_mul, op_sub, op_geom_sum₂, units.op_pow],
  exact (commute.op h.symm).geom_sum₂_mul n
end

lemma commute.mul_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) :
  (x - y) * (geom_sum₂ x y n) = x ^ n - y ^ n :=
by rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul_eq_neg_mul_symm, neg_sub]

theorem geom_sum₂_mul [comm_ring α] (x y : α) (n : ℕ) :
  (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n :=
(commute.all x y).geom_sum₂_mul n

theorem geom_sum_mul [ring α] (x : α) (n : ℕ) :
  (geom_sum x n) * (x - 1) = x ^ n - 1 :=
begin
  have := (commute.one_right x).geom_sum₂_mul n,
  rw [one_pow, geom_sum₂_with_one] at this,
  exact this
end

lemma mul_geom_sum [ring α] (x : α) (n : ℕ) :
  (x - 1) * (geom_sum x n) = x ^ n - 1 :=
begin
  rw ← op_inj_iff,
  simpa using geom_sum_mul (op x) n,
end

theorem geom_sum_mul_neg [ring α] (x : α) (n : ℕ) :
  (geom_sum x n) * (1 - x) = 1 - x ^ n :=
begin
  have := congr_arg has_neg.neg (geom_sum_mul x n),
  rw [neg_sub, ← mul_neg_eq_neg_mul_symm, neg_sub] at this,
  exact this
end

lemma mul_neg_geom_sum [ring α] (x : α) (n : ℕ) :
  (1 - x) * (geom_sum x n) = 1 - x ^ n :=
begin
  rw ← op_inj_iff,
  simpa using geom_sum_mul_neg (op x) n,
end

protected theorem commute.geom_sum₂ [division_ring α] {x y : α} (h' : commute x y) (h : x ≠ y)
  (n : ℕ) : (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h'.geom_sum₂_mul, mul_div_cancel _ this]

theorem geom₂_sum [field α] {x y : α} (h : x ≠ y) (n : ℕ) :
  (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) :=
(commute.all x y).geom_sum₂ h n

theorem geom_sum_eq [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) :
  (geom_sum x n) = (x ^ n - 1) / (x - 1) :=
have x - 1 ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← geom_sum_mul, mul_div_cancel _ this]

protected theorem commute.mul_geom_sum₂_Ico [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
begin
  rw [sum_Ico_eq_sub _ hmn, ← geom_sum₂_def],
  have : ∑ k in range m, x ^ k * y ^ (n - 1 - k)
    = ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)),
    { refine sum_congr rfl (λ j j_in, _),
      rw ← pow_add,
      congr,
      rw [mem_range, nat.lt_iff_add_one_le, add_comm] at j_in,
      have h' : n - m + (m - (1 + j)) = n - (1 + j) := nat.sub_add_sub_cancel hmn j_in,
      rw [nat.sub_sub m, h', nat.sub_sub] },
  rw this,
  simp_rw pow_mul_comm y (n-m) _,
  simp_rw ← mul_assoc,
  rw [← sum_mul, ← geom_sum₂_def, mul_sub, h.mul_geom_sum₂, ← mul_assoc,
    h.mul_geom_sum₂, sub_mul, ← pow_add, nat.add_sub_of_le hmn,
    sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)],
end

protected theorem commute.geom_sum₂_succ_eq {α : Type u} [ring α] {x y : α}
  (h : commute x y) {n : ℕ} :
  geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) :=
begin
  simp_rw [geom_sum₂, mul_sum, sum_range_succ_comm, nat.add_succ_sub_one, add_zero, nat.sub_self,
    pow_zero, mul_one, add_right_inj, ←mul_assoc, (h.symm.pow_right _).eq, mul_assoc, ←pow_succ],
  refine sum_congr rfl (λ i hi, _),
  suffices : n - 1 - i + 1 = n - i, { rw this },
  cases n,
  { exact absurd (list.mem_range.mp hi) i.not_lt_zero },
  { rw [nat.sub_add_eq_add_sub (nat.le_pred_of_lt (list.mem_range.mp hi)),
        nat.sub_add_cancel (nat.succ_le_iff.mpr n.succ_pos)] },
end

theorem geom_sum₂_succ_eq {α : Type u} [comm_ring α] (x y : α)  {n : ℕ} :
  geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) :=
(commute.all x y).geom_sum₂_succ_eq

theorem mul_geom_sum₂_Ico [comm_ring α] (x y : α) {m n : ℕ} (hmn : m ≤ n) :
  (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
(commute.all x y).mul_geom_sum₂_Ico hmn

protected theorem commute.geom_sum₂_Ico_mul [ring α] {x y : α} (h : commute x y) {m n : ℕ}
  (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n -  y ^ (n - m) * x ^ m :=
begin
  rw ← op_inj_iff,
  simp only [op_sub, op_mul, units.op_pow, op_sum],
  have : ∑ k in Ico m n, op y ^ (n - 1 - k) * op x ^ k
    = ∑ k in Ico m n, op x ^ k * op y ^ (n - 1 - k),
  { refine sum_congr rfl (λ k k_in, _),
    apply commute.pow_pow (commute.op h.symm) },
  rw this,
  exact (commute.op h).mul_geom_sum₂_Ico hmn
end

theorem geom_sum_Ico_mul [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (x - 1) = x^n - x^m :=
by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul,
  geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right]

theorem geom_sum_Ico_mul_neg [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
  (∑ i in finset.Ico m n, x ^ i) * (1 - x) = x^m - x^n :=
by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul,
  geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left]

protected theorem commute.geom_sum₂_Ico [division_ring α] {x y : α} (h : commute x y) (hxy : x ≠ y)
  {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *,
by rw [← h.geom_sum₂_Ico_mul hmn, mul_div_cancel _ this]

theorem geom_sum₂_Ico [field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i) = (x ^ n - y ^ (n - m) * x ^ m ) / (x - y) :=
(commute.all x y).geom_sum₂_Ico hxy hmn

theorem geom_sum_Ico [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ n - x ^ m) / (x - 1) :=
by simp only [sum_Ico_eq_sub _ hmn, (geom_sum_def _ _).symm, geom_sum_eq hx, div_sub_div_same,
  sub_sub_sub_cancel_right]

theorem geom_sum_Ico' [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
  ∑ i in finset.Ico m n, x ^ i = (x ^ m - x ^ n) / (1 - x) :=
by { simp only [geom_sum_Ico hx hmn], convert neg_div_neg_eq (x^m - x^n) (1-x); abel }

lemma geom_sum_inv [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
  (geom_sum x⁻¹ n) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) :=
have h₁ : x⁻¹ ≠ 1, by rwa [inv_eq_one_div, ne.def, div_eq_iff_mul_eq hx0, one_mul],
have h₂ : x⁻¹ - 1 ≠ 0, from mt sub_eq_zero.1 h₁,
have h₃ : x - 1 ≠ 0, from mt sub_eq_zero.1 hx1,
have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x :=
  nat.rec_on n (by simp)
  (λ n h, by rw [pow_succ, mul_inv_rev', ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc,
    inv_mul_cancel hx0]),
begin
  rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃,
    ← mul_assoc, ← mul_assoc, mul_inv_cancel h₃],
  simp [mul_add, add_mul, mul_inv_cancel hx0, mul_assoc, h₄, sub_eq_add_neg, add_comm,
    add_left_comm],
end

variables {β : Type*}

theorem ring_hom.map_geom_sum [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) :
  f (geom_sum x n) = geom_sum (f x) n :=
by simp [geom_sum_def, f.map_sum]

theorem ring_hom.map_geom_sum₂ [semiring α] [semiring β] (x y : α) (n : ℕ) (f : α →+* β) :
  f (geom_sum₂ x y n) = geom_sum₂ (f x) (f y) n :=
by simp [geom_sum₂_def, f.map_sum]


import mynat.definition
import mynat.mul
import world2.level2

namespace mynat

lemma mul_add (t a b : mynat) : t * (a + b) = t * a + t * b :=
begin [nat_num_game]
    induction b with d hd,
    {
        rw add_zero,
        rw mul_zero,
        rw add_zero,
        refl,
    },
    {
        rw add_succ,
        rw mul_succ,
        rw hd,
        rw mul_succ,
        rw add_assoc,
        refl,
    },
end

end mynat


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

import tactic.basic

open tactic

-- `suggest` fails if there are no goals.
example : true :=
begin
  trivial,
  success_if_fail { suggest },
end

example (a : Prop) : a ∨ true :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"), exact or.inr trivial,
end

example {a a' : ℕ} (h : a == a') : a = a' :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact eq_of_heq h"), exact eq_of_heq h,
end
example {a b c : ℤ} (h₁ : a = b) (h₂ : b = c) : a = c :=
begin
  (do s ← suggest_scripts, guard $ "Try this: exact eq.trans h₁ h₂" ∈ s), exact eq.trans h₁ h₂,
end

example (n : nat) : n + 0 = n :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact rfl"), exact rfl,
end

example (n : nat) : n < n + 1 :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact nat.lt.base n"),
  exact nat.lt.base n
end
example (n : nat) : n < n + 2 :=
begin
  (do s ← suggest_scripts, guard $ "Try this: refine nat.lt.step _" ∈ s),
  refine nat.lt.step _, -- this wasn't the first result; humans still necessary :-(
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact nat.lt.base n"),
  exact nat.lt.base n
end

example (a b : Prop) : (a ∨ true) ∧ (b ∨ true) :=
begin
  (do s ← suggest_scripts, guard $ "Try this: refine ⟨_, _⟩" ∈ s),
  refine ⟨_, _⟩, -- wasn't the first result, because it created two new goals
  { (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"),
    exact or.inr trivial },
  { (do s ← suggest_scripts, guard $ s.head = "Try this: exact or.inr trivial"),
    exact or.inr trivial },
end

example (A B : Prop) (a : A) (b : unit → B) : A ∧ B :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: refine ⟨a, _⟩"),
  refine ⟨a, _⟩,
  replace b := b (),
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact b"),
  exact b,
end

example {a b c : ℕ} (h₁ : a ≤ b) (h₂ : b ≤ c) : a ≤ c :=
begin
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact le_trans h₁ h₂"),
  exact le_trans h₁ h₂
end

-- Verify that `suggest` focuses on the first goal when there are multiple goals.
example (a b c d e f : ℕ) (hab : a ≤ b) (hbc : b ≤ c) (hde : d ≤ e) (hef : e ≤ f) :
  a ≤ c ∧ d ≤ f :=
begin
  split,
  (do s ← suggest_scripts, guard $ s.head = "Try this: exact le_trans hab hbc"),
  exact le_trans hab hbc,
  exact le_trans hde hef
end


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Bryan Gin-ge Chen, Yaël Dillies
-/

import order.boolean_algebra
import logic.equiv.basic

/-!
# Symmetric difference and bi-implication

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

This file defines the symmetric difference and bi-implication operators in (co-)Heyting algebras.

## Examples

Some examples are
* The symmetric difference of two sets is the set of elements that are in either but not both.
* The symmetric difference on propositions is `xor`.
* The symmetric difference on `bool` is `bxor`.
* The equivalence of propositions. Two propositions are equivalent if they imply each other.
* The symmetric difference translates to addition when considering a Boolean algebra as a Boolean
  ring.

## Main declarations

* `symm_diff`: The symmetric difference operator, defined as `(a \ b) ⊔ (b \ a)`
* `bihimp`: The bi-implication operator, defined as `(b ⇨ a) ⊓ (a ⇨ b)`

In generalized Boolean algebras, the symmetric difference operator is:

* `symm_diff_comm`: commutative, and
* `symm_diff_assoc`: associative.

## Notations

* `a ∆ b`: `symm_diff a b`
* `a ⇔ b`: `bihimp a b`

## References

The proof of associativity follows the note "Associativity of the Symmetric Difference of Sets: A
Proof from the Book" by John McCuan:

* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

## Tags

boolean ring, generalized boolean algebra, boolean algebra, symmetric difference, bi-implication,
Heyting
-/

open function order_dual

variables {ι α β : Type*} {π : ι → Type*}

/-- The symmetric difference operator on a type with `⊔` and `\` is `(A \ B) ⊔ (B \ A)`. -/
def symm_diff [has_sup α] [has_sdiff α] (a b : α) : α := a \ b ⊔ b \ a

/-- The Heyting bi-implication is `(b ⇨ a) ⊓ (a ⇨ b)`. This generalizes equivalence of
propositions. -/
def bihimp [has_inf α] [has_himp α] (a b : α) : α := (b ⇨ a) ⊓ (a ⇨ b)

/- This notation might conflict with the Laplacian once we have it. Feel free to put it in locale
`order` or `symm_diff` if that happens. -/
infix ` ∆ `:100 := symm_diff
infix ` ⇔ `:100 := bihimp

lemma symm_diff_def [has_sup α] [has_sdiff α] (a b : α) : a ∆ b = (a \ b) ⊔ (b \ a) := rfl
lemma bihimp_def [has_inf α] [has_himp α] (a b : α) : a ⇔ b = (b ⇨ a) ⊓ (a ⇨ b):= rfl

lemma symm_diff_eq_xor (p q : Prop) : p ∆ q = xor p q := rfl
@[simp] lemma bihimp_iff_iff {p q : Prop} : p ⇔ q ↔ (p ↔ q) :=
(iff_iff_implies_and_implies _ _).symm.trans iff.comm

@[simp] lemma bool.symm_diff_eq_bxor : ∀ p q : bool, p ∆ q = bxor p q := dec_trivial

section generalized_coheyting_algebra
variables [generalized_coheyting_algebra α] (a b c d : α)

@[simp] lemma to_dual_symm_diff : to_dual (a ∆ b) = to_dual a ⇔ to_dual b := rfl
@[simp] lemma of_dual_bihimp (a b : αᵒᵈ) : of_dual (a ⇔ b) = of_dual a ∆ of_dual b := rfl

lemma symm_diff_comm : a ∆ b = b ∆ a := by simp only [(∆), sup_comm]

instance symm_diff_is_comm : is_commutative α (∆) := ⟨symm_diff_comm⟩

@[simp] lemma symm_diff_self : a ∆ a = ⊥ := by rw [(∆), sup_idem, sdiff_self]
@[simp] lemma symm_diff_bot : a ∆ ⊥ = a := by rw [(∆), sdiff_bot, bot_sdiff, sup_bot_eq]
@[simp] lemma bot_symm_diff : ⊥ ∆ a = a := by rw [symm_diff_comm, symm_diff_bot]

@[simp] lemma symm_diff_eq_bot {a b : α} : a ∆ b = ⊥ ↔ a = b :=
by simp_rw [symm_diff, sup_eq_bot_iff, sdiff_eq_bot_iff, le_antisymm_iff]

lemma symm_diff_of_le {a b : α} (h : a ≤ b) : a ∆ b = b \ a :=
by rw [symm_diff, sdiff_eq_bot_iff.2 h, bot_sup_eq]

lemma symm_diff_of_ge {a b : α} (h : b ≤ a) : a ∆ b = a \ b :=
by rw [symm_diff, sdiff_eq_bot_iff.2 h, sup_bot_eq]

lemma symm_diff_le {a b c : α} (ha : a ≤ b ⊔ c) (hb : b ≤ a ⊔ c) : a ∆ b ≤ c :=
sup_le (sdiff_le_iff.2 ha) $ sdiff_le_iff.2 hb

lemma symm_diff_le_iff {a b c : α} : a ∆ b ≤ c ↔ a ≤ b ⊔ c ∧ b ≤ a ⊔ c :=
by simp_rw [symm_diff, sup_le_iff, sdiff_le_iff]

@[simp] lemma symm_diff_le_sup {a b : α} : a ∆ b ≤ a ⊔ b := sup_le_sup sdiff_le sdiff_le

lemma symm_diff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) := by simp [sup_sdiff, symm_diff]

lemma disjoint.symm_diff_eq_sup {a b : α} (h : disjoint a b) : a ∆ b = a ⊔ b :=
by rw [(∆), h.sdiff_eq_left, h.sdiff_eq_right]

lemma symm_diff_sdiff : (a ∆ b) \ c = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) :=
by rw [symm_diff, sup_sdiff_distrib, sdiff_sdiff_left, sdiff_sdiff_left]

@[simp] lemma symm_diff_sdiff_inf : a ∆ b \ (a ⊓ b) = a ∆ b :=
by { rw symm_diff_sdiff, simp [symm_diff] }

@[simp] lemma symm_diff_sdiff_eq_sup : a ∆ (b \ a) = a ⊔ b :=
begin
  rw [symm_diff, sdiff_idem],
  exact le_antisymm (sup_le_sup sdiff_le sdiff_le)
    (sup_le le_sdiff_sup $ le_sdiff_sup.trans $ sup_le le_sup_right le_sdiff_sup),
end

@[simp] lemma sdiff_symm_diff_eq_sup : (a \ b) ∆ b = a ⊔ b :=
by rw [symm_diff_comm, symm_diff_sdiff_eq_sup, sup_comm]

@[simp] lemma symm_diff_sup_inf : a ∆ b ⊔ a ⊓ b = a ⊔ b :=
begin
  refine le_antisymm (sup_le symm_diff_le_sup inf_le_sup) _,
  rw [sup_inf_left, symm_diff],
  refine sup_le (le_inf le_sup_right _) (le_inf _ le_sup_right),
  { rw sup_right_comm,
    exact le_sup_of_le_left le_sdiff_sup },
  { rw sup_assoc,
    exact le_sup_of_le_right le_sdiff_sup }
end

@[simp] lemma inf_sup_symm_diff : a ⊓ b ⊔ a ∆ b = a ⊔ b := by rw [sup_comm, symm_diff_sup_inf]

@[simp] lemma symm_diff_symm_diff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b :=
by rw [←symm_diff_sdiff_inf a, sdiff_symm_diff_eq_sup, symm_diff_sup_inf]

@[simp] lemma inf_symm_diff_symm_diff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b :=
by rw [symm_diff_comm, symm_diff_symm_diff_inf]

lemma symm_diff_triangle : a ∆ c ≤ a ∆ b ⊔ b ∆ c :=
begin
  refine (sup_le_sup (sdiff_triangle a b c) $ sdiff_triangle _ b _).trans_eq _,
  rw [@sup_comm _ _ (c \ b), sup_sup_sup_comm, symm_diff, symm_diff],
end

end generalized_coheyting_algebra

section generalized_heyting_algebra
variables [generalized_heyting_algebra α] (a b c d : α)

@[simp] lemma to_dual_bihimp : to_dual (a ⇔ b) = to_dual a ∆ to_dual b := rfl
@[simp] lemma of_dual_symm_diff (a b : αᵒᵈ) : of_dual (a ∆ b) = of_dual a ⇔ of_dual b := rfl

lemma bihimp_comm : a ⇔ b = b ⇔ a := by simp only [(⇔), inf_comm]

instance bihimp_is_comm : is_commutative α (⇔) := ⟨bihimp_comm⟩

@[simp] lemma bihimp_self : a ⇔ a = ⊤ := by rw [(⇔), inf_idem, himp_self]
@[simp] lemma bihimp_top : a ⇔ ⊤ = a := by rw [(⇔), himp_top, top_himp, inf_top_eq]
@[simp] lemma top_bihimp : ⊤ ⇔ a = a := by rw [bihimp_comm, bihimp_top]

@[simp] lemma bihimp_eq_top {a b : α} : a ⇔ b = ⊤ ↔ a = b := @symm_diff_eq_bot αᵒᵈ _ _ _

lemma bihimp_of_le {a b : α} (h : a ≤ b) : a ⇔ b = b ⇨ a :=
by rw [bihimp, himp_eq_top_iff.2 h, inf_top_eq]

lemma bihimp_of_ge {a b : α} (h : b ≤ a) : a ⇔ b = a ⇨ b :=
by rw [bihimp, himp_eq_top_iff.2 h, top_inf_eq]

lemma le_bihimp {a b c : α} (hb : a ⊓ b ≤ c) (hc : a ⊓ c ≤ b) : a ≤ b ⇔ c :=
le_inf (le_himp_iff.2 hc) $ le_himp_iff.2 hb

lemma le_bihimp_iff {a b c : α} : a ≤ b ⇔ c ↔ a ⊓ b ≤ c ∧ a ⊓ c ≤ b :=
by simp_rw [bihimp, le_inf_iff, le_himp_iff, and.comm]

@[simp] lemma inf_le_bihimp {a b : α} : a ⊓ b ≤ a ⇔ b := inf_le_inf le_himp le_himp

lemma bihimp_eq_inf_himp_inf : a ⇔ b = (a ⊔ b) ⇨ (a ⊓ b) := by simp [himp_inf_distrib, bihimp]

lemma codisjoint.bihimp_eq_inf {a b : α} (h : codisjoint a b) : a ⇔ b = a ⊓ b :=
by rw [(⇔), h.himp_eq_left, h.himp_eq_right]

lemma himp_bihimp : a ⇨ (b ⇔ c) = ((a ⊓ c) ⇨ b) ⊓ ((a ⊓ b) ⇨ c) :=
by rw [bihimp, himp_inf_distrib, himp_himp, himp_himp]

@[simp] lemma sup_himp_bihimp : (a ⊔ b) ⇨ (a ⇔ b) = a ⇔ b :=
by { rw himp_bihimp, simp [bihimp] }

@[simp] lemma bihimp_himp_eq_inf : a ⇔ (a ⇨ b) = a ⊓ b := @symm_diff_sdiff_eq_sup αᵒᵈ _ _ _
@[simp] lemma himp_bihimp_eq_inf : (b ⇨ a) ⇔ b = a ⊓ b := @sdiff_symm_diff_eq_sup αᵒᵈ _ _ _

@[simp] lemma bihimp_inf_sup : a ⇔ b ⊓ (a ⊔ b) = a ⊓ b := @symm_diff_sup_inf αᵒᵈ _ _ _
@[simp] lemma sup_inf_bihimp : (a ⊔ b) ⊓ a ⇔ b = a ⊓ b := @inf_sup_symm_diff αᵒᵈ _ _ _

@[simp] lemma bihimp_bihimp_sup : a ⇔ b ⇔ (a ⊔ b) = a ⊓ b := @symm_diff_symm_diff_inf αᵒᵈ _ _ _
@[simp] lemma sup_bihimp_bihimp : (a ⊔ b) ⇔ (a ⇔ b) = a ⊓ b := @inf_symm_diff_symm_diff αᵒᵈ _ _ _

lemma bihimp_triangle : a ⇔ b ⊓ b ⇔ c ≤ a ⇔ c := @symm_diff_triangle αᵒᵈ _ _ _ _

end generalized_heyting_algebra

section coheyting_algebra
variables [coheyting_algebra α] (a : α)

@[simp] lemma symm_diff_top' : a ∆ ⊤ = ￢a := by simp [symm_diff]
@[simp] lemma top_symm_diff' : ⊤ ∆ a = ￢a := by simp [symm_diff]

@[simp] lemma hnot_symm_diff_self : (￢a) ∆ a = ⊤ :=
begin
  rw [eq_top_iff, symm_diff, hnot_sdiff, sup_sdiff_self],
  exact codisjoint.top_le codisjoint_hnot_left
end

@[simp] lemma symm_diff_hnot_self : a ∆ ￢a = ⊤ := by rw [symm_diff_comm, hnot_symm_diff_self]

lemma is_compl.symm_diff_eq_top {a b : α} (h : is_compl a b) : a ∆ b = ⊤ :=
by rw [h.eq_hnot, hnot_symm_diff_self]

end coheyting_algebra

section heyting_algebra
variables [heyting_algebra α] (a : α)

@[simp] lemma bihimp_bot : a ⇔ ⊥ = aᶜ := by simp [bihimp]
@[simp] lemma bot_bihimp : ⊥ ⇔ a = aᶜ := by simp [bihimp]

@[simp] lemma compl_bihimp_self : aᶜ ⇔ a = ⊥ := @hnot_symm_diff_self αᵒᵈ _ _
@[simp] lemma bihimp_hnot_self : a ⇔ aᶜ = ⊥ := @symm_diff_hnot_self αᵒᵈ _ _

lemma is_compl.bihimp_eq_bot {a b : α} (h : is_compl a b) : a ⇔ b = ⊥ :=
by rw [h.eq_compl, compl_bihimp_self]

end heyting_algebra

section generalized_boolean_algebra
variables [generalized_boolean_algebra α] (a b c d : α)

@[simp] lemma sup_sdiff_symm_diff : (a ⊔ b) \ (a ∆ b) = a ⊓ b :=
sdiff_eq_symm inf_le_sup (by rw symm_diff_eq_sup_sdiff_inf)

lemma disjoint_symm_diff_inf : disjoint (a ∆ b) (a ⊓ b) :=
begin
  rw [symm_diff_eq_sup_sdiff_inf],
  exact disjoint_sdiff_self_left,
end

lemma inf_symm_diff_distrib_left : a ⊓ (b ∆ c) = (a ⊓ b) ∆ (a ⊓ c) :=
by rw [symm_diff_eq_sup_sdiff_inf, inf_sdiff_distrib_left, inf_sup_left, inf_inf_distrib_left,
  symm_diff_eq_sup_sdiff_inf]

lemma inf_symm_diff_distrib_right : (a ∆ b) ⊓ c = (a ⊓ c) ∆ (b ⊓ c) :=
by simp_rw [@inf_comm _ _ _ c, inf_symm_diff_distrib_left]

lemma sdiff_symm_diff : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ ((c \ a) ⊓ (c \ b)) :=
by simp only [(∆), sdiff_sdiff_sup_sdiff']

lemma sdiff_symm_diff' : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ (c \ (a ⊔ b)) :=
by rw [sdiff_symm_diff, sdiff_sup, sup_comm]

@[simp] lemma symm_diff_sdiff_left : (a ∆ b) \ a = b \ a :=
by rw [symm_diff_def, sup_sdiff, sdiff_idem, sdiff_sdiff_self, bot_sup_eq]

@[simp] lemma symm_diff_sdiff_right : (a ∆ b) \ b = a \ b :=
by rw [symm_diff_comm, symm_diff_sdiff_left]

@[simp] lemma sdiff_symm_diff_left : a \ (a ∆ b) = a ⊓ b := by simp [sdiff_symm_diff]
@[simp] lemma sdiff_symm_diff_right : b \ (a ∆ b) = a ⊓ b :=
by rw [symm_diff_comm, inf_comm, sdiff_symm_diff_left]

lemma symm_diff_eq_sup : a ∆ b = a ⊔ b ↔ disjoint a b :=
begin
  refine ⟨λ h, _, disjoint.symm_diff_eq_sup⟩,
  rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h,
  exact h.of_disjoint_inf_of_le le_sup_left,
end

@[simp] lemma le_symm_diff_iff_left : a ≤ a ∆ b ↔ disjoint a b :=
begin
  refine ⟨λ h, _, λ h, h.symm_diff_eq_sup.symm ▸ le_sup_left⟩,
  rw symm_diff_eq_sup_sdiff_inf at h,
  exact disjoint_iff_inf_le.mpr (le_sdiff_iff.1 $ inf_le_of_left_le h).le,
end

@[simp] lemma le_symm_diff_iff_right : b ≤ a ∆ b ↔ disjoint a b :=
by rw [symm_diff_comm, le_symm_diff_iff_left, disjoint.comm]

lemma symm_diff_symm_diff_left :
  a ∆ b ∆ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ b ∆ c = ((a ∆ b) \ c) ⊔ (c \ (a ∆ b))   : symm_diff_def _ _
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   ((c \ (a ⊔ b)) ⊔ (c ⊓ a ⊓ b)) :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (c ⊓ a ⊓ b), symm_diff_sdiff]
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

lemma symm_diff_symm_diff_right :
  a ∆ (b ∆ c) = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ (b ∆ c) = (a \ (b ∆ c)) ⊔ ((b ∆ c) \ a) : symm_diff_def _ _
             ... = (a \ (b ⊔ c)) ⊔ (a ⊓ b ⊓ c) ⊔
                     (b \ (c ⊔ a) ⊔ c \ (b ⊔ a))   :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (a ⊓ b ⊓ c), symm_diff_sdiff]
             ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                     (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

lemma symm_diff_assoc : a ∆ b ∆ c = a ∆ (b ∆ c) :=
by rw [symm_diff_symm_diff_left, symm_diff_symm_diff_right]

instance symm_diff_is_assoc : is_associative α (∆) := ⟨symm_diff_assoc⟩

lemma symm_diff_left_comm : a ∆ (b ∆ c) = b ∆ (a ∆ c) :=
by simp_rw [←symm_diff_assoc, symm_diff_comm]

lemma symm_diff_right_comm : a ∆ b ∆ c = a ∆ c ∆ b := by simp_rw [symm_diff_assoc, symm_diff_comm]

lemma symm_diff_symm_diff_symm_diff_comm : (a ∆ b) ∆ (c ∆ d) = (a ∆ c) ∆ (b ∆ d) :=
by simp_rw [symm_diff_assoc, symm_diff_left_comm]

@[simp] lemma symm_diff_symm_diff_cancel_left : a ∆ (a ∆ b) = b := by simp [←symm_diff_assoc]
@[simp] lemma symm_diff_symm_diff_cancel_right : b ∆ a ∆ a = b := by simp [symm_diff_assoc]

@[simp] lemma symm_diff_symm_diff_self' : a ∆ b ∆ a = b :=
by rw [symm_diff_comm,symm_diff_symm_diff_cancel_left]

lemma symm_diff_left_involutive (a : α) : involutive (∆ a) := symm_diff_symm_diff_cancel_right _
lemma symm_diff_right_involutive (a : α) : involutive ((∆) a) := symm_diff_symm_diff_cancel_left _
lemma symm_diff_left_injective (a : α) : injective (∆ a) := (symm_diff_left_involutive _).injective
lemma symm_diff_right_injective (a : α) : injective ((∆) a) :=
(symm_diff_right_involutive _).injective
lemma symm_diff_left_surjective (a : α) : surjective (∆ a) :=
(symm_diff_left_involutive _).surjective
lemma symm_diff_right_surjective (a : α) : surjective ((∆) a) :=
(symm_diff_right_involutive _).surjective

variables {a b c}

@[simp] lemma symm_diff_left_inj : a ∆ b = c ∆ b ↔ a = c := (symm_diff_left_injective _).eq_iff
@[simp] lemma symm_diff_right_inj : a ∆ b = a ∆ c ↔ b = c := (symm_diff_right_injective _).eq_iff

@[simp] lemma symm_diff_eq_left : a ∆ b = a ↔ b = ⊥ :=
calc a ∆ b = a ↔ a ∆ b = a ∆ ⊥ : by rw symm_diff_bot
           ... ↔     b = ⊥     : by rw symm_diff_right_inj

@[simp] lemma symm_diff_eq_right : a ∆ b = b ↔ a = ⊥ := by rw [symm_diff_comm, symm_diff_eq_left]

protected lemma disjoint.symm_diff_left (ha : disjoint a c) (hb : disjoint b c) :
  disjoint (a ∆ b) c :=
by { rw symm_diff_eq_sup_sdiff_inf, exact (ha.sup_left hb).disjoint_sdiff_left }

protected lemma disjoint.symm_diff_right (ha : disjoint a b) (hb : disjoint a c) :
  disjoint a (b ∆ c) :=
(ha.symm.symm_diff_left hb.symm).symm

lemma symm_diff_eq_iff_sdiff_eq (ha : a ≤ c) : a ∆ b = c ↔ c \ a = b :=
begin
  rw ←symm_diff_of_le ha,
  exact ((symm_diff_right_involutive a).to_perm _).apply_eq_iff_eq_symm_apply.trans eq_comm,
end

end generalized_boolean_algebra

section boolean_algebra
variables [boolean_algebra α] (a b c d : α)

/- `cogeneralized_boolean_algebra` isn't actually a typeclass, but the lemmas in here are dual to
the `generalized_boolean_algebra` ones -/
section cogeneralized_boolean_algebra

@[simp] lemma inf_himp_bihimp : (a ⇔ b) ⇨ (a ⊓ b) = a ⊔ b := @sup_sdiff_symm_diff αᵒᵈ _ _ _

lemma codisjoint_bihimp_sup : codisjoint (a ⇔ b) (a ⊔ b) := @disjoint_symm_diff_inf αᵒᵈ _ _ _

@[simp] lemma himp_bihimp_left : a ⇨ (a ⇔ b) = a ⇨ b := @symm_diff_sdiff_left αᵒᵈ _ _ _
@[simp] lemma himp_bihimp_right : b ⇨ (a ⇔ b) = b ⇨ a := @symm_diff_sdiff_right αᵒᵈ _ _ _

@[simp] lemma bihimp_himp_left : (a ⇔ b) ⇨ a = a ⊔ b := @sdiff_symm_diff_left αᵒᵈ _ _ _
@[simp] lemma bihimp_himp_right : (a ⇔ b) ⇨ b = a ⊔ b := @sdiff_symm_diff_right αᵒᵈ _ _ _

@[simp]

@[simp] lemma bihimp_le_iff_left : a ⇔ b ≤ a ↔ codisjoint a b := @le_symm_diff_iff_left αᵒᵈ _ _ _
@[simp] lemma bihimp_le_iff_right : a ⇔ b ≤ b ↔ codisjoint a b := @le_symm_diff_iff_right αᵒᵈ _ _ _

lemma bihimp_assoc : a ⇔ b ⇔ c = a ⇔ (b ⇔ c) := @symm_diff_assoc αᵒᵈ _ _ _ _

instance bihimp_is_assoc : is_associative α (⇔) := ⟨bihimp_assoc⟩

lemma bihimp_left_comm : a ⇔ (b ⇔ c) = b ⇔ (a ⇔ c) := by simp_rw [←bihimp_assoc, bihimp_comm]
lemma bihimp_right_comm : a ⇔ b ⇔ c = a ⇔ c ⇔ b := by simp_rw [bihimp_assoc, bihimp_comm]

lemma bihimp_bihimp_bihimp_comm : (a ⇔ b) ⇔ (c ⇔ d) = (a ⇔ c) ⇔ (b ⇔ d) :=
by simp_rw [bihimp_assoc, bihimp_left_comm]

@[simp] lemma bihimp_bihimp_cancel_left : a ⇔ (a ⇔ b) = b := by simp [←bihimp_assoc]
@[simp] lemma bihimp_bihimp_cancel_right : b ⇔ a ⇔ a = b := by simp [bihimp_assoc]

@[simp] lemma bihimp_bihimp_self : a ⇔ b ⇔ a = b := by rw [bihimp_comm, bihimp_bihimp_cancel_left]

lemma bihimp_left_involutive (a : α) : involutive (⇔ a) := bihimp_bihimp_cancel_right _
lemma bihimp_right_involutive (a : α) : involutive ((⇔) a) := bihimp_bihimp_cancel_left _
lemma bihimp_left_injective (a : α) : injective (⇔ a) := @symm_diff_left_injective αᵒᵈ  _ _
lemma bihimp_right_injective (a : α) : injective ((⇔) a) := @symm_diff_right_injective αᵒᵈ  _ _
lemma bihimp_left_surjective (a : α) : surjective (⇔ a) := @symm_diff_left_surjective αᵒᵈ  _ _
lemma bihimp_right_surjective (a : α) : surjective ((⇔) a) := @symm_diff_right_surjective αᵒᵈ  _ _

variables {a b c}

@[simp] lemma bihimp_left_inj : a ⇔ b = c ⇔ b ↔ a = c := (bihimp_left_injective _).eq_iff
@[simp] lemma bihimp_right_inj : a ⇔ b = a ⇔ c ↔ b = c := (bihimp_right_injective _).eq_iff

@[simp] lemma bihimp_eq_left : a ⇔ b = a ↔ b = ⊤ := @symm_diff_eq_left αᵒᵈ _ _ _
@[simp] lemma bihimp_eq_right : a ⇔ b = b ↔ a = ⊤ := @symm_diff_eq_right αᵒᵈ _ _ _

protected lemma codisjoint.bihimp_left (ha : codisjoint a c) (hb : codisjoint b c) :
  codisjoint (a ⇔ b) c :=
(ha.inf_left hb).mono_left inf_le_bihimp

protected lemma codisjoint.bihimp_right (ha : codisjoint a b) (hb : codisjoint a c) :
  codisjoint a (b ⇔ c) :=
(ha.inf_right hb).mono_right inf_le_bihimp

end cogeneralized_boolean_algebra

lemma symm_diff_eq : a ∆ b = (a ⊓ bᶜ) ⊔ (b ⊓ aᶜ) := by simp only [(∆), sdiff_eq]
lemma bihimp_eq : a ⇔ b = (a ⊔ bᶜ) ⊓ (b ⊔ aᶜ) := by simp only [(⇔), himp_eq]

lemma symm_diff_eq' : a ∆ b = (a ⊔ b) ⊓ (aᶜ ⊔ bᶜ) :=
by rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq, compl_inf]

lemma bihimp_eq' : a ⇔ b = (a ⊓ b) ⊔ (aᶜ ⊓ bᶜ) := @symm_diff_eq' αᵒᵈ _ _ _

lemma symm_diff_top : a ∆ ⊤ = aᶜ := symm_diff_top' _
lemma top_symm_diff : ⊤ ∆ a = aᶜ := top_symm_diff' _

@[simp] lemma compl_symm_diff : (a ∆ b)ᶜ = a ⇔ b :=
by simp_rw [symm_diff, compl_sup_distrib, compl_sdiff, bihimp, inf_comm]

@[simp] lemma compl_bihimp : (a ⇔ b)ᶜ = a ∆ b := @compl_symm_diff αᵒᵈ _ _ _

@[simp] lemma compl_symm_diff_compl : aᶜ ∆ bᶜ = a ∆ b :=
sup_comm.trans $ by simp_rw [compl_sdiff_compl, sdiff_eq, symm_diff_eq]

@[simp] lemma compl_bihimp_compl : aᶜ ⇔ bᶜ = a ⇔ b := @compl_symm_diff_compl αᵒᵈ _ _ _

@[simp] lemma symm_diff_eq_top : a ∆ b = ⊤ ↔ is_compl a b :=
by rw [symm_diff_eq', ←compl_inf, inf_eq_top_iff, compl_eq_top, is_compl_iff, disjoint_iff,
 codisjoint_iff, and.comm]

@[simp] lemma bihimp_eq_bot : a ⇔ b = ⊥ ↔ is_compl a b :=
by rw [bihimp_eq', ←compl_sup, sup_eq_bot_iff, compl_eq_bot, is_compl_iff, disjoint_iff,
 codisjoint_iff]

@[simp] lemma compl_symm_diff_self : aᶜ ∆ a = ⊤ := hnot_symm_diff_self _
@[simp] lemma symm_diff_compl_self : a ∆ aᶜ = ⊤ := symm_diff_hnot_self _

lemma symm_diff_symm_diff_right' :
  a ∆ (b ∆ c) = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔ (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) :=
calc a ∆ (b ∆ c) = (a ⊓ ((b ⊓ c) ⊔ (bᶜ ⊓ cᶜ))) ⊔
                     (((b ⊓ cᶜ) ⊔ (c ⊓ bᶜ)) ⊓ aᶜ)  : by rw [symm_diff_eq, compl_symm_diff,
                                                           bihimp_eq', symm_diff_eq]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (b ⊓ cᶜ ⊓ aᶜ) ⊔ (c ⊓ bᶜ ⊓ aᶜ) : by rw [inf_sup_left, inf_sup_right,
                                                            ←sup_assoc, ←inf_assoc, ←inf_assoc]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) : begin
                                                       congr' 1,
                                                       { congr' 1,
                                                         rw [inf_comm, inf_assoc], },
                                                       { apply inf_left_right_swap }
                                                     end

variables {a b c}

lemma disjoint.le_symm_diff_sup_symm_diff_left (h : disjoint a b) : c ≤ a ∆ c ⊔ b ∆ c :=
begin
  transitivity c \ (a ⊓ b),
  { rw [h.eq_bot, sdiff_bot] },
  { rw sdiff_inf,
    exact sup_le_sup le_sup_right le_sup_right }
end

lemma disjoint.le_symm_diff_sup_symm_diff_right (h : disjoint b c) : a ≤ a ∆ b ⊔ a ∆ c :=
by { simp_rw symm_diff_comm a, exact h.le_symm_diff_sup_symm_diff_left }

lemma codisjoint.bihimp_inf_bihimp_le_left (h : codisjoint a b) : a ⇔ c ⊓ b ⇔ c ≤ c :=
h.dual.le_symm_diff_sup_symm_diff_left

lemma codisjoint.bihimp_inf_bihimp_le_right (h : codisjoint b c) : a ⇔ b ⊓ a ⇔ c ≤ a :=
h.dual.le_symm_diff_sup_symm_diff_right

end boolean_algebra

/-! ### Prod -/

section prod

@[simp] lemma symm_diff_fst [generalized_coheyting_algebra α] [generalized_coheyting_algebra β]
  (a b : α × β) :
  (a ∆ b).1 = a.1 ∆ b.1 := rfl
@[simp] lemma symm_diff_snd [generalized_coheyting_algebra α] [generalized_coheyting_algebra β]
  (a b : α × β) :
  (a ∆ b).2 = a.2 ∆ b.2 := rfl

@[simp] lemma bihimp_fst [generalized_heyting_algebra α] [generalized_heyting_algebra β]
  (a b : α × β) :
  (a ⇔ b).1 = a.1 ⇔ b.1 := rfl
@[simp] lemma bihimp_snd [generalized_heyting_algebra α] [generalized_heyting_algebra β]
  (a b : α × β) :
  (a ⇔ b).2 = a.2 ⇔ b.2 := rfl

end prod

/-! ### Pi -/

namespace pi

lemma symm_diff_def [Π i, generalized_coheyting_algebra (π i)] (a b : Π i, π i) :
  a ∆ b = λ i, a i ∆ b i := rfl

lemma bihimp_def [Π i, generalized_heyting_algebra (π i)] (a b : Π i, π i) :
  a ⇔ b = λ i, a i ⇔ b i := rfl

@[simp] lemma symm_diff_apply [Π i, generalized_coheyting_algebra (π i)] (a b : Π i, π i) (i : ι) :
  (a ∆ b) i = a i ∆ b i := rfl

@[simp] lemma bihimp_apply [Π i, generalized_heyting_algebra (π i)] (a b : Π i, π i) (i : ι) :
  (a ⇔ b) i = a i ⇔ b i := rfl

end pi