/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yaël Dillies
-/
import data.finset.preimage
import data.set.pointwise

/-!
# Pointwise operations of finsets

This file defines pointwise algebraic operations on finsets.

## Main declarations

For finsets `s` and `t`:
* `0` (`finset.has_zero`): The singleton `{0}`.
* `1` (`finset.has_one`): The singleton `{1}`.
* `-s` (`finset.has_neg`): Negation, finset of all `-x` where `x ∈ s`.
* `s⁻¹` (`finset.has_inv`): Inversion, finset of all `x⁻¹` where `x ∈ s`.
* `s + t` (`finset.has_add`): Addition, finset of all `x + y` where `x ∈ s` and `y ∈ t`.
* `s * t` (`finset.has_mul`): Multiplication, finset of all `x * y` where `x ∈ s` and `y ∈ t`.
* `s - t` (`finset.has_sub`): Subtraction, finset of all `x - y` where `x ∈ s` and `y ∈ t`.
* `s / t` (`finset.has_div`): Division, finset of all `x / y` where `x ∈ s` and `y ∈ t`.
* `s +ᵥ t` (`finset.has_vadd`): Scalar addition, finset of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
* `s • t` (`finset.has_scalar`): Scalar multiplication, finset of all `x • y` where `x ∈ s` and
  `y ∈ t`.
* `s -ᵥ t` (`finset.has_vsub`): Scalar subtraction, finset of all `x -ᵥ y` where `x ∈ s` and
  `y ∈ t`.
* `a • s` (`finset.has_scalar_finset`): Scaling, finset of all `a • x` where `x ∈ s`.
* `a +ᵥ s` (`finset.has_vadd_finset`): Translation, finset of all `a +ᵥ x` where `x ∈ s`.

For `α` a semigroup/monoid, `finset α` is a semigroup/monoid.
As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between
pointwise scaling and repeated pointwise addition; the former has `(2 : ℕ) • {1, 2} = {2, 4}`, while
the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`.

## Implementation notes

We put all instances in the locale `pointwise`, so that these instances are not available by
default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
since we expect the locale to be open whenever the instances are actually used (and making the
instances reducible changes the behavior of `simp`.

## Tags

finset multiplication, finset addition, pointwise addition, pointwise multiplication,
pointwise subtraction
-/

open function
open_locale pointwise

variables {F α β γ : Type*}

namespace finset

/-! ### `0`/`1` as sets -/

section has_one
variables [has_one α] {s : finset α} {a : α}

/-- The finset `(1 : finset α)` is defined as `{1}` in locale `pointwise`. -/
@[to_additive "The finset `(0 : finset α)` is defined as `{0}` in locale `pointwise`."]
protected def has_one : has_one (finset α) := ⟨{1}⟩

localized "attribute [instance] finset.has_one finset.has_zero" in pointwise

@[simp, to_additive] lemma mem_one : a ∈ (1 : finset α) ↔ a = 1 := mem_singleton
@[simp, to_additive] lemma coe_one : ↑(1 : finset α) = (1 : set α) := coe_singleton 1
@[simp, to_additive] lemma one_subset : (1 : finset α) ⊆ s ↔ (1 : α) ∈ s := singleton_subset_iff
@[to_additive] lemma singleton_one : ({1} : finset α) = 1 := rfl
@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : finset α) := mem_singleton_self _
@[to_additive] lemma one_nonempty : (1 : finset α).nonempty := ⟨1, one_mem_one⟩
@[simp, to_additive] protected lemma map_one {f : α ↪ β} : map f 1 = {f 1} := map_singleton f 1

@[simp, to_additive]
lemma image_one [decidable_eq β] {f : α → β} : image f 1 = {f 1} := image_singleton f 1

end has_one

open_locale pointwise

/-! ### Finset negation/inversion -/

section has_inv
variables [decidable_eq α] [has_inv α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α}

/-- The pointwise inverse of a finset `s`: `s⁻¹ = {x⁻¹ | x ∈ s}`. -/
@[to_additive "The pointwise negation of a finset `s`: `-s = {-x | x ∈ s}`."]
protected def has_inv : has_inv (finset α) := ⟨image has_inv.inv⟩

localized "attribute [instance] finset.has_inv finset.has_neg" in pointwise

@[to_additive] lemma inv_def : s⁻¹ = s.image (λ x, x⁻¹) := rfl
@[to_additive] lemma image_inv : s.image (λ x, x⁻¹)  = s⁻¹ := rfl
@[to_additive] lemma mem_inv {x : α} : x ∈ s⁻¹ ↔ ∃ y ∈ s, y⁻¹ = x := mem_image
@[to_additive] lemma inv_mem_inv (ha : a ∈ s) : a⁻¹ ∈ s⁻¹ := mem_image_of_mem _ ha
@[to_additive] lemma card_inv_le : s⁻¹.card ≤ s.card := card_image_le

@[simp, to_additive] lemma inv_empty : (∅ : finset α)⁻¹ = ∅ := image_empty _
@[simp, to_additive] lemma inv_nonempty_iff : s⁻¹.nonempty ↔ s.nonempty := nonempty.image_iff _

alias inv_nonempty_iff ↔ finset.nonempty.inv finset.nonempty.of_inv

@[to_additive, mono] lemma inv_subset_inv  (h : s ⊆ t) : s⁻¹ ⊆ t⁻¹ := image_subset_image h

attribute [mono] neg_subset_neg

@[simp, to_additive] lemma inv_singleton (a : α) : ({a} : finset α)⁻¹ = {a⁻¹} := image_singleton _ _

end has_inv

open_locale pointwise

section has_involutive_inv
variables [decidable_eq α] [has_involutive_inv α] {s t : finset α}

@[simp, norm_cast, to_additive]
lemma coe_inv (s : finset α) : ↑(s⁻¹) = (s : set α)⁻¹ := coe_image.trans set.image_inv

@[simp, to_additive] lemma card_inv : s⁻¹.card = s.card := card_image_of_injective _ inv_injective

@[simp, to_additive] lemma preimage_inv : s.preimage has_inv.inv (inv_injective.inj_on _) = s⁻¹ :=
coe_injective $ by rw [coe_preimage, set.inv_preimage, coe_inv]

end has_involutive_inv

/-! ### Finset addition/multiplication -/

section has_mul
variables [decidable_eq α] [has_mul α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α}

/-- The pointwise product of two finsets `s` and `t`: `s * t = {x * y | x ∈ s, y ∈ t}`. -/
@[to_additive "The pointwise sum of two finsets `s` and `t`: `s + t = {x + y | x ∈ s, y ∈ t}`."]
protected def has_mul : has_mul (finset α) := ⟨λ s t, (s.product t).image $ λ p : α × α, p.1 * p.2⟩

localized "attribute [instance] finset.has_mul finset.has_add" in pointwise

@[to_additive]
lemma mul_def : s * t = (s.product t).image (λ p : α × α, p.1 * p.2) := rfl

@[to_additive add_image_prod]
lemma image_mul_prod : (s.product t).image (λ x : α × α, x.fst * x.snd)  = s * t := rfl

@[to_additive]
lemma mem_mul {x : α} : x ∈ s * t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y * z = x :=
by simp only [finset.mul_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product]

@[simp, norm_cast, to_additive]
lemma coe_mul (s t : finset α) : (↑(s * t) : set α) = ↑s * ↑t :=
set.ext $ λ _, by simp only [mem_mul, set.mem_mul, mem_coe]

@[to_additive]
lemma mul_mem_mul (ha : a ∈ s) (hb : b ∈ t) : a * b ∈ s * t := mem_mul.2 ⟨a, b, ha, hb, rfl⟩

@[to_additive]
lemma mul_card_le : (s * t).card ≤ s.card * t.card := card_image_le.trans (card_product _ _).le

@[simp, to_additive] lemma empty_mul (s : finset α) : ∅ * s = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_mul]

@[simp, to_additive] lemma mul_empty (s : finset α) : s * ∅ = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_mul]

@[simp, to_additive]
lemma mul_nonempty_iff (s t : finset α) : (s * t).nonempty ↔ s.nonempty ∧ t.nonempty :=
(nonempty.image_iff _).trans nonempty_product

@[to_additive, mono] lemma mul_subset_mul  (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ * t₁ ⊆ s₂ * t₂ :=
image_subset_image $ product_subset_product hs ht

attribute [mono] add_subset_add

@[simp, to_additive]
lemma mul_singleton (a : α) : s * {a} = s.image (* a) :=
by { rw [mul_def, product_singleton, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_mul (a : α) : {a} * s = s.image ((*) a) :=
by { rw [mul_def, singleton_product, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_mul_singleton (a b : α) : ({a} : finset α) * {b} = {a * b} :=
by rw [mul_def, singleton_product_singleton, image_singleton]

/-- If a finset `u` is contained in the product of two sets `s * t`, we can find two finsets `s'`,
`t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' * t'`. -/
@[to_additive "If a finset `u` is contained in the sum of two sets `s + t`, we can find two finsets
`s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' + t'`."]
lemma subset_mul {s t : set α} (f : ↑u ⊆ s * t) :
  ∃ s' t' : finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' * t' :=
begin
  apply finset.induction_on' u,
  { exact ⟨∅, ∅, set.empty_subset _, set.empty_subset _, empty_subset _⟩ },
  rintro a u ha _ _ ⟨s', t', hs, hs', h⟩,
  obtain ⟨x, y, hx, hy, ha⟩ := f ha,
  use [insert x s', insert y t'],
  simp_rw [coe_insert, set.insert_subset],
  exact ⟨⟨hx, hs⟩, ⟨hy, hs'⟩, insert_subset.2 ⟨mem_mul.2 ⟨x, y, mem_insert_self _ _,
    mem_insert_self _ _, ha⟩, h.trans $ mul_subset_mul (subset_insert _ _) $ subset_insert _ _⟩⟩,
end

end has_mul

open_locale pointwise

section mul_zero_class
variables [decidable_eq α] [mul_zero_class α] {s t : finset α}

lemma mul_zero_subset (s : finset α) : s * 0 ⊆ 0 := by simp [subset_iff, mem_mul]
lemma zero_mul_subset (s : finset α) : 0 * s ⊆ 0 := by simp [subset_iff, mem_mul]

lemma nonempty.mul_zero (hs : s.nonempty) : s * 0 = 0 :=
s.mul_zero_subset.antisymm $ by simpa [finset.mem_mul] using hs

lemma nonempty.zero_mul (hs : s.nonempty) : 0 * s = 0 :=
s.zero_mul_subset.antisymm $ by simpa [finset.mem_mul] using hs

end mul_zero_class

section group
variables [group α] {s t : finset α} {a b : α}

section decidable_eq
variables [decidable_eq α]

@[simp, to_additive]
lemma image_mul_left :
  image (λ b, a * b) t = preimage t (λ b, a⁻¹ * b) (λ x hx y hy, (mul_right_inj a⁻¹).mp) :=
coe_injective $ by simp

@[simp, to_additive]
lemma image_mul_right : image (* b) t = preimage t (* b⁻¹) (λ x hx y hy, (mul_left_inj b⁻¹).mp) :=
coe_injective $ by simp

@[to_additive]
lemma image_mul_left' :
  image (λ b, a⁻¹ * b) t = preimage t (λ b, a * b) (λ x hx y hy, (mul_right_inj a).mp) :=
by simp

@[to_additive]
lemma image_mul_right' : image (* b⁻¹) t = preimage t (* b) (λ x hx y hy, (mul_left_inj b).mp) :=
by simp

end decidable_eq

@[simp, to_additive]
lemma preimage_mul_left_singleton :
  preimage {b} ((*) a) (λ x hx y hy, (mul_right_inj a).mp) = {a⁻¹ * b} :=
by { classical, rw [← image_mul_left', image_singleton] }

@[simp, to_additive]
lemma preimage_mul_right_singleton :
  preimage {b} (* a) (λ x hx y hy, (mul_left_inj a).mp) = {b * a⁻¹} :=
by { classical, rw [← image_mul_right', image_singleton] }

@[simp, to_additive]
lemma preimage_mul_left_one : preimage 1 (λ b, a * b) (λ x hx y hy, (mul_right_inj a).mp) = {a⁻¹} :=
by { classical, rw [← image_mul_left', image_one, mul_one] }

@[simp, to_additive]
lemma preimage_mul_right_one : preimage 1 (* b) (λ x hx y hy, (mul_left_inj b).mp) = {b⁻¹} :=
by { classical, rw [← image_mul_right', image_one, one_mul] }

@[to_additive]
lemma preimage_mul_left_one' :
  preimage 1 (λ b, a⁻¹ * b) (λ x hx y hy, (mul_right_inj _).mp) = {a} :=
by rw [preimage_mul_left_one, inv_inv]

@[to_additive]
lemma preimage_mul_right_one' : preimage 1 (* b⁻¹) (λ x hx y hy, (mul_left_inj _).mp) = {b} :=
by rw [preimage_mul_right_one, inv_inv]

end group

open_locale pointwise

/-! ### Finset subtraction/division -/

section has_div
variables [decidable_eq α] [has_div α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α}

/-- The pointwise product of two finsets `s` and `t`: `s / t = {x / y | x ∈ s, y ∈ t}`. -/
@[to_additive "The pointwise sum of two finsets `s` and `t`: `s - t = {x - y | x ∈ s, y ∈ t}`."]
protected def has_div : has_div (finset α) := ⟨λ s t, (s.product t).image $ λ p : α × α, p.1 / p.2⟩

localized "attribute [instance] finset.has_div finset.has_add" in pointwise

@[to_additive]
lemma div_def : s / t = (s.product t).image (λ p : α × α, p.1 / p.2) := rfl

@[to_additive add_image_prod]
lemma image_div_prod : (s.product t).image (λ x : α × α, x.fst / x.snd)  = s / t := rfl

@[to_additive]
lemma mem_div {x : α} : x ∈ s / t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y / z = x :=
by simp only [finset.div_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product]

@[simp, norm_cast, to_additive]
lemma coe_div (s t : finset α) : (↑(s / t) : set α) = ↑s / ↑t :=
set.ext $ λ _, by simp only [mem_div, set.mem_div, mem_coe]

@[to_additive]
lemma div_mem_div (ha : a ∈ s) (hb : b ∈ t) : a / b ∈ s / t := mem_div.2 ⟨a, b, ha, hb, rfl⟩

@[to_additive]
lemma div_card_le : (s / t).card ≤ s.card * t.card := card_image_le.trans (card_product _ _).le

@[simp, to_additive] lemma empty_div (s : finset α) : ∅ / s = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_div]

@[simp, to_additive] lemma div_empty (s : finset α) : s / ∅ = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_div]

@[simp, to_additive]
lemma div_nonempty_iff (s t : finset α) : (s / t).nonempty ↔ s.nonempty ∧ t.nonempty :=
(nonempty.image_iff _).trans nonempty_product

@[to_additive, mono] lemma div_subset_div  (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ / t₁ ⊆ s₂ / t₂ :=
image_subset_image $ product_subset_product hs ht

attribute [mono] add_subset_add

@[simp, to_additive]
lemma div_singleton (a : α) : s / {a} = s.image (/ a) :=
by { rw [div_def, product_singleton, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_div (a : α) : {a} / s = s.image ((/) a) :=
by { rw [div_def, singleton_product, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_div_singleton (a b : α) : ({a} : finset α) / {b} = {a / b} :=
by rw [div_def, singleton_product_singleton, image_singleton]

/-- If a finset `u` is contained in the product of two sets `s / t`, we can find two finsets `s'`,
`t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' / t'`. -/
@[to_additive "If a finset `u` is contained in the sum of two sets `s - t`, we can find two finsets
`s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' - t'`."]
lemma subset_div {s t : set α} (f : ↑u ⊆ s / t) :
  ∃ s' t' : finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' / t' :=
begin
  apply finset.induction_on' u,
  { exact ⟨∅, ∅, set.empty_subset _, set.empty_subset _, empty_subset _⟩ },
  rintro a u ha _ _ ⟨s', t', hs, hs', h⟩,
  obtain ⟨x, y, hx, hy, ha⟩ := f ha,
  use [insert x s', insert y t'],
  simp_rw [coe_insert, set.insert_subset],
  exact ⟨⟨hx, hs⟩, ⟨hy, hs'⟩, insert_subset.2 ⟨mem_div.2 ⟨x, y, mem_insert_self _ _,
    mem_insert_self _ _, ha⟩, h.trans $ div_subset_div (subset_insert _ _) $ subset_insert _ _⟩⟩,
end

end has_div

open_locale pointwise

section group_with_zero
variables [decidable_eq α] [group_with_zero α] {s t : finset α}

lemma div_zero_subset (s : finset α) : s / 0 ⊆ 0 := by simp [subset_iff, mem_div]
lemma zero_div_subset (s : finset α) : 0 / s ⊆ 0 := by simp [subset_iff, mem_div]

lemma nonempty.div_zero (hs : s.nonempty) : s / 0 = 0 :=
s.div_zero_subset.antisymm $ by simpa [finset.mem_div] using hs

lemma nonempty.zero_div (hs : s.nonempty) : 0 / s = 0 :=
s.zero_div_subset.antisymm $ by simpa [finset.mem_div] using hs

end group_with_zero

/-! ### Instances -/

open_locale pointwise

section instances
variables [decidable_eq α]

/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `finset`. -/
protected def has_nsmul [has_zero α] [has_add α] : has_scalar ℕ (finset α) := ⟨nsmul_rec⟩

/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
`finset`. -/
@[to_additive]
protected def has_npow [has_one α] [has_mul α] : has_pow (finset α) ℕ := ⟨λ s n, npow_rec n s⟩

/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
addition/subtraction!) of a `finset`. -/
protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_scalar ℤ (finset α) :=
⟨zsmul_rec⟩

/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
multiplication/division!) of a `finset`. -/
@[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (finset α) ℤ :=
⟨λ s n, zpow_rec n s⟩

localized "attribute [instance] finset.has_nsmul finset.has_npow finset.has_zsmul finset.has_zpow"
  in pointwise

@[simp, to_additive]
lemma coe_pow [monoid α] (s : finset α) (n : ℕ) : ↑(s ^ n) = (s ^ n : set α) :=
begin
  change ↑(npow_rec n s) = _,
  induction n with n ih,
  { rw [npow_rec, pow_zero, coe_one] },
  { rw [npow_rec, pow_succ, coe_mul, ih] }
end

/- TODO: The below lemmas are duplicate because there is no typeclass greater than
`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/

@[simp, to_additive] lemma coe_zpow [group α] (s : finset α) : ∀ n : ℤ, ↑(s ^ n) = (s ^ n : set α)
| (int.of_nat n) := coe_pow _ _
| (int.neg_succ_of_nat n) :=
  by { refine (coe_inv _).trans _, convert congr_arg has_inv.inv (coe_pow _ _) }

@[simp] lemma coe_zpow' [group_with_zero α] (s : finset α) : ∀ n : ℤ, ↑(s ^ n) = (s ^ n : set α)
| (int.of_nat n) := coe_pow _ _
| (int.neg_succ_of_nat n) :=
  by { refine (coe_inv _).trans _, convert congr_arg has_inv.inv (coe_pow _ _) }

/-- `finset α` is a `mul_one_class` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `add_zero_class` under pointwise operations if `α` is."]
protected def mul_one_class [mul_one_class α] : mul_one_class (finset α) :=
coe_injective.mul_one_class _ (coe_singleton 1) (by simp)

/-- `finset α` is a `semigroup` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `add_semigroup` under pointwise operations if `α` is. "]
protected def semigroup [semigroup α] : semigroup (finset α) :=
coe_injective.semigroup _ coe_mul

/-- `finset α` is a `comm_semigroup` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `add_comm_semigroup` under pointwise operations if `α` is. "]
protected def comm_semigroup [comm_semigroup α] : comm_semigroup (finset α) :=
coe_injective.comm_semigroup _ coe_mul

/-- `finset α` is a `monoid` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `add_monoid` under pointwise operations if `α` is. "]
protected def monoid [monoid α] : monoid (finset α) :=
coe_injective.monoid _ coe_one coe_mul coe_pow

/-- `finset α` is a `comm_monoid` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `add_comm_monoid` under pointwise operations if `α` is. "]
protected def comm_monoid [comm_monoid α] : comm_monoid (finset α) :=
coe_injective.comm_monoid _ coe_one coe_mul coe_pow

/- TODO: The below instances are duplicate because there is no typeclass greater than
`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/

/-- `finset α` is a `div_inv_monoid` under pointwise operations if `α` is. -/
@[to_additive "`finset α` is an `sub_neg_add_monoid` under pointwise operations if `α` is."]
protected def div_inv_monoid [group α] : div_inv_monoid (finset α) :=
coe_injective.div_inv_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow

/-- `finset α` is a `div_inv_monoid` under pointwise operations if `α` is. -/
protected def div_inv_monoid' [group_with_zero α] : div_inv_monoid (finset α) :=
coe_injective.div_inv_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow'

localized "attribute [instance] finset.mul_one_class finset.add_zero_class finset.semigroup
  finset.add_semigroup finset.monoid finset.add_monoid finset.comm_monoid finset.add_comm_monoid
  finset.div_inv_monoid finset.sub_neg_add_monoid finset.div_inv_monoid'"
  in pointwise

end instances

/-! ### Finset addition/multiplication -/

section has_scalar
variables [decidable_eq β] [has_scalar α β] {s s₁ s₂ : finset α} {t t₁ t₂ u : finset β} {a : α}
  {b : β}

/-- The pointwise product of two finsets `s` and `t`: `s • t = {x • y | x ∈ s, y ∈ t}`. -/
@[to_additive has_vadd "The pointwise sum of two finsets `s` and
`t`: `s +ᵥ t = {x +ᵥ y | x ∈ s, y ∈ t}`."]
protected def has_scalar : has_scalar (finset α) (finset β) :=
⟨λ s t, (s.product t).image $ λ p : α × β, p.1 • p.2⟩

localized "attribute [instance] finset.has_scalar finset.has_vadd" in pointwise

@[to_additive] lemma smul_def : s • t = (s.product t).image (λ p : α × β, p.1 • p.2) := rfl

@[to_additive]
lemma image_smul_product : (s.product t).image (λ x : α × β, x.fst • x.snd)  = s • t := rfl

@[to_additive]
lemma mem_smul {x : β} : x ∈ s • t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y • z = x :=
by simp only [finset.smul_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product]

@[simp, norm_cast, to_additive]
lemma coe_smul (s : finset α) (t : finset β) : (↑(s • t) : set β) = (s : set α) • t :=
set.ext $ λ _, by simp only [mem_smul, set.mem_smul, mem_coe]

@[to_additive]
lemma smul_mem_smul (ha : a ∈ s) (hb : b ∈ t) : a • b ∈ s • t := mem_smul.2 ⟨a, b, ha, hb, rfl⟩

@[to_additive]
lemma smul_card_le : (s • t).card ≤ s.card • t.card := card_image_le.trans (card_product _ _).le

@[simp, to_additive] lemma empty_smul (t : finset β) : (∅ : finset α) • t = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_smul]

@[simp, to_additive] lemma smul_empty (s : finset α) : s • (∅ : finset β) = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_smul]

@[simp, to_additive]
lemma smul_nonempty_iff : (s • t).nonempty ↔ s.nonempty ∧ t.nonempty :=
(nonempty.image_iff _).trans nonempty_product

@[to_additive] lemma nonempty.smul (hs : s.nonempty) (ht : t.nonempty) : (s • t).nonempty :=
smul_nonempty_iff.2 ⟨hs, ht⟩

@[to_additive, mono] lemma smul_subset_smul (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ • t₁ ⊆ s₂ • t₂ :=
image_subset_image $ product_subset_product hs ht

attribute [mono] add_subset_add

@[simp, to_additive]
lemma smul_singleton (b : β) : s • ({b} : finset β) = s.image (• b) :=
by { classical, rw [smul_def, product_singleton, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_smul (a : α) : ({a} : finset α) • t = t.image ((•) a) :=
by { classical, rw [smul_def, singleton_product, map_eq_image, image_image], refl }

@[simp, to_additive]
lemma singleton_smul_singleton (a : α) (b : β) : ({a} : finset α) • ({b} : finset β) = {a • b} :=
by rw [smul_def, singleton_product_singleton, image_singleton]

/-- If a finset `u` is contained in the scalar product of two sets `s • t`, we can find two finsets
`s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' • t'`. -/
@[to_additive "If a finset `u` is contained in the scalar sum of two sets `s +ᵥ t`, we can find two
finsets `s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' +ᵥ t'`."]
lemma subset_smul {s : set α} {t : set β} (f : ↑u ⊆ s • t) :
  ∃ (s' : finset α) (t' : finset β), ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' • t' :=
begin
  apply finset.induction_on' u,
  { exact ⟨∅, ∅, set.empty_subset _, set.empty_subset _, empty_subset _⟩ },
  rintro a u ha _ _ ⟨s', t', hs, hs', h⟩,
  obtain ⟨x, y, hx, hy, ha⟩ := f ha,
  classical,
  use [insert x s', insert y t'],
  simp_rw [coe_insert, set.insert_subset],
  refine ⟨⟨hx, hs⟩, ⟨hy, hs'⟩, _⟩,
  convert insert_subset.2 ⟨mem_smul.2 ⟨x, y, mem_insert_self _ _,
    mem_insert_self _ _, ha⟩, h.trans $ _⟩,
  convert smul_subset_smul (subset_insert _ _) (subset_insert _ _),
end

end has_scalar

/-! ### Finset addition/multiplication -/

section has_vsub
variables [decidable_eq α] [has_vsub α β] {s s₁ s₂ t t₁ t₂ u : finset β} {a : α} {b c : β}
include α

/-- The pointwise product of two finsets `s` and `t`: `s -ᵥ t = {x -ᵥ y | x ∈ s, y ∈ t}`. -/
protected def has_vsub : has_vsub (finset α) (finset β) :=
⟨λ s t, (s.product t).image $ λ p : β × β, p.1 -ᵥ p.2⟩

localized "attribute [instance] finset.has_vsub" in pointwise

lemma vsub_def : s -ᵥ t = (s.product t).image (λ p : β × β, p.1 -ᵥ p.2) := rfl
lemma image_vsub_product : (s.product t).image (λ x : β × β, x.fst -ᵥ x.snd)  = s -ᵥ t := rfl

lemma mem_vsub : a ∈ s -ᵥ t ↔ ∃ b c, b ∈ s ∧ c ∈ t ∧ b -ᵥ c = a :=
by simp only [finset.vsub_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product]

@[simp, norm_cast]
lemma coe_vsub (s t : finset β) : (↑(s -ᵥ t) : set α) = (s : set β) -ᵥ t :=
set.ext $ λ _, by simp only [mem_vsub, set.mem_vsub, mem_coe]

lemma vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t := mem_vsub.2 ⟨b, c, hb, hc, rfl⟩

lemma vsub_card_le : (s -ᵥ t : finset α).card ≤ s.card * t.card :=
card_image_le.trans (card_product _ _).le

@[simp] lemma empty_vsub (t : finset β) : (∅ : finset β) -ᵥ t = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_vsub]

@[simp] lemma vsub_empty (s : finset β) : s -ᵥ (∅ : finset β) = ∅ :=
eq_empty_of_forall_not_mem $ by simp [mem_vsub]

@[simp]
lemma vsub_nonempty_iff : (s -ᵥ t : finset α).nonempty ↔ s.nonempty ∧ t.nonempty :=
(nonempty.image_iff _).trans nonempty_product

lemma nonempty.vsub (hs : s.nonempty) (ht : t.nonempty) : (s -ᵥ t : finset α).nonempty :=
vsub_nonempty_iff.2 ⟨hs, ht⟩

@[mono] lemma vsub_subset_vsub (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ :=
image_subset_image $ product_subset_product hs ht

@[simp] lemma vsub_singleton (b : β) : s -ᵥ ({b} : finset β) = s.image (-ᵥ b) :=
by { classical, rw [vsub_def, product_singleton, map_eq_image, image_image], refl }

@[simp] lemma singleton_vsub (a : β) : ({a} : finset β) -ᵥ t = t.image ((-ᵥ) a) :=
by { classical, rw [vsub_def, singleton_product, map_eq_image, image_image], refl }

@[simp]
lemma singleton_vsub_singleton (a b : β) : ({a} : finset β) -ᵥ {b} = {a -ᵥ b} :=
by rw [vsub_def, singleton_product_singleton, image_singleton]

/-- If a finset `u` is contained in the pointwise subtraction of two sets `s -ᵥ t`, we can find two
finsets `s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' -ᵥ t'`. -/
lemma subset_vsub {s t : set β} {u : finset α} (f : ↑u ⊆ s -ᵥ t) :
  ∃ s' t' : finset β, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' -ᵥ t' :=
begin
  apply finset.induction_on' u,
  { exact ⟨∅, ∅, set.empty_subset _, set.empty_subset _, empty_subset _⟩ },
  rintro a u ha _ _ ⟨s', t', hs, hs', h⟩,
  obtain ⟨x, y, hx, hy, ha⟩ := f ha,
  classical,
  use [insert x s', insert y t'],
  simp_rw [coe_insert, set.insert_subset],
  refine ⟨⟨hx, hs⟩, ⟨hy, hs'⟩, _⟩,
  convert insert_subset.2 ⟨mem_vsub.2 ⟨x, y, mem_insert_self _ _,
    mem_insert_self _ _, ha⟩, h.trans $ _⟩,
  convert vsub_subset_vsub (subset_insert _ _) (subset_insert _ _),
end

end has_vsub

open_locale pointwise

/-! ### Translation/scaling of finsets -/

section has_scalar
variables [decidable_eq β] [has_scalar α β] {s s₁ s₂ t u : finset β} {a : α} {b : β}

/-- The scaling of a finset `s` by a scalar `a`: `a • s = {a • x | x ∈ s}`. -/
@[to_additive has_vadd_finset "The translation of a finset `s` by a vector `a`:
`a +ᵥ s = {a +ᵥ x | x ∈ s}`."]
protected def has_scalar_finset : has_scalar α (finset β) := ⟨λ a, image $ (•) a⟩

localized "attribute [instance] finset.has_scalar_finset finset.has_vadd_finset" in pointwise

@[to_additive] lemma smul_finset_def : a • s = s.image ((•) a) := rfl
@[to_additive] lemma image_smul : s.image (λ x, a • x)  = a • s := rfl

@[to_additive]
lemma mem_smul_finset {x : β} : x ∈ a • s ↔ ∃ y, y ∈ s ∧ a • y = x :=
by simp only [finset.smul_finset_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product]

@[simp, norm_cast, to_additive]
lemma coe_smul_finset (s : finset β) : (↑(a • s) : set β) = a • s := coe_image

@[to_additive]
lemma smul_finset_mem_smul_finset (hb : b ∈ s) : a • b ∈ a • s := mem_image_of_mem _ hb

@[to_additive] lemma smul_finset_card_le : (a • s).card ≤ s.card := card_image_le

@[simp, to_additive] lemma smul_finset_empty (a : α) : a • (∅ : finset β) = ∅ := image_empty _

@[simp, to_additive]
lemma smul_finset_nonempty_iff : (a • s).nonempty ↔ s.nonempty := nonempty.image_iff _

@[to_additive] lemma nonempty.smul_finset (hs : s.nonempty) : (a • s).nonempty := hs.image _

@[to_additive, mono]
lemma smul_finset_subset_smul_finset : s ⊆ t → a • s ⊆ a • t := image_subset_image

attribute [mono] add_subset_add

@[simp, to_additive]
lemma smul_finset_singleton (b : β) : a • ({b} : finset β) = {a • b} := image_singleton _ _

end has_scalar

open_locale pointwise

section instances
variables [decidable_eq γ]

@[to_additive]
instance smul_comm_class_set [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class α (finset β) (finset γ) :=
⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_comm]⟩

@[to_additive]
instance smul_comm_class_set' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class (finset α) β (finset γ) :=
by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _

@[to_additive]
instance smul_comm_class [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
  smul_comm_class (finset α) (finset β) (finset γ) :=
⟨λ s t u, coe_injective $ by simp_rw [coe_smul, smul_comm]⟩

instance is_scalar_tower [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower α β (finset γ) :=
⟨λ a b s, by simp only [←image_smul, image_image, smul_assoc]⟩

variables [decidable_eq β]

instance is_scalar_tower' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower α (finset β) (finset γ) :=
⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_assoc]⟩

instance is_scalar_tower'' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
  [is_scalar_tower α β γ] :
  is_scalar_tower (finset α) (finset β) (finset γ) :=
⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_assoc]⟩

instance is_central_scalar [has_scalar α β] [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] :
  is_central_scalar α (finset β) :=
⟨λ a s, coe_injective $ by simp only [coe_smul_finset, coe_smul, op_smul_eq_smul]⟩

end instances
end finset


/-
Copyright (c) 2019 Robert A. Spencer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert A. Spencer, Markus Himmel

! This file was ported from Lean 3 source module algebra.category.Module.basic
! leanprover-community/mathlib commit 829895f162a1f29d0133f4b3538f4cd1fb5bffd3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Group.Preadditive
import Mathbin.CategoryTheory.Linear.Basic
import Mathbin.CategoryTheory.Elementwise
import Mathbin.LinearAlgebra.Basic
import Mathbin.CategoryTheory.Conj
import Mathbin.CategoryTheory.Preadditive.AdditiveFunctor

/-!
# The category of `R`-modules

`Module.{v} R` is the category of bundled `R`-modules with carrier in the universe `v`. We show
that it is preadditive and show that being an isomorphism, monomorphism and epimorphism is
equivalent to being a linear equivalence, an injective linear map and a surjective linear map,
respectively.

## Implementation details

To construct an object in the category of `R`-modules from a type `M` with an instance of the
`module` typeclass, write `of R M`. There is a coercion in the other direction.

Similarly, there is a coercion from morphisms in `Module R` to linear maps.

Unfortunately, Lean is not smart enough to see that, given an object `M : Module R`, the expression
`of R M`, where we coerce `M` to the carrier type, is definitionally equal to `M` itself.
This means that to go the other direction, i.e., from linear maps/equivalences to (iso)morphisms
in the category of `R`-modules, we have to take care not to inadvertently end up with an
`of R M` where `M` is already an object. Hence, given `f : M →ₗ[R] N`,
* if `M N : Module R`, simply use `f`;
* if `M : Module R` and `N` is an unbundled `R`-module, use `↿f` or `as_hom_left f`;
* if `M` is an unbundled `R`-module and `N : Module R`, use `↾f` or `as_hom_right f`;
* if `M` and `N` are unbundled `R`-modules, use `↟f` or `as_hom f`.

Similarly, given `f : M ≃ₗ[R] N`, use `to_Module_iso`, `to_Module_iso'_left`, `to_Module_iso'_right`
or `to_Module_iso'`, respectively.

The arrow notations are localized, so you may have to `open_locale Module` to use them. Note that
the notation for `as_hom_left` clashes with the notation used to promote functions between types to
morphisms in the category `Type`, so to avoid confusion, it is probably a good idea to avoid having
the locales `Module` and `category_theory.Type` open at the same time.

If you get an error when trying to apply a theorem and the `convert` tactic produces goals of the
form `M = of R M`, then you probably used an incorrect variant of `as_hom` or `to_Module_iso`.

-/

open CategoryTheory

open CategoryTheory.Limits

open CategoryTheory.Limits.WalkingParallelPair

universe v u

variable (R : Type u) [Ring R]

/-- The category of R-modules and their morphisms.

 Note that in the case of `R = ℤ`, we can not
impose here that the `ℤ`-multiplication field from the module structure is defeq to the one coming
from the `is_add_comm_group` structure (contrary to what we do for all module structures in
mathlib), which creates some difficulties down the road. -/
structure ModuleCat where
  carrier : Type v
  [isAddCommGroup : AddCommGroup carrier]
  [isModule : Module R carrier]
#align Module ModuleCat

attribute [instance] ModuleCat.isAddCommGroup ModuleCat.isModule

namespace ModuleCat

instance : CoeSort (ModuleCat.{v} R) (Type v) :=
  ⟨ModuleCat.Carrier⟩

instance moduleCategory : Category (ModuleCat.{v} R)
    where
  Hom M N := M →ₗ[R] N
  id M := 1
  comp A B C f g := g.comp f
  id_comp' X Y f := LinearMap.id_comp _
  comp_id' X Y f := LinearMap.comp_id _
  assoc' W X Y Z f g h := LinearMap.comp_assoc _ _ _
#align Module.Module_category ModuleCat.moduleCategory

instance moduleConcreteCategory : ConcreteCategory.{v} (ModuleCat.{v} R)
    where
  forget :=
    { obj := fun R => R
      map := fun R S f => (f : R → S) }
  forget_faithful := { }
#align Module.Module_concrete_category ModuleCat.moduleConcreteCategory

instance hasForgetToAddCommGroup : HasForget₂ (ModuleCat R) AddCommGroupCat
    where forget₂ :=
    { obj := fun M => AddCommGroupCat.of M
      map := fun M₁ M₂ f => LinearMap.toAddMonoidHom f }
#align Module.has_forget_to_AddCommGroup ModuleCat.hasForgetToAddCommGroup

instance (M N : ModuleCat R) : LinearMapClass (M ⟶ N) R M N :=
  { LinearMap.semilinearMapClass with coe := fun f => f }

/-- The object in the category of R-modules associated to an R-module -/
def of (X : Type v) [AddCommGroup X] [Module R X] : ModuleCat R :=
  ⟨X⟩
#align Module.of ModuleCat.of

@[simp]
theorem forget₂_obj (X : ModuleCat R) :
    (forget₂ (ModuleCat R) AddCommGroupCat).obj X = AddCommGroupCat.of X :=
  rfl
#align Module.forget₂_obj ModuleCat.forget₂_obj

@[simp]
theorem forget₂_obj_moduleCat_of (X : Type v) [AddCommGroup X] [Module R X] :
    (forget₂ (ModuleCat R) AddCommGroupCat).obj (of R X) = AddCommGroupCat.of X :=
  rfl
#align Module.forget₂_obj_Module_of ModuleCat.forget₂_obj_moduleCat_of

@[simp]
theorem forget₂_map (X Y : ModuleCat R) (f : X ⟶ Y) :
    (forget₂ (ModuleCat R) AddCommGroupCat).map f = LinearMap.toAddMonoidHom f :=
  rfl
#align Module.forget₂_map ModuleCat.forget₂_map

/-- Typecheck a `linear_map` as a morphism in `Module R`. -/
def ofHom {R : Type u} [Ring R] {X Y : Type v} [AddCommGroup X] [Module R X] [AddCommGroup Y]
    [Module R Y] (f : X →ₗ[R] Y) : of R X ⟶ of R Y :=
  f
#align Module.of_hom ModuleCat.ofHom

@[simp]
theorem ofHom_apply {R : Type u} [Ring R] {X Y : Type v} [AddCommGroup X] [Module R X]
    [AddCommGroup Y] [Module R Y] (f : X →ₗ[R] Y) (x : X) : ofHom f x = f x :=
  rfl
#align Module.of_hom_apply ModuleCat.ofHom_apply

instance : Inhabited (ModuleCat R) :=
  ⟨of R PUnit⟩

instance ofUnique {X : Type v} [AddCommGroup X] [Module R X] [i : Unique X] : Unique (of R X) :=
  i
#align Module.of_unique ModuleCat.ofUnique

@[simp]
theorem coe_of (X : Type v) [AddCommGroup X] [Module R X] : (of R X : Type v) = X :=
  rfl
#align Module.coe_of ModuleCat.coe_of

variable {R}

/-- Forgetting to the underlying type and then building the bundled object returns the original
module. -/
@[simps]
def ofSelfIso (M : ModuleCat R) : ModuleCat.of R M ≅ M
    where
  Hom := 𝟙 M
  inv := 𝟙 M
#align Module.of_self_iso ModuleCat.ofSelfIso

theorem isZero_of_subsingleton (M : ModuleCat R) [Subsingleton M] : IsZero M :=
  by
  refine' ⟨fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩, fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩⟩
  · ext
    have : x = 0 := Subsingleton.elim _ _
    rw [this, map_zero, map_zero]
  · ext
    apply Subsingleton.elim
#align Module.is_zero_of_subsingleton ModuleCat.isZero_of_subsingleton

instance : HasZeroObject (ModuleCat.{v} R) :=
  ⟨⟨of R PUnit, isZero_of_subsingleton _⟩⟩

variable {R} {M N U : ModuleCat.{v} R}

@[simp]
theorem id_apply (m : M) : (𝟙 M : M → M) m = m :=
  rfl
#align Module.id_apply ModuleCat.id_apply

@[simp]
theorem coe_comp (f : M ⟶ N) (g : N ⟶ U) : (f ≫ g : M → U) = g ∘ f :=
  rfl
#align Module.coe_comp ModuleCat.coe_comp

theorem comp_def (f : M ⟶ N) (g : N ⟶ U) : f ≫ g = g.comp f :=
  rfl
#align Module.comp_def ModuleCat.comp_def

end ModuleCat

variable {R}

variable {X₁ X₂ : Type v}

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def ModuleCat.asHom [AddCommGroup X₁] [Module R X₁] [AddCommGroup X₂] [Module R X₂] :
    (X₁ →ₗ[R] X₂) → (ModuleCat.of R X₁ ⟶ ModuleCat.of R X₂) :=
  id
#align Module.as_hom ModuleCat.asHom

-- mathport name: Module.as_hom
scoped[ModuleCat] notation "↟" f:1024 => ModuleCat.asHom f

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def ModuleCat.asHomRight [AddCommGroup X₁] [Module R X₁] {X₂ : ModuleCat.{v} R} :
    (X₁ →ₗ[R] X₂) → (ModuleCat.of R X₁ ⟶ X₂) :=
  id
#align Module.as_hom_right ModuleCat.asHomRight

-- mathport name: Module.as_hom_right
scoped[ModuleCat] notation "↾" f:1024 => ModuleCat.asHomRight f

/-- Reinterpreting a linear map in the category of `R`-modules. -/
def ModuleCat.asHomLeft {X₁ : ModuleCat.{v} R} [AddCommGroup X₂] [Module R X₂] :
    (X₁ →ₗ[R] X₂) → (X₁ ⟶ ModuleCat.of R X₂) :=
  id
#align Module.as_hom_left ModuleCat.asHomLeft

-- mathport name: Module.as_hom_left
scoped[ModuleCat] notation "↿" f:1024 => ModuleCat.asHomLeft f

/-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s. -/
@[simps]
def LinearEquiv.toModuleIso {g₁ : AddCommGroup X₁} {g₂ : AddCommGroup X₂} {m₁ : Module R X₁}
    {m₂ : Module R X₂} (e : X₁ ≃ₗ[R] X₂) : ModuleCat.of R X₁ ≅ ModuleCat.of R X₂
    where
  Hom := (e : X₁ →ₗ[R] X₂)
  inv := (e.symm : X₂ →ₗ[R] X₁)
  hom_inv_id' := by ext; exact e.left_inv x
  inv_hom_id' := by ext; exact e.right_inv x
#align linear_equiv.to_Module_iso LinearEquiv.toModuleIso

/-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def LinearEquiv.toModuleIso' {M N : ModuleCat.{v} R} (i : M ≃ₗ[R] N) : M ≅ N
    where
  Hom := i
  inv := i.symm
  hom_inv_id' := LinearMap.ext fun x => by simp
  inv_hom_id' := LinearMap.ext fun x => by simp
#align linear_equiv.to_Module_iso' LinearEquiv.toModuleIso'

/-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def LinearEquiv.toModuleIso'Left {X₁ : ModuleCat.{v} R} {g₂ : AddCommGroup X₂} {m₂ : Module R X₂}
    (e : X₁ ≃ₗ[R] X₂) : X₁ ≅ ModuleCat.of R X₂
    where
  Hom := (e : X₁ →ₗ[R] X₂)
  inv := (e.symm : X₂ →ₗ[R] X₁)
  hom_inv_id' := LinearMap.ext fun x => by simp
  inv_hom_id' := LinearMap.ext fun x => by simp
#align linear_equiv.to_Module_iso'_left LinearEquiv.toModuleIso'Left

/-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s.

This version is better than `linear_equiv_to_Module_iso` when applicable, because Lean can't see
`Module.of R M` is defeq to `M` when `M : Module R`. -/
@[simps]
def LinearEquiv.toModuleIso'Right {g₁ : AddCommGroup X₁} {m₁ : Module R X₁} {X₂ : ModuleCat.{v} R}
    (e : X₁ ≃ₗ[R] X₂) : ModuleCat.of R X₁ ≅ X₂
    where
  Hom := (e : X₁ →ₗ[R] X₂)
  inv := (e.symm : X₂ →ₗ[R] X₁)
  hom_inv_id' := LinearMap.ext fun x => by simp
  inv_hom_id' := LinearMap.ext fun x => by simp
#align linear_equiv.to_Module_iso'_right LinearEquiv.toModuleIso'Right

namespace CategoryTheory.Iso

/-- Build a `linear_equiv` from an isomorphism in the category `Module R`. -/
@[simps]
def toLinearEquiv {X Y : ModuleCat R} (i : X ≅ Y) : X ≃ₗ[R] Y
    where
  toFun := i.Hom
  invFun := i.inv
  left_inv := by tidy
  right_inv := by tidy
  map_add' := by tidy
  map_smul' := by tidy
#align category_theory.iso.to_linear_equiv CategoryTheory.Iso.toLinearEquiv

end CategoryTheory.Iso

/-- linear equivalences between `module`s are the same as (isomorphic to) isomorphisms
in `Module` -/
@[simps]
def linearEquivIsoModuleIso {X Y : Type u} [AddCommGroup X] [AddCommGroup Y] [Module R X]
    [Module R Y] : (X ≃ₗ[R] Y) ≅ ModuleCat.of R X ≅ ModuleCat.of R Y
    where
  Hom e := e.toModuleIso
  inv i := i.toLinearEquiv
#align linear_equiv_iso_Module_iso linearEquivIsoModuleIso

namespace ModuleCat

instance : Preadditive (ModuleCat.{v} R)
    where
  add_comp P Q R f f' g :=
    show (f + f') ≫ g = f ≫ g + f' ≫ g by
      ext
      simp
  comp_add P Q R f g g' :=
    show f ≫ (g + g') = f ≫ g + f ≫ g' by
      ext
      simp

instance forget₂_addCommGroupCat_additive : (forget₂ (ModuleCat.{v} R) AddCommGroupCat).Additive
    where
#align Module.forget₂_AddCommGroup_additive ModuleCat.forget₂_addCommGroupCat_additive

section

variable {S : Type u} [CommRing S]

instance : Linear S (ModuleCat.{v} S)
    where
  homModule X Y := LinearMap.module
  smul_comp' := by
    intros
    ext
    simp
  comp_smul' := by
    intros
    ext
    simp

variable {X Y X' Y' : ModuleCat.{v} S}

theorem Iso.homCongr_eq_arrowCongr (i : X ≅ X') (j : Y ≅ Y') (f : X ⟶ Y) :
    Iso.homCongr i j f = LinearEquiv.arrowCongr i.toLinearEquiv j.toLinearEquiv f :=
  rfl
#align Module.iso.hom_congr_eq_arrow_congr ModuleCat.Iso.homCongr_eq_arrowCongr

theorem Iso.conj_eq_conj (i : X ≅ X') (f : End X) :
    Iso.conj i f = LinearEquiv.conj i.toLinearEquiv f :=
  rfl
#align Module.iso.conj_eq_conj ModuleCat.Iso.conj_eq_conj

end

end ModuleCat

instance (M : Type u) [AddCommGroup M] [Module R M] : Coe (Submodule R M) (ModuleCat R) :=
  ⟨fun N => ModuleCat.of R N⟩


example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
  { intro h,
    cases h.right with hq hr,
    { show (p ∧ q) ∨ (p ∧ r),
        exact or.inl ⟨h.left, hq⟩ },
    { show (p ∧ q) ∨ (p ∧ r),
        exact or.inr ⟨h.left, hr⟩ }},
  { intro h,
    cases h with hpq hpr,
    { show p ∧ (q ∨ r),
        exact ⟨hpq.left, or.inl hpq.right⟩ },
    { show p ∧ (q ∨ r),
        exact ⟨hpr.left, or.inr hpr.right⟩ }}
end


import graphs.allexts
open function

lemma iso.bij {G H : graph} (α : G ↦ H) (hyp : isomorphism α) : bijective α.vertex_map ∧ bijective α.edge_map :=
begin
  cases hyp with β hβ,
  cases hβ with h₁ h₂,
  split,
  split,
  have h₃ : left_inverse β.vertex_map α.vertex_map,
  {
    intro x,
    calc β.vertex_map (α.vertex_map x) = (β ⊚ α).vertex_map x : by refl
                                   ... = (𝕀 G).vertex_map x : by rw eq_mor_eq_vmap (β ⊚ α) (𝕀 G) (h₂)
                                   ... = x : by refl,
  },
  apply left_inverse.injective h₃,

  have h₃ : right_inverse β.vertex_map α.vertex_map,
  {
    intro x,
    calc α.vertex_map (β.vertex_map x) = (α ⊚ β).vertex_map x : by refl
                                   ... = (𝕀 H).vertex_map x : by rw eq_mor_eq_vmap (α ⊚ β) (𝕀 H) (h₁)
                                   ... = x : by refl,
  },
  apply right_inverse.surjective h₃,

  split,
  have h₃ : left_inverse β.edge_map α.edge_map,
  {
    intro x,
    calc β.edge_map (α.edge_map x) = (β ⊚ α).edge_map x : by refl
                                   ... = (𝕀 G).edge_map x : by rw eq_mor_eq_emap (β ⊚ α) (𝕀 G) (h₂)
                                   ... = x : by refl,
  },
  apply left_inverse.injective h₃,

  have h₃ : right_inverse β.edge_map α.edge_map,
  {
    intro x,
    calc α.edge_map (β.edge_map x) = (α ⊚ β).edge_map x : by refl
                                   ... = (𝕀 H).edge_map x : by rw eq_mor_eq_emap (α ⊚ β) (𝕀 H) (h₁)
                                   ... = x : by refl,
  },
  apply right_inverse.surjective h₃,
end

lemma bij.iso {G H : graph} (α : G ↦ H) (hv : bijective α.vertex_map) (he : bijective α.edge_map) : isomorphism α :=
begin
  let φ := α.vertex_map,
  let ψ := α.edge_map,

  rw bijective_iff_has_inverse at hv,
  cases hv with φ' hφ',
  rw bijective_iff_has_inverse at he,
  cases he with ψ' hψ',

  have comp' : G.endpoints ∘ ψ' = sym2.map φ' ∘ H.endpoints,
  {
    calc G.endpoints ∘ ψ' = id ∘ G.endpoints ∘ ψ' : by refl
                      ... = sym2.map id ∘ G.endpoints ∘ ψ' : by rw sym2.map_id
                      ... = sym2.map (φ' ∘ φ) ∘ G.endpoints ∘ ψ' : by rw left_inverse.id hφ'.1
                      ... = sym2.map φ' ∘ sym2.map φ ∘ G.endpoints ∘ ψ' : by rw sym2.map_comp
                      ... = sym2.map φ' ∘ (H.endpoints ∘ ψ) ∘ ψ' : by rw α.compatability
                      ... = sym2.map φ' ∘ H.endpoints ∘ (ψ ∘ ψ') : by refl
                      ... = sym2.map φ' ∘ H.endpoints ∘ id : by rw right_inverse.id hψ'.2
                      ... = sym2.map φ' ∘ H.endpoints : by refl,
  },

  let β := morphism.mk (φ') (ψ') (comp'),
  use β,
  split,

  {
    apply mor_ext,
    {
      calc (α ⊚ β).vertex_map = α.vertex_map ∘ β.vertex_map : by refl
                          ... = φ ∘ φ' : by refl
                          ... = id : by exact left_inverse.id hφ'.2
                          ... = (𝕀 H).vertex_map : by refl,
    },
    {
      calc (α ⊚ β).edge_map = α.edge_map ∘ β.edge_map : by refl
                          ... = ψ ∘ ψ' : by refl
                          ... = id : by exact left_inverse.id hψ'.2
                          ... = (𝕀 H).edge_map : by refl,
    },
  },

  {
    apply mor_ext,
    {
      calc (β ⊚ α).vertex_map = β.vertex_map ∘ α.vertex_map : by refl
                          ... = φ' ∘ φ : by refl
                          ... = id : by exact left_inverse.id hφ'.1
                          ... = (𝕀 G).vertex_map : by refl,
    },
    {
      calc (β ⊚ α).edge_map = β.edge_map ∘ α.edge_map : by refl
                          ... = ψ' ∘ ψ : by refl
                          ... = id : by exact left_inverse.id hψ'.1
                          ... = (𝕀 G).edge_map : by refl,
    },
  },
end


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.basic
import algebra.lie.subalgebra
import algebra.algebra.subalgebra

/-!
# Lie algebras of associative algebras

This file defines the Lie algebra structure that arises on an associative algebra via the ring
commutator.

Since the linear endomorphisms of a Lie algebra form an associative algebra, one can define the
adjoint action as a morphism of Lie algebras from a Lie algebra to its linear endomorphisms. We
make such a definition in this file.

## Main definitions

 * `lie_algebra.of_associative_algebra`
 * `lie_algebra.of_associative_algebra_hom`
 * `lie_module.to_endomorphism`
 * `lie_algebra.ad`
 * `linear_equiv.lie_conj`
 * `alg_equiv.to_lie_equiv`

## Tags

lie algebra, ring commutator, adjoint action
-/

universes u v w w₁ w₂

section of_associative

variables {A : Type v} [ring A]

namespace ring

/-- The bracket operation for rings is the ring commutator, which captures the extent to which a
ring is commutative. It is identically zero exactly when the ring is commutative. -/
@[priority 100]
instance : has_bracket A A := ⟨λ x y, x*y - y*x⟩

lemma lie_def (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

end ring

namespace lie_ring

/-- An associative ring gives rise to a Lie ring by taking the bracket to be the ring commutator. -/
@[priority 100]
instance of_associative_ring : lie_ring A :=
{ add_lie      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_add      := by simp only [ring.lie_def, right_distrib, left_distrib,
    sub_eq_add_neg, add_comm, add_left_comm, forall_const, eq_self_iff_true, neg_add_rev],
  lie_self     := by simp only [ring.lie_def, forall_const, sub_self],
  leibniz_lie  := λ x y z, by { repeat { rw ring.lie_def, }, noncomm_ring, } }

lemma of_associative_ring_bracket (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl

end lie_ring

namespace lie_algebra

variables {R : Type u} [comm_ring R] [algebra R A]

/-- An associative algebra gives rise to a Lie algebra by taking the bracket to be the ring
commutator. -/
@[priority 100]
instance of_associative_algebra : lie_algebra R A :=
{ lie_smul := λ t x y,
    by rw [lie_ring.of_associative_ring_bracket, lie_ring.of_associative_ring_bracket,
           algebra.mul_smul_comm, algebra.smul_mul_assoc, smul_sub], }

/-- The map `of_associative_algebra` associating a Lie algebra to an associative algebra is
functorial. -/
def of_associative_algebra_hom {B : Type w} [ring B] [algebra R B] (f : A →ₐ[R] B) : A →ₗ⁅R⁆ B :=
 { map_lie' := λ x y, show f ⁅x,y⁆ = ⁅f x,f y⁆,
     by simp only [lie_ring.of_associative_ring_bracket, alg_hom.map_sub, alg_hom.map_mul],
  ..f.to_linear_map, }

@[simp] lemma of_associative_algebra_hom_id : of_associative_algebra_hom (alg_hom.id R A) = 1 := rfl

@[simp] lemma of_associative_algebra_hom_apply {B : Type w} [ring B] [algebra R B]
  (f : A →ₐ[R] B) (x : A) : of_associative_algebra_hom f x = f x := rfl

@[simp] lemma of_associative_algebra_hom_comp {B : Type w} {C : Type w₁}
  [ring B] [ring C] [algebra R B] [algebra R C] (f : A →ₐ[R] B) (g : B →ₐ[R] C) :
  of_associative_algebra_hom (g.comp f) =
  (of_associative_algebra_hom g).comp (of_associative_algebra_hom f) := rfl

end lie_algebra

end of_associative

section adjoint_action

variables (R : Type u) (L : Type v) (M : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]

/-- A Lie module yields a Lie algebra morphism into the linear endomorphisms of the module.

See also `lie_module.to_module_hom`. -/
@[simps] def lie_module.to_endomorphism : L →ₗ⁅R⁆ module.End R M :=
{ to_fun    := λ x,
  { to_fun    := λ m, ⁅x, m⁆,
    map_add'  := lie_add x,
    map_smul' := λ t, lie_smul t x, },
  map_add'  := λ x y, by { ext m, apply add_lie, },
  map_smul' := λ t x, by { ext m, apply smul_lie, },
  map_lie'  := λ x y, by { ext m, apply lie_lie, }, }

/-- The adjoint action of a Lie algebra on itself. -/
def lie_algebra.ad : L →ₗ⁅R⁆ module.End R L := lie_module.to_endomorphism R L L

@[simp] lemma lie_algebra.ad_apply (x y : L) : lie_algebra.ad R L x y = ⁅x, y⁆ := rfl

end adjoint_action

/-- A subalgebra of an associative algebra is a Lie subalgebra of the associated Lie algebra. -/
def lie_subalgebra_of_subalgebra (R : Type u) [comm_ring R] (A : Type v) [ring A] [algebra R A]
  (A' : subalgebra R A) : lie_subalgebra R A :=
{ lie_mem' := λ x y hx hy, by {
    change ⁅x, y⁆ ∈ A', change x ∈ A' at hx, change y ∈ A' at hy,
    rw lie_ring.of_associative_ring_bracket,
    have hxy := A'.mul_mem hx hy,
    have hyx := A'.mul_mem hy hx,
    exact submodule.sub_mem A'.to_submodule hxy hyx, },
  ..A'.to_submodule }

namespace linear_equiv

variables {R : Type u} {M₁ : Type v} {M₂ : Type w}
variables [comm_ring R] [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]
variables (e : M₁ ≃ₗ[R] M₂)

/-- A linear equivalence of two modules induces a Lie algebra equivalence of their endomorphisms. -/
def lie_conj : module.End R M₁ ≃ₗ⁅R⁆ module.End R M₂ :=
{ map_lie' := λ f g, show e.conj ⁅f, g⁆ = ⁅e.conj f, e.conj g⁆,
    by simp only [lie_ring.of_associative_ring_bracket, linear_map.mul_eq_comp, e.conj_comp,
                  linear_equiv.map_sub],
  ..e.conj }

@[simp] lemma lie_conj_apply (f : module.End R M₁) : e.lie_conj f = e.conj f := rfl

@[simp] lemma lie_conj_symm : e.lie_conj.symm = e.symm.lie_conj := rfl

end linear_equiv

namespace alg_equiv

variables {R : Type u} {A₁ : Type v} {A₂ : Type w}
variables [comm_ring R] [ring A₁] [ring A₂] [algebra R A₁] [algebra R A₂]
variables (e : A₁ ≃ₐ[R] A₂)

/-- An equivalence of associative algebras is an equivalence of associated Lie algebras. -/
def to_lie_equiv : A₁ ≃ₗ⁅R⁆ A₂ :=
{ to_fun   := e.to_fun,
  map_lie' := λ x y, by simp [lie_ring.of_associative_ring_bracket],
  ..e.to_linear_equiv }

@[simp] lemma to_lie_equiv_apply (x : A₁) : e.to_lie_equiv x = e x := rfl

@[simp] lemma to_lie_equiv_symm_apply (x : A₂) : e.to_lie_equiv.symm x = e.symm x := rfl

end alg_equiv


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_123
  (a b : ℕ+)
  (h₀ : a + b = 20)
  (h₁ : a = 3 * b) :
  a - b = 10 :=
begin
  rw h₁ at h₀,
  rw h₁,
  have h₂ : 3 * (b:ℕ) + (b:ℕ) = (20:ℕ), {
    exact subtype.mk.inj h₀,
  },
  have h₃ : (b:ℕ) = 5, linarith,
  have h₄ : b = 5, {
    exact pnat.eq h₃,
  },
  rw h₄,
  calc (3:ℕ+) * 5 - 5 = 15 - 5 : by {congr,}
            ... = 10 : by {exact rfl},
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.bitwise
import Mathlib.data.nat.parity
import Mathlib.ring_theory.int.basic
import Mathlib.algebra.big_operators.intervals
import Mathlib.PostPort

namespace Mathlib

/-!

# Natural number multiplicity

This file contains lemmas about the multiplicity function (the maximum prime power divding a number).

# Main results

There are natural number versions of some basic lemmas about multiplicity.

There are also lemmas about the multiplicity of primes in factorials and in binomial coefficients.
-/

namespace nat

/-- The multiplicity of a divisor `m` of `n`, is the cardinality of the set of
  positive natural numbers `i` such that `p ^ i` divides `n`. The set is expressed
  by filtering `Ico 1 b` where `b` is any bound at least `n` -/
theorem multiplicity_eq_card_pow_dvd {m : ℕ} {n : ℕ} {b : ℕ} (hm1 : m ≠ 1) (hn0 : 0 < n) (hb : n ≤ b) : multiplicity m n = ↑(finset.card (finset.filter (fun (i : ℕ) => m ^ i ∣ n) (finset.Ico 1 b))) := sorry

namespace prime

theorem multiplicity_one {p : ℕ} (hp : prime p) : multiplicity p 1 = 0 :=
  multiplicity.one_right (prime.not_unit (iff.mp prime_iff_prime hp))

theorem multiplicity_mul {p : ℕ} {m : ℕ} {n : ℕ} (hp : prime p) : multiplicity p (m * n) = multiplicity p m + multiplicity p n :=
  multiplicity.mul (iff.mp prime_iff_prime hp)

theorem multiplicity_pow {p : ℕ} {m : ℕ} {n : ℕ} (hp : prime p) : multiplicity p (m ^ n) = n •ℕ multiplicity p m :=
  multiplicity.pow (iff.mp prime_iff_prime hp)

theorem multiplicity_self {p : ℕ} (hp : prime p) : multiplicity p p = 1 :=
  multiplicity.multiplicity_self (prime.not_unit (iff.mp prime_iff_prime hp)) (ne_zero hp)

theorem multiplicity_pow_self {p : ℕ} {n : ℕ} (hp : prime p) : multiplicity p (p ^ n) = ↑n :=
  multiplicity.multiplicity_pow_self (ne_zero hp) (prime.not_unit (iff.mp prime_iff_prime hp)) n

/-- The multiplicity of a prime in `n!` is the sum of the quotients `n / p ^ i`.
  This sum is expressed over the set `Ico 1 b` where `b` is any bound at least `n` -/
theorem multiplicity_factorial {p : ℕ} (hp : prime p) {n : ℕ} {b : ℕ} : n ≤ b → multiplicity p (factorial n) = ↑(finset.sum (finset.Ico 1 b) fun (i : ℕ) => n / p ^ i) := sorry

/-- The multiplicity of `p` in `(p(n+1))!` is one more than the sum
  of the multiplicities of `p` in `(p * n)!` and `n + 1`. -/
theorem multiplicity_factorial_mul_succ {n : ℕ} {p : ℕ} (hp : prime p) : multiplicity p (factorial (p * (n + 1))) = multiplicity p (factorial (p * n)) + multiplicity p (n + 1) + 1 := sorry

/-- The multiplicity of `p` in `(pn)!` is `n` more than that of `n!`. -/
theorem multiplicity_factorial_mul {n : ℕ} {p : ℕ} (hp : prime p) : multiplicity p (factorial (p * n)) = multiplicity p (factorial n) + ↑n := sorry

/-- A prime power divides `n!` iff it is at most the sum of the quotients `n / p ^ i`.
  This sum is expressed over the set `Ico 1 b` where `b` is any bound at least `n` -/
theorem pow_dvd_factorial_iff {p : ℕ} {n : ℕ} {r : ℕ} {b : ℕ} (hp : prime p) (hbn : n ≤ b) : p ^ r ∣ factorial n ↔ r ≤ finset.sum (finset.Ico 1 b) fun (i : ℕ) => n / p ^ i := sorry

theorem multiplicity_choose_aux {p : ℕ} {n : ℕ} {b : ℕ} {k : ℕ} (hp : prime p) (hkn : k ≤ n) : (finset.sum (finset.Ico 1 b) fun (i : ℕ) => n / p ^ i) =
  ((finset.sum (finset.Ico 1 b) fun (i : ℕ) => k / p ^ i) +
      finset.sum (finset.Ico 1 b) fun (i : ℕ) => (n - k) / p ^ i) +
    finset.card (finset.filter (fun (i : ℕ) => p ^ i ≤ k % p ^ i + (n - k) % p ^ i) (finset.Ico 1 b)) := sorry

/-- The multiplity of `p` in `choose n k` is the number of carries when `k` and `n - k`
  are added in base `p`. The set is expressed by filtering `Ico 1 b` where `b`
  is any bound at least `n`. -/
theorem multiplicity_choose {p : ℕ} {n : ℕ} {k : ℕ} {b : ℕ} (hp : prime p) (hkn : k ≤ n) (hnb : n ≤ b) : multiplicity p (choose n k) =
  ↑(finset.card (finset.filter (fun (i : ℕ) => p ^ i ≤ k % p ^ i + (n - k) % p ^ i) (finset.Ico 1 b))) := sorry

/-- A lower bound on the multiplicity of `p` in `choose n k`. -/
theorem multiplicity_le_multiplicity_choose_add {p : ℕ} (hp : prime p) (n : ℕ) (k : ℕ) : multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k := sorry

theorem multiplicity_choose_prime_pow {p : ℕ} {n : ℕ} {k : ℕ} (hp : prime p) (hkn : k ≤ p ^ n) (hk0 : 0 < k) : multiplicity p (choose (p ^ n) k) + multiplicity p k = ↑n := sorry

end prime

theorem multiplicity_two_factorial_lt {n : ℕ} (h : n ≠ 0) : multiplicity (bit0 1) (factorial n) < ↑n := sorry


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_104
  (x : ℝ)
  (h₀ : 125 / 8 = x / 12) :
  x = 375 / 2 :=
begin
  linarith,
end


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Fox Thomson.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.data.finset.basic
import Mathlib.tactic.rcases
import Mathlib.tactic.omega.default
import Mathlib.computability.language
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Regular Expressions

This file contains the formal definition for regular expressions and basic lemmas. Note these are
regular expressions in terms of formal language theory. Note this is different to regex's used in
computer science such as the POSIX standard.

TODO
* Show that this regular expressions and DFA/NFA's are equivalent.
* `attribute [pattern] has_mul.mul` has been added into this file, it could be moved.
-/

/--
This is the definition of regular expressions. The names used here is to mirror the definition
of a Kleene algebra (https://en.wikipedia.org/wiki/Kleene_algebra).
* `0` (`zero`) matches nothing
* `1` (`epsilon`) matches only the empty string
* `char a` matches only the string 'a'
* `star P` matches any finite concatenation of strings which match `P`
* `P + Q` (`plus P Q`) matches anything which match `P` or `Q`
* `P * Q` (`comp P Q`) matches `x ++ y` if `x` matches `P` and `y` matches `Q`
-/
inductive regular_expression (α : Type u) where
| zero : regular_expression α
| epsilon : regular_expression α
| char : α → regular_expression α
| plus : regular_expression α → regular_expression α → regular_expression α
| comp : regular_expression α → regular_expression α → regular_expression α
| star : regular_expression α → regular_expression α

namespace regular_expression

protected instance inhabited {α : Type u} : Inhabited (regular_expression α) := { default := zero }

protected instance has_add {α : Type u} : Add (regular_expression α) := { add := plus }

protected instance has_mul {α : Type u} : Mul (regular_expression α) := { mul := comp }

protected instance has_one {α : Type u} : HasOne (regular_expression α) := { one := epsilon }

protected instance has_zero {α : Type u} : HasZero (regular_expression α) := { zero := zero }

@[simp] theorem zero_def {α : Type u} : zero = 0 := rfl

@[simp] theorem one_def {α : Type u} : epsilon = 1 := rfl

@[simp] theorem plus_def {α : Type u} (P : regular_expression α) (Q : regular_expression α) :
    plus P Q = P + Q :=
  rfl

@[simp] theorem comp_def {α : Type u} (P : regular_expression α) (Q : regular_expression α) :
    comp P Q = P * Q :=
  rfl

/-- `matches P` provides a language which contains all strings that `P` matches -/
def matches {α : Type u} : regular_expression α → language α := sorry

@[simp] theorem matches_zero_def {α : Type u} : matches 0 = 0 := rfl

@[simp] theorem matches_epsilon_def {α : Type u} : matches 1 = 1 := rfl

@[simp] theorem matches_add_def {α : Type u} (P : regular_expression α) (Q : regular_expression α) :
    matches (P + Q) = matches P + matches Q :=
  rfl

@[simp] theorem matches_mul_def {α : Type u} (P : regular_expression α) (Q : regular_expression α) :
    matches (P * Q) = matches P * matches Q :=
  rfl

@[simp] theorem matches_star_def {α : Type u} (P : regular_expression α) :
    matches (star P) = language.star (matches P) :=
  rfl

/-- `match_epsilon P` is true if and only if `P` matches the empty string -/
def match_epsilon {α : Type u} : regular_expression α → Bool := sorry

/-- `P.deriv a` matches `x` if `P` matches `a :: x`, the Brzozowski derivative of `P` with respect
  to `a` -/
def deriv {α : Type u} [dec : DecidableEq α] : regular_expression α → α → regular_expression α :=
  sorry

/-- `P.rmatch x` is true if and only if `P` matches `x`. This is a computable definition equivalent
  to `matches`. -/
def rmatch {α : Type u} [dec : DecidableEq α] : regular_expression α → List α → Bool := sorry

@[simp] theorem zero_rmatch {α : Type u} [dec : DecidableEq α] (x : List α) : rmatch 0 x = false :=
  sorry

theorem one_rmatch_iff {α : Type u} [dec : DecidableEq α] (x : List α) : ↥(rmatch 1 x) ↔ x = [] :=
  sorry

theorem char_rmatch_iff {α : Type u} [dec : DecidableEq α] (a : α) (x : List α) :
    ↥(rmatch (char a) x) ↔ x = [a] :=
  sorry

theorem add_rmatch_iff {α : Type u} [dec : DecidableEq α] (P : regular_expression α)
    (Q : regular_expression α) (x : List α) : ↥(rmatch (P + Q) x) ↔ ↥(rmatch P x) ∨ ↥(rmatch Q x) :=
  sorry

theorem mul_rmatch_iff {α : Type u} [dec : DecidableEq α] (P : regular_expression α)
    (Q : regular_expression α) (x : List α) :
    ↥(rmatch (P * Q) x) ↔
        ∃ (t : List α), ∃ (u : List α), x = t ++ u ∧ ↥(rmatch P t) ∧ ↥(rmatch Q u) :=
  sorry

theorem star_rmatch_iff {α : Type u} [dec : DecidableEq α] (P : regular_expression α) (x : List α) :
    ↥(rmatch (star P) x) ↔
        ∃ (S : List (List α)), x = list.join S ∧ ∀ (t : List α), t ∈ S → t ≠ [] ∧ ↥(rmatch P t) :=
  sorry

@[simp] theorem rmatch_iff_matches {α : Type u} [dec : DecidableEq α] (P : regular_expression α)
    (x : List α) : ↥(rmatch P x) ↔ x ∈ matches P :=
  sorry

protected instance matches.decidable_pred {α : Type u} [dec : DecidableEq α]
    (P : regular_expression α) : decidable_pred (matches P) :=
  id fun (x : List α) => id (eq.mpr sorry (eq.decidable (rmatch P x) tt))

end Mathlib


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import ring_theory.power_series.basic
import data.nat.parity
import algebra.big_operators.nat_antidiagonal

/-!
# Definition of well-known power series

In this file we define the following power series:

* `power_series.inv_units_sub`: given `u : Rˣ`, this is the series for `1 / (u - x)`.
  It is given by `∑ n, x ^ n /ₚ u ^ (n + 1)`.

* `power_series.sin`, `power_series.cos`, `power_series.exp` : power series for sin, cosine, and
  exponential functions.
-/

namespace power_series

section ring

variables {R S : Type*} [ring R] [ring S]

/-- The power series for `1 / (u - x)`. -/
def inv_units_sub (u : Rˣ) : power_series R := mk $ λ n, 1 /ₚ u ^ (n + 1)

@[simp] lemma coeff_inv_units_sub (u : Rˣ) (n : ℕ) :
  coeff R n (inv_units_sub u) = 1 /ₚ u ^ (n + 1) :=
coeff_mk _ _

@[simp] lemma constant_coeff_inv_units_sub (u : Rˣ) :
  constant_coeff R (inv_units_sub u) = 1 /ₚ u :=
by rw [← coeff_zero_eq_constant_coeff_apply, coeff_inv_units_sub, zero_add, pow_one]

@[simp] lemma inv_units_sub_mul_X (u : Rˣ) :
  inv_units_sub u * X = inv_units_sub u * C R u - 1 :=
begin
  ext (_|n),
  { simp },
  { simp [n.succ_ne_zero, pow_succ] }
end

@[simp] lemma inv_units_sub_mul_sub (u : Rˣ) : inv_units_sub u * (C R u - X) = 1 :=
by simp [mul_sub, sub_sub_cancel]

lemma map_inv_units_sub (f : R →+* S) (u : Rˣ) :
  map f (inv_units_sub u) = inv_units_sub (units.map (f : R →* S) u) :=
by { ext, simp [← map_pow] }

end ring

section field

variables (A A' : Type*) [ring A] [ring A'] [algebra ℚ A] [algebra ℚ A']

open_locale nat

/-- Power series for the exponential function at zero. -/
def exp : power_series A := mk $ λ n, algebra_map ℚ A (1 / n!)

/-- Power series for the sine function at zero. -/
def sin : power_series A :=
mk $ λ n, if even n then 0 else algebra_map ℚ A ((-1) ^ (n / 2) / n!)

/-- Power series for the cosine function at zero. -/
def cos : power_series A :=
mk $ λ n, if even n then algebra_map ℚ A ((-1) ^ (n / 2) / n!) else 0

variables {A A'} (n : ℕ) (f : A →+* A')

@[simp] lemma coeff_exp : coeff A n (exp A) = algebra_map ℚ A (1 / n!) := coeff_mk _ _

@[simp] lemma constant_coeff_exp : constant_coeff A (exp A) = 1 :=
by { rw [← coeff_zero_eq_constant_coeff_apply, coeff_exp], simp }

@[simp] lemma coeff_sin_bit0 : coeff A (bit0 n) (sin A) = 0 :=
by rw [sin, coeff_mk, if_pos (even_bit0 n)]

@[simp] lemma coeff_sin_bit1 : coeff A (bit1 n) (sin A) = (-1) ^ n * coeff A (bit1 n) (exp A) :=
by rw [sin, coeff_mk, if_neg n.not_even_bit1, nat.bit1_div_two,
  ←mul_one_div, map_mul, map_pow, map_neg, map_one, coeff_exp]

@[simp] lemma coeff_cos_bit0 : coeff A (bit0 n) (cos A) = (-1) ^ n * coeff A (bit0 n) (exp A) :=
by rw [cos, coeff_mk, if_pos (even_bit0 n), nat.bit0_div_two,
  ←mul_one_div, map_mul, map_pow, map_neg, map_one, coeff_exp]

@[simp] lemma coeff_cos_bit1 : coeff A (bit1 n) (cos A) = 0 :=
by rw [cos, coeff_mk, if_neg n.not_even_bit1]

@[simp] lemma map_exp : map (f : A →+* A') (exp A) = exp A' := by { ext, simp }

@[simp] lemma map_sin : map f (sin A) = sin A' := by { ext, simp [sin, apply_ite f] }

@[simp] lemma map_cos : map f (cos A) = cos A' := by { ext, simp [cos, apply_ite f] }

end field

open ring_hom
open finset nat

variables {A : Type*} [comm_ring A]

/-- Shows that $e^{aX} * e^{bX} = e^{(a + b)X}$ -/
theorem exp_mul_exp_eq_exp_add [algebra ℚ A] (a b : A) :
  rescale a (exp A) * rescale b (exp A) = rescale (a + b) (exp A) :=
begin
  ext,
  simp only [coeff_mul, exp, rescale, coeff_mk, coe_mk, factorial,
    nat.sum_antidiagonal_eq_sum_range_succ_mk, add_pow, sum_mul],
  apply sum_congr rfl,
  rintros x hx,
  suffices : a^x * b^(n - x) * (algebra_map ℚ A (1 / ↑(x.factorial)) * algebra_map ℚ A
    (1 / ↑((n - x).factorial))) =
    a^x * b^(n - x) * ((↑(n.choose x) * (algebra_map ℚ A) (1 / ↑(n.factorial)))),
  { convert this using 1; ring },
  congr' 1,
  rw [←map_nat_cast (algebra_map ℚ A) (n.choose x), ←map_mul, ←map_mul],
  refine ring_hom.congr_arg _ _,
  rw [mul_one_div ↑(n.choose x) _, one_div_mul_one_div],
  symmetry,
  rw [div_eq_iff, div_mul_eq_mul_div, one_mul, choose_eq_factorial_div_factorial],
  norm_cast,
  rw cast_div_char_zero,
  { apply factorial_mul_factorial_dvd_factorial (mem_range_succ_iff.1 hx), },
  { apply mem_range_succ_iff.1 hx, },
  { rintros h, apply factorial_ne_zero n, rw cast_eq_zero.1 h, },
end

/-- Shows that $e^{x} * e^{-x} = 1$ -/
theorem exp_mul_exp_neg_eq_one [algebra ℚ A] : exp A * eval_neg_hom (exp A) = 1 :=
by convert exp_mul_exp_eq_exp_add (1 : A) (-1); simp

/-- Shows that $(e^{X})^k = e^{kX}$. -/
theorem exp_pow_eq_rescale_exp [algebra ℚ A] (k : ℕ) : (exp A)^k = rescale (k : A) (exp A) :=
begin
  induction k with k h,
  { simp only [rescale_zero, constant_coeff_exp, function.comp_app, map_one, cast_zero,
      pow_zero, coe_comp], },
  simpa only [succ_eq_add_one, cast_add, ←exp_mul_exp_eq_exp_add (k : A), ←h, cast_one,
    id_apply, rescale_one] using pow_succ' (exp A) k,
end

/-- Shows that
$\sum_{k = 0}^{n - 1} (e^{X})^k = \sum_{p = 0}^{\infty} \sum_{k = 0}^{n - 1} \frac{k^p}{p!}X^p$. -/
theorem exp_pow_sum [algebra ℚ A] (n : ℕ) : (finset.range n).sum (λ k, (exp A)^k) =
  power_series.mk (λ p, (finset.range n).sum (λ k, k^p * algebra_map ℚ A p.factorial⁻¹)) :=
begin
  simp only [exp_pow_eq_rescale_exp, rescale],
  ext,
  simp only [one_div, coeff_mk, coe_mk, coeff_exp, factorial, linear_map.map_sum],
end

end power_series


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll, Kalle Kytölä

! This file was ported from Lean 3 source module analysis.locally_convex.polar
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Field.Basic
import Mathbin.LinearAlgebra.SesquilinearForm
import Mathbin.Topology.Algebra.Module.WeakDual

/-!
# Polar set

In this file we define the polar set. There are different notions of the polar, we will define the
*absolute polar*. The advantage over the real polar is that we can define the absolute polar for
any bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`, where `𝕜` is a normed commutative ring and
`E` and `F` are modules over `𝕜`.

## Main definitions

* `linear_map.polar`: The polar of a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`.

## Main statements

* `linear_map.polar_eq_Inter`: The polar as an intersection.
* `linear_map.subset_bipolar`: The polar is a subset of the bipolar.
* `linear_map.polar_weak_closed`: The polar is closed in the weak topology induced by `B.flip`.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

polar
-/

variable {𝕜 E F : Type _}

open Topology

namespace LinearMap

section NormedRing

variable [NormedCommRing 𝕜] [AddCommMonoid E] [AddCommMonoid F]

variable [Module 𝕜 E] [Module 𝕜 F]

variable (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

/-- The (absolute) polar of `s : set E` is given by the set of all `y : F` such that `‖B x y‖ ≤ 1`
for all `x ∈ s`.-/
def polar (s : Set E) : Set F :=
  { y : F | ∀ x ∈ s, ‖B x y‖ ≤ 1 }
#align linear_map.polar LinearMap.polar

theorem polar_mem_iff (s : Set E) (y : F) : y ∈ B.polar s ↔ ∀ x ∈ s, ‖B x y‖ ≤ 1 :=
  Iff.rfl
#align linear_map.polar_mem_iff LinearMap.polar_mem_iff

theorem polar_mem (s : Set E) (y : F) (hy : y ∈ B.polar s) : ∀ x ∈ s, ‖B x y‖ ≤ 1 :=
  hy
#align linear_map.polar_mem LinearMap.polar_mem

@[simp]
theorem zero_mem_polar (s : Set E) : (0 : F) ∈ B.polar s := fun _ _ => by
  simp only [map_zero, norm_zero, zero_le_one]
#align linear_map.zero_mem_polar LinearMap.zero_mem_polar

theorem polar_eq_interᵢ {s : Set E} : B.polar s = ⋂ x ∈ s, { y : F | ‖B x y‖ ≤ 1 } :=
  by
  ext
  simp only [polar_mem_iff, Set.mem_interᵢ, Set.mem_setOf_eq]
#align linear_map.polar_eq_Inter LinearMap.polar_eq_interᵢ

/-- The map `B.polar : set E → set F` forms an order-reversing Galois connection with
`B.flip.polar : set F → set E`. We use `order_dual.to_dual` and `order_dual.of_dual` to express
that `polar` is order-reversing. -/
theorem polar_gc :
    GaloisConnection (OrderDual.toDual ∘ B.polar) (B.flip.polar ∘ OrderDual.ofDual) := fun s t =>
  ⟨fun h _ hx _ hy => h hy _ hx, fun h _ hx _ hy => h hy _ hx⟩
#align linear_map.polar_gc LinearMap.polar_gc

@[simp]
theorem polar_unionᵢ {ι} {s : ι → Set E} : B.polar (⋃ i, s i) = ⋂ i, B.polar (s i) :=
  B.polar_gc.l_supᵢ
#align linear_map.polar_Union LinearMap.polar_unionᵢ

@[simp]
theorem polar_union {s t : Set E} : B.polar (s ∪ t) = B.polar s ∩ B.polar t :=
  B.polar_gc.l_sup
#align linear_map.polar_union LinearMap.polar_union

theorem polar_antitone : Antitone (B.polar : Set E → Set F) :=
  B.polar_gc.monotone_l
#align linear_map.polar_antitone LinearMap.polar_antitone

@[simp]
theorem polar_empty : B.polar ∅ = Set.univ :=
  B.polar_gc.l_bot
#align linear_map.polar_empty LinearMap.polar_empty

@[simp]
theorem polar_zero : B.polar ({0} : Set E) = Set.univ :=
  by
  refine' set.eq_univ_iff_forall.mpr fun y x hx => _
  rw [set.mem_singleton_iff.mp hx, map_zero, LinearMap.zero_apply, norm_zero]
  exact zero_le_one
#align linear_map.polar_zero LinearMap.polar_zero

theorem subset_bipolar (s : Set E) : s ⊆ B.flip.polar (B.polar s) := fun x hx y hy =>
  by
  rw [B.flip_apply]
  exact hy x hx
#align linear_map.subset_bipolar LinearMap.subset_bipolar

@[simp]
theorem tripolar_eq_polar (s : Set E) : B.polar (B.flip.polar (B.polar s)) = B.polar s :=
  by
  refine' (B.polar_antitone (B.subset_bipolar s)).antisymm _
  convert subset_bipolar B.flip (B.polar s)
  exact B.flip_flip.symm
#align linear_map.tripolar_eq_polar LinearMap.tripolar_eq_polar

/-- The polar set is closed in the weak topology induced by `B.flip`. -/
theorem polar_weak_closed (s : Set E) : is_closed[WeakBilin.topologicalSpace B.flip] (B.polar s) :=
  by
  rw [polar_eq_Inter]
  refine' isClosed_interᵢ fun x => isClosed_interᵢ fun _ => _
  exact isClosed_le (WeakBilin.eval_continuous B.flip x).norm continuous_const
#align linear_map.polar_weak_closed LinearMap.polar_weak_closed

end NormedRing

section NontriviallyNormedField

variable [NontriviallyNormedField 𝕜] [AddCommMonoid E] [AddCommMonoid F]

variable [Module 𝕜 E] [Module 𝕜 F]

variable (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)

theorem polar_univ (h : SeparatingRight B) : B.polar Set.univ = {(0 : F)} :=
  by
  rw [Set.eq_singleton_iff_unique_mem]
  refine' ⟨by simp only [zero_mem_polar], fun y hy => h _ fun x => _⟩
  refine' norm_le_zero_iff.mp (le_of_forall_le_of_dense fun ε hε => _)
  rcases NormedField.exists_norm_lt 𝕜 hε with ⟨c, hc, hcε⟩
  calc
    ‖B x y‖ = ‖c‖ * ‖B (c⁻¹ • x) y‖ := by
      rw [B.map_smul, LinearMap.smul_apply, Algebra.id.smul_eq_mul, norm_mul, norm_inv,
        mul_inv_cancel_left₀ hc.ne']
    _ ≤ ε * 1 := (mul_le_mul hcε.le (hy _ trivial) (norm_nonneg _) hε.le)
    _ = ε := mul_one _

#align linear_map.polar_univ LinearMap.polar_univ

end NontriviallyNormedField

end LinearMap


import data.fintype.basic
import data.set
import data.finset
import tactic
import size

noncomputable theory
localized "attribute [instance, priority 100000] classical.prop_decidable
  noncomputable theory" in classical
open_locale classical
open finset

universes u v

@[ext]
structure matroid (γ : Type u) [fintype γ] :=
(r : finset γ → ℤ)
(R0 : ∀ (X : finset γ ), 0 ≤ r X)
(R1 : ∀ (X : finset γ), r X ≤ size X)
(R2 : ∀ {X Y : finset γ}, X ⊆ Y → r X ≤ r Y)
(R3 : ∀ (X Y : finset γ), r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y)

/-
type mismatch at application
  size X
term
  X
has type
  finset γ : Type u
but is expected to have type
  finset ?m_1 : Type
All Messages (115)
-/

namespace matroid
variables {γ : Type u} [fintype γ] (M : matroid γ)

abbreviation E (M : matroid γ) : finset γ := univ

@[simp]
lemma r_empty_eq_zero : M.r ∅ = 0 :=
by linarith [(M.R0 ∅), (M.R1 ∅), @size_empty γ]

@[simp]
lemma r_univ_compl_eq_zero : M.r M.Eᶜ = 0 :=
by { convert M.r_empty_eq_zero, convert_to ⊤ᶜ = _, simp only [compl_top], refl }

@[simp] lemma subset_E (X : finset γ) : X ⊆ M.E :=
subset_univ X

lemma r_subadditive (X Y : finset γ) : M.r (X ∪ Y) ≤ M.r X + M.r Y :=
by
  linarith [(M.R0 (X ∩ Y)), (M.R1 (X ∩ Y)), (M.R3 X Y)]

lemma r_le_union (X Y : finset γ) : M.r X ≤ M.r (X ∪ Y) :=
by { apply R2, apply subset_union_left }

lemma r_le_union_right (X Y : finset γ) : M.r Y ≤ M.r (X ∪ Y) :=
by { rw union_comm, apply r_le_union }

lemma r_compl (X : finset γ) : M.r M.E ≤ M.r X + M.r Xᶜ :=
begin
  convert M.R3 X Xᶜ,
  suffices h1 : X ∪ Xᶜ = univ,
  suffices h2 : X ∩ Xᶜ = ∅,
  rw [h1, h2, r_empty_eq_zero], simp,
  simp [compl_eq_univ_sdiff],
  simp [compl_eq_univ_sdiff, subset_univ],
end

lemma corank_le (M : matroid γ) (X : finset γ) : M.r M.E - M.r Xᶜ ≤ size X :=
begin
  have hxc := M.R2 (M.subset_E Xᶜ),
  have h1 := M.r_compl X,
  have h2 := M.R1 X,
  omega,
end

/--
The dual matroid
-/
def dual (M : matroid γ) : matroid γ :=
{ r := λ X, size X + M.r Xᶜ - M.r M.E,
  R0 := λ X, begin
    linarith [r_compl M X, M.R1 X],
  end,
  R1 := λ X,
  begin
    have h : M.r Xᶜ ≤ M.r M.E := M.R2 (subset_univ _),
    linarith,
  end,

  R2 := λ X Y hXY, begin
    -- want to show: |X| + r(E \ X) < |Y| + r(E \ Y)
    have YsetminusX : size (Y \ X) = size Y - size X,
    { exact size_sdiff hXY },
    have YC : Yᶜ ∪ (Y \ X) = Xᶜ ,
    { sorry },
    have rYC : M.r(Yᶜ ∪ (Y \ X)) = M.r(Xᶜ),
    { rw YC },
    linarith [(r_subadditive M Yᶜ (Y \ X)), M.R1 (Y \ X)],
  end,
  R3 := λ X Y, begin
    -- linarith [M.R3 Xᶜ Yᶜ, size_modular X Y],
    sorry,
  end }

end matroid
/--
A "submatroid" is the matroid restricted to a subset then contracted.
The rank function is then meant to be for subsets of `E` that contain
`F`.
-/

@[ext] structure minor {γ : Type u} [fintype γ] (M : matroid γ) :=
(C : finset γ)
(D : finset γ)
(H : C ∩ D = ∅)

namespace minor
variables {γ : Type u} [fintype γ] {M : matroid γ}
def r (M' : minor M) (X : finset γ) : ℤ := M.r (X ∪ M'.C) - M.r M'.C --This allows rank-evaluations of sets intersecting C ∪ D - maybe this is ok.

lemma R0 (M' : minor M) (X : finset γ) : 0 ≤ M'.r X :=
begin
  sorry
end

lemma R1 (M' : minor M) (X : finset γ) : M'.r X ≤ size X :=
begin
  sorry
end

lemma R2 (M' : minor M) {X Y : finset γ} (hX : X ⊆ Y) : M'.r X ≤ M'.r Y :=
begin
  sorry
end

lemma R3 (M' : minor M) (X Y : finset γ) : M'.r (X ∪ Y) + M'.r (X ∩ Y) ≤ M'.r X + M'.r Y :=
begin
  sorry
end

def to_matroid (M' : minor M) : matroid (↑(M.E \ M'.C \ M'.D) : set γ) :=
{ r := λ X, M'.r (X.map (function.embedding.subtype _)),
  R0 := λ X, M'.R0 (X.map (function.embedding.subtype _)),
  R1 := λ X, by { rw ← size_map, apply M'.R1 },
  R2 := λ X Y hs, M'.R2 (map_subset_map.mpr hs),
  R3 := λ X Y, by { rw [map_union, map_inter], apply M'.R3 } }
@[simp]
def delete (M' : minor M) (D' : finset γ) (H : D' ∩ (M'.C ∪ M'.D) = ∅) : minor M :=
{ C := M'.C , D := D' ∪ M'.D, H :=
begin
  have := M'.H,
  sorry,
end,
}
@[simp]
def contract (M' : minor M) (C': finset γ) (H: C' ∩ (M'.C ∪ M'.D) = ∅) : minor M :=
{ C := C' ∪ M'.C, D := M'.D, H := sorry,
}

def dual (M' : minor M) : minor M.dual :=
{ C := M'.D,
  D := M'.C,
  H := calc M'.D ∩ M'.C = M'.C ∩ M'.D : inter_comm M'.D M'.C ... = ∅ : M'.H,
}

instance : has_top (minor M) :=
{ top := { C := ∅, D := ∅, H := by tidy } }

end minor

@[ext]
structure submatroid {γ : Type u} [fintype γ] (M : matroid γ) :=
(E : finset γ)
(F : finset γ)
(F_sub : F ⊆ E . obviously)

namespace submatroid
variables {γ : Type u} [fintype γ] {M : matroid γ}

def r (M' : submatroid M) (X : finset γ) : ℤ := M.r (X ∪ M'.F) - M.r M'.F

lemma R1 (M' : submatroid M) (X : finset γ) : M'.r X ≤ size X :=
begin
  dunfold r,
  have h1 := M.R1 X,
  have h2 := M.r_subadditive X M'.F,
  omega,
end

lemma R2 (M' : submatroid M) {X Y : finset γ} (hX : X ⊆ Y) : M'.r X ≤ M'.r Y :=
begin
  dunfold r,
  have hX' : X ∪ M'.F ⊆ Y ∪ M'.F,
  { intro x, simp only [mem_union], intro h, cases h,
    left, exact hX h,
    right, exact h, },
  have h1 := M.R2 hX',
  omega,
end

lemma R3 (M' : submatroid M) (X Y : finset γ) : M'.r (X ∪ Y) + M'.r (X ∩ Y) ≤ M'.r X + M'.r Y :=
begin
  dunfold r,
  have h1 := M.R3 (X ∪ M'.F) (Y ∪ M'.F),
  have ha : X ∪ M'.F ∪ (Y ∪ M'.F) = X ∪ Y ∪ M'.F,
  { rw [union_assoc, union_assoc X Y], congr' 1,
    rw [union_comm, union_assoc], simp, },
  rw ha at h1,
  have hb : (X ∪ M'.F) ∩ (Y ∪ M'.F) = (X ∩ Y) ∪ M'.F,
  { rw union_distrib_right, },
  rw hb at h1,
  have h2 := M.r_le_union_right Y M'.F,
  have h3 := M.r_le_union_right X M'.F,
  have h4 := M.r_le_union_right (X ∪ Y) M'.F,
  have h5 := M.r_le_union_right (X ∩ Y) M'.F,
  omega,
end

def to_matroid (M' : submatroid M) : matroid (↑M'.E : set γ) :=
{ r := λ X, M'.r (X.map (function.embedding.subtype _)),
  R0 := sorry,
  R1 := λ X, by { rw ← size_map, apply M'.R1 },
  R2 := λ X Y hs, M'.R2 (map_subset_map.mpr hs),
  R3 := λ X Y, by { rw [map_union, map_inter], apply M'.R3 } }

instance : has_top (submatroid M) :=
{ top := { E := univ, F := ∅ } }

instance : has_bot (submatroid M) :=
{ bot := { E := ∅, F := ∅ } }

/--
Delete all of `D` from the given submatroid.
`D` is allowed have elements outside of `M'.E`.
To delete from a matroid `M`, there is also the definition `M.delete D`
to get a `submatroid M`.
-/
@[simp]
def delete (M' : submatroid M) (D : finset γ) : submatroid M :=
{ E := M'.E \ D, F := M'.F \ D,
  F_sub := begin
    intro x, simp only [and_imp, mem_sdiff],
    intros xel xnel, use M'.F_sub xel,
  end }

/--
Contract the elements of `C`.  `C` is allowed to have elements outside of `M'.E`.
-/
@[simp]
def contract (M' : submatroid M) (C : finset γ) : submatroid M :=
{ E := M'.E ∪ C, F := M'.F ∪ C,
  F_sub := begin
    intro x, simp only [mem_union], intro h',
    cases h', exact or.inl (M'.F_sub h'), exact or.inr h',
  end }

/--
This is a lemma that seems to be missing from mathlib. (Using a lazy proof for now.)
-/
lemma sdiff_sdiff_eq_sdiff_union (s t u : finset γ) : s \ t \ u = s \ (t ∪ u) :=
begin
  ext x, simp, push_neg, tidy,
end

lemma delete_delete_eq_delete (M' : submatroid M) (F F' : finset γ) :
  (M'.delete F).delete F' = M'.delete (F ∪ F') :=
begin
  ext1,
  repeat { dsimp [delete], apply sdiff_sdiff_eq_sdiff_union, },
end

lemma contract_contract_eq_contract (M' : submatroid M) (F F' : finset γ) :
  (M'.contract F).contract F' = M'.contract (F ∪ F') :=
begin
  ext, simp [contract], simp [contract],
end

def dual (M' : submatroid M) : submatroid M.dual :=
{ E := M.E \ M'.F,
  F := M.E \ M'.E,
  F_sub := begin
    intro x,
    simp only [true_and, mem_sdiff, mem_univ],
    contrapose, push_neg, intro h, exact M'.F_sub h,
  end }

lemma dual_contract (M' : submatroid M) (D : finset γ) :
  (M'.contract D).dual = M'.dual.delete D :=
begin
  ext, repeat { dsimp [contract, delete, dual], rw sdiff_sdiff_eq_sdiff_union, },
end

lemma dual_delete (M' : submatroid M) (D : finset γ) :
  (M'.delete D).dual = M'.dual.contract D :=
begin
  ext,
  dsimp [contract, delete, dual],
  simp only [true_and, mem_union, not_and, mem_sdiff, mem_univ, not_not],
  split,
  intro h', by_cases h'' : a ∈ M'.F, exact or.inr (h' h''), exact or.inl h'',
  intro h', cases h', cc, cc,
  dsimp [contract, delete, dual],
  simp only [true_and, mem_union, not_and, mem_sdiff, mem_univ, not_not],
  split,
  intro h', by_cases h'' : a ∈ M'.E, exact or.inr (h' h''), exact or.inl h'',
  intro h', cases h', cc, cc,
end

end submatroid

namespace matroid
variables {γ : Type u} [fintype γ]

/--
Deletion from a matroid, yielding a submatroid.
-/
def delete (M : matroid γ) (F : finset γ) : submatroid M :=
(⊤ : submatroid M).delete F

def contract (M : matroid γ) (F : finset γ) : submatroid M :=
(⊤ : submatroid M).contract F

@[simp] lemma dual_E_eq (M : matroid γ) : M.dual.E = M.E := rfl
@[simp] lemma dual_r_eq (M : matroid γ) (X : finset γ) : M.dual.r X = size X + M.r Xᶜ - M.r M.E := rfl

lemma dual_dual_eq (M : matroid γ) : M.dual.dual = M :=
begin
  ext X,
  change size X + M.dual.r Xᶜ - M.dual.r M.dual.E = M.r X,
  rw dual_E_eq, rw [dual_r_eq, dual_r_eq], simp [size_compl],
  have hh : type_size γ  = size M.E := begin sorry end,
  have h1 := M.R1 X, have h2 := M.R1 M.E,
  have h3 := M.subset_E X, have h4 := M.R2 h3,
  have h5 := size_le_of_subset h3,
  linarith,
end

@[simp]
def mdelete (M : matroid γ) (F : finset γ) : minor M :=
  { C := ∅, D := F, H := empty_inter F }

@[simp]
def mcontract (M : matroid γ) (F : finset γ) : minor M :=
  { C := F, D := ∅, H := inter_empty F }

lemma cd_rank_equal (M : matroid γ) (X : finset γ) : (delete M X).dual.r =
  (contract M.dual X).r :=
begin
  sorry,
end

lemma cd_matroid_equal (M : matroid γ) (X : finset γ) : (delete M X).dual== (contract M.dual X) :=
begin
  sorry,
end

--lemma something {C: finset γ} {D: finset γ} (h: C ∩ D = ∅) : D ∩ C = ∅ :=

def make_minor (M : matroid γ) (C D : finset γ) (h : C ∩ D = ∅) : minor M :=
  { C := C, D := D, H := h }

lemma mdelete_D (M : matroid γ) (D : finset γ) : (M.mdelete D).D = D := rfl

lemma clear_emptl {C D : finset γ} (h : C ∩ D = ∅) : C ∩ (∅ ∪ D) = ∅ := by tidy
lemma clear_emptr {C D : finset γ} (h : C ∩ D = ∅) : D ∩ (C ∪ ∅) = ∅ := sorry

lemma cd_eq_dc (M: matroid γ) (C: finset γ) (D: finset γ) (h: C ∩ D = ∅) :
  (minor.contract (mdelete M D) C (clear_emptl h)) =
  (minor.delete (mcontract M C) D (clear_emptr h)) :=
by apply minor.ext; simp

lemma cd_eq_dc_m (M: matroid γ) (C: finset γ) (D: finset γ) (h: C ∩ D = ∅) :
  minor.to_matroid (minor.contract (mdelete M D) C (clear_emptl h)) ==
  minor.to_matroid (minor.delete (mcontract M C) D (clear_emptr h)) := by rw cd_eq_dc

variables M : matroid γ
variables C D : finset γ
lemma cd_eq_dc_dual (M : matroid γ)  (C D : finset γ ) (h : C ∩ D = ∅) :
  (make_minor M C D h).dual = M.dual.make_minor D C (sorry : D ∩ C = ∅) :=
  begin
    unfold make_minor, tidy,
  end
lemma cd_eq_dc_dual_m (M : matroid γ)  (C D : finset γ ) (h : C ∩ D = ∅) :
(make_minor M C D h).dual.to_matroid = (M.dual.make_minor D C (sorry : D ∩ C = ∅)).to_matroid :=
begin
  unfold make_minor, tidy,
end

lemma dual_minors_r (M : matroid γ) (M' : minor M) :
  M'.dual.to_matroid.r == M'.to_matroid.dual.r :=
begin
  unfold minor.to_matroid,
  unfold minor.dual,
  unfold matroid.dual,
  simp,
  ext,
  tidy,
  have h: {x // x ∉ M'.C ∧ x ∉ M'.D} = {x // x ∉ M'.dual.C ∧ x ∉ M'.dual.D},
    apply congr_arg subtype,
    apply funext,
    intro x,
    apply propext,
    split,
    intro h,
    split,
    exact h.2,
    exact h.1,
    intro h,
    split,
    exact h.2,
    exact h.1,
rw h,
-- we r here nao

end

lemma dual_minors (M : matroid γ) (M' : minor M) :
  M'.dual.to_matroid == M'.to_matroid.dual :=
begin
  unfold minor.to_matroid,
  unfold minor.dual,
  unfold matroid.dual,

end

  /- (M \ D /  C)* = M* / D \ C -/
/-
{C := ∅, D := D, H := _}.contract C _).C = ({C := C, D := ∅, H := _}.delete D _).C
-/
/-
⊢ a ∈ ((M.mdelete D).contract C _).C ↔ a ∈ ((M.mcontract C).delete D _).C
γ: Type u
_inst_1: fintype γ
M: matroid γ
CD: finset γ
h: C ∩ D = ∅
a: γ
⊢ a ∈ ((M.mdelete D).contract C _).D ↔ a ∈ ((M.mcontract C).delete D _).D
-/

end matroid


import tactic

variable {α : Type*}
variables (s t u : set α)

-- BEGIN

example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  intros x hx,
  have xs : x ∈ s := hx.1,
  have xtu : x ∈ t ∪ u := hx.2,
  cases xtu with xt xu,
  { left,
    show x ∈ s ∩ t,
    exact ⟨xs, xt⟩ },
  right,
  show x ∈ s ∩ u,
  exact ⟨xs, xu⟩
end

/- Alternatively -/
example : s ∩ (t ∪ u) ⊆ (s ∩ t) ∪ (s ∩ u) :=
begin
  rintros x ⟨xs, xt | xu⟩,
  { left, exact ⟨xs, xt⟩ },
  right, exact ⟨xs, xu⟩
end

-- END


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.limits.shapes.kernels

/-!
# The abelian image and coimage.

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

In an abelian category we usually want the image of a morphism `f` to be defined as
`kernel (cokernel.π f)`, and the coimage to be defined as `cokernel (kernel.ι f)`.

We make these definitions here, as `abelian.image f` and `abelian.coimage f`
(without assuming the category is actually abelian),
and later relate these to the usual categorical notions when in an abelian category.

There is a canonical morphism `coimage_image_comparison : abelian.coimage f ⟶ abelian.image f`.
Later we show that this is always an isomorphism in an abelian category,
and conversely a category with (co)kernels and finite products in which this morphism
is always an isomorphism is an abelian category.
-/

noncomputable theory

universes v u

open category_theory
open category_theory.limits

namespace category_theory.abelian

variables {C : Type u} [category.{v} C] [has_zero_morphisms C] [has_kernels C] [has_cokernels C]
variables {P Q : C} (f : P ⟶ Q)

section image

/-- The kernel of the cokernel of `f` is called the (abelian) image of `f`. -/
protected abbreviation image : C := kernel (cokernel.π f)

/-- The inclusion of the image into the codomain. -/
protected abbreviation image.ι : abelian.image f ⟶ Q :=
kernel.ι (cokernel.π f)

/-- There is a canonical epimorphism `p : P ⟶ image f` for every `f`. -/
protected abbreviation factor_thru_image : P ⟶ abelian.image f :=
kernel.lift (cokernel.π f) f $ cokernel.condition f

/-- `f` factors through its image via the canonical morphism `p`. -/
@[simp, reassoc] protected lemma image.fac :
  abelian.factor_thru_image f ≫ image.ι f = f :=
kernel.lift_ι _ _ _

instance mono_factor_thru_image [mono f] : mono (abelian.factor_thru_image f) :=
mono_of_mono_fac $ image.fac f

end image

section coimage

/-- The cokernel of the kernel of `f` is called the (abelian) coimage of `f`. -/
protected abbreviation coimage : C := cokernel (kernel.ι f)

/-- The projection onto the coimage. -/
protected abbreviation coimage.π : P ⟶ abelian.coimage f :=
cokernel.π (kernel.ι f)

/-- There is a canonical monomorphism `i : coimage f ⟶ Q`. -/
protected abbreviation factor_thru_coimage : abelian.coimage f ⟶ Q :=
cokernel.desc (kernel.ι f) f $ kernel.condition f

/-- `f` factors through its coimage via the canonical morphism `p`. -/
protected lemma coimage.fac : coimage.π f ≫ abelian.factor_thru_coimage f = f :=
cokernel.π_desc _ _ _

instance epi_factor_thru_coimage [epi f] : epi (abelian.factor_thru_coimage f) :=
epi_of_epi_fac $ coimage.fac f

end coimage

/--
The canonical map from the abelian coimage to the abelian image.
In any abelian category this is an isomorphism.

Conversely, any additive category with kernels and cokernels and
in which this is always an isomorphism, is abelian.

See <https://stacks.math.columbia.edu/tag/0107>
-/
def coimage_image_comparison : abelian.coimage f ⟶ abelian.image f :=
cokernel.desc (kernel.ι f) (kernel.lift (cokernel.π f) f (by simp)) $ (by { ext, simp, })

/--
An alternative formulation of the canonical map from the abelian coimage to the abelian image.
-/
def coimage_image_comparison' : abelian.coimage f ⟶ abelian.image f :=
kernel.lift (cokernel.π f) (cokernel.desc (kernel.ι f) f (by simp)) (by { ext, simp, })

lemma coimage_image_comparison_eq_coimage_image_comparison' :
  coimage_image_comparison f = coimage_image_comparison' f :=
by { ext, simp [coimage_image_comparison, coimage_image_comparison'], }

@[simp, reassoc]
lemma coimage_image_factorisation :
  coimage.π f ≫ coimage_image_comparison f ≫ image.ι f = f :=
by simp [coimage_image_comparison]

end category_theory.abelian


import category_theory.category -- this transitively imports
-- category_theory.category
-- category_theory.functor
-- category_theory.natural_transformation
import category_theory.isomorphism
import category_theory.groupoid
import tactic

open category_theory

universes v u

variables (C : Type u) [category.{v} C]

--variables {W X Y Z : C}
--variables (f : X ⟶ Y) (g : Y ⟶ X) (h : Y ⟶ X)

/-Exercise 1.1.i-/
/-(i) Show that a morphism can have at most one inverse isomorphism-/

lemma at_most_one_inv {X Y : C} (f : X ⟶ Y) (g : Y ⟶ X) [is_iso g]:
f ≫ g = 𝟙 X → f = inv g:=
begin
    intro h1,
    calc f = f ≫ 𝟙 Y :
        by {rw [category.comp_id]}
        ... = f ≫ g ≫ inv g :
        by {rw [is_iso.hom_inv_id]}
        ... = 𝟙 X ≫ inv g:
        by {symmetry' at h1, rw [h1, category.assoc]}
        ... = inv g:
        by {rw [category.id_comp]}
end

/-(ii) Consider a morphism f: x ⟶ y. Show that if there exists a pair of morphisms
g, h : y ⟶ x so that gf = 𝟙 x and fg = 𝟙 y, then g = h and f is an isomorphism.-/

lemma left_right_inv_eq {X Y : C} (f : X ⟶ Y) (g : Y ⟶ X) (h : Y ⟶ X) :
f ≫ g = 𝟙 X ∧ h ≫ f = 𝟙 Y → g = h :=
begin
    intro h1,
    cases h1 with hgx hhy,
    calc g = 𝟙 Y ≫ g :
    by {rw [category.id_comp]}
    ... = h ≫ f ≫ g :
    by {symmetry' at hhy, rw [hhy, category.assoc]}
    ... = h ≫ 𝟙 X :
    by {rw [hgx]}
    ... = h :
    by {rw [category.comp_id]}
end

def left_right_inv_iso {X Y : C} (f : X ⟶ Y) (g : Y ⟶ X) (h : Y ⟶ X) [is_iso g] [is_iso h]:
f ≫ g = 𝟙 X ∧ h ≫ f = 𝟙 Y → is_iso f :=
begin
    intro h1,
    cases h1 with hgx hhy,
    have hg : g = h :=
        -- not proud of this one
        by {apply left_right_inv_eq, split, exact hgx, exact hhy},
    rw hg at hgx,
    have h2 : f = inv h :=
        by {apply at_most_one_inv, exact hgx},
    rw h2,
    apply is_iso.inv_is_iso,
end

/-Exercise 1.1.ii-/
/-Let C be a category. Show that the collection of isomorphisms in C defines a
subcategory, the maximal groupoid inside C.-/
--To do:
-- define objects (all obj of C)
-- define morphisms (just isomorphisms of C)
-- show that all morphisms have dom/cod? (spoiler: they do, we have all objects)
-- identity morphisms (again, they are isomorphisms)
-- closure of composite morphisms - probably the only hard part in Lean

def identity_is_iso (X : C) : is_iso (𝟙 X) :=
{ inv := 𝟙 X,
  hom_inv_id' := by rw [category.id_comp],
  inv_hom_id' := by rw [category.id_comp]}

-- need f.hom ≫ g.hom ≫ g.inv ≫ f.inv = 𝟙 X and vice versa
def iso_comp_is_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [is_iso g] :
is_iso (f ≫ g) :=
{ inv := (inv g ≫ inv f),
  hom_inv_id' := by rw [← category.assoc, category.assoc f, is_iso.hom_inv_id, category.comp_id, is_iso.hom_inv_id],
  inv_hom_id' := by rw [← category.assoc, category.assoc (inv g), is_iso.inv_hom_id, category.comp_id, is_iso.inv_hom_id]}

def core (C : Type u) : Type u := C --objects are elements of type core C
variable (X : core C)
#check X --nice

-- don't think I need to show that it's a groupoid?

instance has_hom : core C :=
{ hom := is_iso }

instance core_groupoid : groupoid.{v} (core C) := {
  hom := /-λ X Y : core C, X ⟶ Y-/sorry,
  id := by apply identity_is_iso,
  comp := _,
  id_comp' := _,
  comp_id' := _,
  assoc' := _,
  inv := _,
  inv_comp' := _,
  comp_inv' := _ } --hhhhh

/-Exercise 1.1.iii For any category C and any object A ∈ C, show that:-/

/-(i) There is a category A/C whose objects are morphisms f : A ⟶ X
with domain A and in which a morphism from f : A ⟶ X to g : A ⟶ Y
is a map h : X ⟶ Y such that g = hf.-/

/-instance unop_mono_of_epi {A B : Cᵒᵖ} (f : A ⟶ B) [epi f] : mono f.unop :=
⟨λ Z g h eq, has_hom.hom.op_inj ((cancel_epi f).1 (has_hom.hom.unop_inj eq))⟩-/

--goal:
/-
class category_struct (obj : Type u)
extends has_hom.{v} obj : Type (max u (v+1)) :=
(id       : Π X : obj, hom X X)
(comp     : Π {X Y Z : obj}, (X ⟶ Y) → (Y ⟶ Z) → (X ⟶ Z))

class category (obj : Type u)
extends category_struct.{v} obj : Type (max u (v+1)) :=
(id_comp' : ∀ {X Y : obj} (f : hom X Y), 𝟙 X ≫ f = f . obviously)
(comp_id' : ∀ {X Y : obj} (f : hom X Y), f ≫ 𝟙 Y = f . obviously)
(assoc'   : ∀ {W X Y Z : obj} (f : hom W X) (g : hom X Y) (h : hom Y Z),
  (f ≫ g) ≫ h = f ≫ (g ≫ h) . obviously)-/

--ugh
/-class slice_struct (A : C) (obj : Type v) extends has_slice_hom.{v} obj : Type (max v (v+1)) :=
(id : Π {X : C}, (A ⟶ X) : obj, hom (A ⟶ X) (A ⟶ X). obviously)
(comp : Π {(A ⟶ X) (A ⟶ Y) (A ⟶ Z): AC}, (A ⟶ X) ⟶ (A ⟶ Y))-/

/-class slice (obj : Type u) extends category.{v} obj : Type (max u (v+1)) :=
(inv       : Π {X Y : obj}, (X ⟶ Y) → (Y ⟶ X))
(inv_comp' : ∀ {X Y : obj} (f : X ⟶ Y), comp (inv f) f = id Y . obviously)
(comp_inv' : ∀ {X Y : obj} (f : X ⟶ Y), comp f (inv f) = id X . obviously)-/