/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Johan Commelin, Patrick Massot
-/

import algebra.linear_ordered_comm_group_with_zero
import algebra.group_power
import ring_theory.ideal.operations
import algebra.punit_instances

/-!

# The basics of valuation theory.

The basic theory of valuations (non-archimedean norms) on a commutative ring,
following T. Wedhorn's unpublished notes “Adic Spaces” ([wedhorn_adic]).

The definition of a valuation we use here is Definition 1.22 of [wedhorn_adic].
A valuation on a ring `R` is a monoid homomorphism `v` to a linearly ordered
commutative monoid with zero, that in addition satisfies the following two axioms:
 * `v 0 = 0`
 * `∀ x y, v (x + y) ≤ max (v x) (v y)`

`valuation R Γ₀`is the type of valuations `R → Γ₀`, with a coercion to the underlying
function. If `v` is a valuation from `R` to `Γ₀` then the induced group
homomorphism `units(R) → Γ₀` is called `unit_map v`.

The equivalence "relation" `is_equiv v₁ v₂ : Prop` defined in 1.27 of [wedhorn_adic] is not strictly
speaking a relation, because `v₁ : valuation R Γ₁` and `v₂ : valuation R Γ₂` might
not have the same type. This corresponds in ZFC to the set-theoretic difficulty
that the class of all valuations (as `Γ₀` varies) on a ring `R` is not a set.
The "relation" is however reflexive, symmetric and transitive in the obvious
sense. Note that we use 1.27(iii) of [wedhorn_adic] as the definition of equivalence.

The support of a valuation `v : valuation R Γ₀` is `supp v`. If `J` is an ideal of `R`
with `h : J ⊆ supp v` then the induced valuation
on R / J = `ideal.quotient J` is `on_quot v h`.

## Main definitions

* `valuation R Γ₀`, the type of valuations on `R` with values in `Γ₀`
* `valuation.is_equiv`, the heterogeneous equivalence relation on valuations
* `valuation.supp`, the support of a valuation

* `add_valuation R Γ₀`, the type of additive valuations on `R` with values in a
  linearly ordered additive commutative group with a top element, `Γ₀`.

## Implementation Details
`add_valuation R Γ₀` is implemented as `valuation R (multiplicative (order_dual Γ₀))`.

-/

open_locale classical big_operators
noncomputable theory

open function ideal

variables {R : Type*} -- This will be a ring, assumed commutative in some sections

set_option old_structure_cmd true

section
variables (R) (Γ₀ : Type*) [linear_ordered_comm_monoid_with_zero Γ₀] [ring R]

/-- The type of `Γ₀`-valued valuations on `R`. -/
@[nolint has_inhabited_instance]
structure valuation extends monoid_with_zero_hom R Γ₀ :=
(map_add' : ∀ x y, to_fun (x + y) ≤ max (to_fun x) (to_fun y))

/-- The `monoid_with_zero_hom` underlying a valuation. -/
add_decl_doc valuation.to_monoid_with_zero_hom

end

namespace valuation

variables {Γ₀   : Type*}
variables {Γ'₀  : Type*}
variables {Γ''₀ : Type*} [linear_ordered_comm_monoid_with_zero Γ''₀]

section basic

variables (R) (Γ₀) [ring R]

section monoid
variables [linear_ordered_comm_monoid_with_zero Γ₀] [linear_ordered_comm_monoid_with_zero Γ'₀]

/-- A valuation is coerced to the underlying function `R → Γ₀`. -/
instance : has_coe_to_fun (valuation R Γ₀) := { F := λ _, R → Γ₀, coe := valuation.to_fun }

/-- A valuation is coerced to a monoid morphism R → Γ₀. -/
instance : has_coe (valuation R Γ₀) (monoid_with_zero_hom R Γ₀) :=
⟨valuation.to_monoid_with_zero_hom⟩

variables {R} {Γ₀} (v : valuation R Γ₀) {x y z : R}

@[simp, norm_cast] lemma coe_coe : ((v : monoid_with_zero_hom R Γ₀) : R → Γ₀) = v := rfl

@[simp] lemma map_zero : v 0 = 0 := v.map_zero'
@[simp] lemma map_one  : v 1 = 1 := v.map_one'
@[simp] lemma map_mul  : ∀ x y, v (x * y) = v x * v y := v.map_mul'
@[simp] lemma map_add  : ∀ x y, v (x + y) ≤ max (v x) (v y) := v.map_add'

lemma map_add_le {x y g} (hx : v x ≤ g) (hy : v y ≤ g) : v (x + y) ≤ g :=
le_trans (v.map_add x y) $ max_le hx hy

lemma map_add_lt {x y g} (hx : v x < g) (hy : v y < g) : v (x + y) < g :=
lt_of_le_of_lt (v.map_add x y) $ max_lt hx hy

lemma map_sum_le {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hf : ∀ i ∈ s, v (f i) ≤ g) :
  v (∑ i in s, f i) ≤ g :=
begin
  refine finset.induction_on s
    (λ _, trans_rel_right (≤) v.map_zero zero_le') (λ a s has ih hf, _) hf,
  rw finset.forall_mem_insert at hf, rw finset.sum_insert has,
  exact v.map_add_le hf.1 (ih hf.2)
end

lemma map_sum_lt {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : g ≠ 0)
  (hf : ∀ i ∈ s, v (f i) < g) : v (∑ i in s, f i) < g :=
begin
  refine finset.induction_on s
    (λ _, trans_rel_right (<) v.map_zero (zero_lt_iff.2 hg)) (λ a s has ih hf, _) hf,
  rw finset.forall_mem_insert at hf, rw finset.sum_insert has,
  exact v.map_add_lt hf.1 (ih hf.2)
end

lemma map_sum_lt' {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : 0 < g)
  (hf : ∀ i ∈ s, v (f i) < g) : v (∑ i in s, f i) < g :=
v.map_sum_lt (ne_of_gt hg) hf

@[simp] lemma map_pow  : ∀ x (n:ℕ), v (x^n) = (v x)^n :=
v.to_monoid_with_zero_hom.to_monoid_hom.map_pow

@[ext] lemma ext {v₁ v₂ : valuation R Γ₀} (h : ∀ r, v₁ r = v₂ r) : v₁ = v₂ :=
by { cases v₁, cases v₂, congr, funext r, exact h r }

lemma ext_iff {v₁ v₂ : valuation R Γ₀} : v₁ = v₂ ↔ ∀ r, v₁ r = v₂ r :=
⟨λ h r, congr_arg _ h, ext⟩

-- The following definition is not an instance, because we have more than one `v` on a given `R`.
-- In addition, type class inference would not be able to infer `v`.

/-- A valuation gives a preorder on the underlying ring. -/
def to_preorder : preorder R := preorder.lift v

/-- If `v` is a valuation on a division ring then `v(x) = 0` iff `x = 0`. -/
@[simp] lemma zero_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
  (v : valuation K Γ₀) {x : K} : v x = 0 ↔ x = 0 :=
v.to_monoid_with_zero_hom.map_eq_zero

lemma ne_zero_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
  (v : valuation K Γ₀) {x : K} : v x ≠ 0 ↔ x ≠ 0 :=
v.to_monoid_with_zero_hom.map_ne_zero

theorem unit_map_eq (u : units R) :
  (units.map (v : R →* Γ₀) u : Γ₀) = v u := rfl

/-- A ring homomorphism `S → R` induces a map `valuation R Γ₀ → valuation S Γ₀`. -/
def comap {S : Type*} [ring S] (f : S →+* R) (v : valuation R Γ₀) :
  valuation S Γ₀ :=
{ to_fun := v ∘ f,
  map_add' := λ x y, by simp only [comp_app, map_add, f.map_add],
  .. v.to_monoid_with_zero_hom.comp f.to_monoid_with_zero_hom, }

@[simp] lemma comap_id : v.comap (ring_hom.id R) = v := ext $ λ r, rfl

lemma comap_comp {S₁ : Type*} {S₂ : Type*} [ring S₁] [ring S₂] (f : S₁ →+* S₂) (g : S₂ →+* R) :
  v.comap (g.comp f) = (v.comap g).comap f :=
ext $ λ r, rfl

/-- A `≤`-preserving group homomorphism `Γ₀ → Γ'₀` induces a map `valuation R Γ₀ → valuation R Γ'₀`.
-/
def map (f : monoid_with_zero_hom Γ₀ Γ'₀) (hf : monotone f) (v : valuation R Γ₀) :
  valuation R Γ'₀ :=
{ to_fun := f ∘ v,
  map_add' := λ r s,
    calc f (v (r + s)) ≤ f (max (v r) (v s))     : hf (v.map_add r s)
                   ... = max (f (v r)) (f (v s)) : hf.map_max,
  .. monoid_with_zero_hom.comp f v.to_monoid_with_zero_hom }

/-- Two valuations on `R` are defined to be equivalent if they induce the same preorder on `R`. -/
def is_equiv (v₁ : valuation R Γ₀) (v₂ : valuation R Γ'₀) : Prop :=
∀ r s, v₁ r ≤ v₁ s ↔ v₂ r ≤ v₂ s

end monoid

section group
variables [linear_ordered_comm_group_with_zero Γ₀] {R} {Γ₀} (v : valuation R Γ₀) {x y z : R}

@[simp] lemma map_inv {K : Type*} [division_ring K]
  (v : valuation K Γ₀) {x : K} : v x⁻¹ = (v x)⁻¹ :=
v.to_monoid_with_zero_hom.map_inv' x

lemma map_units_inv (x : units R) : v (x⁻¹ : units R) = (v x)⁻¹ :=
v.to_monoid_with_zero_hom.to_monoid_hom.map_units_inv x

@[simp] lemma map_neg (x : R) : v (-x) = v x :=
v.to_monoid_with_zero_hom.to_monoid_hom.map_neg x

lemma map_sub_swap (x y : R) : v (x - y) = v (y - x) :=
v.to_monoid_with_zero_hom.to_monoid_hom.map_sub_swap x y

lemma map_sub_le_max (x y : R) : v (x - y) ≤ max (v x) (v y) :=
calc v (x - y) = v (x + -y)         : by rw [sub_eq_add_neg]
           ... ≤ max (v x) (v $ -y) : v.map_add _ _
           ... = max (v x) (v y)    : by rw map_neg

lemma map_add_of_distinct_val (h : v x ≠ v y) : v (x + y) = max (v x) (v y) :=
begin
  suffices : ¬v (x + y) < max (v x) (v y),
    from or_iff_not_imp_right.1 (le_iff_eq_or_lt.1 (v.map_add x y)) this,
  intro h',
  wlog vyx : v y < v x using x y,
  { apply lt_or_gt_of_ne h.symm },
  { rw max_eq_left_of_lt vyx at h',
    apply lt_irrefl (v x),
    calc v x = v ((x+y) - y)         : by simp
         ... ≤ max (v $ x + y) (v y) : map_sub_le_max _ _ _
         ... < v x                   : max_lt h' vyx },
  { apply this h.symm,
    rwa [add_comm, max_comm] at h' }
end

lemma map_eq_of_sub_lt (h : v (y - x) < v x) : v y = v x :=
begin
  have := valuation.map_add_of_distinct_val v (ne_of_gt h).symm,
  rw max_eq_right (le_of_lt h) at this,
  simpa using this
end

end group
end basic -- end of section

namespace is_equiv
variables [ring R]
variables [linear_ordered_comm_monoid_with_zero Γ₀] [linear_ordered_comm_monoid_with_zero Γ'₀]
variables {v : valuation R Γ₀}
variables {v₁ : valuation R Γ₀} {v₂ : valuation R Γ'₀} {v₃ : valuation R Γ''₀}

@[refl] lemma refl : v.is_equiv v :=
λ _ _, iff.refl _

@[symm] lemma symm (h : v₁.is_equiv v₂) : v₂.is_equiv v₁ :=
λ _ _, iff.symm (h _ _)

@[trans] lemma trans (h₁₂ : v₁.is_equiv v₂) (h₂₃ : v₂.is_equiv v₃) : v₁.is_equiv v₃ :=
λ _ _, iff.trans (h₁₂ _ _) (h₂₃ _ _)

lemma of_eq {v' : valuation R Γ₀} (h : v = v') : v.is_equiv v' :=
by { subst h }

lemma map {v' : valuation R Γ₀} (f : monoid_with_zero_hom Γ₀ Γ'₀) (hf : monotone f)
  (inf : injective f) (h : v.is_equiv v') :
  (v.map f hf).is_equiv (v'.map f hf) :=
let H : strict_mono f := strict_mono_of_monotone_of_injective hf inf in
λ r s,
calc f (v r) ≤ f (v s) ↔ v r ≤ v s   : by rw H.le_iff_le
                   ... ↔ v' r ≤ v' s : h r s
                   ... ↔ f (v' r) ≤ f (v' s) : by rw H.le_iff_le

/-- `comap` preserves equivalence. -/
lemma comap {S : Type*} [ring S] (f : S →+* R) (h : v₁.is_equiv v₂) :
  (v₁.comap f).is_equiv (v₂.comap f) :=
λ r s, h (f r) (f s)

lemma val_eq (h : v₁.is_equiv v₂) {r s : R} :
  v₁ r = v₁ s ↔ v₂ r = v₂ s :=
by simpa only [le_antisymm_iff] using and_congr (h r s) (h s r)

lemma ne_zero (h : v₁.is_equiv v₂) {r : R} :
  v₁ r ≠ 0 ↔ v₂ r ≠ 0 :=
begin
  have : v₁ r ≠ v₁ 0 ↔ v₂ r ≠ v₂ 0 := not_iff_not_of_iff h.val_eq,
  rwa [v₁.map_zero, v₂.map_zero] at this,
end

end is_equiv -- end of namespace

section

lemma is_equiv_of_map_strict_mono [linear_ordered_comm_monoid_with_zero Γ₀]
  [linear_ordered_comm_monoid_with_zero Γ'₀]
  [ring R] {v : valuation R Γ₀}
  (f : monoid_with_zero_hom Γ₀ Γ'₀) (H : strict_mono f) :
  is_equiv (v.map f (H.monotone)) v :=
λ x y, ⟨H.le_iff_le.mp, λ h, H.monotone h⟩

lemma is_equiv_of_val_le_one [linear_ordered_comm_group_with_zero Γ₀]
  [linear_ordered_comm_group_with_zero Γ'₀]
  {K : Type*} [division_ring K]
  (v : valuation K Γ₀) (v' : valuation K Γ'₀) (h : ∀ {x:K}, v x ≤ 1 ↔ v' x ≤ 1) :
  v.is_equiv v' :=
begin
  intros x y,
  by_cases hy : y = 0, { simp [hy, zero_iff], },
  rw show y = 1 * y, by rw one_mul,
  rw [← (inv_mul_cancel_right' hy x)],
  iterate 2 {rw [v.map_mul _ y, v'.map_mul _ y]},
  rw [v.map_one, v'.map_one],
  split; intro H,
  { apply mul_le_mul_right',
    replace hy := v.ne_zero_iff.mpr hy,
    replace H := le_of_le_mul_right hy H,
    rwa h at H, },
  { apply mul_le_mul_right',
    replace hy := v'.ne_zero_iff.mpr hy,
    replace H := le_of_le_mul_right hy H,
    rwa h, },
end

end

section supp
variables [comm_ring R]
variables [linear_ordered_comm_monoid_with_zero Γ₀] [linear_ordered_comm_monoid_with_zero Γ'₀]
variables (v : valuation R Γ₀)

/-- The support of a valuation `v : R → Γ₀` is the ideal of `R` where `v` vanishes. -/
def supp : ideal R :=
{ carrier   := {x | v x = 0},
  zero_mem' := map_zero v,
  add_mem'  := λ x y hx hy, le_zero_iff.mp $
    calc v (x + y) ≤ max (v x) (v y) : v.map_add x y
               ... ≤ 0               : max_le (le_zero_iff.mpr hx) (le_zero_iff.mpr hy),
  smul_mem' := λ c x hx, calc v (c * x)
                        = v c * v x : map_mul v c x
                    ... = v c * 0 : congr_arg _ hx
                    ... = 0 : mul_zero _ }

@[simp] lemma mem_supp_iff (x : R) : x ∈ supp v ↔ v x = 0 := iff.rfl
-- @[simp] lemma mem_supp_iff' (x : R) : x ∈ (supp v : set R) ↔ v x = 0 := iff.rfl

/-- The support of a valuation is a prime ideal. -/
instance [nontrivial Γ₀] [no_zero_divisors Γ₀] : ideal.is_prime (supp v) :=
⟨λ (h : v.supp = ⊤), one_ne_zero $ show (1 : Γ₀) = 0,
from calc 1 = v 1 : v.map_one.symm
        ... = 0   : show (1:R) ∈ supp v, by { rw h, trivial },
 λ x y hxy, begin
    show v x = 0 ∨ v y = 0,
    change v (x * y) = 0 at hxy,
    rw [v.map_mul x y] at hxy,
    exact eq_zero_or_eq_zero_of_mul_eq_zero hxy
  end⟩

lemma map_add_supp (a : R) {s : R} (h : s ∈ supp v) : v (a + s) = v a :=
begin
  have aux : ∀ a s, v s = 0 → v (a + s) ≤ v a,
  { intros a' s' h', refine le_trans (v.map_add a' s') (max_le (le_refl _) _), simp [h'], },
  apply le_antisymm (aux a s h),
  calc v a = v (a + s + -s) : by simp
       ... ≤ v (a + s)      : aux (a + s) (-s) (by rwa ←ideal.neg_mem_iff at h)
end

/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
Note: it's just the function; the valuation is `on_quot hJ`. -/
def on_quot_val {J : ideal R} (hJ : J ≤ supp v) :
  J.quotient → Γ₀ :=
λ q, quotient.lift_on' q v $ λ a b h,
calc v a = v (b + (a - b)) : by simp
     ... = v b             : v.map_add_supp b (hJ h)

/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
def on_quot {J : ideal R} (hJ : J ≤ supp v) :
  valuation J.quotient Γ₀ :=
{ to_fun := v.on_quot_val hJ,
  map_zero' := v.map_zero,
  map_one'  := v.map_one,
  map_mul'  := λ xbar ybar, quotient.ind₂' v.map_mul xbar ybar,
  map_add'  := λ xbar ybar, quotient.ind₂' v.map_add xbar ybar }

@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
ext $ λ r,
begin
  refine @quotient.lift_on_mk _ _ (J.quotient_rel) v (λ a b h, _) _,
  calc v a = v (b + (a - b)) : by simp
       ... = v b             : v.map_add_supp b (hJ h)
end

lemma comap_supp {S : Type*} [comm_ring S] (f : S →+* R) :
  supp (v.comap f) = ideal.comap f v.supp :=
ideal.ext $ λ x,
begin
  rw [mem_supp_iff, ideal.mem_comap, mem_supp_iff],
  refl,
end

lemma self_le_supp_comap (J : ideal R) (v : valuation (quotient J) Γ₀) :
  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
by { rw [comap_supp, ← ideal.map_le_iff_le_comap], simp }

@[simp] lemma comap_on_quot_eq (J : ideal R) (v : valuation J.quotient Γ₀) :
  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
ext $ by { rintro ⟨x⟩, refl }

/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
begin
  apply le_antisymm,
  { rintro ⟨x⟩ hx,
    apply ideal.subset_span,
    exact ⟨x, hx, rfl⟩ },
  { rw ideal.map_le_iff_le_comap,
    intros x hx, exact hx }
end

lemma supp_quot_supp : supp (v.on_quot (le_refl _)) = 0 :=
by { rw supp_quot, exact ideal.map_quotient_self _ }

end supp -- end of section

end valuation

section add_monoid

variables (R) [ring R] (Γ₀ : Type*) [linear_ordered_add_comm_monoid_with_top Γ₀]

/-- The type of `Γ₀`-valued additive valuations on `R`. -/
@[nolint has_inhabited_instance]
def add_valuation := valuation R (multiplicative (order_dual Γ₀))

end add_monoid

namespace add_valuation
variables {Γ₀   : Type*} [linear_ordered_add_comm_monoid_with_top Γ₀]
variables {Γ'₀  : Type*} [linear_ordered_add_comm_monoid_with_top Γ'₀]

section basic

variables (R) (Γ₀) [ring R]

/-- A valuation is coerced to the underlying function `R → Γ₀`. -/
instance : has_coe_to_fun (add_valuation R Γ₀) := { F := λ _, R → Γ₀, coe := valuation.to_fun }

variables {R} {Γ₀} (v : add_valuation R Γ₀) {x y z : R}

section

variables (f : R → Γ₀) (h0 : f 0 = ⊤) (h1 : f 1 = 0)
variables (hadd : ∀ x y, min (f x) (f y) ≤ f (x + y)) (hmul : ∀ x y, f (x * y) = f x + f y)

/-- An alternate constructor of `add_valuation`, that doesn't reference
  `multiplicative (order_dual Γ₀)` -/
def of : add_valuation R Γ₀ :=
{ to_fun := f,
  map_one' := h1,
  map_zero' := h0,
  map_add' := hadd,
  map_mul' := hmul }

variables {h0} {h1} {hadd} {hmul} {r : R}

@[simp]
theorem of_apply : (of f h0 h1 hadd hmul) r = f r := rfl

end

@[simp] lemma map_zero : v 0 = ⊤ := v.map_zero
@[simp] lemma map_one  : v 1 = 0 := v.map_one
@[simp] lemma map_mul  : ∀ x y, v (x * y) = v x + v y := v.map_mul
@[simp] lemma map_add  : ∀ x y, min (v x) (v y) ≤ v (x + y) := v.map_add

lemma map_le_add {x y g} (hx : g ≤ v x) (hy : g ≤ v y) : g ≤ v (x + y) := v.map_add_le hx hy

lemma map_lt_add {x y g} (hx : g < v x) (hy : g < v y) : g < v (x + y) := v.map_add_lt hx hy

lemma map_le_sum {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hf : ∀ i ∈ s, g ≤ v (f i)) :
  g ≤ v (∑ i in s, f i) := v.map_sum_le hf

lemma map_lt_sum {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : g ≠ ⊤)
  (hf : ∀ i ∈ s, g < v (f i)) : g < v (∑ i in s, f i) := v.map_sum_lt hg hf

lemma map_lt_sum' {ι : Type*} {s : finset ι} {f : ι → R} {g : Γ₀} (hg : g < ⊤)
  (hf : ∀ i ∈ s, g < v (f i)) : g < v (∑ i in s, f i) := v.map_sum_lt' hg hf

@[simp] lemma map_pow  : ∀ x (n:ℕ), v (x^n) = n • (v x) := v.map_pow

@[ext] lemma ext {v₁ v₂ : add_valuation R Γ₀} (h : ∀ r, v₁ r = v₂ r) : v₁ = v₂ :=
valuation.ext h

lemma ext_iff {v₁ v₂ : add_valuation R Γ₀} : v₁ = v₂ ↔ ∀ r, v₁ r = v₂ r :=
valuation.ext_iff

-- The following definition is not an instance, because we have more than one `v` on a given `R`.
-- In addition, type class inference would not be able to infer `v`.

/-- A valuation gives a preorder on the underlying ring. -/
def to_preorder : preorder R := preorder.lift v

/-- If `v` is an additive valuation on a division ring then `v(x) = ⊤` iff `x = 0`. -/
@[simp] lemma top_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
  (v : add_valuation K Γ₀) {x : K} : v x = ⊤ ↔ x = 0 :=
v.zero_iff

lemma ne_top_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
  (v : add_valuation K Γ₀) {x : K} : v x ≠ ⊤ ↔ x ≠ 0 := v.ne_zero_iff

/-- A ring homomorphism `S → R` induces a map `add_valuation R Γ₀ → add_valuation S Γ₀`. -/
def comap {S : Type*} [ring S] (f : S →+* R) (v : add_valuation R Γ₀) :
  add_valuation S Γ₀ :=
v.comap f

@[simp] lemma comap_id : v.comap (ring_hom.id R) = v := v.comap_id

lemma comap_comp {S₁ : Type*} {S₂ : Type*} [ring S₁] [ring S₂] (f : S₁ →+* S₂) (g : S₂ →+* R) :
  v.comap (g.comp f) = (v.comap g).comap f :=
v.comap_comp f g

/-- A `≤`-preserving, `⊤`-preserving group homomorphism `Γ₀ → Γ'₀` induces a map
  `add_valuation R Γ₀ → add_valuation R Γ'₀`.
-/
def map (f : Γ₀ →+ Γ'₀) (ht : f ⊤ = ⊤) (hf : monotone f) (v : add_valuation R Γ₀) :
  add_valuation R Γ'₀ :=
v.map {
  to_fun := f,
  map_mul' := f.map_add,
  map_one' := f.map_zero,
  map_zero' := ht } (λ x y h, hf h)

/-- Two additive valuations on `R` are defined to be equivalent if they induce the same
  preorder on `R`. -/
def is_equiv (v₁ : add_valuation R Γ₀) (v₂ : add_valuation R Γ'₀) : Prop :=
v₁.is_equiv v₂

end basic

namespace is_equiv
variables [ring R]
variables {Γ''₀ : Type*} [linear_ordered_add_comm_monoid_with_top Γ''₀]
variables {v : add_valuation R Γ₀}
variables {v₁ : add_valuation R Γ₀} {v₂ : add_valuation R Γ'₀} {v₃ : add_valuation R Γ''₀}

@[refl] lemma refl : v.is_equiv v := valuation.is_equiv.refl

@[symm] lemma symm (h : v₁.is_equiv v₂) : v₂.is_equiv v₁ := h.symm

@[trans] lemma trans (h₁₂ : v₁.is_equiv v₂) (h₂₃ : v₂.is_equiv v₃) : v₁.is_equiv v₃ :=
h₁₂.trans h₂₃

lemma of_eq {v' : add_valuation R Γ₀} (h : v = v') : v.is_equiv v' :=
valuation.is_equiv.of_eq h

lemma map {v' : add_valuation R Γ₀} (f : Γ₀ →+ Γ'₀) (ht : f ⊤ = ⊤) (hf : monotone f)
  (inf : injective f) (h : v.is_equiv v') :
  (v.map f ht hf).is_equiv (v'.map f ht hf) :=
h.map {
  to_fun := f,
  map_mul' := f.map_add,
  map_one' := f.map_zero,
  map_zero' := ht } (λ x y h, hf h) inf

/-- `comap` preserves equivalence. -/
lemma comap {S : Type*} [ring S] (f : S →+* R) (h : v₁.is_equiv v₂) :
  (v₁.comap f).is_equiv (v₂.comap f) :=
h.comap f

lemma val_eq (h : v₁.is_equiv v₂) {r s : R} :
  v₁ r = v₁ s ↔ v₂ r = v₂ s :=
h.val_eq

end is_equiv

section supp
variables [comm_ring R]
variables (v : add_valuation R Γ₀)

/-- The support of an additive valuation `v : R → Γ₀` is the ideal of `R` where `v x = ⊤` -/
def supp : ideal R := v.supp

@[simp] lemma mem_supp_iff (x : R) : x ∈ supp v ↔ v x = ⊤ := v.mem_supp_iff x

lemma map_add_supp (a : R) {s : R} (h : s ∈ supp v) : v (a + s) = v a :=
v.map_add_supp a h

/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
Note: it's just the function; the valuation is `on_quot hJ`. -/
def on_quot_val {J : ideal R} (hJ : J ≤ supp v) : J.quotient → Γ₀ := v.on_quot_val hJ

/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
def on_quot {J : ideal R} (hJ : J ≤ supp v) :
  add_valuation J.quotient Γ₀ :=
v.on_quot hJ

@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
v.on_quot_comap_eq hJ

lemma comap_supp {S : Type*} [comm_ring S] (f : S →+* R) :
  supp (v.comap f) = ideal.comap f v.supp :=
v.comap_supp f

lemma self_le_supp_comap (J : ideal R) (v : add_valuation (quotient J) Γ₀) :
  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
v.self_le_supp_comap J

@[simp] lemma comap_on_quot_eq (J : ideal R) (v : add_valuation J.quotient Γ₀) :
  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
v.comap_on_quot_eq J

/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
v.supp_quot hJ

lemma supp_quot_supp : supp (v.on_quot (le_refl _)) = 0 :=
v.supp_quot_supp

end supp -- end of section

end add_valuation


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes, Morenikeji Neri
-/

import algebra.euclidean_domain
import ring_theory.ideals ring_theory.noetherian ring_theory.unique_factorization_domain

variables {α : Type*}

open set function ideal
local attribute [instance] classical.prop_decidable

class ideal.is_principal [comm_ring α] (S : ideal α) : Prop :=
(principal : ∃ a, S = span {a})

class principal_ideal_domain (α : Type*) extends integral_domain α :=
(principal : ∀ (S : ideal α), S.is_principal)
attribute [instance] principal_ideal_domain.principal
namespace ideal.is_principal
variable [comm_ring α]

noncomputable def generator (S : ideal α) [S.is_principal] : α :=
classical.some (principal S)

lemma span_singleton_generator (S : ideal α) [S.is_principal] : span {generator S} = S :=
eq.symm (classical.some_spec (principal S))

@[simp] lemma generator_mem (S : ideal α) [S.is_principal] : generator S ∈ S :=
by conv {to_rhs, rw ← span_singleton_generator S}; exact subset_span (mem_singleton _)

lemma mem_iff_generator_dvd (S : ideal α) [S.is_principal] {x : α} : x ∈ S ↔ generator S ∣ x :=
by rw [← mem_span_singleton, span_singleton_generator]

lemma eq_bot_iff_generator_eq_zero (S : ideal α) [S.is_principal] :
  S = ⊥ ↔ generator S = 0 :=
by rw [← span_singleton_eq_bot, span_singleton_generator]

end ideal.is_principal

namespace is_prime
open ideal.is_principal ideal

lemma to_maximal_ideal [principal_ideal_domain α] {S : ideal α}
  [hpi : is_prime S] (hS : S ≠ ⊥) : is_maximal S :=
is_maximal_iff.2 ⟨(ne_top_iff_one S).1 hpi.1, begin
  assume T x hST hxS hxT,
  haveI := principal_ideal_domain.principal S,
  haveI := principal_ideal_domain.principal T,
  cases (mem_iff_generator_dvd _).1 (hST $ generator_mem S) with z hz,
  cases hpi.2 (show generator T * z ∈ S, from hz ▸ generator_mem S),
  { have hTS : T ≤ S, rwa [← span_singleton_generator T, span_le, singleton_subset_iff],
    exact (hxS $ hTS hxT).elim },
  cases (mem_iff_generator_dvd _).1 h with y hy,
  have : generator S ≠ 0 := mt (eq_bot_iff_generator_eq_zero _).2 hS,
  rw [← mul_one (generator S), hy, mul_left_comm, domain.mul_left_inj this] at hz,
  exact hz.symm ▸ ideal.mul_mem_right _ (generator_mem T)
end⟩

end is_prime

section
open euclidean_domain
variable [euclidean_domain α]

lemma mod_mem_iff {S : ideal α} {x y : α} (hy : y ∈ S) : x % y ∈ S ↔ x ∈ S :=
⟨λ hxy, div_add_mod x y ▸ ideal.add_mem S (mul_mem_right S hy) hxy,
  λ hx, (mod_eq_sub_mul_div x y).symm ▸ ideal.sub_mem S hx (ideal.mul_mem_right S hy)⟩

instance euclidean_domain.to_principal_ideal_domain : principal_ideal_domain α :=
{ principal := λ S, by exactI
    ⟨if h : {x : α | x ∈ S ∧ x ≠ 0} = ∅
    then ⟨0, submodule.ext $ λ a, by rw [← @submodule.bot_coe α α _ _ ring.to_module, span_eq, submodule.mem_bot]; exact
      ⟨λ haS, by_contradiction $ λ ha0, eq_empty_iff_forall_not_mem.1 h a ⟨haS, ha0⟩,
      λ h₁, h₁.symm ▸ S.zero_mem⟩⟩
    else
    have wf : well_founded euclidean_domain.r := euclidean_domain.r_well_founded α,
    have hmin : well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ∈ S ∧
        well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ≠ 0,
      from well_founded.min_mem wf {x : α | x ∈ S ∧ x ≠ 0} h,
    ⟨well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h,
      submodule.ext $ λ x,
      ⟨λ hx, div_add_mod x (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ▸
        (mem_span_singleton.2 $ dvd_add (dvd_mul_right _ _) $
        have (x % (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ∉ {x : α | x ∈ S ∧ x ≠ 0}),
          from λ h₁, well_founded.not_lt_min wf _ h h₁ (mod_lt x hmin.2),
        have x % well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h = 0, by finish [(mod_mem_iff hmin.1).2 hx],
        by simp *),
      λ hx, let ⟨y, hy⟩ := mem_span_singleton.1 hx in hy.symm ▸ ideal.mul_mem_right _ hmin.1⟩⟩⟩ }

end

namespace principal_ideal_domain
variables [principal_ideal_domain α]

instance is_noetherian_ring : is_noetherian_ring α :=
⟨assume s : ideal α,
begin
  cases (principal s).principal with a hs,
  refine ⟨finset.singleton a, submodule.ext' _⟩, rw hs, refl
end⟩

section
local attribute [instance] classical.prop_decidable
open submodule

lemma factors_decreasing (b₁ b₂ : α) (h₁ : b₁ ≠ 0) (h₂ : ¬ is_unit b₂) :
  submodule.span α ({b₁ * b₂} : set α) < submodule.span α {b₁} :=
lt_of_le_not_le (ideal.span_le.2 $ singleton_subset_iff.2 $
  ideal.mem_span_singleton.2 ⟨b₂, rfl⟩) $ λ h,
h₂ $ is_unit_of_dvd_one _ $ (mul_dvd_mul_iff_left h₁).1 $
by rwa [mul_one, ← ideal.span_singleton_le_span_singleton]

end

lemma is_maximal_of_irreducible {p : α} (hp : irreducible p) :
  is_maximal (span ({p} : set α)) :=
⟨mt span_singleton_eq_top.1 hp.1, λ I hI, begin
  rcases principal I with ⟨a, rfl⟩,
  rw span_singleton_eq_top,
  unfreezeI,
  rcases span_singleton_le_span_singleton.1 (le_of_lt hI) with ⟨b, rfl⟩,
  refine (of_irreducible_mul hp).resolve_right (mt (λ hb, _) (not_le_of_lt hI)),
  rw [span_singleton_le_span_singleton, mul_dvd_of_is_unit_right hb]
end⟩

lemma irreducible_iff_prime {p : α} : irreducible p ↔ prime p :=
⟨λ hp, (span_singleton_prime $ nonzero_of_irreducible hp).1 $
    (is_maximal_of_irreducible hp).is_prime,
  irreducible_of_prime⟩

lemma associates_irreducible_iff_prime : ∀{p : associates α}, irreducible p ↔ p.prime :=
associates.forall_associated.2 $ assume a,
by rw [associates.irreducible_mk_iff, associates.prime_mk, irreducible_iff_prime]

section
local attribute [instance] classical.prop_decidable

noncomputable def factors (a : α) : multiset α :=
if h : a = 0 then ∅ else classical.some
  (is_noetherian_ring.exists_factors a h)

lemma factors_spec (a : α) (h : a ≠ 0) :
  (∀b∈factors a, irreducible b) ∧ associated a (factors a).prod :=
begin
  unfold factors, rw [dif_neg h],
  exact classical.some_spec
    (is_noetherian_ring.exists_factors a h)
end

/-- The unique factorization domain structure given by the principal ideal domain.

This is not added as type class instance, since the `factors` might be computed in a different way.
E.g. factors could return normalized values.
-/
noncomputable def to_unique_factorization_domain : unique_factorization_domain α :=
{ factors := factors,
  factors_prod := assume a ha, associated.symm (factors_spec a ha).2,
  prime_factors := assume a ha, by simpa [irreducible_iff_prime] using (factors_spec a ha).1 }

end

end principal_ideal_domain


import game.order.level04

namespace xena -- hide

theorem abs_le_if_pos_neg_le (c ε  : ℝ) : max (c)(-c) ≤ ε → |c| ≤ ε  :=
begin
  intro h,
  rcases lt_trichotomy c 0 with cn | cz | cp,
  swap,
  rw cz,
  rw cz at h,
  rw max_eq_left at h,
  norm_num,
  exact h,
  norm_num,
  have h1 : | c | = - c, exact abs_of_neg cn,
  rw h1,
  rw max_eq_right at h,
  exact h,
  linarith,
  have h1 : | c | = c, exact abs_of_pos cp,
  rw h1,
  rw max_eq_left at h,
  exact h,
  linarith,
end

end xena -- hide


/-
Copyright (c) 2022 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import data.nat.choose.central
import algebra.big_operators.fin
import tactic.field_simp
import tactic.linear_combination

/-!
# Catalan numbers

The Catalan numbers (http://oeis.org/A000108) are probably the most ubiquitous sequence of integers
in mathematics. They enumerate several important objects like binary trees, Dyck paths, and
triangulations of convex polygons.

## Main definitions

* `catalan n`: the `n`th Catalan number, defined recursively as
  `catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i)`.

## Main results

* `catalan_eq_central_binom_div `: The explicit formula for the Catalan number using the central
  binomial coefficient, `catalan n = nat.central_binom n / (n + 1)`.

## Implementation details

The proof of `catalan_eq_central_binom_div` follows
https://math.stackexchange.com/questions/3304415/catalan-numbers-algebraic-proof-of-the-recurrence-relation

## TODO

* Prove that the Catalan numbers enumerate many interesting objects.
* Provide the many variants of Catalan numbers, e.g. associated to complex reflection groups,
  Fuss-Catalan, etc.

-/

open_locale big_operators
open finset

/-- The recursive definition of the sequence of Catalan numbers:
`catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i)` -/
def catalan : ℕ → ℕ
| 0       := 1
| (n + 1) := ∑ i : fin n.succ, have _ := i.2, have _ := nat.lt_succ_iff.mpr (n.sub_le i),
             catalan i * catalan (n - i)

@[simp] lemma catalan_zero : catalan 0 = 1 := by rw catalan

lemma catalan_succ (n : ℕ) : catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i) :=
by rw catalan

@[simp] lemma catalan_one : catalan 1 = 1 := by simp [catalan_succ]

/-- A helper sequence that can be used to prove the equality of the recursive and the explicit
definition using a telescoping sum argument. -/
private def gosper_catalan (n j : ℕ) : ℚ :=
nat.central_binom j * nat.central_binom (n - j) * (2 * j - n) / (2 * n * (n + 1))

private lemma gosper_trick {n i : ℕ} (h : i ≤ n) :
  gosper_catalan (n+1) (i+1) - gosper_catalan (n+1) i =
  nat.central_binom i / (i + 1) * nat.central_binom (n - i) / (n - i + 1) :=
begin
  have : (n:ℚ) + 1 ≠ 0 := by exact_mod_cast n.succ_ne_zero,
  have : (n:ℚ) + 1 + 1 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero,
  have : (i:ℚ) + 1 ≠ 0 := by exact_mod_cast i.succ_ne_zero,
  have : (n:ℚ) - i + 1 ≠ 0 := by exact_mod_cast (n - i).succ_ne_zero,
  have h₁ : ((i:ℚ) + 1) * (i + 1).central_binom = 2 * (2 * i + 1) * i.central_binom,
  { exact_mod_cast nat.succ_mul_central_binom_succ i },
  have h₂ : ((n:ℚ) - i + 1) * (n - i + 1).central_binom
    = 2 * (2 * (n - i) + 1) * (n - i).central_binom,
  { exact_mod_cast nat.succ_mul_central_binom_succ (n - i) },
  simp only [gosper_catalan],
  push_cast,
  field_simp,
  rw (nat.succ_sub h),
  linear_combination
    (2:ℚ) * (n - i).central_binom * (i + 1 - (n - i)) * (n + 1) * (n + 2) * ((n - i) + 1) * h₁
    - 2 * i.central_binom * (n + 1) * (n + 2) * (i - (n - i) - 1) * (i + 1) * h₂,
end

private lemma gosper_catalan_sub_eq_central_binom_div (n : ℕ) :
  gosper_catalan (n + 1) (n + 1) - gosper_catalan (n + 1) 0 = nat.central_binom (n + 1) / (n + 2) :=
begin
  have : (n:ℚ) + 1 ≠ 0 := by exact_mod_cast n.succ_ne_zero,
  have : (n:ℚ) + 1 + 1 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero,
  have h : (n:ℚ) + 2 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero,
  simp only [gosper_catalan, nat.sub_zero, nat.central_binom_zero, nat.sub_self],
  field_simp,
  ring,
end

theorem catalan_eq_central_binom_div (n : ℕ) :
  catalan n = n.central_binom / (n + 1) :=
begin
  suffices : (catalan n : ℚ) = nat.central_binom n / (n + 1),
  { have h := nat.succ_dvd_central_binom n,
    exact_mod_cast this },
  induction n using nat.case_strong_induction_on with d hd,
  { simp },
  { simp_rw [catalan_succ, nat.cast_sum, nat.cast_mul],
    transitivity (∑ i : fin d.succ, (nat.central_binom i / (i + 1)) * (nat.central_binom (d - i) /
                  (d - i + 1)) : ℚ),
    { refine sum_congr rfl (λ i _, _),
      congr,
      { exact_mod_cast hd i i.is_le },
      { rw_mod_cast hd (d - i),
        push_cast,
        rw nat.cast_sub i.is_le,
        exact tsub_le_self }, },
    { transitivity ∑ i : fin d.succ, (gosper_catalan (d + 1) (i + 1) - gosper_catalan (d + 1) i),
      { refine sum_congr rfl (λ i _, _),
        rw_mod_cast [gosper_trick i.is_le, mul_div] },
      { rw [← sum_range (λi, gosper_catalan (d + 1) (i + 1) - gosper_catalan (d + 1) i),
            sum_range_sub, nat.succ_eq_add_one],
        exact_mod_cast gosper_catalan_sub_eq_central_binom_div d } } }
end

theorem succ_mul_catalan_eq_central_binom (n : ℕ) :
  (n+1) * catalan n = n.central_binom :=
(nat.eq_mul_of_div_eq_right n.succ_dvd_central_binom (catalan_eq_central_binom_div n).symm).symm

lemma catalan_two : catalan 2 = 2 :=
by norm_num [catalan_eq_central_binom_div, nat.central_binom, nat.choose]

lemma catalan_three : catalan 3 = 5 :=
by norm_num [catalan_eq_central_binom_div, nat.central_binom, nat.choose]


variables (x y z w : ℕ) (p : ℕ → Prop)

local attribute [simp] mul_comm mul_assoc mul_left_comm

example : x * y + z * w  * x = x * w * z + y * x :=
  by simp [add_comm]
-- lean 3.6 removes simp attributes from add_comm
-- i.e., now it is required to provide that lemma to solve this example.

example (h : p (x * y + z * w  * x)) : p (x * w * z + y * x) :=
begin
  simp [add_comm],
  simp at h,
  assumption
end
-- lean 3.6 removes simp attributes from add_comm
-- i.e., now it is required to provide that lemma to solve this example.


import Lib.Algebra.Monoid
import Lib.Logic.Basic
import Lib.Order.Basic
import Lib.Meta.About
import Lib.Tactic
import Lib.Util

class Group (α : Type u) extends Monoid α where
  inv : α → α
  mul_inv (x : α) : x * inv x = 1

namespace Group
open Monoid

variable [Group α]

attribute [simp] mul_inv

notation x "⁻¹" => inv x

theorem inv_unique {a x y : α}
        (hx : x * a = 1)
        (hy : a * y = 1) :
  x = y :=
calc
  x = x *  1      := by rw [mul_one]
  _ = x * (a * y) := by rw [hy]
  _ = (x * a) * y := by rw [mul_assoc]
  _ = y           := by rw [hx, one_mul]

theorem inv_unique' {a x : α}
        (hx : x * a = 1) :
  x = a⁻¹ :=
inv_unique hx <| mul_inv _

@[simp]
theorem inv_inv (a : α) : a⁻¹⁻¹ = a :=
inv_unique' (mul_inv _) |>.symm

@[simp]
theorem inv_mul (x : α) : x⁻¹ * x = 1 := by
have := mul_inv (inv x)
rw [inv_inv] at this; assumption

@[simp]
theorem inv_one : 1⁻¹ = (1 : α) :=
calc
  1⁻¹ =@{α} 1 * 1⁻¹ := by rw [one_mul]
  _   =@{α} 1       := by rw [mul_inv]

theorem inv_injective {x y : α} :
  x⁻¹ = y⁻¹ ↔ x = y := by
constructor <;> intro h
next =>
  rw [← inv_inv x, h, inv_inv]
next =>
  apply congrArg _ h

theorem inv_eq_iff_l {x y : α} :
  x⁻¹ = y ↔ 1 = x * y := by
constructor <;> intro h
next =>
  exact calc
    1 =@{α} x * x⁻¹ := by simp
    _     = x * y := by rw [h]
next =>
  exact calc
    x⁻¹ = x⁻¹ * 1 := by simp
    _   = x⁻¹ * x * y := by rw [h, mul_assoc]
    _   = 1 * y := by simp
    _   = y := by simp

theorem inv_eq_iff_r {x y : α} :
  x⁻¹ = y ↔ 1 = y * x := by
rw [← inv_inv y, ← inv_eq_iff_l, inv_injective, inv_inv]
apply Eq.comm

theorem mul_cancel_iff_l {x y z : α} :
  x⁻¹ * z = y ↔ z = x * y := by
constructor <;> intro h
next =>
  exact calc
    z =@{α} x * x⁻¹ * z := by simp
    _     = x * y       := by rw [← h, mul_assoc]
next =>
  exact calc
    x⁻¹ * z = x⁻¹ * x * y := by rw [h, mul_assoc]
    _       = 1 * y := by simp
    _       = y := by simp

@[simp]
theorem inv_mul_inv {x y : α } :
  (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
rw [inv_eq_iff_r]; symmetry
exact calc
  (y⁻¹ * x⁻¹) * (x * y) = y⁻¹ * (x⁻¹ * x) * y :=
    by simp only [mul_assoc]
  _                     = y⁻¹ * 1 * y         :=
    by rw [inv_mul]
  _                     =@{α} 1               :=
    by rw [mul_one, inv_mul]

theorem mul_cancel_iff_r {x y z : α} :
  z * x⁻¹ = y ↔ z = y * x := by
rw [← inv_injective, inv_mul_inv, mul_cancel_iff_l]
rw [← inv_mul_inv, inv_injective]
refl

end Group

abbrev AddGroup (α : Type u) := Group (Additive α)

namespace AddGroup
open Group

variable [AddGroup α]

def neg (x : α) : α := inv (α := Additive α) x

instance : Neg α := ⟨ neg ⟩

instance : Sub α where
  sub x y := x + -y

@[simp]
theorem neg_zero : (- 0 : α) = 0 :=
Group.inv_one (α := Additive α)

@[simp]
theorem neg_neg (x : α) : - - x = x :=
Group.inv_inv (α := Additive α) _

@[simp]
theorem neg_add (x : α) : - x + x = 0 :=
Group.inv_mul (α := Additive α) _

@[simp]
theorem add_neg (x : α) : x + - x = 0 :=
Group.mul_inv (α := Additive α) _

theorem neg_eq_iff_l {x y : α} :
  -x = y ↔ 0 = x + y :=
Group.inv_eq_iff_l (α := Additive α)

theorem neg_eq_iff_r {x y : α} :
  -x = y ↔ 0 = y + x :=
Group.inv_eq_iff_r (α := Additive α)

@[simp]
theorem neg_add_neg (x y : α) : -(x + y) = -y + -x :=
Group.inv_mul_inv (α := Additive α)

theorem add_cancel_iff_l {x y z : α} :
  -x + z = y ↔ z = x + y :=
Group.mul_cancel_iff_l (α := Additive α)

theorem add_cancel_iff_r {x y z : α} :
  z + -x = y ↔ z = y + x :=
Group.mul_cancel_iff_r (α := Additive α)

end AddGroup

class OrderedGroup (α : Type u) [LE α]
extends Group α where
  mul_le_mul {x x' y y' : α} :
    x ≤ x' →
    y ≤ y' →
    x * y ≤ x' * y'

namespace OrderedGroup
open Monoid Group OrderedMonoid

variable [LE α] [OG : OrderedGroup α]

instance : OrderedMonoid α :=
{ OG.toMonoid with
  mul_le_mul := OrderedGroup.mul_le_mul }

variable [Preorder α]

open Reflexive

@[auto]
theorem inv_le_inv {x y : α} :
  x ≤ y → y⁻¹ ≤ x⁻¹ := by
intros h
suffices (x⁻¹ * x) * y⁻¹ ≤ x⁻¹ * 1
  by simp [- mul_assoc] at this; auto
rw [mul_assoc]
apply mul_le_mul_r (α := α)
suffices x * y⁻¹ ≤ y * y⁻¹
  by simp at this; auto
auto [mul_le_mul_l]

theorem inv_le_inv_iff {x y : α} :
  x⁻¹ ≤ y⁻¹ ↔ y ≤ x := by
constructor <;> intros h
next =>
  have h := inv_le_inv h
  simp at h; assumption
next =>
  auto

theorem inv_le_one {x : α} :
  x⁻¹ ≤ 1 ↔ 1 ≤ x :=
by rw [← inv_le_inv_iff]; simp

theorem one_le_inv {x : α} :
  1 ≤ x⁻¹ ↔ x ≤ 1 :=
by rw [← inv_le_inv_iff]; simp

theorem inv_mul_le_cancel_l {x y z : α} :
  x⁻¹ * y ≤ z ↔ y ≤ x * z := by
constructor <;> intros h
next =>
  trans 1 * y
  next => rw [one_mul]; refl
  next =>
    rw [← mul_inv (x := x), mul_assoc]
    auto [mul_le_mul_r]
next =>
  rw [← one_mul (x := z), ← inv_mul (x := x), mul_assoc]
  auto [mul_le_mul_r]

theorem inv_mul_le_cancel_r {x y z : α} :
  x * y⁻¹ ≤ z ↔ x ≤ z * y := by
rw [← inv_le_inv_iff, inv_mul_inv, ← inv_mul_le_cancel_l]
rw [← inv_mul_inv, inv_le_inv_iff, inv_inv]
refl

end OrderedGroup

instance [LE α] [I : Preorder α] : Preorder (Additive α) := I

abbrev AddOrderedGroup (α : Type u) [LE α] :=
OrderedGroup (Additive α)

namespace AddOrderedGroup
open OrderedGroup Reflexive

section abs
variable [LT α] [Neg α] [@DecidableRel α LT.lt]

def abs (x : α) : α :=
max x (-x)

end abs

section Preorder
variable [LE α] [Preorder α]

variable [AddOrderedGroup α]
open AddMonoid AddGroup AddOrderedMonoid

@[auto]
theorem neg_le_neg {x y : α} :
  x ≤ y → - y ≤ - x := by
intros h
suffices (-x + x) + -y ≤ - x + 0
  by simp at this; auto
rw [add_assoc]
apply add_le_add_r (α := α)
suffices x + -y ≤ y + -y
  by simp at this; auto
apply add_le_add_l (α := α) h

@[simp]
theorem neg_le_neg_iff {x y : α} :
  - x ≤ - y ↔ y ≤ x := by
constructor <;> intros h
next =>
  have h := neg_le_neg h
  simp at h; assumption
next =>
  auto

@[simp]
theorem neg_le_zero {x : α} :
  - x ≤ 0 ↔ 0 ≤ x :=
by rw [← neg_le_neg_iff]; simp

@[simp]
theorem zero_le_neg {x : α} :
  0 ≤ -x ↔ x ≤ 0 :=
by rw [← neg_le_neg_iff]; simp

theorem neg_add_le_cancel_l {x y z : α} :
  -x + y ≤ z ↔ y ≤ x + z :=
let inst : Preorder (Additive α) := inferInstance
  -- TODO: report breakage
  -- this let should not be necessary
inv_mul_le_cancel_l (α := Additive α)

theorem neg_add_le_cancel_r {x y z : α} :
  x + -y ≤ z ↔ x ≤ z + y :=
let inst : Preorder (Additive α) := inferInstance
inv_mul_le_cancel_r (α := Additive α)

end Preorder

open TotalOrder
variable [LE α] [DecidableTotalOrder α]
variable [AddOrderedGroup α]

@[auto]
theorem abs_nonneg {x : α} : 0 ≤ abs x := by
simp [abs, zero_le_neg, total]

@[simp]
theorem abs_le_iff {x z : α} : abs x ≤ z ↔ x ≤ z ∧ -x ≤ z := by
simp [abs]

@[simp]
theorem le_abs_iff {x z : α} :
  z ≤ abs x ↔ z ≤ x ∨ z ≤ -x := by
simp [abs]

@[auto]
theorem le_abs_self {x : α} :
  x ≤ abs x :=
by simp; left; refl

@[auto]
theorem neg_le_abs_self {x : α} :
  -x ≤ abs x :=
by simp; right; refl

end AddOrderedGroup

class CommGroup (α : Type u) extends Group α where
  mul_comm {x y : α} : x * y = y * x

instance [G : CommGroup α] : CommMonoid α :=
{ G.toGroup.toMonoid with
  mul_comm := CommGroup.mul_comm }

abbrev CommAddGroup (α : Type u) :=
CommGroup (Additive α)

namespace CommAddGroup

variable [CommAddGroup α]

theorem add_comm {x y : α} : x + y = y + x :=
CommGroup.mul_comm (α := Additive α)

end CommAddGroup

class abbrev OrderedCommGroup (α : Type u) [LE α] :=
 CommGroup α, OrderedGroup α

abbrev OrderedCommAddGroup (α : Type u) [LE α] :=
OrderedCommGroup (Additive α)

instance [LE α] [OrderedCommAddGroup α] : AddOrderedGroup α :=
inferInstance

namespace OrderedCommAddGroup
variable [LE α] [DecidableTotalOrder α] [OrderedCommAddGroup α]

open AddOrderedMonoid AddGroup AddMonoid
open DecidableTotalOrder AddOrderedGroup CommAddGroup

theorem triangle_ineq {x y : α} :
  abs (x + y) ≤ abs x + abs y := by
rw [abs_le_iff (α := α)]
constructor
next =>
  apply add_le_add (α := α) <;> auto
next =>
  rw [add_comm, neg_add_neg]
  apply add_le_add (α := α) <;> auto

end OrderedCommAddGroup


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Scott Morrison
-/
import category_theory.limits.preserves.shapes.biproducts
import category_theory.preadditive.functor_category

/-!
# Additive Functors

A functor between two preadditive categories is called *additive*
provided that the induced map on hom types is a morphism of abelian
groups.

An additive functor between preadditive categories creates and preserves biproducts.
Conversely, if `F : C ⥤ D` is a functor between preadditive categories, where `C` has binary
biproducts, and if `F` preserves binary biproducts, then `F` is additive.

We also define the category of bundled additive functors.

# Implementation details

`functor.additive` is a `Prop`-valued class, defined by saying that for every two objects `X` and
`Y`, the map `F.map : (X ⟶ Y) → (F.obj X ⟶ F.obj Y)` is a morphism of abelian groups.

-/

namespace category_theory

/-- A functor `F` is additive provided `F.map` is an additive homomorphism. -/
class functor.additive {C D : Type*} [category C] [category D]
  [preadditive C] [preadditive D] (F : C ⥤ D) : Prop :=
(map_add' : Π {X Y : C} {f g : X ⟶ Y}, F.map (f + g) = F.map f + F.map g . obviously)

section preadditive

namespace functor

section
variables {C D : Type*} [category C] [category D] [preadditive C]
  [preadditive D] (F : C ⥤ D) [functor.additive F]

@[simp]
lemma map_add {X Y : C} {f g : X ⟶ Y} : F.map (f + g) = F.map f + F.map g :=
functor.additive.map_add'

/-- `F.map_add_hom` is an additive homomorphism whose underlying function is `F.map`. -/
@[simps {fully_applied := ff}]
def map_add_hom {X Y : C} : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y) :=
add_monoid_hom.mk' (λ f, F.map f) (λ f g, F.map_add)

lemma coe_map_add_hom {X Y : C} : ⇑(F.map_add_hom : (X ⟶ Y) →+ _) = @map C _ D _ F X Y := rfl

@[priority 100]
instance preserves_zero_morphisms_of_additive : preserves_zero_morphisms F :=
{ map_zero' := λ X Y, F.map_add_hom.map_zero }

instance : additive (𝟭 C) :=
{}

instance {E : Type*} [category E] [preadditive E] (G : D ⥤ E) [functor.additive G] :
  additive (F ⋙ G) :=
{}

@[simp]
lemma map_neg {X Y : C} {f : X ⟶ Y} : F.map (-f) = - F.map f :=
(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_neg _

@[simp]
lemma map_sub {X Y : C} {f g : X ⟶ Y} : F.map (f - g) = F.map f - F.map g :=
(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_sub _ _

-- You can alternatively just use `functor.map_smul` here, with an explicit `(r : ℤ)` argument.
lemma map_zsmul {X Y : C} {f : X ⟶ Y} {r : ℤ} : F.map (r • f) = r • F.map f :=
(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_zsmul _ _

open_locale big_operators

@[simp]
lemma map_sum {X Y : C} {α : Type*} (f : α → (X ⟶ Y)) (s : finset α) :
  F.map (∑ a in s, f a) = ∑ a in s, F.map (f a) :=
(F.map_add_hom : (X ⟶ Y) →+ _).map_sum f s

end

section induced_category
variables {C : Type*} {D : Type*} [category D] [preadditive D] (F : C → D)

instance induced_functor_additive : functor.additive (induced_functor F) := {}

end induced_category

section
-- To talk about preservation of biproducts we need to specify universes explicitly.

noncomputable theory
universes v u₁ u₂

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

open category_theory.limits
open category_theory.preadditive

@[priority 100]
instance preserves_finite_biproducts_of_additive [additive F] : preserves_finite_biproducts F :=
{ preserves := λ J _,
  { preserves := λ f,
    { preserves := λ b hb, by exactI is_bilimit_of_total _
      begin
        simp_rw [F.map_bicone_π, F.map_bicone_ι, ← F.map_comp, ← F.map_sum],
        dsimp only [map_bicone_X],
        simp_rw [← F.map_id],
        refine congr_arg _ (hb.is_limit.hom_ext (λ j, hb.is_colimit.hom_ext (λ j', _))),
        cases j, cases j',
        simp [sum_comp, comp_sum, bicone.ι_π, comp_dite, dite_comp],
      end } } }

lemma additive_of_preserves_binary_biproducts [has_binary_biproducts C] [preserves_zero_morphisms F]
  [preserves_binary_biproducts F] : additive F :=
{ map_add' := λ X Y f g, by rw [biprod.add_eq_lift_id_desc, F.map_comp, ← biprod.lift_map_biprod,
    ← biprod.map_biprod_hom_desc, category.assoc, iso.inv_hom_id_assoc, F.map_id,
    biprod.add_eq_lift_id_desc] }

end

end functor

namespace equivalence

variables {C D : Type*} [category C] [category D] [preadditive C] [preadditive D]

instance inverse_additive (e : C ≌ D) [e.functor.additive] : e.inverse.additive :=
{ map_add' := λ X Y f g, by { apply e.functor.map_injective, simp, }, }

end equivalence

section
variables (C D : Type*) [category C] [category D] [preadditive C] [preadditive D]

/-- Bundled additive functors. -/
@[derive category, nolint has_inhabited_instance]
def AdditiveFunctor :=
{ F : C ⥤ D // functor.additive F }

infixr ` ⥤+ `:26 := AdditiveFunctor

instance : preadditive (C ⥤+ D) :=
preadditive.induced_category.category _

/-- An additive functor is in particular a functor. -/
@[derive full, derive faithful]
def AdditiveFunctor.forget : (C ⥤+ D) ⥤ (C ⥤ D) :=
full_subcategory_inclusion _

variables {C D}

/-- Turn an additive functor into an object of the category `AdditiveFunctor C D`. -/
def AdditiveFunctor.of (F : C ⥤ D) [F.additive] : C ⥤+ D :=
⟨F, infer_instance⟩

@[simp]
lemma AdditiveFunctor.of_fst (F : C ⥤ D) [F.additive] : (AdditiveFunctor.of F).1 = F :=
rfl

@[simp]
lemma AdditiveFunctor.forget_obj (F : C ⥤+ D) : (AdditiveFunctor.forget C D).obj F = F.1 :=
rfl

lemma AdditiveFunctor.forget_obj_of (F : C ⥤ D) [F.additive] :
  (AdditiveFunctor.forget C D).obj (AdditiveFunctor.of F) = F :=
rfl

@[simp]
lemma AdditiveFunctor.forget_map (F G : C ⥤+ D) (α : F ⟶ G) :
  (AdditiveFunctor.forget C D).map α = α :=
rfl

instance : functor.additive (AdditiveFunctor.forget C D) :=
{ map_add' := λ F G α β, rfl }

instance (F : C ⥤+ D) : functor.additive F.1 :=
F.2

end

end preadditive

end category_theory


/-
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, Jeremy Avigad, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.at_top_bot
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# The cofinite filter

In this file we define

`cofinite`: the filter of sets with finite complement

and prove its basic properties. In particular, we prove that for `ℕ` it is equal to `at_top`.

## TODO

Define filters for other cardinalities of the complement.
-/

namespace filter

/-- The cofinite filter is the filter of subsets whose complements are finite. -/
def cofinite {α : Type u_1} : filter α :=
  mk (set_of fun (s : set α) => set.finite (sᶜ)) sorry sorry sorry

@[simp] theorem mem_cofinite {α : Type u_1} {s : set α} : s ∈ cofinite ↔ set.finite (sᶜ) :=
  iff.rfl

@[simp] theorem eventually_cofinite {α : Type u_1} {p : α → Prop} : filter.eventually (fun (x : α) => p x) cofinite ↔ set.finite (set_of fun (x : α) => ¬p x) :=
  iff.rfl

protected instance cofinite_ne_bot {α : Type u_1} [infinite α] : ne_bot cofinite :=
  mt (iff.mpr empty_in_sets_eq_bot)
    (eq.mpr
      (id
        ((fun (a a_1 : Prop) (e_1 : a = a_1) => congr_arg Not e_1) (∅ ∈ cofinite) (set.finite set.univ)
          (Eq.trans (propext mem_cofinite)
            ((fun (s s_1 : set α) (e_1 : s = s_1) => congr_arg set.finite e_1) (∅ᶜ) set.univ set.compl_empty))))
      set.infinite_univ)

theorem frequently_cofinite_iff_infinite {α : Type u_1} {p : α → Prop} : filter.frequently (fun (x : α) => p x) cofinite ↔ set.infinite (set_of fun (x : α) => p x) := sorry

end filter

theorem set.finite.compl_mem_cofinite {α : Type u_1} {s : set α} (hs : set.finite s) : sᶜ ∈ filter.cofinite :=
  iff.mpr filter.mem_cofinite (Eq.symm (compl_compl s) ▸ hs)

theorem set.finite.eventually_cofinite_nmem {α : Type u_1} {s : set α} (hs : set.finite s) : filter.eventually (fun (x : α) => ¬x ∈ s) filter.cofinite :=
  set.finite.compl_mem_cofinite hs

theorem finset.eventually_cofinite_nmem {α : Type u_1} (s : finset α) : filter.eventually (fun (x : α) => ¬x ∈ s) filter.cofinite :=
  set.finite.eventually_cofinite_nmem (finset.finite_to_set s)

theorem set.infinite_iff_frequently_cofinite {α : Type u_1} {s : set α} : set.infinite s ↔ filter.frequently (fun (x : α) => x ∈ s) filter.cofinite :=
  iff.symm filter.frequently_cofinite_iff_infinite

theorem filter.eventually_cofinite_ne {α : Type u_1} (x : α) : filter.eventually (fun (a : α) => a ≠ x) filter.cofinite :=
  set.finite.eventually_cofinite_nmem (set.finite_singleton x)

/-- For natural numbers the filters `cofinite` and `at_top` coincide. -/
theorem nat.cofinite_eq_at_top : filter.cofinite = filter.at_top := sorry

theorem nat.frequently_at_top_iff_infinite {p : ℕ → Prop} : filter.frequently (fun (n : ℕ) => p n) filter.at_top ↔ set.infinite (set_of fun (n : ℕ) => p n) := sorry