/-
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, Devon Tuma
-/
import measure_theory.probability_mass_function.monad

/-!
# Specific Constructions of Probability Mass Functions

This file gives a number of different `pmf` constructions for common probability distributions.

`map` and `seq` allow pushing a `pmf α` along a function `f : α → β` (or distribution of
functions `f : pmf (α → β)`) to get a `pmf β`

`of_finset` and `of_fintype` simplify the construction of a `pmf α` from a function `f : α → ℝ≥0`,
by allowing the "sum equals 1" constraint to be in terms of `finset.sum` instead of `tsum`.
`of_multiset`, `uniform_of_finset`, and `uniform_of_fintype` construct probability mass functions
from the corresponding object, with proportional weighting for each element of the object.

`normalize` constructs a `pmf α` by normalizing a function `f : α → ℝ≥0` by its sum,
and `filter` uses this to filter the support of a `pmf` and re-normalize the new distribution.

`bernoulli` represents the bernoulli distribution on `bool`

-/

namespace pmf

noncomputable theory
variables {α : Type*} {β : Type*} {γ : Type*}
open_locale classical big_operators nnreal ennreal

section map

/-- The functorial action of a function on a `pmf`. -/
def map (f : α → β) (p : pmf α) : pmf β := bind p (pure ∘ f)

variables (f : α → β) (p : pmf α) (b : β)

@[simp] lemma map_apply : (map f p) b = ∑' a, if b = f a then p a else 0 := by simp [map]

@[simp] lemma support_map : (map f p).support = f '' p.support :=
set.ext (λ b, by simp [map, @eq_comm β b])

lemma mem_support_map_iff : b ∈ (map f p).support ↔ ∃ a ∈ p.support, f a = b := by simp

lemma bind_pure_comp : bind p (pure ∘ f) = map f p := rfl

lemma map_id : map id p = p := by simp [map]

lemma map_comp (g : β → γ) : (p.map f).map g = p.map (g ∘ f) :=
by simp [map]

lemma pure_map (a : α) : (pure a).map f = pure (f a) :=
by simp [map]

end map

section seq

/-- The monadic sequencing operation for `pmf`. -/
def seq (q : pmf (α → β)) (p : pmf α) : pmf β := q.bind (λ m, p.bind $ λ a, pure (m a))

variables (q : pmf (α → β)) (p : pmf α) (b : β)

@[simp] lemma seq_apply : (seq q p) b = ∑' (f : α → β) (a : α), if b = f a then q f * p a else 0 :=
begin
  simp only [seq, mul_boole, bind_apply, pure_apply],
  refine tsum_congr (λ f, (nnreal.tsum_mul_left (q f) _).symm.trans (tsum_congr (λ a, _))),
  simpa only [mul_zero] using mul_ite (b = f a) (q f) (p a) 0
end

@[simp] lemma support_seq : (seq q p).support = ⋃ f ∈ q.support, f '' p.support :=
set.ext (λ b, by simp [-mem_support_iff, seq, @eq_comm β b])

lemma mem_support_seq_iff : b ∈ (seq q p).support ↔ ∃ (f ∈ q.support), b ∈ f '' p.support :=
by simp

end seq

section of_finset

/-- Given a finset `s` and a function `f : α → ℝ≥0` with sum `1` on `s`,
  such that `f a = 0` for `a ∉ s`, we get a `pmf` -/
def of_finset (f : α → ℝ≥0) (s : finset α) (h : ∑ a in s, f a = 1)
  (h' : ∀ a ∉ s, f a = 0) : pmf α :=
⟨f, h ▸ has_sum_sum_of_ne_finset_zero h'⟩

variables {f : α → ℝ≥0} {s : finset α} (h : ∑ a in s, f a = 1) (h' : ∀ a ∉ s, f a = 0)

@[simp] lemma of_finset_apply (a : α) : of_finset f s h h' a = f a := rfl

@[simp] lemma support_of_finset : (of_finset f s h h').support = s ∩ (function.support f) :=
set.ext (λ a, by simpa [mem_support_iff] using mt (h' a))

lemma mem_support_of_finset_iff (a : α) : a ∈ (of_finset f s h h').support ↔ a ∈ s ∧ f a ≠ 0 :=
by simp

lemma of_finset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_finset f s h h' a = 0 :=
h' a ha

end of_finset

section of_fintype

/-- Given a finite type `α` and a function `f : α → ℝ≥0` with sum 1, we get a `pmf`. -/
def of_fintype [fintype α] (f : α → ℝ≥0) (h : ∑ a, f a = 1) : pmf α :=
of_finset f finset.univ h (λ a ha, absurd (finset.mem_univ a) ha)

variables [fintype α] {f : α → ℝ≥0} (h : ∑ a, f a = 1)

@[simp] lemma of_fintype_apply (a : α) : of_fintype f h a = f a := rfl

@[simp] lemma support_of_fintype : (of_fintype f h).support = function.support f := rfl

lemma mem_support_of_fintype_iff (a : α) : a ∈ (of_fintype f h).support ↔ f a ≠ 0 := iff.rfl

end of_fintype

section of_multiset

/-- Given a non-empty multiset `s` we construct the `pmf` which sends `a` to the fraction of
  elements in `s` that are `a`. -/
def of_multiset (s : multiset α) (hs : s ≠ 0) : pmf α :=
⟨λ a, s.count a / s.card,
  have ∑ a in s.to_finset, (s.count a : ℝ) / s.card = 1,
    by simp [div_eq_inv_mul, finset.mul_sum.symm, (nat.cast_sum _ _).symm, hs],
  have ∑ a in s.to_finset, (s.count a : ℝ≥0) / s.card = 1,
    by rw [← nnreal.eq_iff, nnreal.coe_one, ← this, nnreal.coe_sum]; simp,
  begin
    rw ← this,
    apply has_sum_sum_of_ne_finset_zero,
    simp {contextual := tt},
  end⟩

variables {s : multiset α} (hs : s ≠ 0)

@[simp] lemma of_multiset_apply (a : α) : of_multiset s hs a = s.count a / s.card := rfl

@[simp] lemma support_of_multiset : (of_multiset s hs).support = s.to_finset :=
set.ext (by simp [mem_support_iff, hs])

lemma mem_support_of_multiset_iff (a : α) : a ∈ (of_multiset s hs).support ↔ a ∈ s.to_finset :=
by simp

lemma of_multiset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_multiset s hs a = 0 :=
div_eq_zero_iff.2 (or.inl $ nat.cast_eq_zero.2 $ multiset.count_eq_zero_of_not_mem ha)

end of_multiset

section uniform

section uniform_of_finset

/-- Uniform distribution taking the same non-zero probability on the nonempty finset `s` -/
def uniform_of_finset (s : finset α) (hs : s.nonempty) : pmf α :=
of_finset (λ a, if a ∈ s then (s.card : ℝ≥0)⁻¹ else 0) s (Exists.rec_on hs (λ x hx,
  calc ∑ (a : α) in s, ite (a ∈ s) (s.card : ℝ≥0)⁻¹ 0
    = ∑ (a : α) in s, (s.card : ℝ≥0)⁻¹ : finset.sum_congr rfl (λ x hx, by simp [hx])
    ... = s.card • (s.card : ℝ≥0)⁻¹ : finset.sum_const _
    ... = (s.card : ℝ≥0) * (s.card : ℝ≥0)⁻¹ : by rw nsmul_eq_mul
    ... = 1 : div_self (nat.cast_ne_zero.2 $ finset.card_ne_zero_of_mem hx)
  )) (λ x hx, by simp only [hx, if_false])

variables {s : finset α} (hs : s.nonempty) {a : α}

@[simp] lemma uniform_of_finset_apply (a : α) :
  uniform_of_finset s hs a = if a ∈ s then (s.card : ℝ≥0)⁻¹ else 0 := rfl

lemma uniform_of_finset_apply_of_mem (ha : a ∈ s) : uniform_of_finset s hs a = (s.card)⁻¹ :=
by simp [ha]

lemma uniform_of_finset_apply_of_not_mem (ha : a ∉ s) : uniform_of_finset s hs a = 0 :=
by simp [ha]

@[simp] lemma support_uniform_of_finset : (uniform_of_finset s hs).support = s :=
set.ext (let ⟨a, ha⟩ := hs in by simp [mem_support_iff, finset.ne_empty_of_mem ha])

lemma mem_support_uniform_of_finset_iff (a : α) : a ∈ (uniform_of_finset s hs).support ↔ a ∈ s :=
by simp

end uniform_of_finset

section uniform_of_fintype

/-- The uniform pmf taking the same uniform value on all of the fintype `α` -/
def uniform_of_fintype (α : Type*) [fintype α] [nonempty α] : pmf α :=
  uniform_of_finset (finset.univ) (finset.univ_nonempty)

variables [fintype α] [nonempty α]

@[simp] lemma uniform_of_fintype_apply (a : α) : uniform_of_fintype α a = (fintype.card α)⁻¹ :=
by simpa only [uniform_of_fintype, finset.mem_univ, if_true, uniform_of_finset_apply]

variable (α)

@[simp] lemma support_uniform_of_fintype : (uniform_of_fintype α).support = ⊤ :=
set.ext (λ x, by simpa [mem_support_iff] using fintype.card_ne_zero)

variable {α}

lemma mem_support_uniform_of_fintype_iff (a : α) : a ∈ (uniform_of_fintype α).support := by simp

end uniform_of_fintype

end uniform

section normalize

/-- Given a `f` with non-zero sum, we get a `pmf` by normalizing `f` by it's `tsum` -/
def normalize (f : α → ℝ≥0) (hf0 : tsum f ≠ 0) : pmf α :=
⟨λ a, f a * (∑' x, f x)⁻¹,
  (mul_inv_cancel hf0) ▸ has_sum.mul_right (∑' x, f x)⁻¹
    (not_not.mp (mt tsum_eq_zero_of_not_summable hf0 : ¬¬summable f)).has_sum⟩

variables {f : α → ℝ≥0} (hf0 : tsum f ≠ 0)

@[simp] lemma normalize_apply (a : α) : (normalize f hf0) a = f a * (∑' x, f x)⁻¹ := rfl

@[simp] lemma support_normalize : (normalize f hf0).support = function.support f :=
set.ext (by simp [mem_support_iff, hf0])

lemma mem_support_normalize_iff (a : α) : a ∈ (normalize f hf0).support ↔ f a ≠ 0 := by simp

end normalize

section filter

/-- Create new `pmf` by filtering on a set with non-zero measure and normalizing -/
def filter (p : pmf α) (s : set α) (h : ∃ a ∈ s, a ∈ p.support) : pmf α :=
pmf.normalize (s.indicator p) $ nnreal.tsum_indicator_ne_zero p.2.summable h

variables {p : pmf α} {s : set α} (h : ∃ a ∈ s, a ∈ p.support)

@[simp]
lemma filter_apply (a : α) : (p.filter s h) a = (s.indicator p a) * (∑' a', (s.indicator p) a')⁻¹ :=
by rw [filter, normalize_apply]

lemma filter_apply_eq_zero_of_not_mem {a : α} (ha : a ∉ s) : (p.filter s h) a = 0 :=
by rw [filter_apply, set.indicator_apply_eq_zero.mpr (λ ha', absurd ha' ha), zero_mul]

@[simp] lemma support_filter : (p.filter s h).support = s ∩ p.support:=
begin
  refine set.ext (λ a, _),
  rw [mem_support_iff, filter_apply, mul_ne_zero_iff, set.indicator_eq_zero_iff],
  exact ⟨λ ha, ha.1, λ ha, ⟨ha, inv_ne_zero (nnreal.tsum_indicator_ne_zero p.2.summable h)⟩⟩
end

lemma mem_support_filter_iff (a : α) : a ∈ (p.filter s h).support ↔ a ∈ s ∧ a ∈ p.support :=
by simp

lemma filter_apply_eq_zero_iff (a : α) : (p.filter s h) a = 0 ↔ a ∉ s ∨ a ∉ p.support :=
by erw [apply_eq_zero_iff, support_filter, set.mem_inter_iff, not_and_distrib]

lemma filter_apply_ne_zero_iff (a : α) : (p.filter s h) a ≠ 0 ↔ a ∈ s ∧ a ∈ p.support :=
by rw [ne.def, filter_apply_eq_zero_iff, not_or_distrib, not_not, not_not]

end filter

section bernoulli

/-- A `pmf` which assigns probability `p` to `tt` and `1 - p` to `ff`. -/
def bernoulli (p : ℝ≥0) (h : p ≤ 1) : pmf bool :=
of_fintype (λ b, cond b p (1 - p)) (nnreal.eq $ by simp [h])

variables {p : ℝ≥0} (h : p ≤ 1) (b : bool)

@[simp] lemma bernoulli_apply : bernoulli p h b = cond b p (1 - p) := rfl

@[simp] lemma support_bernoulli : (bernoulli p h).support = {b | cond b (p ≠ 0) (p ≠ 1)} :=
begin
  refine set.ext (λ b, _),
  induction b,
  { simp_rw [mem_support_iff, bernoulli_apply, bool.cond_ff, ne.def, tsub_eq_zero_iff_le, not_le],
    exact ⟨ne_of_lt, lt_of_le_of_ne h⟩ },
  { simp only [mem_support_iff, bernoulli_apply, bool.cond_tt, set.mem_set_of_eq], }
end

lemma mem_support_bernoulli_iff : b ∈ (bernoulli p h).support ↔ cond b (p ≠ 0) (p ≠ 1) := by simp

end bernoulli

end pmf


import ..src.tree

open my_tree

/-defining some tree instances-/
def t0 : (tree ℕ ) := @tree.empty ℕ
def t1 : (tree ℕ) := tree.node 5 t0 t0
def t2 : (tree nat) := tree.node 2 t1 t0
def t3 : (tree nat) := tree.node 7 t0 t1
def t4 : (tree nat) := tree.node 12 t2 t1

/-testing out the sum_node function-/
#eval sum_node t0
#eval sum_node t1
#eval sum_node t2
#eval sum_node t3
#eval sum_node t4

/-testing out the tree_map function-/
#reduce tree_map (λ (n: ℕ), (n + 1)) t0
#reduce tree_map (λ (n: ℕ), (n + 1)) t1
#reduce tree_map (λ (n: ℕ), (n + 1)) t2
#reduce tree_map (λ (n: ℕ), (n + 1)) t3
#reduce tree_map (λ (n: ℕ), (n + 1)) t4

theorem five_eq_five : eq (2 + 3) 5 :=
    (eq.refl 5)

theorem zero_eq_zero : 0 = 0 := eq.refl 0

theorem zez_and_5eq5 : (0 = 0) ∧ (5 = 5) :=
    and.intro (eq.refl 0) (eq.refl 5)

theorem all_n_self_eq : ∀ (n : ℕ), n = n :=
    λ (x : ℕ), (eq.refl x)

#check all_n_self_eq

#reduce all_n_self_eq 7


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import algebra.divisibility
import algebra.group.commute
import data.nat.basic

/-!
# Power operations on monoids and groups

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains lemmas about `a ^ n` and `n • a`, where `n : ℕ` or `n : ℤ`.
Further lemmas can be found in `algebra.group_power.lemmas`.

The analogous results for groups with zero can be found in `algebra.group_with_zero.power`.

## Notation

- `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`.
- `n • a` is used as notation for `has_smul.smul n a`; in this file `n : ℕ` or `n : ℤ`.

## Implementation details

We adopt the convention that `0^0 = 1`.
-/

universes u v w x y z u₁ u₂

variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

section has_pow
variables [has_pow M ℕ]

@[simp] lemma pow_ite (P : Prop) [decidable P] (a : M) (b c : ℕ) :
  a ^ (if P then b else c) = if P then a ^ b else a ^ c :=
by split_ifs; refl

@[simp] lemma ite_pow (P : Prop) [decidable P] (a b : M) (c : ℕ) :
  (if P then a else b) ^ c = if P then a ^ c else b ^ c :=
by split_ifs; refl

end has_pow

section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp, to_additive one_nsmul]
theorem pow_one (a : M) : a^1 = a :=
by rw [pow_succ, pow_zero, mul_one]

/-- Note that most of the lemmas about powers of two refer to it as `sq`. -/
@[to_additive two_nsmul, nolint to_additive_doc]
theorem pow_two (a : M) : a^2 = a * a :=
by rw [pow_succ, pow_one]

alias pow_two ← sq

@[to_additive]
theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n

@[to_additive add_nsmul]
theorem pow_add (a : M) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [nat.add_zero, pow_zero, mul_one],
  rw [pow_succ', ← mul_assoc, ← ih, ← pow_succ', nat.add_assoc]]

@[simp] lemma pow_boole (P : Prop) [decidable P] (a : M) :
  a ^ (if P then 1 else 0) = if P then a else 1 :=
by simp

-- the attributes are intentionally out of order. `smul_zero` proves `nsmul_zero`.
@[to_additive nsmul_zero, simp] theorem one_pow (n : ℕ) : (1 : M)^n = 1 :=
by induction n with n ih; [exact pow_zero _, rw [pow_succ, ih, one_mul]]

@[to_additive mul_nsmul']
theorem pow_mul (a : M) (m n : ℕ) : a^(m * n) = (a^m)^n :=
begin
  induction n with n ih,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, pow_succ', ih] }
end

@[to_additive nsmul_left_comm]
lemma pow_right_comm (a : M) (m n : ℕ) : (a^m)^n = (a^n)^m :=
by rw [←pow_mul, nat.mul_comm, pow_mul]

@[to_additive mul_nsmul]
theorem pow_mul' (a : M) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [nat.mul_comm, pow_mul]

@[to_additive nsmul_add_sub_nsmul]
theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n :=
by rw [←pow_add, nat.add_comm, tsub_add_cancel_of_le h]

@[to_additive sub_nsmul_nsmul_add]
theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n :=
by rw [←pow_add, tsub_add_cancel_of_le h]

/-- If `x ^ n = 1`, then `x ^ m` is the same as `x ^ (m % n)` -/
@[to_additive nsmul_eq_mod_nsmul "If `n • x = 0`, then `m • x` is the same as `(m % n) • x`"]
lemma pow_eq_pow_mod {M : Type*} [monoid M] {x : M} (m : ℕ) {n : ℕ} (h : x ^ n = 1) :
  x ^ m = x ^ (m % n) :=
begin
  have t := congr_arg (λ a, x ^ a) (nat.div_add_mod m n).symm,
  dsimp at t,
  rw [t, pow_add, pow_mul, h, one_pow, one_mul],
end

@[to_additive bit0_nsmul]
theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _

@[to_additive bit1_nsmul]
theorem pow_bit1 (a : M) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]

@[to_additive]
theorem pow_mul_comm (a : M) (m n : ℕ) : a^m * a^n = a^n * a^m :=
commute.pow_pow_self a m n

@[to_additive]
lemma commute.mul_pow {a b : M} (h : commute a b) (n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
nat.rec_on n (by simp only [pow_zero, one_mul]) $ λ n ihn,
by simp only [pow_succ, ihn, ← mul_assoc, (h.pow_left n).right_comm]

@[to_additive bit0_nsmul']
theorem pow_bit0' (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
by rw [pow_bit0, (commute.refl a).mul_pow]

@[to_additive bit1_nsmul']
theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [bit1, pow_succ', pow_bit0']

lemma dvd_pow {x y : M} (hxy : x ∣ y) :
  ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n
| 0       hn := (hn rfl).elim
| (n + 1) hn := by { rw pow_succ, exact hxy.mul_right _ }

alias dvd_pow ← has_dvd.dvd.pow

lemma dvd_pow_self (a : M) {n : ℕ} (hn : n ≠ 0) : a ∣ a^n :=
dvd_rfl.pow hn

end monoid

/-!
### Commutative (additive) monoid
-/

section comm_monoid
variables [comm_monoid M] [add_comm_monoid A]

@[to_additive nsmul_add]
theorem mul_pow (a b : M) (n : ℕ) : (a * b)^n = a^n * b^n :=
(commute.all a b).mul_pow n

/-- The `n`th power map on a commutative monoid for a natural `n`, considered as a morphism of
monoids. -/
@[to_additive "Multiplication by a natural `n` on a commutative additive
monoid, considered as a morphism of additive monoids.", simps]
def pow_monoid_hom (n : ℕ) : M →* M :=
{ to_fun := (^ n),
  map_one' := one_pow _,
  map_mul' := λ a b, mul_pow a b n }

-- the below line causes the linter to complain :-/
-- attribute [simps] pow_monoid_hom nsmul_add_monoid_hom

end comm_monoid

section div_inv_monoid
variable [div_inv_monoid G]

open int

@[simp, to_additive one_zsmul]
theorem zpow_one (a : G) : a ^ (1:ℤ) = a :=
by { convert pow_one a using 1, exact zpow_coe_nat a 1 }

@[to_additive two_zsmul]
theorem zpow_two (a : G) : a ^ (2 : ℤ) = a * a :=
by { convert pow_two a using 1, exact zpow_coe_nat a 2 }

@[to_additive neg_one_zsmul]
theorem zpow_neg_one (x : G) : x ^ (-1:ℤ) = x⁻¹ :=
(zpow_neg_succ_of_nat x 0).trans $ congr_arg has_inv.inv (pow_one x)

@[to_additive]
theorem zpow_neg_coe_of_pos (a : G) : ∀ {n : ℕ}, 0 < n → a ^ -(n:ℤ) = (a ^ n)⁻¹
| (n+1) _ := zpow_neg_succ_of_nat _ _

end div_inv_monoid

section division_monoid
variables [division_monoid α] {a b : α}

@[simp, to_additive] lemma inv_pow (a : α) : ∀ n : ℕ, (a⁻¹) ^ n = (a ^ n)⁻¹
| 0       := by rw [pow_zero, pow_zero, inv_one]
| (n + 1) := by rw [pow_succ', pow_succ, inv_pow, mul_inv_rev]

-- the attributes are intentionally out of order. `smul_zero` proves `zsmul_zero`.
@[to_additive zsmul_zero, simp] lemma one_zpow : ∀ (n : ℤ), (1 : α) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one]

@[simp, to_additive neg_zsmul] lemma zpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl }

@[to_additive neg_one_zsmul_add]
lemma mul_zpow_neg_one (a b : α) : (a * b) ^ (-1 : ℤ) = b ^ (-1 : ℤ) * a ^ (-1 : ℤ) :=
by simp_rw [zpow_neg_one, mul_inv_rev]

@[to_additive zsmul_neg] lemma inv_zpow (a : α) : ∀ n : ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow]

@[simp, to_additive zsmul_neg']
lemma inv_zpow' (a : α) (n : ℤ) : a⁻¹ ^ n = a ^ (-n) := by rw [inv_zpow, zpow_neg]

@[to_additive nsmul_zero_sub]
lemma one_div_pow (a : α) (n : ℕ) : (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_pow]

@[to_additive zsmul_zero_sub]
lemma one_div_zpow (a : α) (n : ℤ) :  (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_zpow]

@[to_additive add_commute.zsmul_add]
protected lemma commute.mul_zpow (h : commute a b) : ∀ (i : ℤ), (a * b) ^ i = a ^ i * b ^ i
| (n : ℕ) := by simp [h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev]

end division_monoid

section division_comm_monoid
variables [division_comm_monoid α]

@[to_additive zsmul_add] lemma mul_zpow (a b : α) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n :=
(commute.all a b).mul_zpow

@[simp, to_additive nsmul_sub] lemma div_pow (a b : α) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_pow, inv_pow]

@[simp, to_additive zsmul_sub] lemma div_zpow (a b : α) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_zpow, inv_zpow]

/-- The `n`-th power map (for an integer `n`) on a commutative group, considered as a group
homomorphism. -/
@[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an
additive group homomorphism.", simps]
def zpow_group_hom (n : ℤ) : α →* α :=
{ to_fun := (^ n),
  map_one' := one_zpow n,
  map_mul' := λ a b, mul_zpow a b n }

end division_comm_monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

@[to_additive sub_nsmul] lemma pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
eq_mul_inv_of_mul_eq $ by rw [←pow_add, tsub_add_cancel_of_le h]

@[to_additive] lemma pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
(commute.refl a).inv_left.pow_pow _ _

@[to_additive sub_nsmul_neg]
lemma inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n :=
by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv]

end group

lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, tsub_add_cancel_of_le h]⟩

theorem pow_dvd_pow_of_dvd [comm_monoid R] {a b : R} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
| 0     := by rw [pow_zero, pow_zero]
| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) }

lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_add_zsmul [sub_neg_monoid A] (x : A) (n : ℤ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_mul_pow [monoid A] (x : A) (n : ℕ) :
  additive.of_mul (x ^ n) = n • (additive.of_mul x) := rfl

lemma of_mul_zpow [div_inv_monoid G] (x : G) (n : ℤ) :
  additive.of_mul (x ^ n) = n • additive.of_mul x :=
rfl

@[simp, to_additive]
lemma semiconj_by.zpow_right [group G] {a x y : G} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [zpow_coe_nat, h.pow_right n]
| -[1+n] := by simp [(h.pow_right n.succ).inv_right]

namespace commute

variables [group G] {a b : G}

@[simp, to_additive] lemma zpow_right (h : commute a b) (m : ℤ) : commute a (b^m) := h.zpow_right m

@[simp, to_additive] lemma zpow_left (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right m).symm

@[to_additive]
lemma zpow_zpow (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) := (h.zpow_left m).zpow_right n

variables (a) (m n : ℤ)

@[simp, to_additive] lemma self_zpow : commute a (a ^ n) := (commute.refl a).zpow_right n
@[simp, to_additive] lemma zpow_self : commute (a ^ n) a := (commute.refl a).zpow_left n
@[simp, to_additive] lemma zpow_zpow_self : commute (a ^ m) (a ^ n) :=
(commute.refl a).zpow_zpow m n

end commute


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import algebra.group.type_tags
import algebra.order.monoid.cancel.defs
import algebra.order.monoid.canonical.defs

/-! # Ordered monoid structures on `multiplicative α` and `additive α`.

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

universes u
variables {α : Type u}

instance : Π [has_le α], has_le (multiplicative α) := id
instance : Π [has_le α], has_le (additive α) := id
instance : Π [has_lt α], has_lt (multiplicative α) := id
instance : Π [has_lt α], has_lt (additive α) := id
instance : Π [preorder α], preorder (multiplicative α) := id
instance : Π [preorder α], preorder (additive α) := id
instance : Π [partial_order α], partial_order (multiplicative α) := id
instance : Π [partial_order α], partial_order (additive α) := id
instance : Π [linear_order α], linear_order (multiplicative α) := id
instance : Π [linear_order α], linear_order (additive α) := id
instance [has_le α] : Π [order_bot α], order_bot (multiplicative α) := id
instance [has_le α] : Π [order_bot α], order_bot (additive α) := id
instance [has_le α] : Π [order_top α], order_top (multiplicative α) := id
instance [has_le α] : Π [order_top α], order_top (additive α) := id
instance [has_le α] : Π [bounded_order α], bounded_order (multiplicative α) := id
instance [has_le α] : Π [bounded_order α], bounded_order (additive α) := id

instance [ordered_add_comm_monoid α] : ordered_comm_monoid (multiplicative α) :=
{ mul_le_mul_left := @ordered_add_comm_monoid.add_le_add_left α _,
  ..multiplicative.partial_order,
  ..multiplicative.comm_monoid }

instance [ordered_comm_monoid α] : ordered_add_comm_monoid (additive α) :=
{ add_le_add_left := @ordered_comm_monoid.mul_le_mul_left α _,
  ..additive.partial_order,
  ..additive.add_comm_monoid }

instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) :=
{ le_of_mul_le_mul_left := @ordered_cancel_add_comm_monoid.le_of_add_le_add_left α _,
  ..multiplicative.ordered_comm_monoid }

instance [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) :=
{ le_of_add_le_add_left := @ordered_cancel_comm_monoid.le_of_mul_le_mul_left α _,
  ..additive.ordered_add_comm_monoid }

instance [linear_ordered_add_comm_monoid α] : linear_ordered_comm_monoid (multiplicative α) :=
{ ..multiplicative.linear_order,
  ..multiplicative.ordered_comm_monoid }

instance [linear_ordered_comm_monoid α] : linear_ordered_add_comm_monoid (additive α) :=
{ ..additive.linear_order,
  ..additive.ordered_add_comm_monoid }

instance [has_add α] [has_le α] [has_exists_add_of_le α] :
  has_exists_mul_of_le (multiplicative α) :=
⟨@exists_add_of_le α _ _ _⟩

instance [has_mul α] [has_le α] [has_exists_mul_of_le α] : has_exists_add_of_le (additive α) :=
⟨@exists_mul_of_le α _ _ _⟩

instance [canonically_ordered_add_monoid α] : canonically_ordered_monoid (multiplicative α) :=
{ le_self_mul := @le_self_add α _,
  ..multiplicative.ordered_comm_monoid, ..multiplicative.order_bot,
  ..multiplicative.has_exists_mul_of_le }

instance [canonically_ordered_monoid α] : canonically_ordered_add_monoid (additive α) :=
{ le_self_add := @le_self_mul α _,
  ..additive.ordered_add_comm_monoid, ..additive.order_bot, ..additive.has_exists_add_of_le }

instance [canonically_linear_ordered_add_monoid α] :
  canonically_linear_ordered_monoid (multiplicative α) :=
{ ..multiplicative.canonically_ordered_monoid, ..multiplicative.linear_order }

instance [canonically_linear_ordered_monoid α] :
  canonically_linear_ordered_add_monoid (additive α) :=
{ ..additive.canonically_ordered_add_monoid, ..additive.linear_order }

namespace additive

variables [preorder α]

@[simp] lemma of_mul_le {a b : α} : of_mul a ≤ of_mul b ↔ a ≤ b := iff.rfl

@[simp] lemma of_mul_lt {a b : α} : of_mul a < of_mul b ↔ a < b := iff.rfl

@[simp] lemma to_mul_le {a b : additive α} : to_mul a ≤ to_mul b ↔ a ≤ b := iff.rfl

@[simp] lemma to_mul_lt {a b : additive α} : to_mul a < to_mul b ↔ a < b := iff.rfl

end additive

namespace multiplicative

variables [preorder α]

@[simp] lemma of_add_le {a b : α} : of_add a ≤ of_add b ↔ a ≤ b := iff.rfl

@[simp] lemma of_add_lt {a b : α} : of_add a < of_add b ↔ a < b := iff.rfl

@[simp] lemma to_add_le {a b : multiplicative α} : to_add a ≤ to_add b ↔ a ≤ b := iff.rfl

@[simp] lemma to_add_lt {a b : multiplicative α} : to_add a < to_add b ↔ a < b := iff.rfl

end multiplicative


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import topology.algebra.module.strong_topology
import topology.algebra.module.locally_convex

/-!
# Local convexity of the strong topology

In this file we prove that the strong topology on `E →L[ℝ] F` is locally convex provided that `F` is
locally convex.

## References

* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987]

## Todo

* Characterization in terms of seminorms

## Tags

locally convex, bounded convergence
-/

open_locale topology uniform_convergence

variables {R 𝕜₁ 𝕜₂ E F : Type*}

namespace continuous_linear_map

variables [add_comm_group E] [topological_space E]
  [add_comm_group F] [topological_space F] [topological_add_group F]

section general

variables (R)
variables [ordered_semiring R]
variables [normed_field 𝕜₁] [normed_field 𝕜₂] [module 𝕜₁ E] [module 𝕜₂ F] {σ : 𝕜₁ →+* 𝕜₂}
variables [module R F] [has_continuous_const_smul R F] [locally_convex_space R F]
  [smul_comm_class 𝕜₂ R F]

lemma strong_topology.locally_convex_space (𝔖 : set (set E)) (h𝔖₁ : 𝔖.nonempty)
  (h𝔖₂ : directed_on (⊆) 𝔖) :
  @locally_convex_space R (E →SL[σ] F) _ _ _ (strong_topology σ F 𝔖) :=
begin
  letI : topological_space (E →SL[σ] F) := strong_topology σ F 𝔖,
  haveI : topological_add_group (E →SL[σ] F) := strong_topology.topological_add_group _ _ _,
  refine locally_convex_space.of_basis_zero _ _ _ _
    (strong_topology.has_basis_nhds_zero_of_basis _ _ _ h𝔖₁ h𝔖₂
      (locally_convex_space.convex_basis_zero R F)) _,
  rintros ⟨S, V⟩ ⟨hS, hVmem, hVconvex⟩ f hf g hg a b ha hb hab x hx,
  exact hVconvex (hf x hx) (hg x hx) ha hb hab,
end

end general

section bounded_sets

variables [ordered_semiring R]
variables [normed_field 𝕜₁] [normed_field 𝕜₂] [module 𝕜₁ E] [module 𝕜₂ F] {σ : 𝕜₁ →+* 𝕜₂}
variables [module R F] [has_continuous_const_smul R F] [locally_convex_space R F]
  [smul_comm_class 𝕜₂ R F]

instance : locally_convex_space R (E →SL[σ] F) :=
strong_topology.locally_convex_space R _ ⟨∅, bornology.is_vonN_bounded_empty 𝕜₁ E⟩
  (directed_on_of_sup_mem $ λ _ _, bornology.is_vonN_bounded.union)

end bounded_sets

end continuous_linear_map


/-
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

end Mathlib


namespace Algebra

section
  class Carrier_Of (α : Type u) where
    carrier_of : α → Type v

  @[app_unexpander Carrier_Of.carrier_of] def unexpand_carrier_of : Lean.PrettyPrinter.Unexpander
  | `($(_) $a) => `(↑$a)
  | _                => throw ()

  instance (α) [Carrier_Of α] : CoeSort α (Type v) := ⟨Carrier_Of.carrier_of⟩
end

section
  variable (α) [Carrier_Of α]

  class BinOp_Of where binop_of {X : α} : X → X → X
  class Identity_Of where id_of {X : α} : X
  class Sym_Of where sym_of {X : α} : X → X
  class Add_Of where add_of {X : α} : X → X → X
  class Zero_Of where zero_of {X : α} : X
  class Neg_Of where neg_of {X : α} : X → X
  class Mul_Of where mul_of {X : α} : X → X → X
  class One_Of where one_of {X : α} : X
  class Inv_Of where inv_of {X : α} : X → X
end

section

  structure Carrier.{u} where
    carrier : Type u

  namespace Carrier
    instance : Carrier_Of Carrier := ⟨λ X => X.carrier⟩
  end Carrier

  structure BinOp extends Carrier where
    binop : carrier → carrier → carrier

  namespace BinOp
    instance : Carrier_Of BinOp := ⟨λ X => X.carrier⟩
    instance : BinOp_Of BinOp := ⟨λ {X} => X.binop⟩
  end BinOp

  structure BinOpId extends BinOp where
    identity : carrier

  namespace BinOpId
    instance : Carrier_Of BinOpId := ⟨λ X => X.carrier⟩
    instance : Identity_Of BinOpId := ⟨λ {X} => X.identity⟩
    instance : BinOp_Of BinOpId := ⟨λ {X} => X.binop⟩
    instance : Coe BinOpId BinOp := ⟨λ X => X.toBinOp⟩
  end BinOpId

  structure BinOpIdSym extends BinOpId where
    sym : carrier → carrier

  namespace BinOpIdSym
    instance : Carrier_Of BinOpIdSym := ⟨λ X => X.carrier⟩
    instance : Identity_Of BinOpIdSym := ⟨λ {X} => X.identity⟩
    instance : BinOp_Of BinOpIdSym := ⟨λ {X} => X.binop⟩
    instance : Sym_Of BinOpIdSym := ⟨λ {X} => X.sym⟩
    instance : Coe BinOpIdSym BinOpId := ⟨λ X => X.toBinOpId⟩
    instance : Coe BinOpIdSym BinOp := ⟨λ X => X.toBinOp⟩
  end BinOpIdSym

  structure AddZeroMulOne extends Carrier where
    add : carrier → carrier → carrier
    zero : carrier
    mul : carrier → carrier → carrier
    one : carrier

  namespace AddZeroMulOne
    instance : Carrier_Of AddZeroMulOne := ⟨λ X => X.carrier⟩
    instance : Add_Of AddZeroMulOne := ⟨λ {X} => X.add⟩
    instance : Zero_Of AddZeroMulOne := ⟨λ {X} => X.zero⟩
    instance : Mul_Of AddZeroMulOne := ⟨λ {X} => X.mul⟩
    instance : One_Of AddZeroMulOne := ⟨λ {X} => X.one⟩
    def toAddZero (X : AddZeroMulOne) : BinOpId := {
      carrier := X
      binop := X.add
      identity := X.zero
    }
    instance : Coe AddZeroMulOne BinOpId := ⟨λ X => X.toAddZero⟩
    def toMulOne (X : AddZeroMulOne) : BinOpId := {
      carrier := X
      binop := X.mul
      identity := X.one
    }
  end AddZeroMulOne

  structure AddZeroNegMulOne extends AddZeroMulOne where
    neg : carrier → carrier

  namespace AddZeroNegMulOne
    instance : Carrier_Of AddZeroNegMulOne := ⟨λ X => X.carrier⟩
    instance : Add_Of AddZeroNegMulOne := ⟨λ {X} => X.add⟩
    instance : Zero_Of AddZeroNegMulOne := ⟨λ {X} => X.zero⟩
    instance : Neg_Of AddZeroNegMulOne := ⟨λ {X} => X.neg⟩
    instance : Mul_Of AddZeroNegMulOne := ⟨λ {X} => X.mul⟩
    instance : One_Of AddZeroNegMulOne := ⟨λ {X} => X.one⟩
    instance : Coe AddZeroNegMulOne AddZeroMulOne := ⟨λ X => X.toAddZeroMulOne⟩
    def toAddZeroNeg (X : AddZeroNegMulOne) : BinOpIdSym := {
      carrier := X
      binop := X.add
      identity := X.zero
      sym := X.neg
    }
    instance : Coe AddZeroNegMulOne BinOpIdSym := ⟨λ X => X.toAddZeroNeg⟩
  end AddZeroNegMulOne

end

section
  local infixl:70 " ⋆ " => BinOp_Of.binop_of
  local notation:max "𝟙" => Identity_Of.id_of
  local postfix:max "⁻ⁱ" => Sym_Of.sym_of
  -- local infixl:65 " + " => Add_Of.add_of
  local instance (X : α) [Carrier_Of α] [Add_Of α] : Add X where add := Add_Of.add_of
  local notation:max "𝟬" => Zero_Of.zero_of
  local prefix:max "-" => Neg_Of.neg_of
  -- local infixl:70 " * " => Mul_Of.mul_of
  local instance (X : α) [Carrier_Of α] [Mul_Of α] : Mul X where mul := Mul_Of.mul_of
  local notation:max "𝟭" => One_Of.one_of
  local postfix:max "⁻¹" => Inv_Of.inv_of

  class Comm (X : BinOp) : Prop where
    comm : ∀ x y : X, x ⋆ y = y ⋆ x
  export Comm (comm)

  class Semigroup (X : BinOp) : Prop where
    assoc : ∀ x y z : X, (x ⋆ y) ⋆ z = x ⋆ (y ⋆ z)
  export Semigroup (assoc)

  class CommSemigroup (X : BinOp) extends Semigroup X, Comm X : Prop

  class Unital (X : BinOpId) : Prop where
    id_op : ∀ x : X, 𝟙 ⋆ x = x
    op_id : ∀ x : X, x ⋆ 𝟙 = x
  export Unital (id_op op_id)
  attribute [simp] id_op op_id

  class Monoid (X : BinOpId) extends Semigroup X, Unital X : Prop

  class CommMonoid (X : BinOpId) extends Monoid X, Comm X : Prop

  class Symmetric (X : BinOpIdSym) : Prop where
    op_sym : ∀ x : X, x ⋆ x⁻ⁱ = 𝟙
    sym_op : ∀ x : X, x⁻ⁱ ⋆ x = 𝟙
  export Symmetric (op_sym sym_op)
  attribute [simp] op_sym sym_op

  class Group (X : BinOpIdSym) extends Monoid X, Symmetric X : Prop

  class CommGroup (X : BinOpIdSym) extends Group X, Comm X : Prop

  class BinOp.Morphism {X Y : BinOp} (f : X → Y) : Prop where
    op_law : ∀ x y, f (x ⋆ y) = f x ⋆ f y

  class Unital.Morphism {X Y} [Unital X] [Unital Y] (f : X → Y) extends BinOp.Morphism f : Prop where
    op_id : f 𝟙 = 𝟙

  class Monoid.Morphism {X Y} [Monoid X] [Monoid Y] (f : X → Y) extends Unital.Morphism f : Prop

  class Group.Morphism {X Y} [Group X] [Group Y] (f : X → Y) extends Monoid.Morphism f : Prop

  class Semiring (X : AddZeroMulOne) : Prop where
    comm_monoid_add_zero : CommMonoid X.toAddZero
    monoid_mul_one : Monoid X.toMulOne
    mul_add : ∀ x y z : X, x * (y + z) = x * y + x * z
    add_mul : ∀ x y z : X, (x + y) * z = x * z + y * z
    mul_zero : ∀ x : X, x * 𝟬 = 𝟬
    zero_mul : ∀ x : X, 𝟬 * x = 𝟬
  instance [Semiring X] : CommMonoid X := Semiring.comm_monoid_add_zero
  instance [Semiring X] : Monoid X.toMulOne := Semiring.monoid_mul_one

  class CommSemiring (X : AddZeroMulOne) extends Semiring X, Comm X.toMulOne : Prop where
  instance [CommSemiring X] : CommMonoid X.toMulOne := {}

  class Ring (X : AddZeroNegMulOne) extends Semiring X : Prop where
    sym_add_zero_neg : Symmetric X
  instance [Ring X] : Symmetric X := Ring.sym_add_zero_neg
  instance [Ring X] : Semiring X := inferInstance
  local instance [Ring X] : CommMonoid X := inferInstanceAs <| CommMonoid X.toAddZeroMulOne in
  instance [Ring X] : CommGroup X := {}

  class CommRing (X : AddZeroNegMulOne) extends Ring X, Comm X.toMulOne : Prop where
  instance [CommRing X] : CommSemiring X := {}

  class Ring.Morphism {X Y} [Ring X] [Ring Y] (f : X → Y) : Prop where
    add_morphism : Monoid.Morphism (show X.toAddZero → Y.toAddZero from f)
    mul_morphism : Monoid.Morphism (show X.toMulOne → Y.toMulOne from f)

  def kernel {X Y} [Unital X] [Unital Y] (f : X → Y) [Unital.Morphism f] : X → Prop
    := λ x => f x = 𝟙

  example [CommGroup X] : ∀ x y : X, x ⋆ y = y ⋆ x := comm
  example [CommGroup X] : ∀ x y z : X, (x ⋆ y) ⋆ z = x ⋆ (y ⋆ z) := assoc
  example [CommMonoid X] : ∀ x : X, x ⋆ 𝟙 = x := by simp
  example [CommGroup X] : ∀ x : X, x ⋆ 𝟙 = x := op_id
  example [CommGroup X] : ∀ x : X, x ⋆ 𝟙 = x :=
  show ∀ x : (X : BinOpId), x ⋆ 𝟙 = x from
  by simp
  example [CommGroup X] : ∀ x : X, x ⋆ x⁻ⁱ = 𝟙 := by simp
  example [CommRing X] : ∀ x : X, x + 𝟬 = x :=
  let X := X.toAddZero
  show ∀ x : X, x ⋆ 𝟙 = x from
  by simp

  example {X Y : BinOp} (f : X → Y) [BinOp.Morphism f] : ∀ x y, f (x ⋆ y) = f x ⋆ f y := BinOp.Morphism.op_law
  example {X Y Z : BinOp} (f : X → Y) [fi : BinOp.Morphism f] (g : Y → Z) [gi : BinOp.Morphism g]
  : BinOp.Morphism (g ∘ f) where
    op_law x y := show g (f (x ⋆ y)) = g (f x) ⋆ g (f y) from fi.op_law .. ▸ gi.op_law .. ▸ rfl

  example {X Y} [Ring X] [Ring Y] (f : X → Y) [Ring.Morphism f] : f 𝟬 = 𝟬
    := Ring.Morphism.add_morphism.op_id
  example {X Y} [Ring X] [Ring Y] (f : X → Y) [Ring.Morphism f] : f 𝟭 = 𝟭
    := Ring.Morphism.mul_morphism.op_id

  example {X} [Ring X] : Unital X := inferInstance

  example {X Y} [Ring X] [Ring Y] (f : X → Y)
    [i : Unital.Morphism (show X.toAddZero → Y.toAddZero from f)]
    : kernel (show X.toAddZero → Y.toAddZero from f) (𝟬 : X) :=
    i.op_id

end

end Algebra


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.connected_components
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Chain
import Mathbin.CategoryTheory.IsConnected
import Mathbin.CategoryTheory.Sigma.Basic
import Mathbin.CategoryTheory.FullSubcategory

/-!
# Connected components of a category

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

Defines a type `connected_components J` indexing the connected components of a category, and the
full subcategories giving each connected component: `component j : Type u₁`.
We show that each `component j` is in fact connected.

We show every category can be expressed as a disjoint union of its connected components, in
particular `decomposed J` is the category (definitionally) given by the sigma-type of the connected
components of `J`, and it is shown that this is equivalent to `J`.
-/

universe v₁ v₂ v₃ u₁ u₂

noncomputable section

open CategoryTheory.Category

namespace CategoryTheory

attribute [instance] is_connected.is_nonempty

variable {J : Type u₁} [Category.{v₁} J]

variable {C : Type u₂} [Category.{u₁} C]

#print CategoryTheory.ConnectedComponents /-
/-- This type indexes the connected components of the category `J`. -/
def ConnectedComponents (J : Type u₁) [Category.{v₁} J] : Type u₁ :=
  Quotient (Zigzag.setoid J)
#align category_theory.connected_components CategoryTheory.ConnectedComponents
-/

instance [Inhabited J] : Inhabited (ConnectedComponents J) :=
  ⟨Quotient.mk'' default⟩

#print CategoryTheory.Component /-
/-- Given an index for a connected component, produce the actual component as a full subcategory. -/
def Component (j : ConnectedComponents J) : Type u₁ :=
  FullSubcategory fun k => Quotient.mk'' k = j deriving Category
#align category_theory.component CategoryTheory.Component
-/

/- warning: category_theory.component.ι -> CategoryTheory.Component.ι is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] (j : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1), CategoryTheory.Functor.{u1, u1, u2, u2} (CategoryTheory.Component.{u1, u2} J _inst_1 j) (CategoryTheory.InducedCategory.category.{u1, u2, u2} (CategoryTheory.FullSubcategoryₓ.{u1, u2} J _inst_1 (fun (k : J) => Eq.{succ u2} (Quotient.{succ u2} J (CategoryTheory.Zigzag.setoid.{u1, u2} J _inst_1)) (Quotient.mk''.{succ u2} J (CategoryTheory.Zigzag.setoid.{u1, u2} J _inst_1) k) j)) J _inst_1 (CategoryTheory.FullSubcategoryₓ.obj.{u1, u2} J _inst_1 (fun (k : J) => Eq.{succ u2} (Quotient.{succ u2} J (CategoryTheory.Zigzag.setoid.{u1, u2} J _inst_1)) (Quotient.mk''.{succ u2} J (CategoryTheory.Zigzag.setoid.{u1, u2} J _inst_1) k) j))) J _inst_1
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] (j : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1), CategoryTheory.Functor.{u1, u1, u2, u2} (CategoryTheory.Component.{u1, u2} J _inst_1 j) (CategoryTheory.instCategoryComponent.{u1, u2} J _inst_1 j) J _inst_1
Case conversion may be inaccurate. Consider using '#align category_theory.component.ι CategoryTheory.Component.ιₓ'. -/
/-- The inclusion functor from a connected component to the whole category. -/
@[simps (config := { rhsMd := semireducible })]
def Component.ι (j) : Component j ⥤ J :=
  fullSubcategoryInclusion _ deriving Full, Faithful
#align category_theory.component.ι CategoryTheory.Component.ι

/-- Each connected component of the category is nonempty. -/
instance (j : ConnectedComponents J) : Nonempty (Component j) :=
  by
  apply Quotient.inductionOn' j
  intro k
  refine' ⟨⟨k, rfl⟩⟩

instance (j : ConnectedComponents J) : Inhabited (Component j) :=
  Classical.inhabited_of_nonempty'

/-- Each connected component of the category is connected. -/
instance (j : ConnectedComponents J) : IsConnected (Component j) :=
  by
  -- Show it's connected by constructing a zigzag (in `component j`) between any two objects
  apply is_connected_of_zigzag
  rintro ⟨j₁, hj₁⟩ ⟨j₂, rfl⟩
  -- We know that the underlying objects j₁ j₂ have some zigzag between them in `J`
  have h₁₂ : zigzag j₁ j₂ := Quotient.exact' hj₁
  -- Get an explicit zigzag as a list
  rcases List.exists_chain_of_relationReflTransGen h₁₂ with ⟨l, hl₁, hl₂⟩
  -- Everything which has a zigzag to j₂ can be lifted to the same component as `j₂`.
  let f : ∀ x, zigzag x j₂ → component (Quotient.mk'' j₂) := fun x h => ⟨x, Quotient.sound' h⟩
  -- Everything in our chosen zigzag from `j₁` to `j₂` has a zigzag to `j₂`.
  have hf : ∀ a : J, a ∈ l → zigzag a j₂ := by
    intro i hi
    apply List.Chain.induction (fun t => zigzag t j₂) _ hl₁ hl₂ _ _ _ (Or.inr hi)
    · intro j k
      apply Relation.ReflTransGen.head
    · apply Relation.ReflTransGen.refl
  -- Now lift the zigzag from `j₁` to `j₂` in `J` to the same thing in `component j`.
  refine' ⟨l.pmap f hf, _, _⟩
  · refine' @List.chain_pmap_of_chain _ _ _ f (fun x y _ _ h => _) hl₁ h₁₂ _
    exact zag_of_zag_obj (component.ι _) h
  · erw [List.getLast_pmap _ f (j₁ :: l) (by simpa [h₁₂] using hf) (List.cons_ne_nil _ _)]
    exact full_subcategory.ext _ _ hl₂

#print CategoryTheory.Decomposed /-
/-- The disjoint union of `J`s connected components, written explicitly as a sigma-type with the
category structure.
This category is equivalent to `J`.
-/
abbrev Decomposed (J : Type u₁) [Category.{v₁} J] :=
  Σj : ConnectedComponents J, Component j
#align category_theory.decomposed CategoryTheory.Decomposed
-/

#print CategoryTheory.inclusion /-
-- This name may cause clashes further down the road, and so might need to be changed.
/--
The inclusion of each component into the decomposed category. This is just `sigma.incl` but having
this abbreviation helps guide typeclass search to get the right category instance on `decomposed J`.
-/
abbrev inclusion (j : ConnectedComponents J) : Component j ⥤ Decomposed J :=
  Sigma.incl _
#align category_theory.inclusion CategoryTheory.inclusion
-/

#print CategoryTheory.decomposedTo /-
/-- The forward direction of the equivalence between the decomposed category and the original. -/
@[simps (config := { rhsMd := semireducible })]
def decomposedTo (J : Type u₁) [Category.{v₁} J] : Decomposed J ⥤ J :=
  Sigma.desc Component.ι
#align category_theory.decomposed_to CategoryTheory.decomposedTo
-/

#print CategoryTheory.inclusion_comp_decomposedTo /-
@[simp]
theorem inclusion_comp_decomposedTo (j : ConnectedComponents J) :
    inclusion j ⋙ decomposedTo J = Component.ι j :=
  rfl
#align category_theory.inclusion_comp_decomposed_to CategoryTheory.inclusion_comp_decomposedTo
-/

instance : Full (decomposedTo J)
    where
  Preimage := by
    rintro ⟨j', X, hX⟩ ⟨k', Y, hY⟩ f
    dsimp at f
    have : j' = k'
    rw [← hX, ← hY, Quotient.eq'']
    exact Relation.ReflTransGen.single (Or.inl ⟨f⟩)
    subst this
    refine' sigma.sigma_hom.mk f
  witness' := by
    rintro ⟨j', X, hX⟩ ⟨_, Y, rfl⟩ f
    have : Quotient.mk'' Y = j' := by
      rw [← hX, Quotient.eq'']
      exact Relation.ReflTransGen.single (Or.inr ⟨f⟩)
    subst this
    rfl

instance : Faithful (decomposedTo J)
    where map_injective' := by
    rintro ⟨_, j, rfl⟩ ⟨_, k, hY⟩ ⟨f⟩ ⟨g⟩ e
    change f = g at e
    subst e

instance : EssSurj (decomposedTo J) where mem_essImage j := ⟨⟨_, j, rfl⟩, ⟨Iso.refl _⟩⟩

instance : IsEquivalence (decomposedTo J) :=
  Equivalence.ofFullyFaithfullyEssSurj _

/- warning: category_theory.decomposed_equiv -> CategoryTheory.decomposedEquiv is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J], CategoryTheory.Equivalence.{max u1 u2, u1, u2, u2} (CategoryTheory.Decomposed.{u1, u2} J _inst_1) (CategoryTheory.Sigma.sigma.{u2, u1, u2} (CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) (fun (j : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) => CategoryTheory.Component.{u1, u2} J _inst_1 j) (fun (i : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) => CategoryTheory.Component.category.{u2, u1} J _inst_1 i)) J _inst_1
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J], CategoryTheory.Equivalence.{max u2 u1, u1, u2, u2} (CategoryTheory.Decomposed.{u1, u2} J _inst_1) J (CategoryTheory.Sigma.sigma.{u2, u1, u2} (CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) (fun (j : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) => CategoryTheory.Component.{u1, u2} J _inst_1 j) (fun (i : CategoryTheory.ConnectedComponents.{u1, u2} J _inst_1) => CategoryTheory.instCategoryComponent.{u1, u2} J _inst_1 i)) _inst_1
Case conversion may be inaccurate. Consider using '#align category_theory.decomposed_equiv CategoryTheory.decomposedEquivₓ'. -/
/-- This gives that any category is equivalent to a disjoint union of connected categories. -/
@[simps (config := { rhsMd := semireducible }) Functor]
def decomposedEquiv : Decomposed J ≌ J :=
  (decomposedTo J).asEquivalence
#align category_theory.decomposed_equiv CategoryTheory.decomposedEquiv

end CategoryTheory


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.finset.sort
import data.matrix.notation
import linear_algebra.affine_space.combination
import linear_algebra.basis

/-!
# Affine independence

This file defines affinely independent families of points.

## Main definitions

* `affine_independent` defines affinely independent families of points
  as those where no nontrivial weighted subtraction is 0.  This is
  proved equivalent to two other formulations: linear independence of
  the results of subtracting a base point in the family from the other
  points in the family, or any equal affine combinations having the
  same weights.  A bundled type `simplex` is provided for finite
  affinely independent families of points, with an abbreviation
  `triangle` for the case of three points.

## References

* https://en.wikipedia.org/wiki/Affine_space

-/

noncomputable theory
open_locale big_operators classical affine
open function

section affine_independent

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*}
include V

/-- An indexed family is said to be affinely independent if no
nontrivial weighted subtractions (where the sum of weights is 0) are
0. -/
def affine_independent (p : ι → P) : Prop :=
∀ (s : finset ι) (w : ι → k), ∑ i in s, w i = 0 → s.weighted_vsub p w = (0:V) → ∀ i ∈ s, w i = 0

/-- The definition of `affine_independent`. -/
lemma affine_independent_def (p : ι → P) :
  affine_independent k p ↔
    ∀ (s : finset ι) (w : ι → k),
      ∑ i in s, w i = 0 → s.weighted_vsub p w = (0 : V) → ∀ i ∈ s, w i = 0 :=
iff.rfl

/-- A family with at most one point is affinely independent. -/
lemma affine_independent_of_subsingleton [subsingleton ι] (p : ι → P) :
  affine_independent k p :=
λ s w h hs i hi, fintype.eq_of_subsingleton_of_sum_eq h i hi

/-- A family indexed by a `fintype` is affinely independent if and
only if no nontrivial weighted subtractions over `finset.univ` (where
the sum of the weights is 0) are 0. -/
lemma affine_independent_iff_of_fintype [fintype ι] (p : ι → P) :
  affine_independent k p ↔
    ∀ w : ι → k, ∑ i, w i = 0 → finset.univ.weighted_vsub p w = (0 : V) → ∀ i, w i = 0 :=
begin
  split,
  { exact λ h w hw hs i, h finset.univ w hw hs i (finset.mem_univ _) },
  { intros h s w hw hs i hi,
    rw finset.weighted_vsub_indicator_subset _ _ (finset.subset_univ s) at hs,
    rw set.sum_indicator_subset _ (finset.subset_univ s) at hw,
    replace h := h ((↑s : set ι).indicator w) hw hs i,
    simpa [hi] using h }
end

/-- A family is affinely independent if and only if the differences
from a base point in that family are linearly independent. -/
lemma affine_independent_iff_linear_independent_vsub (p : ι → P) (i1 : ι) :
  affine_independent k p ↔ linear_independent k (λ i : {x // x ≠ i1}, (p i -ᵥ p i1 : V)) :=
begin
  split,
  { intro h,
    rw linear_independent_iff',
    intros s g hg i hi,
    set f : ι → k := λ x, if hx : x = i1 then -∑ y in s, g y else g ⟨x, hx⟩ with hfdef,
    let s2 : finset ι := insert i1 (s.map (embedding.subtype _)),
    have hfg : ∀ x : {x // x ≠ i1}, g x = f x,
    { intro x,
      rw hfdef,
      dsimp only [],
      erw [dif_neg x.property, subtype.coe_eta] },
    rw hfg,
    have hf : ∑ ι in s2, f ι = 0,
    { rw [finset.sum_insert (finset.not_mem_map_subtype_of_not_property s (not_not.2 rfl)),
          finset.sum_subtype_map_embedding (λ x hx, (hfg x).symm)],
      rw hfdef,
      dsimp only [],
      rw dif_pos rfl,
      exact neg_add_self _ },
    have hs2 : s2.weighted_vsub p f = (0:V),
    { set f2 : ι → V := λ x, f x • (p x -ᵥ p i1) with hf2def,
      set g2 : {x // x ≠ i1} → V := λ x, g x • (p x -ᵥ p i1) with hg2def,
      have hf2g2 : ∀ x : {x // x ≠ i1}, f2 x = g2 x,
      { simp_rw [hf2def, hg2def, hfg],
        exact λ x, rfl },
      rw [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero s2 f p hf (p i1),
          finset.weighted_vsub_of_point_insert, finset.weighted_vsub_of_point_apply,
          finset.sum_subtype_map_embedding (λ x hx, hf2g2 x)],
      exact hg },
    exact h s2 f hf hs2 i (finset.mem_insert_of_mem (finset.mem_map.2 ⟨i, hi, rfl⟩)) },
  { intro h,
    rw linear_independent_iff' at h,
    intros s w hw hs i hi,
    rw [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero s w p hw (p i1),
        ←s.weighted_vsub_of_point_erase w p i1, finset.weighted_vsub_of_point_apply] at hs,
    let f : ι → V := λ i, w i • (p i -ᵥ p i1),
    have hs2 : ∑ i in (s.erase i1).subtype (λ i, i ≠ i1), f i = 0,
    { rw [←hs],
      convert finset.sum_subtype_of_mem f (λ x, finset.ne_of_mem_erase) },
    have h2 := h ((s.erase i1).subtype (λ i, i ≠ i1)) (λ x, w x) hs2,
    simp_rw [finset.mem_subtype] at h2,
    have h2b : ∀ i ∈ s, i ≠ i1 → w i = 0 :=
      λ i his hi, h2 ⟨i, hi⟩ (finset.mem_erase_of_ne_of_mem hi his),
    exact finset.eq_zero_of_sum_eq_zero hw h2b i hi }
end

/-- A set is affinely independent if and only if the differences from
a base point in that set are linearly independent. -/
lemma affine_independent_set_iff_linear_independent_vsub {s : set P} {p₁ : P} (hp₁ : p₁ ∈ s) :
  affine_independent k (λ p, p : s → P) ↔
  linear_independent k (λ v, v : (λ p, (p -ᵥ p₁ : V)) '' (s \ {p₁}) → V) :=
begin
  rw affine_independent_iff_linear_independent_vsub k (λ p, p : s → P) ⟨p₁, hp₁⟩,
  split,
  { intro h,
    have hv : ∀ v : (λ p, (p -ᵥ p₁ : V)) '' (s \ {p₁}), (v : V) +ᵥ p₁ ∈ s \ {p₁} :=
      λ v, (set.mem_image_of_injective (vsub_left_injective p₁)).1
             ((vadd_vsub (v : V) p₁).symm ▸ v.property),
    let f : (λ p : P, (p -ᵥ p₁ : V)) '' (s \ {p₁}) → {x : s // x ≠ ⟨p₁, hp₁⟩} :=
      λ x, ⟨⟨(x : V) +ᵥ p₁, set.mem_of_mem_diff (hv x)⟩,
            λ hx, set.not_mem_of_mem_diff (hv x) (subtype.ext_iff.1 hx)⟩,
    convert h.comp f
      (λ x1 x2 hx, (subtype.ext (vadd_right_cancel p₁ (subtype.ext_iff.1 (subtype.ext_iff.1 hx))))),
    ext v,
    exact (vadd_vsub (v : V) p₁).symm },
  { intro h,
    let f : {x : s // x ≠ ⟨p₁, hp₁⟩} → (λ p : P, (p -ᵥ p₁ : V)) '' (s \ {p₁}) :=
      λ x, ⟨((x : s) : P) -ᵥ p₁, ⟨x, ⟨⟨(x : s).property, λ hx, x.property (subtype.ext hx)⟩, rfl⟩⟩⟩,
    convert h.comp f
      (λ x1 x2 hx, subtype.ext (subtype.ext (vsub_left_cancel (subtype.ext_iff.1 hx)))) }
end

/-- A set of nonzero vectors is linearly independent if and only if,
given a point `p₁`, the vectors added to `p₁` and `p₁` itself are
affinely independent. -/
lemma linear_independent_set_iff_affine_independent_vadd_union_singleton {s : set V}
  (hs : ∀ v ∈ s, v ≠ (0 : V)) (p₁ : P) : linear_independent k (λ v, v : s → V) ↔
  affine_independent k (λ p, p : {p₁} ∪ ((λ v, v +ᵥ p₁) '' s) → P) :=
begin
  rw affine_independent_set_iff_linear_independent_vsub k
    (set.mem_union_left _ (set.mem_singleton p₁)),
  have h : (λ p, (p -ᵥ p₁ : V)) '' (({p₁} ∪ (λ v, v +ᵥ p₁) '' s) \ {p₁}) = s,
  { simp_rw [set.union_diff_left, set.image_diff (vsub_left_injective p₁), set.image_image,
             set.image_singleton, vsub_self, vadd_vsub, set.image_id'],
    exact set.diff_singleton_eq_self (λ h, hs 0 h rfl) },
  rw h
end

/-- A family is affinely independent if and only if any affine
combinations (with sum of weights 1) that evaluate to the same point
have equal `set.indicator`. -/
lemma affine_independent_iff_indicator_eq_of_affine_combination_eq (p : ι → P) :
  affine_independent k p ↔ ∀ (s1 s2 : finset ι) (w1 w2 : ι → k), ∑ i in s1, w1 i = 1 →
    ∑ i in s2, w2 i = 1 → s1.affine_combination p w1 = s2.affine_combination p w2 →
      set.indicator ↑s1 w1 = set.indicator ↑s2 w2 :=
begin
  split,
  { intros ha s1 s2 w1 w2 hw1 hw2 heq,
    ext i,
    by_cases hi : i ∈ (s1 ∪ s2),
    { rw ←sub_eq_zero,
      rw set.sum_indicator_subset _ (finset.subset_union_left s1 s2) at hw1,
      rw set.sum_indicator_subset _ (finset.subset_union_right s1 s2) at hw2,
      have hws : ∑ i in s1 ∪ s2, (set.indicator ↑s1 w1 - set.indicator ↑s2 w2) i = 0,
      { simp [hw1, hw2] },
      rw [finset.affine_combination_indicator_subset _ _ (finset.subset_union_left s1 s2),
          finset.affine_combination_indicator_subset _ _ (finset.subset_union_right s1 s2),
          ←@vsub_eq_zero_iff_eq V, finset.affine_combination_vsub] at heq,
      exact ha (s1 ∪ s2) (set.indicator ↑s1 w1 - set.indicator ↑s2 w2) hws heq i hi },
    { rw [←finset.mem_coe, finset.coe_union] at hi,
      simp [mt (set.mem_union_left ↑s2) hi, mt (set.mem_union_right ↑s1) hi] } },
  { intros ha s w hw hs i0 hi0,
    let w1 : ι → k := function.update (function.const ι 0) i0 1,
    have hw1 : ∑ i in s, w1 i = 1,
    { rw [finset.sum_update_of_mem hi0, finset.sum_const_zero, add_zero] },
    have hw1s : s.affine_combination p w1 = p i0 :=
      s.affine_combination_of_eq_one_of_eq_zero w1 p hi0 (function.update_same _ _ _)
                                                (λ _ _ hne, function.update_noteq hne _ _),
    let w2 := w + w1,
    have hw2 : ∑ i in s, w2 i = 1,
    { simp [w2, finset.sum_add_distrib, hw, hw1] },
    have hw2s : s.affine_combination p w2 = p i0,
    { simp [w2, ←finset.weighted_vsub_vadd_affine_combination, hs, hw1s] },
    replace ha := ha s s w2 w1 hw2 hw1 (hw1s.symm ▸ hw2s),
    have hws : w2 i0 - w1 i0 = 0,
    { rw ←finset.mem_coe at hi0,
      rw [←set.indicator_of_mem hi0 w2, ←set.indicator_of_mem hi0 w1, ha, sub_self] },
    simpa [w2] using hws }
end

variables {k}

/-- An affinely independent family is injective, if the underlying
ring is nontrivial. -/
lemma injective_of_affine_independent [nontrivial k] {p : ι → P} (ha : affine_independent k p) :
  function.injective p :=
begin
  intros i j hij,
  rw affine_independent_iff_linear_independent_vsub _ _ j at ha,
  by_contra hij',
  exact ha.ne_zero ⟨i, hij'⟩ (vsub_eq_zero_iff_eq.mpr hij)
end

/-- If a family is affinely independent, so is any subfamily given by
composition of an embedding into index type with the original
family. -/
lemma affine_independent_embedding_of_affine_independent {ι2 : Type*} (f : ι2 ↪ ι) {p : ι → P}
    (ha : affine_independent k p) : affine_independent k (p ∘ f) :=
begin
  intros fs w hw hs i0 hi0,
  let fs' := fs.map f,
  let w' := λ i, if h : ∃ i2, f i2 = i then w h.some else 0,
  have hw' : ∀ i2 : ι2, w' (f i2) = w i2,
  { intro i2,
    have h : ∃ i : ι2, f i = f i2 := ⟨i2, rfl⟩,
    have hs : h.some = i2 := f.injective h.some_spec,
    simp_rw [w', dif_pos h, hs] },
  have hw's : ∑ i in fs', w' i = 0,
  { rw [←hw, finset.sum_map],
    simp [hw'] },
  have hs' : fs'.weighted_vsub p w' = (0:V),
  { rw [←hs, finset.weighted_vsub_map],
    congr' with i,
    simp [hw'] },
  rw [←ha fs' w' hw's hs' (f i0) ((finset.mem_map' _).2 hi0), hw']
end

/-- If a family is affinely independent, so is any subfamily indexed
by a subtype of the index type. -/
lemma affine_independent_subtype_of_affine_independent {p : ι → P}
    (ha : affine_independent k p) (s : set ι) : affine_independent k (λ i : s, p i) :=
affine_independent_embedding_of_affine_independent (embedding.subtype _) ha

/-- If an indexed family of points is affinely independent, so is the
corresponding set of points. -/
lemma affine_independent_set_of_affine_independent {p : ι → P} (ha : affine_independent k p) :
  affine_independent k (λ x, x : set.range p → P) :=
begin
  let f : set.range p → ι := λ x, x.property.some,
  have hf : ∀ x, p (f x) = x := λ x, x.property.some_spec,
  let fe : set.range p ↪ ι := ⟨f, λ x₁ x₂ he, subtype.ext (hf x₁ ▸ hf x₂ ▸ he ▸ rfl)⟩,
  convert affine_independent_embedding_of_affine_independent fe ha,
  ext,
  simp [hf]
end

/-- If a set of points is affinely independent, so is any subset. -/
lemma affine_independent_of_subset_affine_independent {s t : set P}
  (ha : affine_independent k (λ x, x : t → P)) (hs : s ⊆ t) :
  affine_independent k (λ x, x : s → P) :=
affine_independent_embedding_of_affine_independent (set.embedding_of_subset s t hs) ha

/-- If the range of an injective indexed family of points is affinely
independent, so is that family. -/
lemma affine_independent_of_affine_independent_set_of_injective {p : ι → P}
  (ha : affine_independent k (λ x, x : set.range p → P)) (hi : function.injective p) :
  affine_independent k p :=
affine_independent_embedding_of_affine_independent
  (⟨λ i, ⟨p i, set.mem_range_self _⟩, λ x y h, hi (subtype.mk_eq_mk.1 h)⟩ : ι ↪ set.range p) ha

/-- If a family is affinely independent, and the spans of points
indexed by two subsets of the index type have a point in common, those
subsets of the index type have an element in common, if the underlying
ring is nontrivial. -/
lemma exists_mem_inter_of_exists_mem_inter_affine_span_of_affine_independent [nontrivial k]
    {p : ι → P} (ha : affine_independent k p) {s1 s2 : set ι} {p0 : P}
    (hp0s1 : p0 ∈ affine_span k (p '' s1)) (hp0s2 : p0 ∈ affine_span k (p '' s2)):
  ∃ (i : ι), i ∈ s1 ∩ s2 :=
begin
  rw set.image_eq_range at hp0s1 hp0s2,
  rw [mem_affine_span_iff_eq_affine_combination,
      ←finset.eq_affine_combination_subset_iff_eq_affine_combination_subtype] at hp0s1 hp0s2,
  rcases hp0s1 with ⟨fs1, hfs1, w1, hw1, hp0s1⟩,
  rcases hp0s2 with ⟨fs2, hfs2, w2, hw2, hp0s2⟩,
  rw affine_independent_iff_indicator_eq_of_affine_combination_eq at ha,
  replace ha := ha fs1 fs2 w1 w2 hw1 hw2 (hp0s1 ▸ hp0s2),
  have hnz : ∑ i in fs1, w1 i ≠ 0 := hw1.symm ▸ one_ne_zero,
  rcases finset.exists_ne_zero_of_sum_ne_zero hnz with ⟨i, hifs1, hinz⟩,
  simp_rw [←set.indicator_of_mem (finset.mem_coe.2 hifs1) w1, ha] at hinz,
  use [i, hfs1 hifs1, hfs2 (set.mem_of_indicator_ne_zero hinz)]
end

/-- If a family is affinely independent, the spans of points indexed
by disjoint subsets of the index type are disjoint, if the underlying
ring is nontrivial. -/
lemma affine_span_disjoint_of_disjoint_of_affine_independent [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) {s1 s2 : set ι} (hd : s1 ∩ s2 = ∅) :
  (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) = ∅ :=
begin
  by_contradiction hne,
  change (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) ≠ ∅ at hne,
  rw set.ne_empty_iff_nonempty at hne,
  rcases hne with ⟨p0, hp0s1, hp0s2⟩,
  cases exists_mem_inter_of_exists_mem_inter_affine_span_of_affine_independent
    ha hp0s1 hp0s2 with i hi,
  exact set.not_mem_empty i (hd ▸ hi)
end

/-- If a family is affinely independent, a point in the family is in
the span of some of the points given by a subset of the index type if
and only if that point's index is in the subset, if the underlying
ring is nontrivial. -/
@[simp] lemma mem_affine_span_iff_mem_of_affine_independent [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) (i : ι) (s : set ι) :
  p i ∈ affine_span k (p '' s) ↔ i ∈ s :=
begin
  split,
  { intro hs,
    have h := exists_mem_inter_of_exists_mem_inter_affine_span_of_affine_independent
      ha hs (mem_affine_span k (set.mem_image_of_mem _ (set.mem_singleton _))),
    rwa [←set.nonempty_def, set.inter_singleton_nonempty] at h },
  { exact λ h, mem_affine_span k (set.mem_image_of_mem p h) }
end

/-- If a family is affinely independent, a point in the family is not
in the affine span of the other points, if the underlying ring is
nontrivial. -/
lemma not_mem_affine_span_diff_of_affine_independent [nontrivial k] {p : ι → P}
    (ha : affine_independent k p) (i : ι) (s : set ι) :
  p i ∉ affine_span k (p '' (s \ {i})) :=
by simp [ha]

end affine_independent

section field

variables {k : Type*} {V : Type*} {P : Type*} [field k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*}
include V

/-- An affinely independent set of points can be extended to such a
set that spans the whole space. -/
lemma exists_subset_affine_independent_affine_span_eq_top {s : set P}
  (h : affine_independent k (λ p, p : s → P)) :
  ∃ t : set P, s ⊆ t ∧ affine_independent k (λ p, p : t → P) ∧ affine_span k t = ⊤ :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨p₁, hp₁⟩,
  { have p₁ : P := add_torsor.nonempty.some,
    rcases exists_is_basis k V with ⟨sv, hsvi, hsvt⟩,
    have h0 : ∀ v : V, v ∈ sv → v ≠ 0,
    { intros v hv,
      change ((⟨v, hv⟩ : sv) : V) ≠ 0,
      exact hsvi.ne_zero _ },
    rw linear_independent_set_iff_affine_independent_vadd_union_singleton k h0 p₁ at hsvi,
    use [{p₁} ∪ (λ v, v +ᵥ p₁) '' sv, set.empty_subset _, hsvi,
         affine_span_singleton_union_vadd_eq_top_of_span_eq_top p₁ hsvt] },
  { rw affine_independent_set_iff_linear_independent_vsub k hp₁ at h,
    rcases exists_subset_is_basis h with ⟨sv, hsv, hsvi, hsvt⟩,
    have h0 : ∀ v : V, v ∈ sv → v ≠ 0,
    { intros v hv,
      change ((⟨v, hv⟩ : sv) : V) ≠ 0,
      exact hsvi.ne_zero _ },
    rw linear_independent_set_iff_affine_independent_vadd_union_singleton k h0 p₁ at hsvi,
    use {p₁} ∪ (λ v, v +ᵥ p₁) '' sv,
    split,
    { refine set.subset.trans _ (set.union_subset_union_right _ (set.image_subset _ hsv)),
      simp [set.image_image] },
    { use [hsvi, affine_span_singleton_union_vadd_eq_top_of_span_eq_top p₁ hsvt] } }
end

variables (k)

/-- Two different points are affinely independent. -/
lemma affine_independent_of_ne {p₁ p₂ : P} (h : p₁ ≠ p₂) : affine_independent k ![p₁, p₂] :=
begin
  rw affine_independent_iff_linear_independent_vsub k ![p₁, p₂] 0,
  let i₁ : {x // x ≠ (0 : fin 2)} := ⟨1, by norm_num⟩,
  have he' : ∀ i, i = i₁,
  { rintro ⟨i, hi⟩,
    ext,
    fin_cases i,
    { simpa using hi } },
  haveI : unique {x // x ≠ (0 : fin 2)} := ⟨⟨i₁⟩, he'⟩,
  have hz : (![p₁, p₂] ↑(default {x // x ≠ (0 : fin 2)}) -ᵥ ![p₁, p₂] 0 : V) ≠ 0,
  { rw he' (default _), simp, cc },
  exact linear_independent_unique _ hz
end

end field

namespace affine

variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [module k V]
variables [affine_space V P]
include V

/-- A `simplex k P n` is a collection of `n + 1` affinely
independent points. -/
structure simplex (n : ℕ) :=
(points : fin (n + 1) → P)
(independent : affine_independent k points)

/-- A `triangle k P` is a collection of three affinely independent points. -/
abbreviation triangle := simplex k P 2

namespace simplex

variables {P}

/-- Construct a 0-simplex from a point. -/
def mk_of_point (p : P) : simplex k P 0 :=
⟨λ _, p, affine_independent_of_subsingleton k _⟩

/-- The point in a simplex constructed with `mk_of_point`. -/
@[simp] lemma mk_of_point_points (p : P) (i : fin 1) : (mk_of_point k p).points i = p :=
rfl

instance [inhabited P] : inhabited (simplex k P 0) :=
⟨mk_of_point k $ default P⟩

instance nonempty : nonempty (simplex k P 0) :=
⟨mk_of_point k $ add_torsor.nonempty.some⟩

variables {k V}

/-- Two simplices are equal if they have the same points. -/
@[ext] lemma ext {n : ℕ} {s1 s2 : simplex k P n} (h : ∀ i, s1.points i = s2.points i) :
  s1 = s2 :=
begin
  cases s1,
  cases s2,
  congr' with i,
  exact h i
end

/-- Two simplices are equal if and only if they have the same points. -/
lemma ext_iff {n : ℕ} (s1 s2 : simplex k P n): s1 = s2 ↔ ∀ i, s1.points i = s2.points i :=
⟨λ h _, h ▸ rfl, ext⟩

/-- A face of a simplex is a simplex with the given subset of
points. -/
def face {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ} (h : fs.card = m + 1) :
  simplex k P m :=
⟨s.points ∘ fs.order_emb_of_fin h,
 affine_independent_embedding_of_affine_independent
   (fs.order_emb_of_fin h).to_embedding s.independent⟩

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
lemma face_points {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
  (h : fs.card = m + 1) (i : fin (m + 1)) :
  (s.face h).points i = s.points (fs.order_emb_of_fin h i) :=
rfl

/-- The points of a face of a simplex are given by `mono_of_fin`. -/
lemma face_points' {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))} {m : ℕ}
  (h : fs.card = m + 1) : (s.face h).points = s.points ∘ (fs.order_emb_of_fin h) :=
rfl

/-- A single-point face equals the 0-simplex constructed with
`mk_of_point`. -/
@[simp] lemma face_eq_mk_of_point {n : ℕ} (s : simplex k P n) (i : fin (n + 1)) :
  s.face (finset.card_singleton i) = mk_of_point k (s.points i) :=
by { ext, simp [face_points] }

/-- The set of points of a face. -/
@[simp] lemma range_face_points {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))}
  {m : ℕ} (h : fs.card = m + 1) : set.range (s.face h).points = s.points '' ↑fs :=
by rw [face_points', set.range_comp, finset.range_order_emb_of_fin]

end simplex

end affine

namespace affine
namespace simplex

variables {k : Type*} {V : Type*} {P : Type*} [division_ring k]
          [add_comm_group V] [module k V] [affine_space V P]
include V

/-- The centroid of a face of a simplex as the centroid of a subset of
the points. -/
@[simp] lemma face_centroid_eq_centroid {n : ℕ} (s : simplex k P n) {fs : finset (fin (n + 1))}
  {m : ℕ} (h : fs.card = m + 1) :
  finset.univ.centroid k (s.face h).points = fs.centroid k s.points :=
begin
  convert (finset.univ.centroid_map k (fs.order_emb_of_fin h).to_embedding s.points).symm,
  rw [← finset.coe_inj, finset.coe_map, finset.coe_univ, set.image_univ],
  simp
end

/-- Over a characteristic-zero division ring, the centroids given by
two subsets of the points of a simplex are equal if and only if those
faces are given by the same subset of points. -/
@[simp] lemma centroid_eq_iff [char_zero k] {n : ℕ} (s : simplex k P n)
  {fs₁ fs₂ : finset (fin (n + 1))} {m₁ m₂ : ℕ} (h₁ : fs₁.card = m₁ + 1) (h₂ : fs₂.card = m₂ + 1) :
  fs₁.centroid k s.points = fs₂.centroid k s.points ↔ fs₁ = fs₂ :=
begin
  split,
  { intro h,
    rw [finset.centroid_eq_affine_combination_fintype,
        finset.centroid_eq_affine_combination_fintype] at h,
    have ha := (affine_independent_iff_indicator_eq_of_affine_combination_eq k s.points).1
      s.independent _ _ _ _ (fs₁.sum_centroid_weights_indicator_eq_one_of_card_eq_add_one k h₁)
      (fs₂.sum_centroid_weights_indicator_eq_one_of_card_eq_add_one k h₂) h,
    simp_rw [finset.coe_univ, set.indicator_univ, function.funext_iff,
             finset.centroid_weights_indicator_def, finset.centroid_weights, h₁, h₂] at ha,
    ext i,
    replace ha := ha i,
    split,
    all_goals
    { intro hi,
      by_contradiction hni,
      simp [hi, hni] at ha,
      norm_cast at ha } },
  { intro h,
    have hm : m₁ = m₂,
    { subst h,
      simpa [h₁] using h₂ },
    subst hm,
    congr,
    exact h }
end

/-- Over a characteristic-zero division ring, the centroids of two
faces of a simplex are equal if and only if those faces are given by
the same subset of points. -/
lemma face_centroid_eq_iff [char_zero k] {n : ℕ} (s : simplex k P n)
  {fs₁ fs₂ : finset (fin (n + 1))} {m₁ m₂ : ℕ} (h₁ : fs₁.card = m₁ + 1) (h₂ : fs₂.card = m₂ + 1) :
  finset.univ.centroid k (s.face h₁).points = finset.univ.centroid k (s.face h₂).points ↔
    fs₁ = fs₂ :=
begin
  rw [face_centroid_eq_centroid, face_centroid_eq_centroid],
  exact s.centroid_eq_iff h₁ h₂
end

/-- Two simplices with the same points have the same centroid. -/
lemma centroid_eq_of_range_eq {n : ℕ} {s₁ s₂ : simplex k P n}
  (h : set.range s₁.points = set.range s₂.points) :
  finset.univ.centroid k s₁.points = finset.univ.centroid k s₂.points :=
begin
  rw [←set.image_univ, ←set.image_univ, ←finset.coe_univ] at h,
  exact finset.univ.centroid_eq_of_inj_on_of_image_eq k _
    (λ _ _ _ _ he, injective_of_affine_independent s₁.independent he)
    (λ _ _ _ _ he, injective_of_affine_independent s₂.independent he) h
end

end simplex
end affine


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

! This file was ported from Lean 3 source module category_theory.linear.linear_functor
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Preadditive.AdditiveFunctor
import Mathlib.CategoryTheory.Linear.Basic

/-!
# Linear Functors

An additive functor between two `R`-linear categories is called *linear*
if the induced map on hom types is a morphism of `R`-modules.

# Implementation details

`Functor.Linear` 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 `R`-modules.

-/

namespace CategoryTheory

variable (R : Type _) [Semiring R]

/-- An additive functor `F` is `R`-linear provided `F.map` is an `R`-module morphism. -/
class Functor.Linear {C D : Type _} [Category C] [Category D] [Preadditive C] [Preadditive D]
  [Linear R C] [Linear R D] (F : C ⥤ D) [F.Additive] : Prop where
  /-- the functor induces a linear map on morphisms -/
  map_smul : ∀ {X Y : C} (f : X ⟶ Y) (r : R), F.map (r • f) = r • F.map f := by aesop_cat
#align category_theory.functor.linear CategoryTheory.Functor.Linear

section Linear

namespace Functor

section

variable {R}
variable {C D : Type _} [Category C] [Category D] [Preadditive C] [Preadditive D]
  [CategoryTheory.Linear R C] [CategoryTheory.Linear R D] (F : C ⥤ D) [Additive F] [Linear R F]

@[simp]
theorem map_smul {X Y : C} (r : R) (f : X ⟶ Y) : F.map (r • f) = r • F.map f :=
  Functor.Linear.map_smul _ _
#align category_theory.functor.map_smul CategoryTheory.Functor.map_smul

instance : Linear R (𝟭 C) where

instance {E : Type _} [Category E] [Preadditive E] [CategoryTheory.Linear R E] (G : D ⥤ E)
    [Additive G] [Linear R G] : Linear R (F ⋙ G) where

variable (R)

/-- `F.mapLinearMap` is an `R`-linear map whose underlying function is `F.map`. -/
@[simps]
def mapLinearMap {X Y : C} : (X ⟶ Y) →ₗ[R] F.obj X ⟶ F.obj Y :=
  { F.mapAddHom with map_smul' := fun r f => F.map_smul r f }
#align category_theory.functor.map_linear_map CategoryTheory.Functor.mapLinearMap

theorem coe_mapLinearMap {X Y : C} : ⇑(F.mapLinearMap R : (X ⟶ Y) →ₗ[R] _) = F.map := rfl
#align category_theory.functor.coe_map_linear_map CategoryTheory.Functor.coe_mapLinearMap

end

section InducedCategory

variable {C : Type _} {D : Type _} [Category D] [Preadditive D] [CategoryTheory.Linear R D]
  (F : C → D)

instance inducedFunctorLinear : Functor.Linear R (inducedFunctor F) where
#align category_theory.functor.induced_functor_linear CategoryTheory.Functor.inducedFunctorLinear

end InducedCategory

instance fullSubcategoryInclusionLinear {C : Type _} [Category C] [Preadditive C]
    [CategoryTheory.Linear R C] (Z : C → Prop) : (fullSubcategoryInclusion Z).Linear R where
#align category_theory.functor.full_subcategory_inclusion_linear CategoryTheory.Functor.fullSubcategoryInclusionLinear

section

variable {R} {C D : Type _} [Category C] [Category D] [Preadditive C] [Preadditive D] (F : C ⥤ D)
  [Additive F]

instance natLinear : F.Linear ℕ where
  map_smul := F.mapAddHom.map_nsmul
#align category_theory.functor.nat_linear CategoryTheory.Functor.natLinear

instance intLinear : F.Linear ℤ where
  map_smul f r := F.mapAddHom.map_zsmul f r
#align category_theory.functor.int_linear CategoryTheory.Functor.intLinear

variable [CategoryTheory.Linear ℚ C] [CategoryTheory.Linear ℚ D]

instance ratLinear : F.Linear ℚ where
  map_smul f r := F.mapAddHom.toRatLinearMap.map_smul r f
#align category_theory.functor.rat_linear CategoryTheory.Functor.ratLinear

end

end Functor

namespace Equivalence

variable {C D : Type _} [Category C] [Category D] [Preadditive C] [Linear R C] [Preadditive D]
  [Linear R D]

instance inverseLinear (e : C ≌ D) [e.functor.Additive] [e.functor.Linear R] :
  e.inverse.Linear R where
    map_smul r f := by
      apply e.functor.map_injective
      simp
#align category_theory.equivalence.inverse_linear CategoryTheory.Equivalence.inverseLinear

end Equivalence

end Linear

end CategoryTheory


import data.real.basic

/-
Tactics you may consider
-intro
-rw
-apply
-exact
-/

#check le_antisymm
#check mul_eq_zero.mp

-- BEGIN
example {x y : ℝ} (h₀ : x ≤ y) (h₁ : ¬ y ≤ x) : ¬ x = y :=
begin
  intro h,
    /- In Lean, ¬ P is defined as an implication P → false.
       In this context, ¬ x = y refers to 'x = y → false'.
       'intro h' introduces the hypothesis x = y and tells
       Lean to find a contradiction. -/
  apply h₁,
    /- '¬ y ≤ x' is equivalent to 'y ≤ x → false' by the definition
       of negation. The apply tactic transforms the current goal
       to sufficient conditions. 'apply h₁' matches the goal with
       false and leaves y ≤ x as a new goal. -/
  rw h,
    /- Replace x with y so that the goal becomes ⊢ y ≤ y. This is
       true by le_refl: a ≤ a. And the 'rw' tactic acknowledges it. -/
end

example {x y : ℝ} (h : x ≤ y ∧ x ≠ y) : ¬ y ≤ x :=
begin
  intro h',
    /- In Lean, ¬ P is defined as an implication 'P → false'.
       In this context, ¬ y ≤ x means 'y ≤ x → false'. intro h'
       introduces the hypothesis y ≤ x and tells Lean to
       find a contradiction. -/
  apply h.right,
    /- x ≠ y is eqivelant to ¬ x = y, meaning 'x = y → false'
       by the definition of negation. The apply tactic transforms
       the current goal to sufficient conditions. 'apply h.right
       (x ≠ y)' matches the goal with false and leaves x = y as
       a new goal. -/
  exact le_antisymm h.left h',
    /- le_antisymm refers to 'a ≤ b → b ≤ a → a = b'; 'h.left'
       refers to x ≤ y; and h' is the type y ≤ x. exact le_antisymm
       h.left h' therefore solves the goal x = y. -/
end

example {x y : ℝ} (h : x ≤ y ∧ x ≠ y) : ¬ y ≤ x :=
λ h', h.right (le_antisymm h.left h')

example {a b : ℕ } : a ≠ 0 → b ≠ 0 → a * b ≠ 0 :=
begin
  intros ha hb,
  intro hab,
    apply ha,

end

-- END


import filter_world.level4 --hide
open set --hide
namespace filters --hide
localized "notation `P` := principal" in filters --hide

/-
# Level 5: The meet filter of two filters, greates lower bound
-/

/- Lemma
The meet of two filters is their greatest lower bound.
-/
lemma meet_greatest_lower_bound {X : Type} (V F : filter X): ∀ (T : filter X),
    T ≤ V ∧ T ≤ F → T ≤ meet V F :=
begin
  intros T hVF A hA,
  obtain ⟨v, f, hv, hf, H⟩ := hA,
  have hfv : v ∩ f ∈ T,
  {
    exact T.inter_sets (hVF.1 hv) (hVF.2 hf)
  },
  exact T.sets_of_superset hfv H,

end

end filters --hide


/-
Copyright (c) 2021 Justus Springer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Justus Springer
-/
import algebra.category.Mon.basic
import category_theory.limits.concrete_category
import category_theory.limits.preserves.filtered

/-!
# The forgetful functor from (commutative) (additive) monoids preserves filtered colimits.

Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend
to preserve _filtered_ colimits.

In this file, we start with a small filtered category `J` and a functor `F : J ⥤ Mon`.
We then construct a monoid structure on the colimit of `F ⋙ forget Mon` (in `Type`), thereby
showing that the forgetful functor `forget Mon` preserves filtered colimits. Similarly for `AddMon`,
`CommMon` and `AddCommMon`.

-/

universes v u

noncomputable theory
open_locale classical

open category_theory
open category_theory.limits
open category_theory.is_filtered (renaming max → max') -- avoid name collision with `_root_.max`.

namespace Mon.filtered_colimits

section

-- We use parameters here, mainly so we can have the abbreviations `M` and `M.mk` below, without
-- passing around `F` all the time.
parameters {J : Type v} [small_category J] (F : J ⥤ Mon.{max v u})

/--
The colimit of `F ⋙ forget Mon` in the category of types.
In the following, we will construct a monoid structure on `M`.
-/
@[to_additive "The colimit of `F ⋙ forget AddMon` in the category of types.
In the following, we will construct an additive monoid structure on `M`."]
abbreviation M : Type (max v u) := types.quot (F ⋙ forget Mon)

/-- The canonical projection into the colimit, as a quotient type. -/
@[to_additive "The canonical projection into the colimit, as a quotient type."]
abbreviation M.mk : (Σ j, F.obj j) → M := quot.mk (types.quot.rel (F ⋙ forget Mon))

@[to_additive]
lemma M.mk_eq (x y : Σ j, F.obj j)
  (h : ∃ (k : J) (f : x.1 ⟶ k) (g : y.1 ⟶ k), F.map f x.2 = F.map g y.2) :
  M.mk x = M.mk y :=
quot.eqv_gen_sound (types.filtered_colimit.eqv_gen_quot_rel_of_rel (F ⋙ forget Mon) x y h)

variables [is_filtered J]

/--
As `J` is nonempty, we can pick an arbitrary object `j₀ : J`. We use this object to define the
"one" in the colimit as the equivalence class of `⟨j₀, 1 : F.obj j₀⟩`.
-/
@[to_additive "As `J` is nonempty, we can pick an arbitrary object `j₀ : J`. We use this object to
define the \"zero\" in the colimit as the equivalence class of `⟨j₀, 0 : F.obj j₀⟩`."]
instance colimit_has_one : has_one M :=
{ one := M.mk ⟨is_filtered.nonempty.some, 1⟩ }

/--
The definition of the "one" in the colimit is independent of the chosen object of `J`.
In particular, this lemma allows us to "unfold" the definition of `colimit_one` at a custom chosen
object `j`.
-/
@[to_additive "The definition of the \"zero\" in the colimit is independent of the chosen object
of `J`. In particular, this lemma allows us to \"unfold\" the definition of `colimit_zero` at a
custom chosen object `j`."]
lemma colimit_one_eq (j : J) : (1 : M) = M.mk ⟨j, 1⟩ :=
begin
  apply M.mk_eq,
  refine ⟨max' _ j, left_to_max _ j, right_to_max _ j, _⟩,
  simp,
end

/--
The "unlifted" version of multiplication in the colimit. To multiply two dependent pairs
`⟨j₁, x⟩` and `⟨j₂, y⟩`, we pass to a common successor of `j₁` and `j₂` (given by `is_filtered.max`)
and multiply them there.
-/
@[to_additive "The \"unlifted\" version of addition in the colimit. To add two dependent pairs
`⟨j₁, x⟩` and `⟨j₂, y⟩`, we pass to a common successor of `j₁` and `j₂` (given by `is_filtered.max`)
and add them there."]
def colimit_mul_aux (x y : Σ j, F.obj j) : M :=
M.mk ⟨max' x.1 y.1, F.map (left_to_max x.1 y.1) x.2 * F.map (right_to_max x.1 y.1) y.2⟩

/-- Multiplication in the colimit is well-defined in the left argument. -/
@[to_additive "Addition in the colimit is well-defined in the left argument."]
lemma colimit_mul_aux_eq_of_rel_left {x x' y : Σ j, F.obj j}
  (hxx' : types.filtered_colimit.rel (F ⋙ forget Mon) x x') :
  colimit_mul_aux x y = colimit_mul_aux x' y :=
begin
  cases x with j₁ x, cases y with j₂ y, cases x' with j₃ x',
  obtain ⟨l, f, g, hfg⟩ := hxx',
  simp at hfg,
  obtain ⟨s, α, β, γ, h₁, h₂, h₃⟩ := tulip (left_to_max j₁ j₂) (right_to_max j₁ j₂)
    (right_to_max j₃ j₂) (left_to_max j₃ j₂) f g,
  apply M.mk_eq,
  use [s, α, γ],
  dsimp,
  simp_rw [monoid_hom.map_mul, ← comp_apply, ← F.map_comp, h₁, h₂, h₃, F.map_comp, comp_apply, hfg]
end

/-- Multiplication in the colimit is well-defined in the right argument. -/
@[to_additive "Addition in the colimit is well-defined in the right argument."]
lemma colimit_mul_aux_eq_of_rel_right {x y y' : Σ j, F.obj j}
  (hyy' : types.filtered_colimit.rel (F ⋙ forget Mon) y y') :
  colimit_mul_aux x y = colimit_mul_aux x y' :=
begin
  cases y with j₁ y, cases x with j₂ x, cases y' with j₃ y',
  obtain ⟨l, f, g, hfg⟩ := hyy',
  simp at hfg,
  obtain ⟨s, α, β, γ, h₁, h₂, h₃⟩ := tulip (right_to_max j₂ j₁) (left_to_max j₂ j₁)
    (left_to_max j₂ j₃) (right_to_max j₂ j₃) f g,
  apply M.mk_eq,
  use [s, α, γ],
  dsimp,
  simp_rw [monoid_hom.map_mul, ← comp_apply, ← F.map_comp, h₁, h₂, h₃, F.map_comp, comp_apply, hfg]
end

/-- Multiplication in the colimit. See also `colimit_mul_aux`. -/
@[to_additive "Addition in the colimit. See also `colimit_add_aux`."]
instance colimit_has_mul : has_mul M :=
{ mul := λ x y, begin
    refine quot.lift₂ (colimit_mul_aux F) _ _ x y,
  { intros x y y' h,
    apply colimit_mul_aux_eq_of_rel_right,
    apply types.filtered_colimit.rel_of_quot_rel,
    exact h },
  { intros x x' y h,
    apply colimit_mul_aux_eq_of_rel_left,
    apply types.filtered_colimit.rel_of_quot_rel,
    exact h },
  end }

/--
Multiplication in the colimit is independent of the chosen "maximum" in the filtered category.
In particular, this lemma allows us to "unfold" the definition of the multiplication of `x` and `y`,
using a custom object `k` and morphisms `f : x.1 ⟶ k` and `g : y.1 ⟶ k`.
-/
@[to_additive "Addition in the colimit is independent of the chosen \"maximum\" in the filtered
category. In particular, this lemma allows us to \"unfold\" the definition of the addition of `x`
and `y`, using a custom object `k` and morphisms `f : x.1 ⟶ k` and `g : y.1 ⟶ k`."]
lemma colimit_mul_mk_eq (x y : Σ j, F.obj j) (k : J) (f : x.1 ⟶ k) (g : y.1 ⟶ k) :
  (M.mk x) * (M.mk y) = M.mk ⟨k, F.map f x.2 * F.map g y.2⟩ :=
begin
  cases x with j₁ x, cases y with j₂ y,
  obtain ⟨s, α, β, h₁, h₂⟩ := bowtie (left_to_max j₁ j₂) f (right_to_max j₁ j₂) g,
  apply M.mk_eq,
  use [s, α, β],
  dsimp,
  simp_rw [monoid_hom.map_mul, ← comp_apply, ← F.map_comp, h₁, h₂],
end

@[to_additive]
instance colimit_monoid : monoid M :=
{ one_mul := λ x, begin
    apply quot.induction_on x, clear x, intro x, cases x with j x,
    rw [colimit_one_eq F j, colimit_mul_mk_eq F ⟨j, 1⟩ ⟨j, x⟩ j (𝟙 j) (𝟙 j),
      monoid_hom.map_one, one_mul, F.map_id, id_apply],
  end,
  mul_one := λ x, begin
    apply quot.induction_on x, clear x, intro x, cases x with j x,
    rw [colimit_one_eq F j, colimit_mul_mk_eq F ⟨j, x⟩ ⟨j, 1⟩ j (𝟙 j) (𝟙 j),
      monoid_hom.map_one, mul_one, F.map_id, id_apply],
  end,
  mul_assoc := λ x y z, begin
    apply quot.induction_on₃ x y z, clear x y z, intros x y z,
    cases x with j₁ x, cases y with j₂ y, cases z with j₃ z,
    rw [colimit_mul_mk_eq F ⟨j₁, x⟩ ⟨j₂, y⟩ _ (first_to_max₃ j₁ j₂ j₃) (second_to_max₃ j₁ j₂ j₃),
      colimit_mul_mk_eq F ⟨max₃ j₁ j₂ j₃, _⟩ ⟨j₃, z⟩ _ (𝟙 _) (third_to_max₃ j₁ j₂ j₃),
      colimit_mul_mk_eq F ⟨j₂, y⟩ ⟨j₃, z⟩ _ (second_to_max₃ j₁ j₂ j₃) (third_to_max₃ j₁ j₂ j₃),
      colimit_mul_mk_eq F ⟨j₁, x⟩ ⟨max₃ j₁ j₂ j₃, _⟩ _ (first_to_max₃ j₁ j₂ j₃) (𝟙 _)],
    simp only [F.map_id, id_apply, mul_assoc],
  end,
  ..colimit_has_one,
  ..colimit_has_mul }

/-- The bundled monoid giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive monoid giving the filtered colimit of a diagram."]
def colimit : Mon := Mon.of M

/-- The monoid homomorphism from a given monoid in the diagram to the colimit monoid. -/
@[to_additive "The additive monoid homomorphism from a given additive monoid in the diagram to the
colimit additive monoid."]
def cocone_morphism (j : J) : F.obj j ⟶ colimit :=
{ to_fun := (types.colimit_cocone (F ⋙ forget Mon)).ι.app j,
  map_one' := (colimit_one_eq j).symm,
  map_mul' := λ x y, begin
    convert (colimit_mul_mk_eq F ⟨j, x⟩ ⟨j, y⟩ j (𝟙 j) (𝟙 j)).symm,
    rw [F.map_id, id_apply, id_apply], refl,
  end }

@[simp, to_additive]
lemma cocone_naturality {j j' : J} (f : j ⟶ j') :
  F.map f ≫ (cocone_morphism j') = cocone_morphism j :=
monoid_hom.coe_inj ((types.colimit_cocone (F ⋙ forget Mon)).ι.naturality f)

/-- The cocone over the proposed colimit monoid. -/
@[to_additive "The cocone over the proposed colimit additive monoid."]
def colimit_cocone : cocone F :=
{ X := colimit,
  ι := { app := cocone_morphism } }.

/--
Given a cocone `t` of `F`, the induced monoid homomorphism from the colimit to the cocone point.
As a function, this is simply given by the induced map of the corresponding cocone in `Type`.
The only thing left to see is that it is a monoid homomorphism.
-/
@[to_additive "Given a cocone `t` of `F`, the induced additive monoid homomorphism from the colimit
to the cocone point. As a function, this is simply given by the induced map of the corresponding
cocone in `Type`. The only thing left to see is that it is an additive monoid homomorphism."]
def colimit_desc (t : cocone F) : colimit ⟶ t.X :=
{ to_fun := (types.colimit_cocone_is_colimit (F ⋙ forget Mon)).desc ((forget Mon).map_cocone t),
  map_one' := begin
    rw colimit_one_eq F is_filtered.nonempty.some,
    exact monoid_hom.map_one _,
  end,
  map_mul' := λ x y, begin
    apply quot.induction_on₂ x y, clear x y, intros x y,
    cases x with i x, cases y with j y,
    rw colimit_mul_mk_eq F ⟨i, x⟩ ⟨j, y⟩ (max' i j) (left_to_max i j) (right_to_max i j),
    dsimp [types.colimit_cocone_is_colimit],
    rw [monoid_hom.map_mul, t.w_apply, t.w_apply],
  end }

/-- The proposed colimit cocone is a colimit in `Mon`. -/
@[to_additive "The proposed colimit cocone is a colimit in `AddMon`."]
def colimit_cocone_is_colimit : is_colimit colimit_cocone :=
{ desc := colimit_desc,
  fac' := λ t j, monoid_hom.coe_inj
    ((types.colimit_cocone_is_colimit (F ⋙ forget Mon)).fac ((forget Mon).map_cocone t) j),
  uniq' := λ t m h, monoid_hom.coe_inj $
    (types.colimit_cocone_is_colimit (F ⋙ forget Mon)).uniq ((forget Mon).map_cocone t) m
      (λ j, funext $ λ x, monoid_hom.congr_fun (h j) x) }

@[to_additive]
instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Mon.{u}) :=
{ preserves_filtered_colimits := λ J _ _, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
      (colimit_cocone_is_colimit.{u u} F) (types.colimit_cocone_is_colimit (F ⋙ forget Mon.{u})) } }

end

end Mon.filtered_colimits

namespace CommMon.filtered_colimits

open Mon.filtered_colimits (colimit_mul_mk_eq)

section

-- We use parameters here, mainly so we can have the abbreviation `M` below, without
-- passing around `F` all the time.
parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommMon.{max v u})

/--
The colimit of `F ⋙ forget₂ CommMon Mon` in the category `Mon`.
In the following, we will show that this has the structure of a _commutative_ monoid.
-/
@[to_additive "The colimit of `F ⋙ forget₂ AddCommMon AddMon` in the category `AddMon`. In the
following, we will show that this has the structure of a _commutative_ additive monoid."]
abbreviation M : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ CommMon Mon.{max v u})

@[to_additive]
instance colimit_comm_monoid : comm_monoid M :=
{ mul_comm := λ x y, begin
    apply quot.induction_on₂ x y, clear x y, intros x y,
    let k := max' x.1 y.1,
    let f := left_to_max x.1 y.1,
    let g := right_to_max x.1 y.1,
    rw [colimit_mul_mk_eq _ x y k f g, colimit_mul_mk_eq _ y x k g f],
    dsimp,
    rw mul_comm,
 end
  ..M.monoid }

/-- The bundled commutative monoid giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive commutative monoid giving the filtered colimit of a diagram."]
def colimit : CommMon := CommMon.of M

/-- The cocone over the proposed colimit commutative monoid. -/
@[to_additive "The cocone over the proposed colimit additive commutative monoid."]
def colimit_cocone : cocone F :=
{ X := colimit,
  ι := { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommMon Mon.{max v u})).ι } }

/-- The proposed colimit cocone is a colimit in `CommMon`. -/
@[to_additive "The proposed colimit cocone is a colimit in `AddCommMon`."]
def colimit_cocone_is_colimit : is_colimit colimit_cocone :=
{ desc := λ t, Mon.filtered_colimits.colimit_desc (F ⋙ forget₂ CommMon Mon.{max v u})
    ((forget₂ CommMon Mon.{max v u}).map_cocone t),
  fac' := λ t j, monoid_hom.coe_inj $
    (types.colimit_cocone_is_colimit (F ⋙ forget CommMon)).fac ((forget CommMon).map_cocone t) j,
  uniq' := λ t m h, monoid_hom.coe_inj $
    (types.colimit_cocone_is_colimit (F ⋙ forget CommMon)).uniq ((forget CommMon).map_cocone t) m
    ((λ j, funext $ λ x, monoid_hom.congr_fun (h j) x)) }

@[to_additive forget₂_AddMon_preserves_filtered_colimits]
instance forget₂_Mon_preserves_filtered_colimits :
  preserves_filtered_colimits (forget₂ CommMon Mon.{u}) :=
{ preserves_filtered_colimits := λ J _ _, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
      (colimit_cocone_is_colimit.{u u} F)
      (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommMon Mon.{u})) } }

@[to_additive]
instance forget_preserves_filtered_colimits :
  preserves_filtered_colimits (forget CommMon.{u}) :=
limits.comp_preserves_filtered_colimits (forget₂ CommMon Mon) (forget Mon)

end

end CommMon.filtered_colimits