/-
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, Yaël Dillies

! This file was ported from Lean 3 source module order.disjointed
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.PartialSups

/-!
# Consecutive differences of sets

This file defines the way to make a sequence of elements into a sequence of disjoint elements with
the same partial sups.

For a sequence `f : ℕ → α`, this new sequence will be `f 0`, `f 1 \ f 0`, `f 2 \ (f 0 ⊔ f 1)`.
It is actually unique, as `disjointed_unique` shows.

## Main declarations

* `disjointed f`: The sequence `f 0`, `f 1 \ f 0`, `f 2 \ (f 0 ⊔ f 1)`, ....
* `partialSups_disjointed`: `disjointed f` has the same partial sups as `f`.
* `disjoint_disjointed`: The elements of `disjointed f` are pairwise disjoint.
* `disjointed_unique`: `disjointed f` is the only pairwise disjoint sequence having the same partial
  sups as `f`.
* `supᵢ_disjointed`: `disjointed f` has the same supremum as `f`. Limiting case of
  `partialSups_disjointed`.

We also provide set notation variants of some lemmas.

## TODO

Find a useful statement of `disjointedRec_succ`.

One could generalize `disjointed` to any locally finite bot preorder domain, in place of `ℕ`.
Related to the TODO in the module docstring of `Mathlib.Order.PartialSups`.
-/

variable {α β : Type _}

section GeneralizedBooleanAlgebra

variable [GeneralizedBooleanAlgebra α]

/-- If `f : ℕ → α` is a sequence of elements, then `disjointed f` is the sequence formed by
subtracting each element from the nexts. This is the unique disjoint sequence whose partial sups
are the same as the original sequence. -/
def disjointed (f : ℕ → α) : ℕ → α
  | 0 => f 0
  | n + 1 => f (n + 1) \ partialSups f n
#align disjointed disjointed

@[simp]
theorem disjointed_zero (f : ℕ → α) : disjointed f 0 = f 0 :=
  rfl
#align disjointed_zero disjointed_zero

theorem disjointed_succ (f : ℕ → α) (n : ℕ) : disjointed f (n + 1) = f (n + 1) \ partialSups f n :=
  rfl
#align disjointed_succ disjointed_succ

theorem disjointed_le_id : disjointed ≤ (id : (ℕ → α) → ℕ → α) := by
  rintro f n
  cases n
  · rfl
  · exact sdiff_le
#align disjointed_le_id disjointed_le_id

theorem disjointed_le (f : ℕ → α) : disjointed f ≤ f :=
  disjointed_le_id f
#align disjointed_le disjointed_le

theorem disjoint_disjointed (f : ℕ → α) : Pairwise (Disjoint on disjointed f) := by
  refine' (Symmetric.pairwise_on Disjoint.symm _).2 fun m n h => _
  cases n
  · exact (Nat.not_lt_zero _ h).elim
  exact
    disjoint_sdiff_self_right.mono_left
      ((disjointed_le f m).trans (le_partialSups_of_le f (Nat.lt_add_one_iff.1 h)))
#align disjoint_disjointed disjoint_disjointed

-- Porting note: `disjointedRec` had a change in universe level.
/-- An induction principle for `disjointed`. To define/prove something on `disjointed f n`, it's
enough to define/prove it for `f n` and being able to extend through diffs. -/
def disjointedRec {f : ℕ → α} {p : α → Sort _} (hdiff : ∀ ⦃t i⦄, p t → p (t \ f i)) :
    ∀ ⦃n⦄, p (f n) → p (disjointed f n)
  | 0 => id
  | n + 1 => fun h => by
    suffices H : ∀ k, p (f (n + 1) \ partialSups f k)
    · exact H n
    rintro k
    induction' k with k ih
    · exact hdiff h
    rw [partialSups_succ, ← sdiff_sdiff_left]
    exact hdiff ih
#align disjointed_rec disjointedRec

@[simp]
theorem disjointedRec_zero {f : ℕ → α} {p : α → Sort _} (hdiff : ∀ ⦃t i⦄, p t → p (t \ f i))
    (h₀ : p (f 0)) : disjointedRec hdiff h₀ = h₀ :=
  rfl
#align disjointed_rec_zero disjointedRec_zero

-- TODO: Find a useful statement of `disjointedRec_succ`.
theorem Monotone.disjointed_eq {f : ℕ → α} (hf : Monotone f) (n : ℕ) :
    disjointed f (n + 1) = f (n + 1) \ f n := by rw [disjointed_succ, hf.partialSups_eq]
#align monotone.disjointed_eq Monotone.disjointed_eq

@[simp]
theorem partialSups_disjointed (f : ℕ → α) : partialSups (disjointed f) = partialSups f := by
  ext n
  induction' n with k ih
  · rw [partialSups_zero, partialSups_zero, disjointed_zero]
  · rw [partialSups_succ, partialSups_succ, disjointed_succ, ih, sup_sdiff_self_right]
#align partial_sups_disjointed partialSups_disjointed

/-- `disjointed f` is the unique sequence that is pairwise disjoint and has the same partial sups
as `f`. -/
theorem disjointed_unique {f d : ℕ → α} (hdisj : Pairwise (Disjoint on d))
    (hsups : partialSups d = partialSups f) : d = disjointed f := by
  ext n
  cases' n with n
  · rw [← partialSups_zero d, hsups, partialSups_zero, disjointed_zero]
  suffices h : d n.succ = partialSups d n.succ \ partialSups d n
  · rw [h, hsups, partialSups_succ, disjointed_succ, sup_sdiff, sdiff_self, bot_sup_eq]
  rw [partialSups_succ, sup_sdiff, sdiff_self, bot_sup_eq, eq_comm, sdiff_eq_self_iff_disjoint]
  suffices h : ∀ m ≤ n, Disjoint (partialSups d m) (d n.succ)
  · exact h n le_rfl
  rintro m hm
  induction' m with m ih
  · exact hdisj (Nat.succ_ne_zero _).symm
  rw [partialSups_succ, disjoint_iff, inf_sup_right, sup_eq_bot_iff, ← disjoint_iff, ← disjoint_iff]
  exact ⟨ih (Nat.le_of_succ_le hm), hdisj (Nat.lt_succ_of_le hm).ne⟩
#align disjointed_unique disjointed_unique

end GeneralizedBooleanAlgebra

section CompleteBooleanAlgebra

variable [CompleteBooleanAlgebra α]

theorem supᵢ_disjointed (f : ℕ → α) : (⨆ n, disjointed f n) = ⨆ n, f n :=
  supᵢ_eq_supᵢ_of_partialSups_eq_partialSups (partialSups_disjointed f)
#align supr_disjointed supᵢ_disjointed

theorem disjointed_eq_inf_compl (f : ℕ → α) (n : ℕ) : disjointed f n = f n ⊓ ⨅ i < n, f iᶜ :=
  by
  cases n
  · rw [disjointed_zero, eq_comm, inf_eq_left]
    simp_rw [le_infᵢ_iff]
    exact fun i hi => (i.not_lt_zero hi).elim
  simp_rw [disjointed_succ, partialSups_eq_bsupᵢ, sdiff_eq, compl_supᵢ]
  congr
  ext i
  rw [Nat.lt_succ_iff]
#align disjointed_eq_inf_compl disjointed_eq_inf_compl

end CompleteBooleanAlgebra

/-! ### Set notation variants of lemmas -/

theorem disjointed_subset (f : ℕ → Set α) (n : ℕ) : disjointed f n ⊆ f n :=
  disjointed_le f n
#align disjointed_subset disjointed_subset

theorem unionᵢ_disjointed {f : ℕ → Set α} : (⋃ n, disjointed f n) = ⋃ n, f n :=
  supᵢ_disjointed f
#align Union_disjointed unionᵢ_disjointed

theorem disjointed_eq_inter_compl (f : ℕ → Set α) (n : ℕ) : disjointed f n = f n ∩ ⋂ i < n, f iᶜ :=
  disjointed_eq_inf_compl f n
#align disjointed_eq_inter_compl disjointed_eq_inter_compl

theorem preimage_find_eq_disjointed (s : ℕ → Set α) (H : ∀ x, ∃ n, x ∈ s n)
    [∀ x n, Decidable (x ∈ s n)] (n : ℕ) : (fun x => Nat.find (H x)) ⁻¹' {n} = disjointed s n :=
  by
  ext x
  simp [Nat.find_eq_iff, disjointed_eq_inter_compl]
#align preimage_find_eq_disjointed preimage_find_eq_disjointed


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

! This file was ported from Lean 3 source module ring_theory.coprime.ideal
! leanprover-community/mathlib commit 932872382355f00112641d305ba0619305dc8642
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Dfinsupp
import Mathbin.RingTheory.Ideal.Operations

/-!
# An additional lemma about coprime ideals

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

This lemma generalises `exists_sum_eq_one_iff_pairwise_coprime` to the case of non-principal ideals.
It is on a separate file due to import requirements.
-/

namespace Ideal

variable {ι R : Type _} [CommSemiring R]

/- warning: ideal.supr_infi_eq_top_iff_pairwise -> Ideal.supᵢ_infᵢ_eq_top_iff_pairwise is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {R : Type.{u2}} [_inst_1 : CommSemiring.{u2} R] {t : Finset.{u1} ι}, (Finset.Nonempty.{u1} ι t) -> (forall (I : ι -> (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))), Iff (Eq.{succ u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (supᵢ.{u2, succ u1} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (ConditionallyCompleteLattice.toHasSup.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (CompleteLattice.toConditionallyCompleteLattice.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.completeLattice.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))))) ι (fun (i : ι) => supᵢ.{u2, 0} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (ConditionallyCompleteLattice.toHasSup.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (CompleteLattice.toConditionallyCompleteLattice.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.completeLattice.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))))) (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i t) (fun (H : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) i t) => infᵢ.{u2, succ u1} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.hasInf.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))) ι (fun (j : ι) => infᵢ.{u2, 0} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.hasInf.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))) (Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) j t) (fun (hj : Membership.Mem.{u1, u1} ι (Finset.{u1} ι) (Finset.hasMem.{u1} ι) j t) => infᵢ.{u2, 0} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.hasInf.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))) (Ne.{succ u1} ι j i) (fun (ij : Ne.{succ u1} ι j i) => I j)))))) (Top.top.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.hasTop.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))))) (Set.Pairwise.{u1} ι ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} ι) (Set.{u1} ι) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} ι) (Set.{u1} ι) (Finset.Set.hasCoeT.{u1} ι))) t) (fun (i : ι) (j : ι) => Eq.{succ u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Sup.sup.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (SemilatticeSup.toHasSup.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (IdemSemiring.toSemilatticeSup.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.idemSemiring.{u2, u2} R _inst_1 R (CommSemiring.toSemiring.{u2} R _inst_1) (Algebra.id.{u2} R _inst_1)))) (I i) (I j)) (Top.top.{u2} (Ideal.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Submodule.hasTop.{u2, u2} R R (CommSemiring.toSemiring.{u2} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u2} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Semiring.toModule.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))))))
but is expected to have type
  forall {ι : Type.{u2}} {R : Type.{u1}} [_inst_1 : CommSemiring.{u1} R] {t : Finset.{u2} ι}, (Finset.Nonempty.{u2} ι t) -> (forall (I : ι -> (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))), Iff (Eq.{succ u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (supᵢ.{u1, succ u2} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (ConditionallyCompleteLattice.toSupSet.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (CompleteLattice.toConditionallyCompleteLattice.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.completeLattice.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) ι (fun (i : ι) => supᵢ.{u1, 0} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (ConditionallyCompleteLattice.toSupSet.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (CompleteLattice.toConditionallyCompleteLattice.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.completeLattice.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i t) (fun (H : Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) i t) => infᵢ.{u1, succ u2} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.instInfSetSubmodule.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))) ι (fun (j : ι) => infᵢ.{u1, 0} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.instInfSetSubmodule.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))) (Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) j t) (fun (hj : Membership.mem.{u2, u2} ι (Finset.{u2} ι) (Finset.instMembershipFinset.{u2} ι) j t) => infᵢ.{u1, 0} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.instInfSetSubmodule.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))) (Ne.{succ u2} ι j i) (fun (ij : Ne.{succ u2} ι j i) => I j)))))) (Top.top.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.instTopSubmodule.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))))) (Set.Pairwise.{u2} ι (Finset.toSet.{u2} ι t) (fun (i : ι) (j : ι) => Eq.{succ u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Sup.sup.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (SemilatticeSup.toSup.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (IdemCommSemiring.toSemilatticeSup.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Ideal.instIdemCommSemiringIdealToSemiring.{u1} R _inst_1))) (I i) (I j)) (Top.top.{u1} (Ideal.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Submodule.instTopSubmodule.{u1, u1} R R (CommSemiring.toSemiring.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))))))
Case conversion may be inaccurate. Consider using '#align ideal.supr_infi_eq_top_iff_pairwise Ideal.supᵢ_infᵢ_eq_top_iff_pairwiseₓ'. -/
/-- A finite family of ideals is pairwise coprime (that is, any two of them generate the whole ring)
iff when taking all the possible intersections of all but one of these ideals, the resulting family
of ideals still generate the whole ring.

For example with three ideals : `I ⊔ J = I ⊔ K = J ⊔ K = ⊤ ↔ (I ⊓ J) ⊔ (I ⊓ K) ⊔ (J ⊓ K) = ⊤`.

When ideals are all of the form `I i = R ∙ s i`, this is equivalent to the
`exists_sum_eq_one_iff_pairwise_coprime` lemma.-/
theorem supᵢ_infᵢ_eq_top_iff_pairwise {t : Finset ι} (h : t.Nonempty) (I : ι → Ideal R) :
    (⨆ i ∈ t, ⨅ (j) (hj : j ∈ t) (ij : j ≠ i), I j) = ⊤ ↔
      (t : Set ι).Pairwise fun i j => I i ⊔ I j = ⊤ :=
  by
  haveI : DecidableEq ι := Classical.decEq ι
  rw [eq_top_iff_one, Submodule.mem_supᵢ_finset_iff_exists_sum]
  refine' h.cons_induction _ _ <;> clear t h
  · simp only [Finset.sum_singleton, Finset.coe_singleton, Set.pairwise_singleton, iff_true_iff]
    refine' fun a => ⟨fun i => if h : i = a then ⟨1, _⟩ else 0, _⟩
    · rw [h]
      simp only [Finset.mem_singleton, Ne.def, infᵢ_infᵢ_eq_left, eq_self_iff_true, not_true,
        infᵢ_false]
    · simp only [dif_pos, dif_ctx_congr, Submodule.coe_mk, eq_self_iff_true]
  intro a t hat h ih
  rw [Finset.coe_cons,
    Set.pairwise_insert_of_symmetric fun i j (h : I i ⊔ I j = ⊤) => sup_comm.trans h]
  constructor
  · rintro ⟨μ, hμ⟩
    rw [Finset.sum_cons] at hμ
    refine' ⟨ih.mp ⟨Pi.single h.some ⟨μ a, _⟩ + fun i => ⟨μ i, _⟩, _⟩, fun b hb ab => _⟩
    · have := Submodule.coe_mem (μ a)
      rw [mem_infi] at this⊢
      --for some reason `simp only [mem_infi]` times out
      intro i
      specialize this i
      rw [mem_infi, mem_infi] at this⊢
      intro hi _
      apply this (Finset.subset_cons _ hi)
      rintro rfl
      exact hat hi
    · have := Submodule.coe_mem (μ i)
      simp only [mem_infi] at this⊢
      intro j hj ij
      exact this _ (Finset.subset_cons _ hj) ij
    · rw [← @if_pos _ _ h.some_spec R (μ a) 0, ← Finset.sum_pi_single', ← Finset.sum_add_distrib] at
        hμ
      convert hμ
      ext i
      rw [Pi.add_apply, Submodule.coe_add, Submodule.coe_mk]
      by_cases hi : i = h.some
      · rw [hi, Pi.single_eq_same, Pi.single_eq_same, Submodule.coe_mk]
      · rw [Pi.single_eq_of_ne hi, Pi.single_eq_of_ne hi, Submodule.coe_zero]
    · rw [eq_top_iff_one, Submodule.mem_sup]
      rw [add_comm] at hμ
      refine' ⟨_, _, _, _, hμ⟩
      · refine' sum_mem _ fun x hx => _
        have := Submodule.coe_mem (μ x)
        simp only [mem_infi] at this
        apply this _ (Finset.mem_cons_self _ _)
        rintro rfl
        exact hat hx
      · have := Submodule.coe_mem (μ a)
        simp only [mem_infi] at this
        exact this _ (Finset.subset_cons _ hb) ab.symm
  · rintro ⟨hs, Hb⟩
    obtain ⟨μ, hμ⟩ := ih.mpr hs
    have := sup_infi_eq_top fun b hb => Hb b hb (ne_of_mem_of_not_mem hb hat).symm
    rw [eq_top_iff_one, Submodule.mem_sup] at this
    obtain ⟨u, hu, v, hv, huv⟩ := this
    refine' ⟨fun i => if hi : i = a then ⟨v, _⟩ else ⟨u * μ i, _⟩, _⟩
    · simp only [mem_infi] at hv⊢
      intro j hj ij
      rw [Finset.mem_cons, ← hi] at hj
      exact hv _ (hj.resolve_left ij)
    · have := Submodule.coe_mem (μ i)
      simp only [mem_infi] at this⊢
      intro j hj ij
      rcases finset.mem_cons.mp hj with (rfl | hj)
      · exact mul_mem_right _ _ hu
      · exact mul_mem_left _ _ (this _ hj ij)
    · rw [Finset.sum_cons, dif_pos rfl, add_comm]
      rw [← mul_one u] at huv
      rw [← huv, ← hμ, Finset.mul_sum]
      congr 1
      apply Finset.sum_congr rfl
      intro j hj
      rw [dif_neg]
      rfl
      rintro rfl
      exact hat hj
#align ideal.supr_infi_eq_top_iff_pairwise Ideal.supᵢ_infᵢ_eq_top_iff_pairwise

end Ideal


import category_theory.abelian.opposite

noncomputable theory

open category_theory category_theory.limits

variables {𝓐 : Type*} [category 𝓐] [abelian 𝓐]

structure sum_str (A B X : 𝓐) :=
(inl : A ⟶ X)
(inr : B ⟶ X)
(fst : X ⟶ A)
(snd : X ⟶ B)
(inl_fst : inl ≫ fst = 𝟙 _)
(inr_snd : inr ≫ snd = 𝟙 _)
(inl_snd : inl ≫ snd = 0)
(inr_fst : inr ≫ fst = 0)
(total : fst ≫ inl + snd ≫ inr = 𝟙 _)

namespace sum_str

variables {A B X : 𝓐}

attribute [simp, reassoc] sum_str.inl_fst sum_str.inr_snd sum_str.inl_snd sum_str.inr_fst

@[simps]
def biprod (A B : 𝓐) : sum_str A B (A ⊞ B) :=
{ inl := biprod.inl,
  inr := biprod.inr,
  fst := biprod.fst,
  snd := biprod.snd,
  inl_fst := biprod.inl_fst,
  inr_snd := biprod.inr_snd,
  inl_snd := biprod.inl_snd,
  inr_fst := biprod.inr_fst,
  total := biprod.total }

@[simps]
def symm (sum : sum_str A B X) : sum_str B A X :=
{ inl := sum.inr,
  inr := sum.inl,
  fst := sum.snd,
  snd := sum.fst,
  inl_fst := sum.inr_snd,
  inr_snd := sum.inl_fst,
  inl_snd := sum.inr_fst,
  inr_fst := sum.inl_snd,
  total := by { rw [add_comm, sum.total], } }

open category_theory.preadditive opposite

section iso

variables {X₁ X₂ : 𝓐} (S₁ : sum_str A B X₁) (S₂ : sum_str A B X₂)

@[simps]
def iso : X₁ ≅ X₂ :=
{ hom := S₁.fst ≫ S₂.inl + S₁.snd ≫ S₂.inr,
  inv := S₂.fst ≫ S₁.inl + S₂.snd ≫ S₁.inr,
  hom_inv_id' := by simp only [comp_add, add_comp_assoc, category.assoc, add_comp, inl_fst_assoc,
    inl_snd_assoc, zero_comp, comp_zero, add_zero, inr_fst_assoc, inr_snd_assoc, zero_add, total],
  inv_hom_id' := by simp only [comp_add, add_comp_assoc, category.assoc, add_comp, inl_fst_assoc,
    inl_snd_assoc, zero_comp, comp_zero, add_zero, inr_fst_assoc, inr_snd_assoc, zero_add, total], }

end iso

@[simps]
protected def op (sum : sum_str A B X) : sum_str (op A) (op B) (op X) :=
{ inl := sum.fst.op,
  inr := sum.snd.op,
  fst := sum.inl.op,
  snd := sum.inr.op,
  inl_fst := by { rw [← op_comp, sum.inl_fst, op_id] },
  inr_snd := by { rw [← op_comp, sum.inr_snd, op_id] },
  inl_snd := by { rw [← op_comp, sum.inr_fst, op_zero] },
  inr_fst := by { rw [← op_comp, sum.inl_snd, op_zero] },
  total := by { rw [← op_comp, ← op_comp, ← op_add, sum.total, op_id] } }

@[simps]
protected def unop {A B X : 𝓐ᵒᵖ} (sum : sum_str A B X) : sum_str (unop A) (unop B) (unop X) :=
{ inl := sum.fst.unop,
  inr := sum.snd.unop,
  fst := sum.inl.unop,
  snd := sum.inr.unop,
  inl_fst := by { rw [← unop_comp, sum.inl_fst, unop_id] },
  inr_snd := by { rw [← unop_comp, sum.inr_snd, unop_id] },
  inl_snd := by { rw [← unop_comp, sum.inr_fst, unop_zero] },
  inr_fst := by { rw [← unop_comp, sum.inl_snd, unop_zero] },
  total := by { rw [← unop_comp, ← unop_comp, ← unop_add, sum.total, unop_id] } }

lemma symm_symm (sum : sum_str A B X) : sum.symm.symm = sum :=
by { cases sum, refl }

lemma op_symm (sum : sum_str A B X) : sum.symm.op = sum.op.symm :=
by { cases sum, refl }

lemma unop_symm {A B X : 𝓐ᵒᵖ} (sum : sum_str A B X) : sum.symm.unop = sum.unop.symm :=
by { cases sum, refl }

lemma unop_op (sum : sum_str A B X) : sum.op.unop = sum :=
by { cases sum, refl }

lemma op_unop {A B X : 𝓐ᵒᵖ} (sum : sum_str A B X) : sum.unop.op = sum :=
by { cases sum, refl }

end sum_str


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import tactic.norm_num
import data.fin.basic

/-!
# `ring`

Evaluate expressions in the language of commutative (semi)rings.
Based on <http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf> .
-/

namespace tactic
namespace ring

/-- The normal form that `ring` uses is mediated by the function `horner a x n b := a * x ^ n + b`.
The reason we use a definition rather than the (more readable) expression on the right is because
this expression contains a number of typeclass arguments in different positions, while `horner`
contains only one `comm_semiring` instance at the top level. See also `horner_expr` for a
description of normal form. -/
def horner {α} [comm_semiring α] (a x : α) (n : ℕ) (b : α) := a * x ^ n + b

/-- This cache contains data required by the `ring` tactic during execution. -/
meta structure cache :=
(α : expr)
(univ : level)
(comm_semiring_inst : expr)
(red : transparency)
(ic : ref instance_cache)
(nc : ref instance_cache)
(atoms : ref (buffer expr))

/-- The monad that `ring` works in. This is a reader monad containing a mutable cache (using `ref`
for mutability), as well as the list of atoms-up-to-defeq encountered thus far, used for atom
sorting. -/
@[derive [monad, alternative]]
meta def ring_m (α : Type) : Type :=
reader_t cache tactic α

/-- Get the `ring` data from the monad. -/
meta def get_cache : ring_m cache := reader_t.read

/-- Get an already encountered atom by its index. -/
meta def get_atom (n : ℕ) : ring_m expr :=
⟨λ c, do es ← read_ref c.atoms, pure (es.read' n)⟩

/-- Get the index corresponding to an atomic expression, if it has already been encountered, or
put it in the list of atoms and return the new index, otherwise. -/
meta def add_atom (e : expr) : ring_m ℕ :=
⟨λ c, do
  let red := c.red,
  es ← read_ref c.atoms,
  es.iterate failed (λ n e' t, t <|> (is_def_eq e e' red $> n)) <|>
  (es.size <$ write_ref c.atoms (es.push_back e))⟩

/-- Lift a tactic into the `ring_m` monad. -/
@[inline] meta def lift {α} (m : tactic α) : ring_m α := reader_t.lift m

/-- Run a `ring_m` tactic in the tactic monad. This version of `ring_m.run` uses an external
atoms ref, so that subexpressions can be named across multiple `ring_m` calls. -/
meta def ring_m.run' (red : transparency) (atoms : ref (buffer expr))
  (e : expr) {α} (m : ring_m α) : tactic α :=
do α ← infer_type e,
   u ← mk_meta_univ,
   infer_type α >>= unify (expr.sort (level.succ u)),
   u ← get_univ_assignment u,
   ic ← mk_instance_cache α,
   (ic, c) ← ic.get ``comm_semiring,
   nc ← mk_instance_cache `(ℕ),
   using_new_ref ic $ λ r,
   using_new_ref nc $ λ nr,
   reader_t.run m ⟨α, u, c, red, r, nr, atoms⟩

/-- Run a `ring_m` tactic in the tactic monad. -/
meta def ring_m.run (red : transparency) (e : expr) {α} (m : ring_m α) : tactic α :=
using_new_ref mk_buffer $ λ atoms, ring_m.run' red atoms e m

/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This version
is abstract over the instance cache in question (either the ring `α`, or `ℕ` for exponents). -/
@[inline] meta def ic_lift' (icf : cache → ref instance_cache) {α}
  (f : instance_cache → tactic (instance_cache × α)) : ring_m α :=
⟨λ c, do
  let r := icf c,
  ic ← read_ref r,
  (ic', a) ← f ic,
  a <$ write_ref r ic'⟩

/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to the ring `α`. -/
@[inline] meta def ic_lift {α} : (instance_cache → tactic (instance_cache × α)) → ring_m α :=
ic_lift' cache.ic

/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to `ℕ`, which is used for computations in the exponent. -/
@[inline] meta def nc_lift {α} : (instance_cache → tactic (instance_cache × α)) → ring_m α :=
ic_lift' cache.nc

/-- Apply a theorem that expects a `comm_semiring` instance. This is a special case of
`ic_lift mk_app`, but it comes up often because `horner` and all its theorems have this assumption;
it also does not require the tactic monad which improves access speed a bit. -/
meta def cache.cs_app (c : cache) (n : name) : list expr → expr :=
(@expr.const tt n [c.univ] c.α c.comm_semiring_inst).mk_app

/-- Every expression in the language of commutative semirings can be viewed as a sum of monomials,
where each monomial is a product of powers of atoms. We fix a global order on atoms (up to
definitional equality), and then separate the terms according to their smallest atom. So the top
level expression is `a * x^n + b` where `x` is the smallest atom and `n > 0` is a numeral, and
`n` is maximal (so `a` contains at least one monomial not containing an `x`), and `b` contains no
monomials with an `x` (hence all atoms in `b` are larger than `x`).

If there is no `x` satisfying these constraints, then the expression must be a numeral. Even though
we are working over rings, we allow rational constants when these can be interpreted in the ring,
so we can solve problems like `x / 3 = 1 / 3 * x` even though these are not technically in the
language of rings.

These constraints ensure that there is a unique normal form for each ring expression, and so the
algorithm is simply to calculate the normal form of each side and compare for equality.

To allow us to efficiently pattern match on normal forms, we maintain this inductive type that
holds a normalized expression together with its structure. All the `expr`s in this type could be
removed without loss of information, and conversely the `horner_expr` structure and the `ℕ` and
`ℚ` values can be recovered from the top level `expr`, but we keep both in order to keep proof
 producing normalization functions efficient. -/
meta inductive horner_expr : Type
| const (e : expr) (coeff : ℚ) : horner_expr
| xadd (e : expr) (a : horner_expr) (x : expr × ℕ) (n : expr × ℕ) (b : horner_expr) : horner_expr

/-- Get the expression corresponding to a `horner_expr`. This can be calculated recursively from
the structure, but we cache the exprs in all subterms so that this function can be computed in
constant time. -/
meta def horner_expr.e : horner_expr → expr
| (horner_expr.const e _) := e
| (horner_expr.xadd e _ _ _ _) := e

/-- Is this expr the constant `0`? -/
meta def horner_expr.is_zero : horner_expr → bool
| (horner_expr.const _ c) := c = 0
| _ := ff

meta instance : has_coe horner_expr expr := ⟨horner_expr.e⟩
meta instance : has_coe_to_fun horner_expr (λ _, expr → expr) := ⟨λ e, ⇑(e : expr)⟩

/-- Construct a `xadd` node, generating the cached expr using the input cache. -/
meta def horner_expr.xadd' (c : cache) (a : horner_expr)
  (x : expr × ℕ) (n : expr × ℕ) (b : horner_expr) : horner_expr :=
horner_expr.xadd (c.cs_app ``horner [a, x.1, n.1, b]) a x n b

open horner_expr

/-- Pretty printer for `horner_expr`. -/
meta def horner_expr.to_string : horner_expr → string
| (const e c) := to_string (e, c)
| (xadd e a x (_, n) b) :=
    "(" ++ a.to_string ++ ") * (" ++ to_string x.1 ++ ")^"
        ++ to_string n ++ " + " ++ b.to_string

/-- Pretty printer for `horner_expr`. -/
meta def horner_expr.pp : horner_expr → tactic format
| (const e c) := pp (e, c)
| (xadd e a x (_, n) b) := do
  pa ← a.pp, pb ← b.pp, px ← pp x.1,
  return $ "(" ++ pa ++ ") * (" ++ px ++ ")^" ++ to_string n ++ " + " ++ pb

meta instance : has_to_tactic_format horner_expr := ⟨horner_expr.pp⟩

/-- Reflexivity conversion for a `horner_expr`. -/
meta def horner_expr.refl_conv (e : horner_expr) : ring_m (horner_expr × expr) :=
do p ← lift $ mk_eq_refl e, return (e, p)

theorem zero_horner {α} [comm_semiring α] (x n b) :
  @horner α _ 0 x n b = b :=
by simp [horner]

theorem horner_horner {α} [comm_semiring α] (a₁ x n₁ n₂ b n')
  (h : n₁ + n₂ = n') :
  @horner α _ (horner a₁ x n₁ 0) x n₂ b = horner a₁ x n' b :=
by simp [h.symm, horner, pow_add, mul_assoc]

/-- Evaluate `horner a n x b` where `a` and `b` are already in normal form. -/
meta def eval_horner : horner_expr → expr × ℕ → expr × ℕ → horner_expr → ring_m (horner_expr × expr)
| ha@(const a coeff) x n b := do
  c ← get_cache,
  if coeff = 0 then
    return (b, c.cs_app ``zero_horner [x.1, n.1, b])
  else (xadd' c ha x n b).refl_conv
| ha@(xadd a a₁ x₁ n₁ b₁) x n b := do
  c ← get_cache,
  if x₁.2 = x.2 ∧ b₁.e.to_nat = some 0 then do
    (n', h) ← nc_lift $ λ nc, norm_num.prove_add_nat' nc n₁.1 n.1,
    return (xadd' c a₁ x (n', n₁.2 + n.2) b,
      c.cs_app ``horner_horner [a₁, x.1, n₁.1, n.1, b, n', h])
  else (xadd' c ha x n b).refl_conv

theorem const_add_horner {α} [comm_semiring α] (k a x n b b') (h : k + b = b') :
  k + @horner α _ a x n b = horner a x n b' :=
by simp [h.symm, horner]; cc

theorem horner_add_const {α} [comm_semiring α] (a x n b k b') (h : b + k = b') :
  @horner α _ a x n b + k = horner a x n b' :=
by simp [h.symm, horner, add_assoc]

theorem horner_add_horner_lt {α} [comm_semiring α] (a₁ x n₁ b₁ a₂ n₂ b₂ k a' b')
  (h₁ : n₁ + k = n₂) (h₂ : (a₁ + horner a₂ x k 0 : α) = a') (h₃ : b₁ + b₂ = b') :
  @horner α _ a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₁ b' :=
by simp [h₂.symm, h₃.symm, h₁.symm, horner, pow_add, mul_add, mul_comm, mul_left_comm]; cc

theorem horner_add_horner_gt {α} [comm_semiring α] (a₁ x n₁ b₁ a₂ n₂ b₂ k a' b')
  (h₁ : n₂ + k = n₁) (h₂ : (horner a₁ x k 0 + a₂ : α) = a') (h₃ : b₁ + b₂ = b') :
  @horner α _ a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₂ b' :=
by simp [h₂.symm, h₃.symm, h₁.symm, horner, pow_add, mul_add, mul_comm, mul_left_comm]; cc

theorem horner_add_horner_eq {α} [comm_semiring α] (a₁ x n b₁ a₂ b₂ a' b' t)
  (h₁ : a₁ + a₂ = a') (h₂ : b₁ + b₂ = b') (h₃ : horner a' x n b' = t) :
  @horner α _ a₁ x n b₁ + horner a₂ x n b₂ = t :=
by simp [h₃.symm, h₂.symm, h₁.symm, horner, add_mul, mul_comm (x ^ n)]; cc

/-- Evaluate `a + b` where `a` and `b` are already in normal form. -/
meta def eval_add : horner_expr → horner_expr → ring_m (horner_expr × expr)
| (const e₁ c₁) (const e₂ c₂) := ic_lift $ λ ic, do
  let n := c₁ + c₂,
  (ic, e) ← ic.of_rat n,
  (ic, p) ← norm_num.prove_add_rat ic e₁ e₂ e c₁ c₂ n,
  return (ic, const e n, p)
| he₁@(const e₁ c₁) he₂@(xadd e₂ a x n b) := do
  c ← get_cache,
  if c₁ = 0 then ic_lift $ λ ic, do
    (ic, p) ← ic.mk_app ``zero_add [e₂],
    return (ic, he₂, p)
  else do
    (b', h) ← eval_add he₁ b,
    return (xadd' c a x n b',
      c.cs_app ``const_add_horner [e₁, a, x.1, n.1, b, b', h])
| he₁@(xadd e₁ a x n b) he₂@(const e₂ c₂) := do
  c ← get_cache,
  if c₂ = 0 then ic_lift $ λ ic, do
    (ic, p) ← ic.mk_app ``add_zero [e₁],
    return (ic, he₁, p)
  else do
    (b', h) ← eval_add b he₂,
    return (xadd' c a x n b',
      c.cs_app ``horner_add_const [a, x.1, n.1, b, e₂, b', h])
| he₁@(xadd e₁ a₁ x₁ n₁ b₁) he₂@(xadd e₂ a₂ x₂ n₂ b₂) := do
  c ← get_cache,
  if x₁.2 < x₂.2 then do
    (b', h) ← eval_add b₁ he₂,
    return (xadd' c a₁ x₁ n₁ b',
      c.cs_app ``horner_add_const [a₁, x₁.1, n₁.1, b₁, e₂, b', h])
  else if x₁.2 ≠ x₂.2 then do
    (b', h) ← eval_add he₁ b₂,
    return (xadd' c a₂ x₂ n₂ b',
      c.cs_app ``const_add_horner [e₁, a₂, x₂.1, n₂.1, b₂, b', h])
  else if n₁.2 < n₂.2 then do
    let k := n₂.2 - n₁.2,
    (ek, h₁) ← nc_lift (λ nc, do
      (nc, ek) ← nc.of_nat k,
      (nc, h₁) ← norm_num.prove_add_nat nc n₁.1 ek n₂.1,
      return (nc, ek, h₁)),
    α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
    (a', h₂) ← eval_add a₁ (xadd' c a₂ x₁ (ek, k) (const α0 0)),
    (b', h₃) ← eval_add b₁ b₂,
    return (xadd' c a' x₁ n₁ b',
      c.cs_app ``horner_add_horner_lt [a₁, x₁.1, n₁.1, b₁, a₂, n₂.1, b₂, ek, a', b', h₁, h₂, h₃])
  else if n₁.2 ≠ n₂.2 then do
    let k := n₁.2 - n₂.2,
    (ek, h₁) ← nc_lift (λ nc, do
      (nc, ek) ← nc.of_nat k,
      (nc, h₁) ← norm_num.prove_add_nat nc n₂.1 ek n₁.1,
      return (nc, ek, h₁)),
    α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
    (a', h₂) ← eval_add (xadd' c a₁ x₁ (ek, k) (const α0 0)) a₂,
    (b', h₃) ← eval_add b₁ b₂,
    return (xadd' c a' x₁ n₂ b',
      c.cs_app ``horner_add_horner_gt [a₁, x₁.1, n₁.1, b₁, a₂, n₂.1, b₂, ek, a', b', h₁, h₂, h₃])
  else do
    (a', h₁) ← eval_add a₁ a₂,
    (b', h₂) ← eval_add b₁ b₂,
    (t, h₃) ← eval_horner a' x₁ n₁ b',
    return (t, c.cs_app ``horner_add_horner_eq
      [a₁, x₁.1, n₁.1, b₁, a₂, b₂, a', b', t, h₁, h₂, h₃])

theorem horner_neg {α} [comm_ring α] (a x n b a' b')
  (h₁ : -a = a') (h₂ : -b = b') :
  -@horner α _ a x n b = horner a' x n b' :=
by simp [h₂.symm, h₁.symm, horner]; cc

/-- Evaluate `-a` where `a` is already in normal form. -/
meta def eval_neg : horner_expr → ring_m (horner_expr × expr)
| (const e coeff) := do
  (e', p) ← ic_lift $ λ ic, norm_num.prove_neg ic e,
  return (const e' (-coeff), p)
| (xadd e a x n b) := do
  c ← get_cache,
  (a', h₁) ← eval_neg a,
  (b', h₂) ← eval_neg b,
  p ← ic_lift $ λ ic, ic.mk_app ``horner_neg [a, x.1, n.1, b, a', b', h₁, h₂],
  return (xadd' c a' x n b', p)

theorem horner_const_mul {α} [comm_semiring α] (c a x n b a' b')
  (h₁ : c * a = a') (h₂ : c * b = b') :
  c * @horner α _ a x n b = horner a' x n b' :=
by simp [h₂.symm, h₁.symm, horner, mul_add, mul_assoc]

theorem horner_mul_const {α} [comm_semiring α] (a x n b c a' b')
  (h₁ : a * c = a') (h₂ : b * c = b') :
  @horner α _ a x n b * c = horner a' x n b' :=
by simp [h₂.symm, h₁.symm, horner, add_mul, mul_right_comm]

/-- Evaluate `k * a` where `k` is a rational numeral and `a` is in normal form. -/
meta def eval_const_mul (k : expr × ℚ) :
  horner_expr → ring_m (horner_expr × expr)
| (const e coeff) := do
  (e', p) ← ic_lift $ λ ic, norm_num.prove_mul_rat ic k.1 e k.2 coeff,
  return (const e' (k.2 * coeff), p)
| (xadd e a x n b) := do
  c ← get_cache,
  (a', h₁) ← eval_const_mul a,
  (b', h₂) ← eval_const_mul b,
  return (xadd' c a' x n b',
    c.cs_app ``horner_const_mul [k.1, a, x.1, n.1, b, a', b', h₁, h₂])

theorem horner_mul_horner_zero {α} [comm_semiring α] (a₁ x n₁ b₁ a₂ n₂ aa t)
  (h₁ : @horner α _ a₁ x n₁ b₁ * a₂ = aa)
  (h₂ : horner aa x n₂ 0 = t) :
  horner a₁ x n₁ b₁ * horner a₂ x n₂ 0 = t :=
by rw [← h₂, ← h₁];
   simp [horner, mul_add, mul_comm, mul_left_comm, mul_assoc]

theorem horner_mul_horner {α} [comm_semiring α]
  (a₁ x n₁ b₁ a₂ n₂ b₂ aa haa ab bb t)
  (h₁ : @horner α _ a₁ x n₁ b₁ * a₂ = aa)
  (h₂ : horner aa x n₂ 0 = haa)
  (h₃ : a₁ * b₂ = ab) (h₄ : b₁ * b₂ = bb)
  (H : haa + horner ab x n₁ bb = t) :
  horner a₁ x n₁ b₁ * horner a₂ x n₂ b₂ = t :=
by rw [← H, ← h₂, ← h₁, ← h₃, ← h₄];
   simp [horner, mul_add, mul_comm, mul_left_comm, mul_assoc]

/-- Evaluate `a * b` where `a` and `b` are in normal form. -/
meta def eval_mul : horner_expr → horner_expr → ring_m (horner_expr × expr)
| (const e₁ c₁) (const e₂ c₂) := do
  (e', p) ← ic_lift $ λ ic, norm_num.prove_mul_rat ic e₁ e₂ c₁ c₂,
  return (const e' (c₁ * c₂), p)
| (const e₁ c₁) e₂ :=
  if c₁ = 0 then do
    c ← get_cache,
    α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
    p ← ic_lift $ λ ic, ic.mk_app ``zero_mul [e₂],
    return (const α0 0, p)
  else if c₁ = 1 then do
    p ← ic_lift $ λ ic, ic.mk_app ``one_mul [e₂],
    return (e₂, p)
  else eval_const_mul (e₁, c₁) e₂
| e₁ he₂@(const e₂ c₂) := do
  p₁ ← ic_lift $ λ ic, ic.mk_app ``mul_comm [e₁, e₂],
  (e', p₂) ← eval_mul he₂ e₁,
  p ← lift $ mk_eq_trans p₁ p₂, return (e', p)
| he₁@(xadd e₁ a₁ x₁ n₁ b₁) he₂@(xadd e₂ a₂ x₂ n₂ b₂) := do
  c ← get_cache,
  if x₁.2 < x₂.2 then do
    (a', h₁) ← eval_mul a₁ he₂,
    (b', h₂) ← eval_mul b₁ he₂,
    return (xadd' c a' x₁ n₁ b',
      c.cs_app ``horner_mul_const [a₁, x₁.1, n₁.1, b₁, e₂, a', b', h₁, h₂])
  else if x₁.2 ≠ x₂.2 then do
    (a', h₁) ← eval_mul he₁ a₂,
    (b', h₂) ← eval_mul he₁ b₂,
    return (xadd' c a' x₂ n₂ b',
      c.cs_app ``horner_const_mul [e₁, a₂, x₂.1, n₂.1, b₂, a', b', h₁, h₂])
  else do
    (aa, h₁) ← eval_mul he₁ a₂,
    α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
    (haa, h₂) ← eval_horner aa x₁ n₂ (const α0 0),
    if b₂.is_zero then
      return (haa, c.cs_app ``horner_mul_horner_zero
        [a₁, x₁.1, n₁.1, b₁, a₂, n₂.1, aa, haa, h₁, h₂])
    else do
      (ab, h₃) ← eval_mul a₁ b₂,
      (bb, h₄) ← eval_mul b₁ b₂,
      (t, H) ← eval_add haa (xadd' c ab x₁ n₁ bb),
      return (t, c.cs_app ``horner_mul_horner
        [a₁, x₁.1, n₁.1, b₁, a₂, n₂.1, b₂, aa, haa, ab, bb, t, h₁, h₂, h₃, h₄, H])

theorem horner_pow {α} [comm_semiring α] (a x n m n' a') (h₁ : n * m = n') (h₂ : a ^ m = a') :
  @horner α _ a x n 0 ^ m = horner a' x n' 0 :=
by simp [h₁.symm, h₂.symm, horner, mul_pow, pow_mul]

theorem pow_succ {α} [comm_semiring α] (a n b c)
  (h₁ : (a:α) ^ n = b) (h₂ : b * a = c) : a ^ (n + 1) = c :=
by rw [← h₂, ← h₁, pow_succ']

/-- Evaluate `a ^ n` where `a` is in normal form and `n` is a natural numeral. -/
meta def eval_pow : horner_expr → expr × ℕ → ring_m (horner_expr × expr)
| e (_, 0) := do
  c ← get_cache,
  α1 ← ic_lift $ λ ic, ic.mk_app ``has_one.one [],
  p ← ic_lift $ λ ic, ic.mk_app ``pow_zero [e],
  return (const α1 1, p)
| e (_, 1) := do
  p ← ic_lift $ λ ic, ic.mk_app ``pow_one [e],
  return (e, p)
| (const e coeff) (e₂, m) := ic_lift $ λ ic, do
  (ic, e', p) ← norm_num.prove_pow e coeff ic e₂,
  return (ic, const e' (coeff ^ m), p)
| he@(xadd e a x n b) m := do
  c ← get_cache,
  match b.e.to_nat with
  | some 0 := do
    (n', h₁) ← nc_lift $ λ nc, norm_num.prove_mul_rat nc n.1 m.1 n.2 m.2,
    (a', h₂) ← eval_pow a m,
    α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
    return (xadd' c a' x (n', n.2 * m.2) (const α0 0),
      c.cs_app ``horner_pow [a, x.1, n.1, m.1, n', a', h₁, h₂])
  | _ := do
    e₂ ← nc_lift $ λ nc, nc.of_nat (m.2-1),
    (tl, hl) ← eval_pow he (e₂, m.2-1),
    (t, p₂) ← eval_mul tl he,
    return (t, c.cs_app ``pow_succ [e, e₂, tl, t, hl, p₂])
  end

theorem horner_atom {α} [comm_semiring α] (x : α) : x = horner 1 x 1 0 :=
by simp [horner]

/-- Evaluate `a` where `a` is an atom. -/
meta def eval_atom (e : expr) : ring_m (horner_expr × expr) :=
do c ← get_cache,
  i ← add_atom e,
  α0 ← ic_lift $ λ ic, ic.mk_app ``has_zero.zero [],
  α1 ← ic_lift $ λ ic, ic.mk_app ``has_one.one [],
  return (xadd' c (const α1 1) (e, i) (`(1), 1) (const α0 0),
    c.cs_app ``horner_atom [e])

/-- Evaluate `a` where `a` is an atom. -/
meta def eval_norm_atom (norm_atom : expr → tactic (expr × expr))
  (e : expr) : ring_m (horner_expr × expr) :=
do o ← lift $ try_core (guard (e.get_app_args.length > 0) >> norm_atom e),
  match o with
  | none := eval_atom e
  | some (e', p) := do
    (e₂, p₂) ← eval_atom e',
    prod.mk e₂ <$> lift (mk_eq_trans p p₂)
  end

lemma subst_into_pow {α} [monoid α] (l r tl tr t)
  (prl : (l : α) = tl) (prr : (r : ℕ) = tr) (prt : tl ^ tr = t) : l ^ r = t :=
by rw [prl, prr, prt]

lemma unfold_sub {α} [add_group α] (a b c : α)
  (h : a + -b = c) : a - b = c :=
by rw [sub_eq_add_neg, h]

lemma unfold_div {α} [division_ring α] (a b c : α)
  (h : a * b⁻¹ = c) : a / b = c :=
by rw [div_eq_mul_inv, h]

/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
meta def eval (norm_atom : expr → tactic (expr × expr)) : expr → ring_m (horner_expr × expr)
| `(%%e₁ + %%e₂) := do
  (e₁', p₁) ← eval e₁,
  (e₂', p₂) ← eval e₂,
  (e', p') ← eval_add e₁' e₂',
  p ← ic_lift $ λ ic, ic.mk_app ``norm_num.subst_into_add [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
  return (e', p)
| e@`(@has_sub.sub %%α %%inst %%e₁ %%e₂) :=
  mcond (succeeds (lift $ mk_app ``comm_ring [α] >>= mk_instance))
    (do
      e₂' ← ic_lift $ λ ic, ic.mk_app ``has_neg.neg [e₂],
      e ← ic_lift $ λ ic, ic.mk_app ``has_add.add [e₁, e₂'],
      (e', p) ← eval e,
      p' ← ic_lift $ λ ic, ic.mk_app ``unfold_sub [e₁, e₂, e', p],
      return (e', p'))
    (eval_norm_atom norm_atom e)
| `(- %%e) := do
  (e₁, p₁) ← eval e,
  (e₂, p₂) ← eval_neg e₁,
  p ← ic_lift $ λ ic, ic.mk_app ``norm_num.subst_into_neg [e, e₁, e₂, p₁, p₂],
  return (e₂, p)
| `(%%e₁ * %%e₂) := do
  (e₁', p₁) ← eval e₁,
  (e₂', p₂) ← eval e₂,
  (e', p') ← eval_mul e₁' e₂',
  p ← ic_lift $ λ ic, ic.mk_app ``norm_num.subst_into_mul [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
  return (e', p)
| e@`(has_inv.inv %%_) := (do
    (e', p) ← lift $ norm_num.derive e <|> refl_conv e,
    n ← lift $ e'.to_rat,
    return (const e' n, p)) <|> eval_norm_atom norm_atom e
| e@`(@has_div.div _ %%inst %%e₁ %%e₂) := mcond
  (succeeds (do
    inst' ← ic_lift $ λ ic, ic.mk_app ``div_inv_monoid.to_has_div [],
    lift $ is_def_eq inst inst'))
  (do
    e₂' ← ic_lift $ λ ic, ic.mk_app ``has_inv.inv [e₂],
    e ← ic_lift $ λ ic, ic.mk_app ``has_mul.mul [e₁, e₂'],
    (e', p) ← eval e,
    p' ← ic_lift $ λ ic, ic.mk_app ``unfold_div [e₁, e₂, e', p],
    return (e', p'))
  (eval_norm_atom norm_atom e)
| e@`(@has_pow.pow _ _ %%inst %%e₁ %%e₂) := mcond
  (succeeds (do
    inst' ← ic_lift $ λ ic, ic.mk_app ``monoid.has_pow [],
    lift $ is_def_eq inst inst'))
  (do
    (e₂', p₂) ← lift $ norm_num.derive e₂ <|> refl_conv e₂,
    match e₂'.to_nat with
    | some k := do
      (e₁', p₁) ← eval e₁,
      (e', p') ← eval_pow e₁' (e₂, k),
      p ← ic_lift $ λ ic, ic.mk_app ``subst_into_pow [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
      return (e', p)
    | _ := eval_norm_atom norm_atom e
    end)
  (eval_norm_atom norm_atom e)
| e := match e.to_nat with
  | some n := (const e n).refl_conv
  | none := eval_norm_atom norm_atom e
  end

/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
meta def eval' (red : transparency) (atoms : ref (buffer expr))
  (norm_atom : expr → tactic (expr × expr)) (e : expr) : tactic (expr × expr) :=
ring_m.run' red atoms e $ do (e', p) ← eval norm_atom e, return (e', p)

theorem horner_def' {α} [comm_semiring α] (a x n b) : @horner α _ a x n b = x ^ n * a + b :=
by simp [horner, mul_comm]

theorem mul_assoc_rev {α} [semigroup α] (a b c : α) : a * (b * c) = a * b * c :=
by simp [mul_assoc]

theorem pow_add_rev {α} [monoid α] (a : α) (m n : ℕ) : a ^ m * a ^ n = a ^ (m + n) :=
by simp [pow_add]

theorem pow_add_rev_right {α} [monoid α] (a b : α) (m n : ℕ) :
  b * a ^ m * a ^ n = b * a ^ (m + n) :=
by simp [pow_add, mul_assoc]

theorem add_neg_eq_sub {α} [add_group α] (a b : α) : a + -b = a - b := (sub_eq_add_neg a b).symm

/-- If `ring` fails to close the goal, it falls back on normalizing the expression to a "pretty"
form so that you can see why it failed. This setting adjusts the resulting form:

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
@[derive [has_reflect, decidable_eq]]
inductive normalize_mode | raw | SOP | horner

instance : inhabited normalize_mode := ⟨normalize_mode.horner⟩

/-- A `ring`-based normalization simplifier that rewrites ring expressions into the specified mode.
See `normalize`. This version takes a list of atoms to persist across multiple calls.

* `atoms`: a mutable reference containing the atom set from the previous call
* `red`: the reducibility setting to use when comparing atoms for defeq
* `mode`: the normalization style (see `normalize_mode`)
* `recursive`: if true, atoms will be reduced recursively using `normalize'`
* `e`: the expression to normalize
* `inner`: This should be set to `ff`. It is used internally to disable normalization
  at the top level when called from `eval` in order to prevent an infinite loop
  `eval' -> eval_atom -> normalize' -> eval'` when called on something that can't
  be simplified like `x`.
-/
meta def normalize' (atoms : ref (buffer expr))
  (red : transparency) (mode := normalize_mode.horner) (recursive := tt) :
  expr → opt_param _ ff → tactic (expr × expr)
| e inner := do
  pow_lemma ← simp_lemmas.mk.add_simp ``pow_one,
  let lemmas := match mode with
  | normalize_mode.SOP :=
    [``horner_def', ``add_zero, ``mul_one, ``mul_add, ``mul_sub,
    ``mul_assoc_rev, ``pow_add_rev, ``pow_add_rev_right,
    ``mul_neg, ``add_neg_eq_sub]
  | normalize_mode.horner :=
    [``horner.equations._eqn_1, ``add_zero, ``one_mul, ``pow_one,
    ``neg_mul, ``add_neg_eq_sub]
  | _ := []
  end,
  lemmas ← lemmas.mfoldl simp_lemmas.add_simp simp_lemmas.mk,
  trans_conv
    (λ e, do
      guard (mode ≠ normalize_mode.raw),
      (e', pr, _) ← simplify simp_lemmas.mk [] e,
      pure (e', pr))
    (λ e, do
      a ← read_ref atoms,
      let norm_rec := if recursive then λ e, normalize' e tt else λ _, failed,
      (a, e', pr) ← ext_simplify_core a {}
        simp_lemmas.mk (λ _, failed) (λ a _ _ p e, do
          guard (inner → p.is_some),
          write_ref atoms a,
          (new_e, pr) ← eval' red atoms norm_rec e,
          (new_e, pr) ← match mode with
          | normalize_mode.raw := λ _, pure (new_e, pr)
          | normalize_mode.horner := trans_conv (λ _, pure (new_e, pr))
            (λ e, do (e', prf, _) ← simplify lemmas [] e, pure (e', prf))
          | normalize_mode.SOP :=
            trans_conv (λ _, pure (new_e, pr)) $
            trans_conv (λ e, do (e', prf, _) ← simplify lemmas [] e, pure (e', prf)) $
            simp_bottom_up' (λ e, norm_num.derive e <|> pow_lemma.rewrite e)
          end e,
          guard (¬ new_e =ₐ e),
          a ← read_ref atoms,
          pure (a, new_e, some pr, ff))
        (λ _ _ _ _ _, failed) `eq e,
      write_ref atoms a,
      pure (e', pr))
    e

/-- A `ring`-based normalization simplifier that rewrites ring expressions into the specified mode.

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
meta def normalize (red : transparency) (mode := normalize_mode.horner)
  (recursive := tt) (e : expr) : tactic (expr × expr) :=
using_new_ref mk_buffer $ λ atoms, normalize' atoms red mode recursive e

/-- Configuration for `ring_nf`.

  * `recursive`: if true, atoms inside ring expressions will be reduced recursively
-/
@[derive inhabited] structure ring_nf_cfg := (recursive := tt)

end ring

namespace interactive

open tactic.ring

setup_tactic_parser

/-- Tactic for solving equations in the language of *commutative* (semi)rings.
  This version of `ring` fails if the target is not an equality
  that is provable by the axioms of commutative (semi)rings. -/
meta def ring1 (red : parse (tk "!")?) : tactic unit :=
let transp := if red.is_some then semireducible else reducible in
do `(%%e₁ = %%e₂) ← target >>= instantiate_mvars,
  ((e₁', p₁), (e₂', p₂)) ← ring_m.run transp e₁ $
    prod.mk <$> eval (λ _, failed) e₁ <*> eval (λ _, failed) e₂,
  is_def_eq e₁' e₂',
  p ← mk_eq_symm p₂ >>= mk_eq_trans p₁,
  tactic.exact p

/-- Parser for `ring_nf`'s `mode` argument, which can only be the "keywords" `raw`, `horner` or
`SOP`. (Because these are not actually keywords we use a name parser and postprocess the result.)
-/
meta def ring.mode : lean.parser ring.normalize_mode :=
with_desc "(SOP|raw|horner)?" $
do mode ← ident?, match mode with
| none         := pure ring.normalize_mode.horner
| some `horner := pure ring.normalize_mode.horner
| some `SOP    := pure ring.normalize_mode.SOP
| some `raw    := pure ring.normalize_mode.raw
| _            := failed
end

/-- Simplification tactic for expressions in the language of commutative (semi)rings,
which rewrites all ring expressions into a normal form. When writing a normal form,
`ring_nf SOP` will use sum-of-products form instead of horner form.
`ring_nf!` will use a more aggressive reducibility setting to identify atoms.
-/
meta def ring_nf (red : parse (tk "!")?) (SOP : parse ring.mode) (loc : parse location)
  (cfg : ring_nf_cfg := {}) : tactic unit :=
do ns ← loc.get_locals,
   let transp := if red.is_some then semireducible else reducible,
   tt ← using_new_ref mk_buffer $ λ atoms,
     tactic.replace_at (normalize' atoms transp SOP cfg.recursive) ns loc.include_goal
   | fail "ring_nf failed to simplify",
   when loc.include_goal $ try tactic.reflexivity

/-- Tactic for solving equations in the language of *commutative* (semi)rings.
`ring!` will use a more aggressive reducibility setting to identify atoms.

If the goal is not solvable, it falls back to rewriting all ring expressions
into a normal form, with a suggestion to use `ring_nf` instead, if this is the intent.
See also `ring1`, which is the same as `ring` but without the fallback behavior.

Based on [Proving Equalities in a Commutative Ring Done Right
in Coq](http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf) by Benjamin Grégoire
and Assia Mahboubi.
-/
meta def ring (red : parse (tk "!")?) : tactic unit :=
ring1 red <|>
(ring_nf red normalize_mode.horner (loc.ns [none]) >> trace "Try this: ring_nf")

add_hint_tactic "ring"

add_tactic_doc
{ name        := "ring",
  category    := doc_category.tactic,
  decl_names  := [``ring, ``ring_nf, ``ring1],
  inherit_description_from := ``ring,
  tags        := ["arithmetic", "simplification", "decision procedure"] }

end interactive
end tactic

namespace conv.interactive
open conv interactive
open tactic tactic.interactive (ring.mode ring1)
open tactic.ring (normalize normalize_mode.horner)

local postfix (name := parser.optional) `?`:9001 := optional

/--
Normalises expressions in commutative (semi-)rings inside of a `conv` block using the tactic `ring`.
-/
meta def ring_nf (red : parse (lean.parser.tk "!")?) (SOP : parse ring.mode)
  (cfg : ring.ring_nf_cfg := {}) : conv unit :=
let transp := if red.is_some then semireducible else reducible in
replace_lhs (normalize transp SOP cfg.recursive)
<|> fail "ring_nf failed to simplify"

/--
Normalises expressions in commutative (semi-)rings inside of a `conv` block using the tactic `ring`.
-/
meta def ring (red : parse (lean.parser.tk "!")?) : conv unit :=
let transp := if red.is_some then semireducible else reducible in
discharge_eq_lhs (ring1 red)
<|> (replace_lhs (normalize transp normalize_mode.horner) >> trace "Try this: ring_nf")
<|> fail "ring failed to simplify"

end conv.interactive


import category_theory.category

inductive bwd (α : Type) : Type
| emp {} : bwd
| snoc : bwd → α → bwd

notation `ε` := @bwd.emp _
infixl `≪`:5 := @bwd.snoc _
notation `⟪` l:(foldl `, ` (h t, (t ≪ h)) ε `⟫`) := l

@[simp]
def append {α} : bwd α → list α → bwd α
| xs [] := xs
| xs (y :: ys) := append (xs ≪ y) ys

infixl `⋉`:3 := append

def fam (α : Type) := α → Type

/-- Thinnings -/
inductive thn {α} : bwd α → bwd α → Type
| emp {} : thn ⟪⟫ ⟪⟫
| cong {Γ Δ τ} : thn Γ Δ → thn (Γ ≪ τ) (Δ ≪ τ)
| drop {Γ Δ τ} : thn Γ Δ → thn (Γ ≪ τ) Δ

infixr `⇾`:30 := @thn _
infixl `≤` := @thn _

def idn {α} : Π (Γ : bwd α), Γ ⇾ Γ
| bwd.emp := thn.emp
| (bwd.snoc Γ _) := thn.cong (idn Γ)

def seq {α} : Π {Γ Δ Ξ : bwd α}, Γ ⇾ Δ → Δ ⇾ Ξ → Γ ⇾ Ξ
| _ _ _ thn.emp thn.emp := thn.emp
| _ _ _ (thn.cong δ) (thn.cong ξ) := thn.cong (seq δ ξ)
| _ _ _ (thn.cong δ) (thn.drop ξ) := thn.drop (seq δ ξ)
| _ _ _ (thn.drop δ) ξ := thn.drop (seq δ ξ)

theorem seq_left_idn {α} : Π {Γ Δ : bwd α} (γ : Δ ⇾ Γ), seq (idn _) γ = γ
| _ _ thn.emp := by refl
| _ _ (thn.cong ξ) :=
  begin
    unfold idn seq,
    rewrite (seq_left_idn ξ)
  end
| _ _ (thn.drop ξ) :=
  begin
    unfold idn seq,
    rewrite (seq_left_idn ξ)
  end

inductive arity (α : Type) : Type
| mk : list arity → α → arity

def sig (α : Type) := fam (arity α)
infixl `▶`:3 := arity.mk

/-- the clone (type of terms) and type of substitutions -/
mutual inductive cn, sb {α} (𝔖 : sig α)
with cn : bwd (arity α) → α → Type
| opr {Γ Δ τ} : 𝔖 (Δ ▶ τ) → sb Γ Δ → cn Γ τ
| var {Γ Δ τ} : Γ ⇾ ⟪ Δ ▶ τ ⟫ → sb Γ Δ → cn Γ τ
with sb : bwd (arity α) → list (arity α) → Type
| nil {Γ} : sb Γ []
| cons {Γ Ξ Δ τ} : cn (Γ ⋉ Δ) τ → sb Γ Ξ → sb Γ ((Δ ▶ τ) :: Ξ)

namespace lambda_calculus
  inductive sort : Type
  | chk
  | syn

  open sort

  inductive LAM : arity sort → Type
  | lam : LAM ([[[] ▶ syn] ▶ chk] ▶ chk)
  | app : LAM ([[] ▶ syn, [] ▶ chk] ▶ syn)
  | up : LAM ([[] ▶ syn] ▶ chk)

  infix `∙`:5 := cn.opr

  notation `⦃` l:(foldr `, ` (h t, (sb.cons h t)) (sb.nil _) `⦄`) := l

  notation `ƛ` t := LAM.lam ∙ ⦃ t ⦄

  notation ξ `#` γ := cn.var ξ γ
  notation `⇑` t := LAM.up ∙ ⦃ t ⦄
  notation `x₀` := thn.cong thn.emp

  def tm (Γ : bwd (arity sort)) := cn LAM Γ chk

  -- identity function
  def foo : _ :=
    ƛ ⇑ (x₀ # ⦃⦄)

end lambda_calculus


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import measure_theory.function.lp_space
import analysis.normed_space.lattice_ordered_group

/-!
# Order related properties of Lp spaces

### Results

- `Lp E p μ` is an `ordered_add_comm_group` when `E` is a `normed_lattice_add_comm_group`.

### TODO

- move definitions of `Lp.pos_part` and `Lp.neg_part` to this file, and define them as
  `has_pos_part.pos` and `has_pos_part.neg` given by the lattice structure.
- show that if `E` is a `normed_lattice_add_comm_group` then so is `Lp E p μ` for `1 ≤ p`. In
  particular, this shows `order_closed_topology` for `Lp`.

-/

open topological_space measure_theory lattice_ordered_comm_group
open_locale ennreal

variables {α E : Type*} {m : measurable_space α} {μ : measure α} {p : ℝ≥0∞}

namespace measure_theory
namespace Lp

section order
variables [normed_lattice_add_comm_group E] [measurable_space E] [borel_space E]
  [second_countable_topology E]

lemma coe_fn_le (f g : Lp E p μ) : f ≤ᵐ[μ] g ↔ f ≤ g :=
by rw [← subtype.coe_le_coe, ← ae_eq_fun.coe_fn_le, ← coe_fn_coe_base, ← coe_fn_coe_base]

lemma coe_fn_nonneg (f : Lp E p μ) : 0 ≤ᵐ[μ] f ↔ 0 ≤ f :=
begin
  rw ← coe_fn_le,
  have h0 := Lp.coe_fn_zero E p μ,
  split; intro h; filter_upwards [h, h0] with _ _ h2,
  { rwa h2, },
  { rwa ← h2, },
end

instance : covariant_class (Lp E p μ) (Lp E p μ) (+) (≤) :=
begin
  refine ⟨λ f g₁ g₂ hg₁₂, _⟩,
  rw ← coe_fn_le at hg₁₂ ⊢,
  filter_upwards [coe_fn_add f g₁, coe_fn_add f g₂, hg₁₂] with _ h1 h2 h3,
  rw [h1, h2, pi.add_apply, pi.add_apply],
  exact add_le_add le_rfl h3,
end

instance : ordered_add_comm_group (Lp E p μ) :=
{ add_le_add_left := λ f g hfg f', add_le_add_left hfg f',
  ..subtype.partial_order _, ..add_subgroup.to_add_comm_group _}

end order

end Lp
end measure_theory


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.basic
import Mathlib.algebra.ring.pi
import Mathlib.PostPort

universes u v u_1 u_2

namespace Mathlib

/-!
# Pi instances for module and multiplicative actions

This file defines instances for module, mul_action and related structures on Pi Types
-/

namespace pi

protected instance has_scalar {I : Type u} {f : I → Type v} {α : Type u_1}
    [(i : I) → has_scalar α (f i)] : has_scalar α ((i : I) → f i) :=
  has_scalar.mk fun (s : α) (x : (i : I) → f i) (i : I) => s • x i

@[simp] theorem smul_apply {I : Type u} {f : I → Type v} (x : (i : I) → f i) (i : I) {α : Type u_1}
    [(i : I) → has_scalar α (f i)] (s : α) : has_scalar.smul s x i = s • x i :=
  rfl

protected instance has_scalar' {I : Type u} {f : I → Type v} {g : I → Type u_1}
    [(i : I) → has_scalar (f i) (g i)] : has_scalar ((i : I) → f i) ((i : I) → g i) :=
  has_scalar.mk fun (s : (i : I) → f i) (x : (i : I) → g i) (i : I) => s i • x i

@[simp] theorem smul_apply' {I : Type u} {f : I → Type v} (i : I) {g : I → Type u_1}
    [(i : I) → has_scalar (f i) (g i)] (s : (i : I) → f i) (x : (i : I) → g i) :
    has_scalar.smul s x i = s i • x i :=
  rfl

protected instance is_scalar_tower {I : Type u} {f : I → Type v} {α : Type u_1} {β : Type u_2}
    [has_scalar α β] [(i : I) → has_scalar β (f i)] [(i : I) → has_scalar α (f i)]
    [∀ (i : I), is_scalar_tower α β (f i)] : is_scalar_tower α β ((i : I) → f i) :=
  is_scalar_tower.mk
    fun (x : α) (y : β) (z : (i : I) → f i) => funext fun (i : I) => smul_assoc x y (z i)

protected instance is_scalar_tower' {I : Type u} {f : I → Type v} {g : I → Type u_1} {α : Type u_2}
    [(i : I) → has_scalar α (f i)] [(i : I) → has_scalar (f i) (g i)] [(i : I) → has_scalar α (g i)]
    [∀ (i : I), is_scalar_tower α (f i) (g i)] :
    is_scalar_tower α ((i : I) → f i) ((i : I) → g i) :=
  is_scalar_tower.mk
    fun (x : α) (y : (i : I) → f i) (z : (i : I) → g i) =>
      funext fun (i : I) => smul_assoc x (y i) (z i)

protected instance is_scalar_tower'' {I : Type u} {f : I → Type v} {g : I → Type u_1}
    {h : I → Type u_2} [(i : I) → has_scalar (f i) (g i)] [(i : I) → has_scalar (g i) (h i)]
    [(i : I) → has_scalar (f i) (h i)] [∀ (i : I), is_scalar_tower (f i) (g i) (h i)] :
    is_scalar_tower ((i : I) → f i) ((i : I) → g i) ((i : I) → h i) :=
  is_scalar_tower.mk
    fun (x : (i : I) → f i) (y : (i : I) → g i) (z : (i : I) → h i) =>
      funext fun (i : I) => smul_assoc (x i) (y i) (z i)

protected instance mul_action {I : Type u} {f : I → Type v} (α : Type u_1) {m : monoid α}
    [(i : I) → mul_action α (f i)] : mul_action α ((i : I) → f i) :=
  mul_action.mk sorry sorry

protected instance mul_action' {I : Type u} {f : I → Type v} {g : I → Type u_1}
    {m : (i : I) → monoid (f i)} [(i : I) → mul_action (f i) (g i)] :
    mul_action ((i : I) → f i) ((i : I) → g i) :=
  mul_action.mk sorry sorry

protected instance distrib_mul_action {I : Type u} {f : I → Type v} (α : Type u_1) {m : monoid α}
    {n : (i : I) → add_monoid (f i)} [(i : I) → distrib_mul_action α (f i)] :
    distrib_mul_action α ((i : I) → f i) :=
  distrib_mul_action.mk sorry sorry

protected instance distrib_mul_action' {I : Type u} {f : I → Type v} {g : I → Type u_1}
    {m : (i : I) → monoid (f i)} {n : (i : I) → add_monoid (g i)}
    [(i : I) → distrib_mul_action (f i) (g i)] :
    distrib_mul_action ((i : I) → f i) ((i : I) → g i) :=
  distrib_mul_action.mk sorry sorry

protected instance semimodule (I : Type u) (f : I → Type v) (α : Type u_1) {r : semiring α}
    {m : (i : I) → add_comm_monoid (f i)} [(i : I) → semimodule α (f i)] :
    semimodule α ((i : I) → f i) :=
  semimodule.mk sorry sorry

protected instance semimodule' {I : Type u} {f : I → Type v} {g : I → Type u_1}
    {r : (i : I) → semiring (f i)} {m : (i : I) → add_comm_monoid (g i)}
    [(i : I) → semimodule (f i) (g i)] : semimodule ((i : I) → f i) ((i : I) → g i) :=
  semimodule.mk sorry sorry

end Mathlib


/- ------------------------------------------------------------------------- -|
| @project: riemann_hypothesis                                                |
| @file:    basic.lean                                                        |
| @authors: Brandon H. Gomes, Alex Kontorovich                                |
| @affil:   Rutgers University                                                |
|- ------------------------------------------------------------------------- -/

/-!
-/

namespace riemann_hypothesis --——————————————————————————————————————————————————————————--
variables {α : Type*} {β : Type*}

/--
-/
def const (b : β)
    := λ _ : α, b
notation `↓`:max b:max := const b

section pointwise_classes --—————————————————————————————————————————————————————————————--

/--
-/
instance pointwise.has_le [has_le β] : has_le (α → β)
    := ⟨λ f g, Π x, f x ≤ g x⟩

/--
-/
instance pointwise.has_zero [has_zero β] : has_zero (α → β)
    := ⟨↓0⟩

end pointwise_classes --—————————————————————————————————————————————————————————————————--

namespace algebra --—————————————————————————————————————————————————————————————————————--
variables (α) (β)

/--
-/
class has_left_add_distributivity [has_add α] [has_mul α]
    := (eq : Π x y z : α, x * (y + z) = x * y + x * z)

/--
-/
class has_right_add_distributivity [has_add α] [has_mul α]
    := (eq : Π x y z : α, (y + z) * x = y * x + z * x)

/--
-/
class has_left_sub_distributivity [has_sub α] [has_mul α]
    := (eq : Π x y z : α, x * (y - z) = x * y - x * z)

/--
-/
class has_right_sub_distributivity [has_sub α] [has_mul α]
    := (eq : Π x y z : α, (y - z) * x = y * x - z * x)

/--
-/
class has_lift_add_comm [has_lift_t α β] [has_add α] [has_add β]
    := (eq : Π x y : α, (↑(x + y) : β) = ↑x + ↑y)

/--
-/
class has_lift_sub_comm [has_lift_t α β] [has_sub α] [has_sub β]
    := (eq : Π x y : α, (↑(x - y) : β) = ↑x - ↑y)

/--
-/
class has_lift_mul_comm [has_lift_t α β] [has_mul α] [has_mul β]
    := (eq : Π x y : α, (↑(x * y) : β) = ↑x * ↑y)

/--
-/
class has_lift_inv_comm [has_lift_t α β] [has_inv α] [has_inv β]
    := (eq : Π a : α, (↑(a⁻¹) : β) = (↑a)⁻¹)

/--
-/
class has_right_unit [has_one α] [has_mul α]
    := (eq : Π a : α, a * 1 = a)

/--
-/
class has_left_unit [has_one α] [has_mul α]
    := (eq : Π a : α, 1 * a = a)

/--
-/
class has_add_le_add [has_le α] [has_add α]
    := (le : Π {a b c d : α}, a ≤ b → c ≤ d → a + c ≤ b + d)

/--
-/
class has_add_lt_add [has_lt α] [has_add α]
    := (lt : Π {a b c d : α}, a < b → c < d → a + c < b + d)

/--
-/
class has_le_add_of_nonneg_of_le [has_le α] [has_zero α] [has_add α]
    := (le : Π {a b c : α}, 0 ≤ a → b ≤ c → b ≤ a + c)

/--
-/
class has_lt_add_of_le_of_pos [has_le α] [has_lt α] [has_zero α] [has_add α]
    := (lt : Π {a b c : α}, 0 < a → b ≤ c → b < a + c)

/--
-/
class has_add_nonneg [has_le α] [has_zero α] [has_add α]
    := (le : Π {a b : α}, 0 ≤ a → 0 ≤ b → 0 ≤ a + b)

/--
-/
class has_zero_mul_is_zero [has_zero α] [has_mul α]
    := (eq : Π a : α, 0 * a = 0)

/--
-/
class has_mul_zero_is_zero [has_zero α] [has_mul α]
    := (eq : Π a : α, a * 0 = 0)

/--
-/
class has_lift_zero_same [has_lift_t α β] [has_zero α] [has_zero β]
    := (eq : ↑(0 : α) = (0 : β))

/--
-/
class has_lift_one_same [has_lift_t α β] [has_one α] [has_one β]
    := (eq : ↑(1 : α) = (1 : β))

/--
-/
class has_zero_right_add_cancel [has_zero α] [has_add α]
    := (eq : Π a : α, a + 0 = a)

/--
-/
class has_zero_left_add_cancel [has_zero α] [has_add α]
    := (eq : Π a : α, 0 + a = a)

/--
-/
class has_sub_self_is_zero [has_zero α] [has_sub α]
    := (eq : Π a : α, a - a = 0)

/--
-/
class has_mul_assoc [has_mul α]
    := (eq : Π a b c : α, (a * b) * c = a * (b * c))

/--
-/
class has_add_sub_assoc [has_add α] [has_sub α]
    := (eq : Π a b c : α, (a + b) - c = a + (b - c))

/--
-/
class has_le_sub_add_le [has_le α] [has_sub α] [has_add α]
    := (le : Π {a b c : α}, a ≤ c - b → a + b ≤ c)

/--
-/
class has_le_pos_mul_preserves_right [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 < c → a ≤ b → a * c ≤ b * c)

/--
-/
class has_le_pos_mul_preserves_left [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 < c → a ≤ b → c * a ≤ c * b)

/--
-/
class has_lt_pos_mul_preserves_right [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b c : α}, 0 < c → a < b → a * c < b * c)

/--
-/
class has_le_nonneg_mul_preserves_left [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 ≤ c → a ≤ b → c * a ≤ c * b)

/--
-/
class has_le_nonneg_mul_preserves_right [has_lt α] [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b c : α}, 0 ≤ c → a ≤ b → a * c ≤ b * c)

/--
-/
class has_lift_le_comm [has_lift_t α β] [has_le α] [has_le β]
    := (le : Π {x y : α}, x ≤ y → ↑x ≤ (↑y : β))

/--
-/
class has_lift_lt_comm [has_lift_t α β] [has_lt α] [has_lt β]
    := (lt : Π {x y : α}, x < y → ↑x < (↑y : β))

/--
-/
class has_lift_ne_comm [has_lift_t α β]
    := (ne : Π {x y : α}, x ≠ y → ↑x ≠ (↑y : β))

/--
-/
class has_sub_add_sub_cancel [has_sub α] [has_add α]
    := (eq : Π a b c : α, a - b + (b - c) = a - c)

/--
-/
class has_double_sub_cancel [has_sub α]
    := (eq : Π a b : α, a - (a - b) = b)

/--
-/
class has_inv_mul_right_cancel_self [has_zero α] [has_one α] [has_inv α] [has_mul α]
    := (eq : Π a : α, a ≠ 0 → a * a⁻¹ = 1)

/--
-/
class has_inv_mul_left_cancel_self [has_zero α] [has_one α] [has_inv α] [has_mul α]
    := (eq : Π a : α, a ≠ 0 → a⁻¹ * a = 1)

/--
-/
class has_add_sub_exchange [has_add α] [has_sub α]
    := (eq : Π a b c d : α, (a - b) + (c - d) = (c - b) + (a - d))

/--
-/
class has_zero_sub_is_neg [has_zero α] [has_neg α] [has_sub α]
    := (eq : Π a : α, 0 - a = -a)

/--
-/
class has_inv_right_mul_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → a < c * b → a * b⁻¹ < c)

/--
-/
class has_right_mul_inv_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → c < b⁻¹ * a → b * c < a)

/--
-/
class has_left_mul_inv_lt_pos [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < b → c < a * b⁻¹ → c * b < a)

/--
-/
class has_left_mul_inv_lt_neg [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, b < 0 → a * b⁻¹ < c → b * c < a)

/--
-/
class has_sub_ne_zero_of_ne [has_zero α] [has_sub α]
    := (ne : Π {a b : α}, a ≠ b → a - b ≠ 0)

/--
-/
class has_lt_sub_neg [has_lt α] [has_zero α] [has_sub α]
    := (lt : Π {a b : α}, a < b → a - b < 0)

/--
-/
class has_zero_lt_one [has_lt α] [has_zero α] [has_one α]
    := (lt : 0 < (1 : α))

/--
-/
class has_pos_mul_neg_is_neg [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b : α}, 0 < a → b < 0 → a * b < 0)

/--
-/
class has_nonneg_mul_nonneg_is_nonneg [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b : α}, 0 ≤ a → 0 ≤ b → 0 ≤ a * b)

/--
-/
class has_squared_le_monotonic [has_le α] [has_zero α] [has_mul α]
    := (le : Π {a b : α}, 0 ≤ a → a ≤ b → a * a ≤ b * b)

/--
-/
class has_sub_pos [has_lt α] [has_zero α] [has_sub α]
    := (lt : Π {a b : α}, a < b → 0 < b - a)

/--
-/
class has_sub_sub [has_add α] [has_sub α]
    := (eq : Π a b c : α, a - (b - c) = (a - b) + c)

/--
-/
class has_add_left_lt [has_lt α] [has_add α]
    := (lt : Π a b c : α, a < b → c + a < c + b)

/--
-/
class has_left_inv_pos_lt [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < c → a < b → c⁻¹ * a < c⁻¹ * b)

/--
-/
class has_right_inv_pos_lt [has_lt α] [has_zero α] [has_mul α] [has_inv α]
    := (lt : Π {a b c : α}, 0 < c → a < b → a * c⁻¹ < b * c⁻¹)

/--
-/
class has_mul_pos [has_lt α] [has_zero α] [has_mul α]
    := (lt : Π {a b : α}, 0 < a → 0 < b → 0 < a * b)

/--
-/
class has_inv_pos [has_lt α] [has_zero α] [has_inv α]
    := (lt : Π {a : α}, 0 < a → 0 < a⁻¹)

/--
-/
class has_inv_reverses_le [has_le α] [has_inv α]
    := (le : Π {a b : α}, a ≤ b → b⁻¹ ≤ a⁻¹)

/--
-/
class has_inv_reverses_lt [has_lt α] [has_inv α]
    := (lt : Π {a b : α}, a < b → b⁻¹ < a⁻¹)

/--
-/
class has_inv_mul_reverse [has_inv α] [has_mul α]
    := (eq : Π a b : α, (a * b)⁻¹ = b⁻¹ * a⁻¹)

/--
-/
structure Half [has_lt α] [has_zero α] [has_add α]
    := (map          : α → α)
       (preserve_pos : Π {x}, 0 < x → 0 < map x)
       (doubled_inv  : Π (x), map x + map x = x)

/--
-/
structure LiftCeil [has_lift_t nat α] [has_lt α]
    := (map     : α → nat)
       (lift_lt : Π {a n}, map a < n → a < ↑n)

section lemmas --————————————————————————————————————————————————————————————————————————--
variables {α β}

/--
-/
def inv_sub_inv_lemma
    [has_zero α]
    [has_one α]
    [has_inv α]
    [has_mul α]
    [has_sub α]
    [has_right_unit α]
    [has_left_unit α]
    [has_inv_mul_right_cancel_self α]
    [has_mul_assoc α]
    [has_right_sub_distributivity α]
    {a b : α}
    (a_ne_0 : a ≠ 0)
    : a⁻¹ - b⁻¹ = (1 - b⁻¹ * a) * a⁻¹ :=
    begin
        rw has_right_sub_distributivity.eq,
        rw has_mul_assoc.eq,
        rw has_inv_mul_right_cancel_self.eq _ a_ne_0,
        rw has_left_unit.eq,
        rw has_right_unit.eq,
    end

/--
-/
def inv_sub_inv_lemma'
    [has_zero α]
    [has_one α]
    [has_inv α]
    [has_mul α]
    [has_sub α]
    [has_right_unit α]
    [has_left_unit α]
    [has_inv_mul_left_cancel_self α]
    [has_mul_assoc α]
    [has_left_sub_distributivity α]
    {a b : α}
    (a_ne_0 : a ≠ 0)
    : a⁻¹ - b⁻¹ = a⁻¹ * (1 - a * b⁻¹) :=
    begin
        rw has_left_sub_distributivity.eq,
        rw ← has_mul_assoc.eq,
        rw has_inv_mul_left_cancel_self.eq _ a_ne_0,
        rw has_left_unit.eq,
        rw has_right_unit.eq,
    end

/--
-/
def mul_inv_add_one_lemma
    [has_lift_t nat α]
    [has_zero α]
    [has_one α]
    [has_sub α]
    [has_mul α]
    [has_inv α]
    [has_left_unit α]
    [has_inv_mul_right_cancel_self α]
    [has_right_sub_distributivity α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_sub_comm nat α]
    [has_lift_ne_comm nat α]
    (n : nat)
    : (↑n : α) * (↑n.succ)⁻¹ = 1 - (↑n.succ)⁻¹ :=
    begin
        rw ← has_left_unit.eq (↑n.succ : α)⁻¹,

        have succ_non_zero : ↑n.succ ≠ (0 : α),
            rw (_ : 0 = (↑0 : α)),
            refine has_lift_ne_comm.ne (nat.succ_ne_zero _),
            rw has_lift_zero_same.eq,

        rw ← has_inv_mul_right_cancel_self.eq _ succ_non_zero,
        rw ← has_right_sub_distributivity.eq,
        rw has_inv_mul_right_cancel_self.eq _ succ_non_zero,
        rw has_left_unit.eq,

        rw (_ : 1 = (↑1 : α)),

        rw ← has_lift_sub_comm.eq,
        rw nat.succ_sub_one,
        rw has_lift_one_same.eq,
    end

/--
-/
def two_mul_lemma
    [has_one α]
    [has_add α]
    [has_mul α]
    [has_right_add_distributivity α]
    [has_left_unit α]
    (a : α)
    : 2 * a = a + a :=
    begin
        refine (has_right_add_distributivity.eq _ _ _).trans _,
        rw has_left_unit.eq,
    end

/--
-/
def two_mul_lemma'
    [has_one α]
    [has_add α]
    [has_mul α]
    [has_left_add_distributivity α]
    [has_right_unit α]
    (a : α)
    : a * 2 = a + a :=
    begin
        refine (has_left_add_distributivity.eq _ _ _).trans _,
        rw has_right_unit.eq,
    end

/--
-/
def two_squares_is_four_lemma
    [has_one α]

    [has_add α] [has_mul α]

    [has_left_unit α]

    [has_left_add_distributivity α] [has_right_add_distributivity α]

    [has_mul_assoc α]

    (a : α)

    : 4 * (a * a) = (a + a) * (a + a) :=

    begin
        rw has_left_add_distributivity.eq,
        rw has_right_add_distributivity.eq,
        rw ← two_mul_lemma,
        rw ← two_mul_lemma,
        rw ← has_mul_assoc.eq,
        rw ← has_mul_assoc.eq,
        rw two_mul_lemma,
        rw has_mul_assoc.eq,

        refine rfl,
    end

/--
-/
def two_squares_is_four_lemma'
    [has_one α]

    [has_add α] [has_mul α]

    [has_right_unit α]

    [has_left_add_distributivity α] [has_right_add_distributivity α]

    [has_mul_assoc α]

    (a : α)

    : (a * a) * 4 = (a + a) * (a + a) :=

    begin
        rw has_right_add_distributivity.eq,
        rw has_left_add_distributivity.eq,
        rw ← two_mul_lemma',
        rw ← two_mul_lemma',
        rw has_mul_assoc.eq,
        rw has_mul_assoc.eq,
        rw two_mul_lemma',
        rw has_mul_assoc.eq,

        refine rfl,
    end

/--
-/
def nat_mul_commute_lemma
    [has_zero α]
    [has_one α]
    [has_add α]
    [has_mul α]

    [has_zero_mul_is_zero α]
    [has_mul_zero_is_zero α]

    [has_right_unit α]
    [has_left_unit α]

    [has_left_add_distributivity α]
    [has_right_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α) (n : nat)

    : a * ↑n = ↑n * a :=

    begin
        induction n with n hn,
            rw has_lift_zero_same.eq,
            rw has_zero_mul_is_zero.eq,
            rw has_mul_zero_is_zero.eq,
            rw nat.succ_eq_add_one,
            rw has_lift_add_comm.eq,
            rw has_left_add_distributivity.eq,
            rw has_right_add_distributivity.eq,
            rw hn,
            rw has_lift_one_same.eq,
            rw has_left_unit.eq,
            rw has_right_unit.eq,
    end

section lifted_lemmas --—————————————————————————————————————————————————————————————————--
variables (α β)

/--
-/
def zero_is_lifted_zero_lemma
    [has_zero α] [has_zero β] [has_lift_t α β] [has_lift_zero_same α β]
    : (0 : β) = ↑(0 : α)
    := by rw has_lift_zero_same.eq

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_one α] [has_one β] [has_lift_t α β] [has_lift_one_same α β]

/--
-/
def one_is_lifted_one_lemma
    : (1 : β) = ↑(1 : α)
    := by rw has_lift_one_same.eq

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_add α] [has_add β] [has_lift_add_comm α β]

/--
-/
def two_is_lifted_two_lemma : (2 : β) = ↑(2 : α) :=
    begin
        rw (_ : (2 : β) = ↑(1 : α) + ↑(1 : α)),
        rw ← has_lift_add_comm.eq,
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

/--
-/
def three_is_lifted_three_lemma : (3 : β) = ↑(3 : α) :=
    begin
        rw (_ : (3 : β) = ↑(1 : α) + ↑(1 : α) + ↑(1 : α)),
        rw [← has_lift_add_comm.eq, ← has_lift_add_comm.eq],
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

/--
-/
def four_is_lifted_four_lemma : (4 : β) = ↑(4 : α) :=
    begin
        rw (_ : (4 : β) = ↑(1 : α) + ↑(1 : α) + (↑(1 : α) + ↑(1 : α))),
        rw [← has_lift_add_comm.eq, ← has_lift_add_comm.eq],
        refine rfl,
        rw has_lift_one_same.eq,
        refine rfl,
    end

end lifted_lemmas --—————————————————————————————————————————————————————————————————————--
end lemmas --————————————————————————————————————————————————————————————————————————————--
end algebra --———————————————————————————————————————————————————————————————————————————--

open algebra

namespace nat --—————————————————————————————————————————————————————————————————————————--

/--
-/
def of_le_succ {n m : nat} (n_le_m_succ : n ≤ m.succ) : n ≤ m ∨ n = m.succ
    := (lt_or_eq_of_le n_le_m_succ).imp nat.le_of_lt_succ id

/--
-/
def sub_sub_sub_cancel_right {a b c} (c_le_b : c ≤ b) : a - c - (b - c) = a - b
    := by rw [nat.sub_sub, ← nat.add_sub_assoc c_le_b, nat.add_sub_cancel_left]

/--
-/
def le_sub_right_of_add_le {m n k} : m + k ≤ n → m ≤ n - k :=
    begin
        intros h,
        rw ← nat.add_sub_cancel m k,
        refine nat.sub_le_sub_right h _,
    end

/--
-/
def le_sub_left_of_add_le {k m n} (h : k + m ≤ n) : m ≤ n - k
    := le_sub_right_of_add_le (by { rw ← nat.add_comm, refine h })

/--
-/
def le_add_of_sub_le_right {k m n} : n - k ≤ m → n ≤ m + k :=
    begin
        intros h,
        rw ← nat.add_sub_cancel m k at h,
        refine (nat.sub_le_sub_right_iff _ _ _ (nat.le_add_left _ _)).mp h,
    end

/--
-/
def add_lt_add_of_le_of_lt {a b c d} (h₁ : a ≤ b) (h₂ : c < d) : a + c < b + d
    := lt_of_le_of_lt (nat.add_le_add_right h₁ c) (nat.add_lt_add_left h₂ b)

/--
-/
def lt_add_of_le_of_pos {a b c} (b_le_c : b ≤ c) (zero_lt_a : 0 < a) : b < c + a
    := nat.add_zero b ▸ nat.add_lt_add_of_le_of_lt b_le_c zero_lt_a

/--
-/
def neg_right_swap {a b c} (c_le_b : c ≤ b) :  a - (b - c) = (a + c) - b :=
    begin
        rw ← nat.add_sub_cancel a _,
        rw nat.sub_sub_sub_cancel_right c_le_b,
        rw nat.add_sub_assoc (le_refl _),
        rw nat.sub_self,
        rw nat.add_zero,
    end

/--
-/
def sub_mono_left_strict {x y z : nat} (z_le_x : z ≤ x) (x_lt_y : x < y)
    : x - z < y - z :=
    begin
        refine @nat.lt_of_add_lt_add_left z _ _ _,
        rw nat.add_sub_of_le (le_trans z_le_x (le_of_lt x_lt_y)),
        rw nat.add_sub_of_le z_le_x,
        refine x_lt_y,
end

/--
-/
def mul_two (n) : n * 2 = n + n :=
    begin
        refine (nat.left_distrib _ _ _).trans _,
        rw nat.mul_one,
    end

/--
-/
def pow_two_ge_one (n : nat) : 1 ≤ 2 ^ n :=
    begin
        induction n with n hn,
            refine le_refl _,
            refine le_trans hn (nat.le_add_left _ _),
    end

/--
-/
def pow_two_monotonic (n : nat) : 2 ^ n < 2 ^ n.succ
    := lt_add_of_le_of_pos (nat.le_add_left _ _) (pow_two_ge_one _)

/--
-/
def smallest_positive_even (n : nat)
    : 2 ≤ 2 * n.succ :=
    begin
        induction n with n hn,
            rw nat.mul_one,
            refine le_trans hn (nat.le.intro rfl),
    end

/--
-/
def successive_difference (u : nat → nat) (n : nat)
    := u n.succ - u n

/--
-/
def power [has_one α] [has_mul α] (a : α) : nat → α
| (nat.zero  ) := 1
| (nat.succ n) := power n * a

namespace power --———————————————————————————————————————————————————————————————————————--
variables [has_one α] [has_mul α]

/--
-/
def mul_commute
    [has_one β] [has_mul β]
    (map     : α → β)
    (map_one : map 1 = 1)
    (map_mul : Π x y, map (x * y) = map x * map y)
    (a : α) (n)
    : map (power a n) = power (map a) n :=
    begin
        induction n with n hn,
            rw [power, power],
            rw map_one,
            rw [power, power],
            rw map_mul,
            rw hn,
    end

end power --—————————————————————————————————————————————————————————————————————————————--

namespace lift --————————————————————————————————————————————————————————————————————————--
variables (α)

/--
-/
def succ_pos
    [has_lt α]
    [has_zero α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    (n : nat)
    : 0 < (↑n.succ : α) :=
    begin
        rw zero_is_lifted_zero_lemma nat α,
        refine has_lift_lt_comm.lt (nat.succ_pos _),
    end

/--
-/
def succ_nonzero
    [preorder α]
    [has_zero α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    (n : nat)
    : (↑n.succ : α) ≠ 0
    := (ne_of_gt (nat.lift.succ_pos α _))

/--
-/
def zero_lt_one
    [has_lt α]
    [has_zero α]
    [has_one α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_lt_comm nat α]
    : (0 : α) < 1 :=
    begin
        rw one_is_lifted_one_lemma nat α,
        refine nat.lift.succ_pos α _,
    end

/--
-/
instance zero_lt_one_instance
    [has_lt α]
    [has_zero α]
    [has_one α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_lt_comm nat α]
    : has_zero_lt_one α
    := ⟨zero_lt_one α⟩

end lift --——————————————————————————————————————————————————————————————————————————————--
end nat --———————————————————————————————————————————————————————————————————————————————--

section sequences --—————————————————————————————————————————————————————————————————————--

/--
-/
def strictly_increasing
    [has_lt α]
    (seq : nat → α)
    := Π n, seq n < seq n.succ

/--
-/
def increasing
    [has_le α]
    (seq : nat → α)
    := Π n, seq n ≤ seq n.succ

/--
-/
def strictly_increasing.as_increasing
    [preorder α]
    (seq : nat → α)
    : strictly_increasing seq → increasing seq :=
    begin
        intros sinc _,
        refine le_of_lt (sinc _),
    end

/--
-/
def increasing_strong
    [has_le α]
    (seq : nat → α)
    := Π i j, i ≤ j → seq i ≤ seq j

/--
-/
def increasing.as_increasing_strong
    [preorder α]
    (seq : nat → α)
    : increasing seq → increasing_strong seq :=
    begin
        intros inc i j i_le_j,
        induction j with j hj,
            cases i_le_j,
                refine le_refl _,
            cases nat.of_le_succ i_le_j,
                refine le_trans (hj h) (inc _),
                rw h,
    end

/--
-/
def strictly_increasing.as_increasing_strong
    [preorder α]
    (seq : nat → α)
    : strictly_increasing seq → increasing_strong seq
    := λ s, increasing.as_increasing_strong _ (strictly_increasing.as_increasing _ s)

/--
-/
def non_increasing
    [has_le α]
    (seq : nat → α)
    := Π n, seq (nat.succ n) ≤ seq n

/--
-/
def non_increasing_strong
    [has_le α]
    (seq : nat → α) (k)
    := Π n, seq (n + k) ≤ seq n

/--
-/
def non_increasing.as_non_increasing_strong
    [preorder α]
    (seq : nat → α)
    : non_increasing seq → Π k, non_increasing_strong seq k :=
    begin
        intros noninc k _,
        induction k with k hk,
            refine le_refl _,
            refine le_trans (noninc _) hk,
    end

/--
-/
def strictly_increasing.ge_index
    (seq) (sinc : strictly_increasing seq)
    (k)
    : k ≤ seq k :=
    begin
        induction k with _ hk,
            refine nat.zero_le _,
            rw nat.succ_eq_add_one,
            refine le_trans (nat.add_le_add hk (le_refl _)) (sinc _),
    end

/--
-/
def nonneg_compose_preserve
    [has_zero α] [has_le α]
    (seq : nat → α) (φ : nat → nat)
    : 0 ≤ seq → 0 ≤ seq ∘ φ
    := λ p _, p (φ _)

/--
-/
def translate
    (seq : nat → α)
    (k)
    (n)
    := seq (k + n)

/--
-/
def translate.preserve_nonneg
    [has_zero α] [has_le α]
    (seq : nat → α)
    : 0 ≤ seq → 0 ≤ translate seq
    := λ p _ _, p _

/--
-/
def translate.monotonicity
    [has_le α]
    {a b : nat → α}
    : a ≤ b → translate a ≤ translate b
    := λ p _ _, p _

/--
-/
def translate.combine
    (seq : nat → α)
    (i j)
    : translate (translate seq i) j = translate seq (i + j)
    := funext (λ _, by rw [translate, translate, translate, nat.add_assoc])

/--
-/
def translate.compose_commute
    (seq : nat → α)
    (f : α → β)
    (n k)
    : f (translate seq n k) = translate (f ∘ seq) n k
    := by rw [translate, translate]

/--
-/
def translate.compose_commute.funext
    (seq : nat → α)
    (f : α → β)
    (n)
    : f ∘ (translate seq n) = translate (f ∘ seq) n
    := funext (translate.compose_commute seq f n)

end sequences --—————————————————————————————————————————————————————————————————————————--

section series --————————————————————————————————————————————————————————————————————————--
variables [has_zero α] [has_add α]

/--
-/
def partial_sum (seq : nat → α) : nat → α
| (nat.zero  ) := 0
| (nat.succ n) := seq n + partial_sum n

/--
-/
def partial_sum.preserve_nonneg
    [preorder α] [has_add_nonneg α]

    (seq : nat → α)

    : 0 ≤ seq → 0 ≤ partial_sum seq :=

    begin
        intros nonneg k,
        induction k with k hk,
            refine le_refl _,
            refine has_add_nonneg.le (nonneg _) hk,
    end

/--
-/
def partial_sum.left_mul_commute
    [has_mul α] [has_mul_zero_is_zero α] [has_left_add_distributivity α]
    (seq : nat → α)
    (C)
    : partial_sum (λ k, C * seq k) = λ n, C * partial_sum seq n :=
    begin
        refine funext _,
        intros n,
        induction n with n hn,
            rw partial_sum,
            rw partial_sum,
            rw has_mul_zero_is_zero.eq,
            rw partial_sum,
            rw partial_sum,
            rw hn,
            rw has_left_add_distributivity.eq,
    end

/--
-/
def partial_sum.right_mul_commute
    [has_mul α] [has_zero_mul_is_zero α] [has_right_add_distributivity α]
    (seq : nat → α)
    (C)
    : partial_sum (λ k, seq k * C) = λ n, partial_sum seq n * C :=
    begin
        refine funext _,
        intros n,
        induction n with n hn,
            rw partial_sum,
            rw partial_sum,
            rw has_zero_mul_is_zero.eq,
            rw partial_sum,
            rw partial_sum,
            rw hn,
            rw has_right_add_distributivity.eq,
    end

/--
-/
def partial_sum.from_mul
    [has_one α]
    [has_mul α]

    [has_zero_mul_is_zero α]
    [has_left_unit α]
    [has_right_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α)
    (n : nat)

    : ↑n * a = partial_sum ↓a n :=

    begin
        induction n with n hn,
            rw partial_sum,
            rw has_lift_zero_same.eq,
            rw has_zero_mul_is_zero.eq,
            rw partial_sum,
            rw nat.succ_eq_add_one,
            rw nat.add_comm,
            rw has_lift_add_comm.eq,
            rw has_right_add_distributivity.eq,
            rw has_lift_one_same.eq,
            rw has_left_unit.eq,
            rw hn,
            rw const,
    end

/--
-/
def partial_sum.from_mul'
    [has_one α]
    [has_mul α]

    [has_mul_zero_is_zero α]
    [has_right_unit α]
    [has_left_add_distributivity α]

    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_one_same nat α]
    [has_lift_add_comm nat α]

    (a : α)
    (n : nat)

    : a * ↑n = partial_sum ↓a n :=

    begin
        induction n with n hn,
            rw partial_sum,
            rw has_lift_zero_same.eq,
            rw has_mul_zero_is_zero.eq,
            rw partial_sum,
            rw nat.succ_eq_add_one,
            rw nat.add_comm,
            rw has_lift_add_comm.eq,
            rw has_left_add_distributivity.eq,
            rw has_lift_one_same.eq,
            rw has_right_unit.eq,
            rw hn,
            rw const,
    end

/--
-/
def partial_sum.monotonicity
    [preorder α] [has_add_le_add α]
    {a b : nat → α}
    : a ≤ b → partial_sum a ≤ partial_sum b :=
    begin
        intros a_le_b n,
        induction n with _ hn,
            refine le_refl _,
            refine has_add_le_add.le (a_le_b _) hn,
    end

/--
-/
def partial_sum.index_monotonicity
    [preorder α] [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {m n}

    : m ≤ n → partial_sum seq m ≤ partial_sum seq n :=

    begin
        intros m_le_n,
        induction n with n hn,
            cases m_le_n,
                refine le_refl _,
            cases nat.of_le_succ m_le_n,
                refine has_le_add_of_nonneg_of_le.le (nonneg _) (hn h),
                rw ← h,
    end

/--
-/
def partial_sum.double_monotonicity
    [preorder α] [has_le_add_of_nonneg_of_le α] [has_add_le_add α]

    (a : nat → α) (na)
    (b : nat → α) (nb)

    : 0 ≤ a → a ≤ b → na ≤ nb → partial_sum a na ≤ partial_sum b nb :=

    begin
        intros zero_le_a a_le_b na_le_nb,
        induction nb with _ hnb,
            cases na_le_nb,
                refine le_refl _,
            cases nat.of_le_succ na_le_nb,
                refine has_le_add_of_nonneg_of_le.le
                    (le_trans (zero_le_a _) (a_le_b _)) (hnb h),
                rw h,
                refine has_add_le_add.le
                    (a_le_b _) (partial_sum.monotonicity a_le_b _),
    end

/--
-/
def partial_sum.sub_as_translate
    [has_sub α] [has_sub_self_is_zero α] [has_add_sub_assoc α]

    (seq : nat → α)

    {m n} (m_le_n : m ≤ n)

    : partial_sum seq n - partial_sum seq m = partial_sum (translate seq m) (n - m) :=

    begin
        induction n with n hn,
            cases m_le_n,
                refine has_sub_self_is_zero.eq _,
            cases m_le_n with _ m_le_n,
                rw has_sub_self_is_zero.eq,
                rw nat.sub_self,
                rw partial_sum,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                rw hn m_le_n,
                rw nat.succ_sub m_le_n,
                rw partial_sum,
                rw translate,
                rw nat.add_sub_of_le m_le_n,
    end

/--
-/
def partial_sum.lower_differences.bottom
    [has_sub α]
    [has_add_sub_assoc α]
    [has_sub_self_is_zero α]

    [preorder α]
    [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {m n} (m_le_n : m ≤ n)

    : 0 ≤ partial_sum seq n - partial_sum seq m :=

    begin
        induction n with n hn,
            cases m_le_n,
                rw has_sub_self_is_zero.eq,
            cases nat.of_le_succ m_le_n,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                refine has_le_add_of_nonneg_of_le.le (nonneg _) (hn h),
                rw ← h,
                rw has_sub_self_is_zero.eq,
    end

/--
-/
def partial_sum.lower_differences
    [has_sub α]
    [has_sub_self_is_zero α]
    [has_add_sub_assoc α]

    [preorder α]
    [has_add_le_add α]
    [has_le_add_of_nonneg_of_le α]

    (seq : nat → α) (nonneg : 0 ≤ seq)

    {k m n} (k_le_m : k ≤ m) (m_le_n : m ≤ n)

    : partial_sum seq n - partial_sum seq m ≤ partial_sum seq n - partial_sum seq k :=

    begin
        induction n with n hn,
            cases m_le_n,
                cases k_le_m,
                    refine le_refl _,
            cases nat.of_le_succ m_le_n,
                rw partial_sum,
                rw has_add_sub_assoc.eq,
                rw has_add_sub_assoc.eq,
                refine has_add_le_add.le (le_refl _) (hn h),
                rw ← h,
                rw has_sub_self_is_zero.eq,
                refine partial_sum.lower_differences.bottom _ nonneg k_le_m,
    end

--———————————————————————————————————————————————————————————————————————————————————————--
variables [has_sub α]

/--
-/
def shape_sum (seq : nat → α) (φ : nat → nat) (n : nat)
    := partial_sum seq (φ n.succ) - partial_sum seq (φ n)

/--
-/
def shape_sum.unfold
    [has_sub_self_is_zero α]
    [has_add_sub_assoc α]
    [has_sub_add_sub_cancel α]

    (seq : nat → α)

    (φ) (sinc_φ : strictly_increasing φ)

    {m n} (m_le_n : m ≤ n)

    : partial_sum (translate (shape_sum seq φ) m) (n - m)
    = partial_sum (translate seq (φ m)) (φ n - φ m) :=

    begin
        let strong_inc := strictly_increasing.as_increasing_strong _ sinc_φ,
        induction n with n hn,
            cases m_le_n,
                rw [nat.sub_self, nat.sub_self, partial_sum, partial_sum],
            cases nat.of_le_succ m_le_n,
                rw nat.succ_sub h,
                rw partial_sum,
                rw hn h,
                rw translate,
                rw nat.add_sub_of_le h,
                rw shape_sum,
                rw ← partial_sum.sub_as_translate seq (strong_inc _ _ h),
                rw ← partial_sum.sub_as_translate seq (strong_inc _ _ m_le_n),
                rw has_sub_add_sub_cancel.eq,
                rw h,
                rw [nat.sub_self, nat.sub_self, partial_sum, partial_sum],
    end

end series --————————————————————————————————————————————————————————————————————————————--

section absolute_value --————————————————————————————————————————————————————————————————--
variables [has_zero α] [has_add α]

/--
-/
def triangle_inequality
    [has_zero β] [has_add β] [preorder β] [has_add_le_add β]

    (abs          : α → β)
    (abs_zero     : abs 0 = 0)
    (abs_triangle : Π x y, abs (x + y) ≤ abs x + abs y)

    (seq) (n)

    : abs (partial_sum seq n) ≤ partial_sum (abs ∘ seq) n :=

    begin
        induction n with _ hn,
            rw [partial_sum, partial_sum],
            rw abs_zero,
            refine le_trans (abs_triangle _ _) (has_add_le_add.le (le_refl _) hn),
    end

/--
-/
def triangle_equality
    [preorder α] [has_add_nonneg α]

    (abs           : α → α)
    (nonneg_to_abs : Π z, 0 ≤ z → abs z = z)

    (seq nonneg) (n)

    : abs (partial_sum seq n) = partial_sum seq n

    := nonneg_to_abs _ (partial_sum.preserve_nonneg _ nonneg _)

end absolute_value --————————————————————————————————————————————————————————————————————--

end riemann_hypothesis --————————————————————————————————————————————————————————————————--