/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import algebra.char_p.invertible
import data.zmod.basic
import field_theory.finite.basic
import ring_theory.localization.fraction_ring
import ring_theory.polynomial.chebyshev

/-!
# Dickson polynomials

The (generalised) Dickson polynomials are a family of polynomials indexed by `ℕ × ℕ`,
with coefficients in a commutative ring `R` depending on an element `a∈R`. More precisely, the
they satisfy the recursion `dickson k a (n + 2) = X * (dickson k a n + 1) - a * (dickson k a n)`
with starting values `dickson k a 0 = 3 - k` and `dickson k a 1 = X`. In the literature,
`dickson k a n` is called the `n`-th Dickson polynomial of the `k`-th kind associated to the
parameter `a : R`. They are closely related to the Chebyshev polynomials in the case that `a=1`.
When `a=0` they are just the family of monomials `X ^ n`.

## Main definition

* `polynomial.dickson`: the generalised Dickson polynomials.

## Main statements

* `polynomial.dickson_one_one_mul`, the `(m * n)`-th Dickson polynomial of the first kind for
  parameter `1 : R` is the composition of the `m`-th and `n`-th Dickson polynomials of the first
  kind for `1 : R`.
* `polynomial.dickson_one_one_char_p`, for a prime number `p`, the `p`-th Dickson polynomial of the
  first kind associated to parameter `1 : R` is congruent to `X ^ p` modulo `p`.

## References

* [R. Lidl, G. L. Mullen and G. Turnwald, _Dickson polynomials_][MR1237403]

## TODO

* Redefine `dickson` in terms of `linear_recurrence`.
* Show that `dickson 2 1` is equal to the characteristic polynomial of the adjacency matrix of a
  type A Dynkin diagram.
* Prove that the adjacency matrices of simply laced Dynkin diagrams are precisely the adjacency
  matrices of simple connected graphs which annihilate `dickson 2 1`.
-/

noncomputable theory

namespace polynomial
open_locale polynomial

variables {R S : Type*} [comm_ring R] [comm_ring S] (k : ℕ) (a : R)

/-- `dickson` is the `n`the (generalised) Dickson polynomial of the `k`-th kind associated to the
element `a ∈ R`. -/
noncomputable def dickson : ℕ → R[X]
| 0       := 3 - k
| 1       := X
| (n + 2) := X * dickson (n + 1) - (C a) * dickson n

@[simp] lemma dickson_zero : dickson k a 0 = 3 - k := rfl
@[simp] lemma dickson_one : dickson k a 1 = X := rfl
lemma dickson_two : dickson k a 2 = X ^ 2 - C a * (3 - k) :=
by simp only [dickson, sq]
@[simp] lemma dickson_add_two (n : ℕ) :
  dickson k a (n + 2) = X * dickson k a (n + 1) - C a * dickson k a n :=
by rw dickson

lemma dickson_of_two_le {n : ℕ} (h : 2 ≤ n) :
  dickson k a n = X * dickson k a (n - 1) - C a * dickson k a (n - 2) :=
begin
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
  rw add_comm,
  exact dickson_add_two k a n
end

variables {R S k a}

lemma map_dickson (f : R →+* S) :
  ∀ (n : ℕ), map f (dickson k a n) = dickson k (f a) n
| 0       := by simp only [dickson_zero, map_sub, polynomial.map_nat_cast,
                            bit1, bit0, map_add, map_one]
| 1       := by simp only [dickson_one, map_X]
| (n + 2) :=
begin
  simp only [dickson_add_two, map_sub, map_mul, map_X, map_C],
  rw [map_dickson, map_dickson]
end

variable {R}

@[simp] lemma dickson_two_zero :
  ∀ (n : ℕ), dickson 2 (0 : R) n = X ^ n
| 0       := by { simp only [dickson_zero, pow_zero], norm_num }
| 1       := by simp only [dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [dickson_add_two, C_0, zero_mul, sub_zero],
  rw [dickson_two_zero, pow_add X (n + 1) 1, mul_comm, pow_one]
end

section dickson
/-!

### A Lambda structure on `polynomial ℤ`

Mathlib doesn't currently know what a Lambda ring is.
But once it does, we can endow `polynomial ℤ` with a Lambda structure
in terms of the `dickson 1 1` polynomials defined below.
There is exactly one other Lambda structure on `polynomial ℤ` in terms of binomial polynomials.

-/

variables {R}

lemma dickson_one_one_eval_add_inv (x y : R) (h : x * y = 1) :
  ∀ n, (dickson 1 (1 : R) n).eval (x + y) = x ^ n + y ^ n
| 0       := by { simp only [bit0, eval_one, eval_add, pow_zero, dickson_zero], norm_num }
| 1       := by simp only [eval_X, dickson_one, pow_one]
| (n + 2) :=
begin
  simp only [eval_sub, eval_mul, dickson_one_one_eval_add_inv, eval_X, dickson_add_two, C_1,
    eval_one],
  conv_lhs { simp only [pow_succ, add_mul, mul_add, h, ← mul_assoc, mul_comm y x, one_mul] },
  ring_exp
end

variables (R)

lemma dickson_one_one_eq_chebyshev_T [invertible (2 : R)] :
  ∀ n, dickson 1 (1 : R) n = 2 * (chebyshev.T R n).comp (C (⅟2) * X)
| 0       := by { simp only [chebyshev.T_zero, mul_one, one_comp, dickson_zero], norm_num }
| 1       := by rw [dickson_one, chebyshev.T_one, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
                    mul_inv_of_self, C_1, one_mul]
| (n + 2) :=
begin
  simp only [dickson_add_two, chebyshev.T_add_two, dickson_one_one_eq_chebyshev_T (n + 1),
    dickson_one_one_eq_chebyshev_T n, sub_comp, mul_comp, add_comp, X_comp, bit0_comp, one_comp],
  simp only [← C_1, ← C_bit0, ← mul_assoc, ← C_mul, mul_inv_of_self],
  rw [C_1, one_mul],
  ring
end

lemma chebyshev_T_eq_dickson_one_one [invertible (2 : R)] (n : ℕ) :
  chebyshev.T R n = C (⅟2) * (dickson 1 1 n).comp (2 * X) :=
begin
  rw dickson_one_one_eq_chebyshev_T,
  simp only [comp_assoc, mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul],
  rw [inv_of_mul_self, C_1, one_mul, one_mul, comp_X]
end

/-- The `(m * n)`-th Dickson polynomial of the first kind is the composition of the `m`-th and
`n`-th. -/
lemma dickson_one_one_mul (m n : ℕ) :
  dickson 1 (1 : R) (m * n) = (dickson 1 1 m).comp (dickson 1 1 n) :=
begin
  have h : (1 : R) = int.cast_ring_hom R (1),
    simp only [ring_hom.eq_int_cast, int.cast_one],
  rw h,
  simp only [← map_dickson (int.cast_ring_hom R), ← map_comp],
  congr' 1,
  apply map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_dickson, map_comp, ring_hom.eq_int_cast, int.cast_one,
    dickson_one_one_eq_chebyshev_T, chebyshev.T_mul, two_mul, ← add_comp],
  simp only [← two_mul, ← comp_assoc],
  apply eval₂_congr rfl rfl,
  rw [comp_assoc],
  apply eval₂_congr rfl _ rfl,
  rw [mul_comp, C_comp, X_comp, ← mul_assoc, ← C_1, ← C_bit0, ← C_mul,
      inv_of_mul_self, C_1, one_mul]
end

lemma dickson_one_one_comp_comm (m n : ℕ) :
  (dickson 1 (1 : R) m).comp (dickson 1 1 n) = (dickson 1 1 n).comp (dickson 1 1 m) :=
by rw [← dickson_one_one_mul, mul_comm, dickson_one_one_mul]

lemma dickson_one_one_zmod_p (p : ℕ) [fact p.prime] :
  dickson 1 (1 : zmod p) p = X ^ p :=
begin
  -- Recall that `dickson_eval_add_inv` characterises `dickson 1 1 p`
  -- as a polynomial that maps `x + x⁻¹` to `x ^ p + (x⁻¹) ^ p`.
  -- Since `X ^ p` also satisfies this property in characteristic `p`,
  -- we can use a variant on `polynomial.funext` to conclude that these polynomials are equal.
  -- For this argument, we need an arbitrary infinite field of characteristic `p`.
  obtain ⟨K, _, _, H⟩ : ∃ (K : Type) (_ : field K), by exactI ∃ (_ : char_p K p), infinite K,
  { let K := fraction_ring (polynomial (zmod p)),
    let f : zmod p →+* K := (algebra_map _ (fraction_ring _)).comp C,
    haveI : char_p K p, { rw ← f.char_p_iff_char_p, apply_instance },
    haveI : infinite K :=
    infinite.of_injective (algebra_map (polynomial (zmod p)) (fraction_ring (polynomial (zmod p))))
      (is_fraction_ring.injective _ _),
    refine ⟨K, _, _, _⟩; apply_instance },
  resetI,
  apply map_injective (zmod.cast_hom (dvd_refl p) K) (ring_hom.injective _),
  rw [map_dickson, polynomial.map_pow, map_X],
  apply eq_of_infinite_eval_eq,
  -- The two polynomials agree on all `x` of the form `x = y + y⁻¹`.
  apply @set.infinite.mono _ {x : K | ∃ y, x = y + y⁻¹ ∧ y ≠ 0},
  { rintro _ ⟨x, rfl, hx⟩,
    simp only [eval_X, eval_pow, set.mem_set_of_eq, @add_pow_char K _ p,
      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow₀, zmod.cast_hom_apply,
      zmod.cast_one'] },
  -- Now we need to show that the set of such `x` is infinite.
  -- If the set is finite, then we will show that `K` is also finite.
  { intro h,
    rw ← set.infinite_univ_iff at H,
    apply H,
    -- To each `x` of the form `x = y + y⁻¹`
    -- we `bind` the set of `y` that solve the equation `x = y + y⁻¹`.
    -- For every `x`, that set is finite (since it is governed by a quadratic equation).
    -- For the moment, we claim that all these sets together cover `K`.
    suffices : (set.univ : set K) =
      {x : K | ∃ (y : K), x = y + y⁻¹ ∧ y ≠ 0} >>= (λ x, {y | x = y + y⁻¹ ∨ y = 0}),
    { rw this, clear this,
      refine h.bUnion (λ x hx, _),
      -- The following quadratic polynomial has as solutions the `y` for which `x = y + y⁻¹`.
      let φ : K[X] := X ^ 2 - C x * X + 1,
      have hφ : φ ≠ 0,
      { intro H,
        have : φ.eval 0 = 0, by rw [H, eval_zero],
        simpa [eval_X, eval_one, eval_pow, eval_sub, sub_zero, eval_add,
          eval_mul, mul_zero, sq, zero_add, one_ne_zero] },
      classical,
      convert (φ.roots ∪ {0}).to_finset.finite_to_set using 1,
      ext1 y,
      simp only [multiset.mem_to_finset, set.mem_set_of_eq, finset.mem_coe, multiset.mem_union,
        mem_roots hφ, is_root, eval_add, eval_sub, eval_pow, eval_mul, eval_X, eval_C, eval_one,
        multiset.mem_singleton],
      by_cases hy : y = 0,
      { simp only [hy, eq_self_iff_true, or_true] },
      apply or_congr _ iff.rfl,
      rw [← mul_left_inj' hy, eq_comm, ← sub_eq_zero, add_mul, inv_mul_cancel hy],
      apply eq_iff_eq_cancel_right.mpr,
      ring },
    -- Finally, we prove the claim that our finite union of finite sets covers all of `K`.
    { apply (set.eq_univ_of_forall _).symm,
      intro x,
      simp only [exists_prop, set.mem_Union, set.bind_def, ne.def, set.mem_set_of_eq],
      by_cases hx : x = 0,
      { simp only [hx, and_true, eq_self_iff_true, inv_zero, or_true],
        exact ⟨_, 1, rfl, one_ne_zero⟩ },
      { simp only [hx, or_false, exists_eq_right],
        exact ⟨_, rfl, hx⟩ } } }
end

lemma dickson_one_one_char_p (p : ℕ) [fact p.prime] [char_p R p] :
  dickson 1 (1 : R) p = X ^ p :=
begin
  have h : (1 : R) = zmod.cast_hom (dvd_refl p) R (1),
    simp only [zmod.cast_hom_apply, zmod.cast_one'],
  rw [h, ← map_dickson (zmod.cast_hom (dvd_refl p) R), dickson_one_one_zmod_p,
      polynomial.map_pow, map_X]
end

end dickson

end polynomial


/-
Copyright (c) 2021 Martin Dvorak. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Martin Dvorak, Kyle Miller, Eric Wieser
-/

import data.matrix.notation
import linear_algebra.bilinear_map
import linear_algebra.matrix.determinant
import algebra.lie.basic

/-!
# Cross products

This module defines the cross product of vectors in $R^3$ for $R$ a commutative ring,
as a bilinear map.

## Main definitions

* `cross_product` is the cross product of pairs of vectors in $R^3$.

## Main results

* `triple_product_eq_det`
* `cross_dot_cross`
* `jacobi_cross`

## Notation

The locale `matrix` gives the following notation:

* `×₃` for the cross product

## Tags

crossproduct
-/

open matrix
open_locale matrix

variables {R : Type*} [comm_ring R]

/-- The cross product of two vectors in $R^3$ for $R$ a commutative ring. -/
def cross_product : (fin 3 → R) →ₗ[R] (fin 3 → R) →ₗ[R] (fin 3 → R) :=
begin
  apply linear_map.mk₂ R (λ (a b : fin 3 → R),
    ![a 1 * b 2 - a 2 * b 1,
      a 2 * b 0 - a 0 * b 2,
      a 0 * b 1 - a 1 * b 0]),
  { intros,
    simp [vec3_add (_ : R), add_comm, add_assoc, add_left_comm, add_mul, sub_eq_add_neg] },
  { intros,
    simp [smul_vec3 (_ : R) (_ : R), mul_comm, mul_assoc, mul_left_comm, mul_add, sub_eq_add_neg] },
  { intros,
    simp [vec3_add (_ : R), add_comm, add_assoc, add_left_comm, mul_add, sub_eq_add_neg] },
  { intros,
    simp [smul_vec3 (_ : R) (_ : R), mul_comm, mul_assoc, mul_left_comm, mul_add, sub_eq_add_neg] },
end

localized "infixl (name := cross_product) ` ×₃ `: 74 := cross_product" in matrix

lemma cross_apply (a b : fin 3 → R) :
  a ×₃ b = ![a 1 * b 2 - a 2 * b 1,
             a 2 * b 0 - a 0 * b 2,
             a 0 * b 1 - a 1 * b 0] :=
rfl

section products_properties

@[simp] lemma cross_anticomm (v w : fin 3 → R) :
  - (v ×₃ w) = w ×₃ v :=
by simp [cross_apply, mul_comm]
alias cross_anticomm ← neg_cross

@[simp] lemma cross_anticomm' (v w : fin 3 → R) :
  v ×₃ w + w ×₃ v = 0 :=
by rw [add_eq_zero_iff_eq_neg, cross_anticomm]

@[simp] lemma cross_self (v : fin 3 → R) :
  v ×₃ v = 0 :=
by simp [cross_apply, mul_comm]

/-- The cross product of two vectors is perpendicular to the first vector. -/
@[simp] lemma dot_self_cross (v w : fin 3 → R) :
  v ⬝ᵥ (v ×₃ w) = 0 :=
by simp [cross_apply, vec3_dot_product, mul_sub, mul_assoc, mul_left_comm]

/-- The cross product of two vectors is perpendicular to the second vector. -/
@[simp] lemma dot_cross_self (v w : fin 3 → R) :
  w ⬝ᵥ (v ×₃ w) = 0 :=
by rw [← cross_anticomm, matrix.dot_product_neg, dot_self_cross, neg_zero]

/-- Cyclic permutations preserve the triple product. See also `triple_product_eq_det`. -/
lemma triple_product_permutation (u v w : fin 3 → R) :
  u ⬝ᵥ (v ×₃ w) = v ⬝ᵥ (w ×₃ u) :=
begin
  simp only [cross_apply, vec3_dot_product,
    matrix.head_cons, matrix.cons_vec_bit0_eq_alt0, matrix.empty_vec_append, matrix.cons_val_one,
    matrix.cons_vec_alt0, matrix.cons_vec_append, matrix.cons_val_zero],
  ring,
end

/-- The triple product of `u`, `v`, and `w` is equal to the determinant of the matrix
    with those vectors as its rows. -/
theorem triple_product_eq_det (u v w : fin 3 → R) :
  u ⬝ᵥ (v ×₃ w) = matrix.det ![u, v, w] :=
begin
  simp only [vec3_dot_product, cross_apply, matrix.det_fin_three,
    matrix.head_cons, matrix.cons_vec_bit0_eq_alt0, matrix.empty_vec_alt0, matrix.cons_vec_alt0,
    matrix.vec_head_vec_alt0, matrix.vec_append_apply_zero, matrix.empty_vec_append,
    matrix.cons_vec_append, matrix.cons_val', matrix.cons_val_one, matrix.cons_val_zero],
  ring,
end

/-- The scalar quadruple product identity, related to the Binet-Cauchy identity. -/
theorem cross_dot_cross (u v w x : fin 3 → R) :
  (u ×₃ v) ⬝ᵥ (w ×₃ x) = (u ⬝ᵥ w) * (v ⬝ᵥ x) - (u ⬝ᵥ x) * (v ⬝ᵥ w) :=
begin
  simp only [vec3_dot_product, cross_apply, cons_vec_append, cons_vec_bit0_eq_alt0,
    cons_val_one, cons_vec_alt0, linear_map.mk₂_apply, cons_val_zero, head_cons, empty_vec_append],
  ring_nf,
end

end products_properties

section leibniz_properties

/-- The cross product satisfies the Leibniz lie property. -/
lemma leibniz_cross (u v w : fin 3 → R) :
  u ×₃ (v ×₃ w) = (u ×₃ v) ×₃ w + v ×₃ (u ×₃ w) :=
begin
  dsimp only [cross_apply],
  ext i,
  fin_cases i; norm_num; ring,
end

/-- The three-dimensional vectors together with the operations + and ×₃ form a Lie ring.
    Note we do not make this an instance as a conflicting one already exists
    via `lie_ring.of_associative_ring`. -/
def cross.lie_ring : lie_ring (fin 3 → R) :=
{ bracket := λ u v, u ×₃ v,
  add_lie := linear_map.map_add₂ _,
  lie_add := λ u, linear_map.map_add _,
  lie_self := cross_self,
  leibniz_lie := leibniz_cross,
  ..pi.add_comm_group }

local attribute [instance] cross.lie_ring

lemma cross_cross (u v w : fin 3 → R) :
  (u ×₃ v) ×₃ w = u ×₃ (v ×₃ w) - v ×₃ (u ×₃ w) :=
lie_lie u v w

/-- Jacobi identity: For a cross product of three vectors,
    their sum over the three even permutations is equal to the zero vector. -/
theorem jacobi_cross (u v w : fin 3 → R) :
  u ×₃ (v ×₃ w) + v ×₃ (w ×₃ u) + w ×₃ (u ×₃ v) = 0 :=
lie_jacobi u v w

end leibniz_properties


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import algebra.group.defs
import logic.relation

/-!
# Shapes of homological complexes

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

We define a structure `complex_shape ι` for describing the shapes of homological complexes
indexed by a type `ι`.
This is intended to capture chain complexes and cochain complexes, indexed by either `ℕ` or `ℤ`,
as well as more exotic examples.

Rather than insisting that the indexing type has a `succ` function
specifying where differentials should go,
inside `c : complex_shape` we have `c.rel : ι → ι → Prop`,
and when we define `homological_complex`
we only allow nonzero differentials `d i j` from `i` to `j` if `c.rel i j`.
Further, we require that `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons.
This means that the shape consists of some union of lines, rays, intervals, and circles.

Convenience functions `c.next` and `c.prev` provide these related elements
when they exist, and return their input otherwise.

This design aims to avoid certain problems arising from dependent type theory.
In particular we never have to ensure morphisms `d i : X i ⟶ X (succ i)` compose as
expected (which would often require rewriting by equations in the indexing type).
Instead such identities become separate proof obligations when verifying that a
complex we've constructed is of the desired shape.

If `α` is an `add_right_cancel_semigroup`, then we define `up α : complex_shape α`,
the shape appropriate for cohomology,so `d : X i ⟶ X j` is nonzero only when `j = i + 1`,
as well as `down α : complex_shape α`, appropriate for homology,
so `d : X i ⟶ X j` is nonzero only when `i = j + 1`.
(Later we'll introduce `cochain_complex` and `chain_complex` as abbreviations for
`homological_complex` with one of these shapes baked in.)
-/

open_locale classical
noncomputable theory

/--
A `c : complex_shape ι` describes the shape of a chain complex,
with chain groups indexed by `ι`.
Typically `ι` will be `ℕ`, `ℤ`, or `fin n`.

There is a relation `rel : ι → ι → Prop`,
and we will only allow a non-zero differential from `i` to `j` when `rel i j`.

There are axioms which imply `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons.
This means that the shape consists of some union of lines, rays, intervals, and circles.

Below we define `c.next` and `c.prev` which provide these related elements.
-/
@[ext, nolint has_nonempty_instance]
structure complex_shape (ι : Type*) :=
(rel : ι → ι → Prop)
(next_eq : ∀ {i j j'}, rel i j → rel i j' → j = j')
(prev_eq : ∀ {i i' j}, rel i j → rel i' j → i = i')

namespace complex_shape
variables {ι : Type*}

/--
The complex shape where only differentials from each `X.i` to itself are allowed.

This is mostly only useful so we can describe the relation of "related in `k` steps" below.
-/
@[simps]
def refl (ι : Type*) : complex_shape ι :=
{ rel := λ i j, i = j,
  next_eq := λ i j j' w w', w.symm.trans w',
  prev_eq := λ i i' j w w', w.trans w'.symm, }

/--
The reverse of a `complex_shape`.
-/
@[simps]
def symm (c : complex_shape ι) : complex_shape ι :=
{ rel := λ i j, c.rel j i,
  next_eq := λ i j j' w w', c.prev_eq w w',
  prev_eq := λ i i' j w w', c.next_eq w w', }

@[simp]
lemma symm_symm (c : complex_shape ι) : c.symm.symm = c :=
by { ext, simp, }

/--
The "composition" of two `complex_shape`s.

We need this to define "related in k steps" later.
-/
@[simp]
def trans (c₁ c₂ : complex_shape ι) : complex_shape ι :=
{ rel := relation.comp c₁.rel c₂.rel,
  next_eq := λ i j j' w w',
  begin
    obtain ⟨k, w₁, w₂⟩ := w,
    obtain ⟨k', w₁', w₂'⟩ := w',
    rw c₁.next_eq w₁ w₁' at w₂,
    exact c₂.next_eq w₂ w₂',
  end,
  prev_eq := λ i i' j w w',
  begin
    obtain ⟨k, w₁, w₂⟩ := w,
    obtain ⟨k', w₁', w₂'⟩ := w',
    rw c₂.prev_eq w₂ w₂' at w₁,
    exact c₁.prev_eq w₁ w₁',
  end }

instance subsingleton_next (c : complex_shape ι) (i : ι) :
  subsingleton { j // c.rel i j } :=
begin
  fsplit,
  rintros ⟨j, rij⟩ ⟨k, rik⟩,
  congr,
  exact c.next_eq rij rik,
end

instance subsingleton_prev (c : complex_shape ι) (j : ι) :
  subsingleton { i // c.rel i j } :=
begin
  fsplit,
  rintros ⟨i, rik⟩ ⟨j, rjk⟩,
  congr,
  exact c.prev_eq rik rjk,
end

/--
An arbitary choice of index `j` such that `rel i j`, if such exists.
Returns `i` otherwise.
-/
def next (c : complex_shape ι) (i : ι) : ι :=
if h : ∃ j, c.rel i j then h.some else i

/--
An arbitary choice of index `i` such that `rel i j`, if such exists.
Returns `j` otherwise.
-/
def prev (c : complex_shape ι) (j : ι) : ι :=
if h : ∃ i, c.rel i j then h.some else j

lemma next_eq' (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.next i = j :=
by { apply c.next_eq _ h, dsimp only [next], rw dif_pos, exact Exists.some_spec ⟨j, h⟩, }

lemma prev_eq' (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.prev j = i :=
by { apply c.prev_eq _ h, dsimp only [prev], rw dif_pos, exact Exists.some_spec ⟨i, h⟩, }

/--
The `complex_shape` allowing differentials from `X i` to `X (i+a)`.
(For example when `a = 1`, a cohomology theory indexed by `ℕ` or `ℤ`)
-/
@[simps]
def up' {α : Type*} [add_right_cancel_semigroup α] (a : α) : complex_shape α :=
{ rel := λ i j , i + a = j,
  next_eq := λ i j k hi hj, hi.symm.trans hj,
  prev_eq := λ i j k hi hj, add_right_cancel (hi.trans hj.symm), }

/--
The `complex_shape` allowing differentials from `X (j+a)` to `X j`.
(For example when `a = 1`, a homology theory indexed by `ℕ` or `ℤ`)
-/
@[simps]
def down' {α : Type*} [add_right_cancel_semigroup α] (a : α) : complex_shape α :=
{ rel := λ i j , j + a = i,
  next_eq := λ i j k hi hj, add_right_cancel (hi.trans (hj.symm)),
  prev_eq := λ i j k hi hj, hi.symm.trans hj, }

lemma down'_mk {α : Type*} [add_right_cancel_semigroup α] (a : α)
  (i j : α) (h : j + a = i) : (down' a).rel i j := h

/--
The `complex_shape` appropriate for cohomology, so `d : X i ⟶ X j` only when `j = i + 1`.
-/
@[simps]
def up (α : Type*) [add_right_cancel_semigroup α] [has_one α] : complex_shape α :=
up' 1

/--
The `complex_shape` appropriate for homology, so `d : X i ⟶ X j` only when `i = j + 1`.
-/
@[simps]
def down (α : Type*) [add_right_cancel_semigroup α] [has_one α] : complex_shape α :=
down' 1

lemma down_mk {α : Type*} [add_right_cancel_semigroup α] [has_one α]
  (i j : α) (h : j + 1 = i) : (down α).rel i j :=
down'_mk (1 : α) i j h

end complex_shape


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

! This file was ported from Lean 3 source module category_theory.punit
! leanprover-community/mathlib commit 2738d2ca56cbc63be80c3bd48e9ed90ad94e947d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Const
import Mathlib.CategoryTheory.DiscreteCategory

/-!
# The category `Discrete PUnit`

We define `star : C ⥤ Discrete PUnit` sending everything to `PUnit.star`,
show that any two functors to `Discrete PUnit` are naturally isomorphic,
and construct the equivalence `(Discrete PUnit ⥤ C) ≌ C`.
-/

universe v u

-- morphism levels before object levels. See note [CategoryTheory universes].
namespace CategoryTheory

variable (C : Type u) [Category.{v} C]

namespace Functor

/-- The constant functor sending everything to `PUnit.star`. -/
@[simps!]
def star : C ⥤ Discrete PUnit :=
  (Functor.const _).obj ⟨⟨⟩⟩
#align category_theory.functor.star CategoryTheory.Functor.star
-- Porting note: simp can simplify this
attribute [nolint simpNF] star_map_down_down
variable {C}

/-- Any two functors to `Discrete PUnit` are isomorphic. -/
@[simps!]
def pUnitExt (F G : C ⥤ Discrete PUnit) : F ≅ G := by
  refine NatIso.ofComponents (fun X => eqToIso ?_) fun {X} {Y} f => ?_
  · simp only [eq_iff_true_of_subsingleton]
  · aesop_cat
#align category_theory.functor.punit_ext CategoryTheory.Functor.pUnitExt
-- Porting note: simp does indeed fire for these despite the linter warning
attribute [nolint simpNF] pUnitExt_hom_app_down_down pUnitExt_inv_app_down_down

/-- Any two functors to `Discrete PUnit` are *equal*.
You probably want to use `pUnitExt` instead of this. -/
theorem pUnit_ext' (F G : C ⥤ Discrete PUnit) : F = G := by
  refine Functor.ext (fun X => ?_) fun {X} {Y} f => ?_
  · simp only [eq_iff_true_of_subsingleton]
  · aesop_cat
#align category_theory.functor.punit_ext' CategoryTheory.Functor.pUnit_ext'

/-- The functor from `Discrete PUnit` sending everything to the given object. -/
abbrev fromPUnit (X : C) : Discrete PUnit.{v + 1} ⥤ C :=
  (Functor.const _).obj X
#align category_theory.functor.from_punit CategoryTheory.Functor.fromPUnit

/-- Functors from `Discrete PUnit` are equivalent to the category itself. -/
@[simps]
def equiv : Discrete PUnit ⥤ C ≌ C where
  functor :=
    { obj := fun F => F.obj ⟨⟨⟩⟩
      map := fun θ => θ.app ⟨⟨⟩⟩ }
  inverse := Functor.const _
  unitIso := by
    apply NatIso.ofComponents _ _
    intro X
    apply Discrete.natIso
    rintro ⟨⟨⟩⟩
    apply Iso.refl _
    intros
    ext ⟨⟨⟩⟩
    simp
  counitIso := by
    refine' NatIso.ofComponents Iso.refl _
    intro X Y f
    dsimp; simp
#align category_theory.functor.equiv CategoryTheory.Functor.equiv

-- See note [dsimp, simp].
end Functor

/-- A category being equivalent to `PUnit` is equivalent to it having a unique morphism between
  any two objects. (In fact, such a category is also a groupoid;
  see `CategoryTheory.Groupoid.ofHomUnique`) -/
theorem equiv_pUnit_iff_unique :
    Nonempty (C ≌ Discrete PUnit) ↔ Nonempty C ∧ ∀ x y : C, Nonempty <| Unique (x ⟶ y) := by
  constructor
  · rintro ⟨h⟩
    refine' ⟨⟨h.inverse.obj ⟨⟨⟩⟩⟩, fun x y => Nonempty.intro _⟩
    let f : x ⟶  y := by
      have hx : x ⟶ h.inverse.obj ⟨⟨⟩⟩ := by convert h.unit.app x
      have hy : h.inverse.obj ⟨⟨⟩⟩ ⟶ y := by convert h.unitInv.app y
      exact hx ≫ hy
    suffices sub : Subsingleton (x ⟶  y) from uniqueOfSubsingleton f
    have : ∀ z, z = h.unit.app x ≫ (h.functor ⋙ h.inverse).map z ≫ h.unitInv.app y := by
      intro z
      simp [congrArg (· ≫ h.unitInv.app y) (h.unit.naturality z)]
    apply Subsingleton.intro
    intro a b
    rw [this a, this b]
    simp only [Functor.comp_map]
    congr 3
    apply ULift.ext
    simp
  · rintro ⟨⟨p⟩, h⟩
    haveI := fun x y => (h x y).some
    refine'
      Nonempty.intro
        (CategoryTheory.Equivalence.mk ((Functor.const _).obj ⟨⟨⟩⟩)
          ((@Functor.const <| Discrete PUnit).obj p) ?_ (by apply Functor.pUnitExt))
    exact
      NatIso.ofComponents
        (fun _ =>
          { hom := default
            inv := default })
        fun {X} {Y} f => by aesop_cat
#align category_theory.equiv_punit_iff_unique CategoryTheory.equiv_pUnit_iff_unique

end CategoryTheory


import combinatorics.simple_graph.basic

open finset
universes u v w

namespace simple_graph
variables {𝕜 : Type*} {V : Type u} {W : Type v} {X : Type w} (G : simple_graph V)
  (G' : simple_graph W) {a b c u v w : V} {e : sym2 V}
/-!

# Intro to Graph Theory

If you're familiar with graph theory, you may have already noticed that we've narrowed down to
a specific definition of a graph that actually doesn't encompass everything that graph theory
has to offer. For the scope of this project (unless someone suggests otherwise, of course!)
we'll be focusing on *simple* graphs - they're graphs with properties that make them nice to work
with.

Traditionally, the definition of a simple graph is a vertex type V and edge type E such that
* no vertex has an edge to itself (irreflexive)
* for every pair of vertices u, v ∈ V, if u has an edge to v, v has an edge to u (symmetric)
* no two vertices can have more than one edge between them

So the way we've defined this in Lean is a bit different. Instead of having an explicit edge type,
we have an adjacency relation between pairs of vertices that says either they're adjacent or they're
not. The definition looks like this:
```
structure simple_graph (V : Type u) :=
(adj : V → V → Prop)
(symm : symmetric adj . obviously)
(loopless : irreflexive adj . obviously)
```

Let's prove some simple lemmas about it!
-/

-- v is not adjacent to itself
lemma irrefl' {v : V} : ¬G.adj v v :=
begin
  sorry,
end

-- If u is adjacent to v, then v is adjacent to u
lemma adj_symm' (h : G.adj u v) : G.adj v u :=
begin
  sorry,
end

-- This is just the same as the last lemma, but in an iff form
lemma adj_comm' (u v : V) : G.adj u v ↔ G.adj v u :=
begin
  sorry,
end

-- If two vertices are adjacent, then they're not equal
lemma ne_of_adj' (h : G.adj a b) : a ≠ b :=
begin
  sorry,
end

-- if v is adjacent to x and w is not adjacent to x, then v ≠ w
lemma ne_of_adj_of_not_adj' {v w x : V} (h : G.adj v x) (hn : ¬ G.adj w x) : v ≠ w :=
begin
  sorry,
end

/-!
See if you can complete the definitions of the complete graph and the empty graph!
-/

def complete_graph' (V : Type u) : simple_graph V := {
  adj := ne, -- `ne` is "not equal", so the relation is that a pair of vertices
              -- is adjacent if they're not equal
  symm :=
    begin
      sorry,
    end
  loopless :=
    begin
      sorry,
    end }

def empty_graph' (V : Type u) : simple_graph V := {
  adj := λ i j, false, -- in other words, for every pair of vertices, adjacency between them is "false"
  symm :=
    begin
      sorry,
    end
  loopless :=
    begin
      sorry,
    end }

/-!
The complement Gᶜ of a graph G is defined as a graph on V where, for every pair of vertices
v, w that are adjacent in G, they are *NOT* adjacent in Gᶜ, and for every pair of nonadjacent
vertices in G, they *ARE* adjacent in Gᶜ.

Now, note that we have to be a bit more careful with this definition when we're talking
about simple graphs! Remember that a graph is simple when it doesn't contain any loops,
i.e. v is not adjacent to itself. However, if we blindly take the complement as defined above,
v will be adjacent to itself in Gᶜ! So we have to explicitly specify that it's not adjacent
when we take the complement.
-/
instance : has_compl (simple_graph V) := ⟨λ G,
  { adj := λ v w, v ≠ w ∧ ¬G.adj v w, -- we include v ≠ w so that we're not accidentally
                                      -- creating loops in our definition.
    symm :=
      begin
        sorry,
      end
    loopless :=
      begin
        sorry,
      end }⟩

/-!
You'll notice that we don't actually define a simple graph as having a distinct edge type.
Rather, we've made the edges implicit in the definition by saying we have an adjacency relation
between the vertices, and then the edge type emerges from that as a set of unordered pairs of
vertices that are related, like so:
```
def edge_set : set (sym2 V) := sym2.from_rel G.symm
```

Tricky problem: See if you can prove that two vertices are adjacent if and only if there is a
corresponding element in the edge set of G! (Hint: I've included some helper lemmas!)
-/

-- vertices v, w are adjacent iff v is not equal to w and there is an edge in G
-- such that v, w ∈ e
lemma adj_iff_exists_edge' {v w : V} :
  G.adj v w ↔ v ≠ w ∧ ∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e :=
begin
  sorry,
end

/-!
Now we're gonna look at some basic definitions we need to talk about properties of graphs.

```
def neighbor_set (v : V) : set V := set_of (G.adj v)
```
-/

-- a vertex w is in the neighbor set of vertex v iff v and w are adjacent
lemma mem_neighbor_set' (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w :=
begin
  sorry,
end

/-!
```
def incidence_set (v : V) : set (sym2 V) := {e ∈ G.edge_set | v ∈ e}
```
-/

-- the incidence set of a vertex is a subset of the graph's edge set
lemma incidence_set_subset' (v : V) : G.incidence_set v ⊆ G.edge_set :=
begin
  sorry,
end

-- an edge vw is in the incidence set of v iff v and w are adjacent
lemma mk_mem_incidence_set_left_iff' : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ G.adj v w :=
begin
  sorry,
end

-- an edge vw is in the incidence set of w iff v and w are adjacent
lemma mk_mem_incidence_set_right_iff' : ⟦(v, w)⟧ ∈ G.incidence_set w ↔ G.adj v w :=
begin
  sorry,
end

-- an edge vw is in the incidence set of v iff w is in the neighbor set of v
lemma mem_incidence_iff_neighbor' {v w : V} : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ w ∈ G.neighbor_set v :=
begin
  sorry,
end

end simple_graph


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

! This file was ported from Lean 3 source module logic.unique
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Basic
import Mathbin.Logic.IsEmpty

/-!
# Types with a unique term

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

In this file we define a typeclass `unique`,
which expresses that a type has a unique term.
In other words, a type that is `inhabited` and a `subsingleton`.

## Main declaration

* `unique`: a typeclass that expresses that a type has a unique term.

## Main statements

* `unique.mk'`: an inhabited subsingleton type is `unique`. This can not be an instance because it
  would lead to loops in typeclass inference.

* `function.surjective.unique`: if the domain of a surjective function is `unique`, then its
  codomain is `unique` as well.

* `function.injective.subsingleton`: if the codomain of an injective function is `subsingleton`,
  then its domain is `subsingleton` as well.

* `function.injective.unique`: if the codomain of an injective function is `subsingleton` and its
  domain is `inhabited`, then its domain is `unique`.

## Implementation details

The typeclass `unique α` is implemented as a type,
rather than a `Prop`-valued predicate,
for good definitional properties of the default term.

-/

universe u v w

variable {α : Sort u} {β : Sort v} {γ : Sort w}

#print Unique /-
/-- `unique α` expresses that `α` is a type with a unique term `default`.

This is implemented as a type, rather than a `Prop`-valued predicate,
for good definitional properties of the default term. -/
@[ext]
structure Unique (α : Sort u) extends Inhabited α where
  uniq : ∀ a : α, a = default
#align unique Unique
-/

attribute [class] Unique

#print unique_iff_exists_unique /-
theorem unique_iff_exists_unique (α : Sort u) : Nonempty (Unique α) ↔ ∃! a : α, True :=
  ⟨fun ⟨u⟩ => ⟨u.default, trivial, fun a _ => u.uniq a⟩, fun ⟨a, _, h⟩ =>
    ⟨⟨⟨a⟩, fun _ => h _ trivial⟩⟩⟩
#align unique_iff_exists_unique unique_iff_exists_unique
-/

#print unique_subtype_iff_exists_unique /-
theorem unique_subtype_iff_exists_unique {α} (p : α → Prop) :
    Nonempty (Unique (Subtype p)) ↔ ∃! a, p a :=
  ⟨fun ⟨u⟩ => ⟨u.default.1, u.default.2, fun a h => congr_arg Subtype.val (u.uniq ⟨a, h⟩)⟩,
    fun ⟨a, ha, he⟩ =>
    ⟨⟨⟨⟨a, ha⟩⟩, fun ⟨b, hb⟩ => by
        congr
        exact he b hb⟩⟩⟩
#align unique_subtype_iff_exists_unique unique_subtype_iff_exists_unique
-/

#print uniqueOfSubsingleton /-
/-- Given an explicit `a : α` with `[subsingleton α]`, we can construct
a `[unique α]` instance. This is a def because the typeclass search cannot
arbitrarily invent the `a : α` term. Nevertheless, these instances are all
equivalent by `unique.subsingleton.unique`.

See note [reducible non-instances]. -/
@[reducible]
def uniqueOfSubsingleton {α : Sort _} [Subsingleton α] (a : α) : Unique α
    where
  default := a
  uniq _ := Subsingleton.elim _ _
#align unique_of_subsingleton uniqueOfSubsingleton
-/

#print PUnit.unique /-
instance PUnit.unique : Unique PUnit.{u}
    where
  default := PUnit.unit
  uniq x := PUnit.subsingleton x _
#align punit.unique PUnit.unique
-/

#print PUnit.default_eq_unit /-
@[simp]
theorem PUnit.default_eq_unit : (default : PUnit) = PUnit.unit :=
  rfl
#align punit.default_eq_star PUnit.default_eq_unit
-/

#print uniqueProp /-
/-- Every provable proposition is unique, as all proofs are equal. -/
def uniqueProp {p : Prop} (h : p) : Unique p
    where
  default := h
  uniq x := rfl
#align unique_prop uniqueProp
-/

instance : Unique True :=
  uniqueProp trivial

#print Fin.eq_zero /-
theorem Fin.eq_zero : ∀ n : Fin 1, n = 0
  | ⟨n, hn⟩ => Fin.eq_of_veq (Nat.eq_zero_of_le_zero (Nat.le_of_lt_succ hn))
#align fin.eq_zero Fin.eq_zero
-/

instance {n : ℕ} : Inhabited (Fin n.succ) :=
  ⟨0⟩

#print inhabitedFinOneAdd /-
instance inhabitedFinOneAdd (n : ℕ) : Inhabited (Fin (1 + n)) :=
  ⟨⟨0, Nat.zero_lt_one_add n⟩⟩
#align inhabited_fin_one_add inhabitedFinOneAdd
-/

#print Fin.default_eq_zero /-
@[simp]
theorem Fin.default_eq_zero (n : ℕ) : (default : Fin n.succ) = 0 :=
  rfl
#align fin.default_eq_zero Fin.default_eq_zero
-/

#print Fin.unique /-
instance Fin.unique : Unique (Fin 1) :=
  { Fin.inhabited with uniq := Fin.eq_zero }
#align fin.unique Fin.unique
-/

namespace Unique

open Function

section

variable [Unique α]

-- see Note [lower instance priority]
instance (priority := 100) : Inhabited α :=
  toInhabited ‹Unique α›

#print Unique.eq_default /-
theorem eq_default (a : α) : a = default :=
  uniq _ a
#align unique.eq_default Unique.eq_default
-/

#print Unique.default_eq /-
theorem default_eq (a : α) : default = a :=
  (uniq _ a).symm
#align unique.default_eq Unique.default_eq
-/

-- see Note [lower instance priority]
instance (priority := 100) : Subsingleton α :=
  subsingleton_of_forall_eq _ eq_default

#print Unique.forall_iff /-
theorem forall_iff {p : α → Prop} : (∀ a, p a) ↔ p default :=
  ⟨fun h => h _, fun h x => by rwa [Unique.eq_default x]⟩
#align unique.forall_iff Unique.forall_iff
-/

#print Unique.exists_iff /-
theorem exists_iff {p : α → Prop} : Exists p ↔ p default :=
  ⟨fun ⟨a, ha⟩ => eq_default a ▸ ha, Exists.intro default⟩
#align unique.exists_iff Unique.exists_iff
-/

end

#print Unique.subsingleton_unique' /-
@[ext]
protected theorem subsingleton_unique' : ∀ h₁ h₂ : Unique α, h₁ = h₂
  | ⟨⟨x⟩, h⟩, ⟨⟨y⟩, _⟩ => by congr <;> rw [h x, h y]
#align unique.subsingleton_unique' Unique.subsingleton_unique'
-/

#print Unique.subsingleton_unique /-
instance subsingleton_unique : Subsingleton (Unique α) :=
  ⟨Unique.subsingleton_unique'⟩
#align unique.subsingleton_unique Unique.subsingleton_unique
-/

#print Unique.mk' /-
/-- Construct `unique` from `inhabited` and `subsingleton`. Making this an instance would create
a loop in the class inheritance graph. -/
@[reducible]
def mk' (α : Sort u) [h₁ : Inhabited α] [Subsingleton α] : Unique α :=
  { h₁ with uniq := fun x => Subsingleton.elim _ _ }
#align unique.mk' Unique.mk'
-/

end Unique

#print unique_iff_subsingleton_and_nonempty /-
theorem unique_iff_subsingleton_and_nonempty (α : Sort u) :
    Nonempty (Unique α) ↔ Subsingleton α ∧ Nonempty α :=
  ⟨fun ⟨u⟩ => by constructor <;> exact inferInstance, fun ⟨hs, hn⟩ =>
    ⟨by
      skip
      inhabit α
      exact Unique.mk' α⟩⟩
#align unique_iff_subsingleton_and_nonempty unique_iff_subsingleton_and_nonempty
-/

#print Pi.default_def /-
@[simp]
theorem Pi.default_def {β : α → Sort v} [∀ a, Inhabited (β a)] :
    @default (∀ a, β a) _ = fun a : α => @default (β a) _ :=
  rfl
#align pi.default_def Pi.default_def
-/

#print Pi.default_apply /-
theorem Pi.default_apply {β : α → Sort v} [∀ a, Inhabited (β a)] (a : α) :
    @default (∀ a, β a) _ a = default :=
  rfl
#align pi.default_apply Pi.default_apply
-/

/- warning: pi.unique -> Pi.unique is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : α -> Sort.{u2}} [_inst_1 : forall (a : α), Unique.{u2} (β a)], Unique.{imax u1 u2} (forall (a : α), β a)
but is expected to have type
  forall {α : Sort.{u2}} {β : α -> Sort.{u1}} [_inst_1 : forall (a : α), Unique.{u1} (β a)], Unique.{imax u2 u1} (forall (a : α), β a)
Case conversion may be inaccurate. Consider using '#align pi.unique Pi.uniqueₓ'. -/
instance Pi.unique {β : α → Sort v} [∀ a, Unique (β a)] : Unique (∀ a, β a) :=
  { Pi.inhabited α with uniq := fun f => funext fun x => Unique.eq_default _ }
#align pi.unique Pi.unique

/- warning: pi.unique_of_is_empty -> Pi.uniqueOfIsEmpty is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} [_inst_1 : IsEmpty.{u1} α] (β : α -> Sort.{u2}), Unique.{imax u1 u2} (forall (a : α), β a)
but is expected to have type
  forall {α : Sort.{u2}} [_inst_1 : IsEmpty.{u2} α] (β : α -> Sort.{u1}), Unique.{imax u2 u1} (forall (a : α), β a)
Case conversion may be inaccurate. Consider using '#align pi.unique_of_is_empty Pi.uniqueOfIsEmptyₓ'. -/
/-- There is a unique function on an empty domain. -/
instance Pi.uniqueOfIsEmpty [IsEmpty α] (β : α → Sort v) : Unique (∀ a, β a)
    where
  default := isEmptyElim
  uniq f := funext isEmptyElim
#align pi.unique_of_is_empty Pi.uniqueOfIsEmpty

/- warning: eq_const_of_unique -> eq_const_of_unique is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} [_inst_1 : Unique.{u1} α] (f : α -> β), Eq.{imax u1 u2} (α -> β) f (Function.const.{u2, u1} β α (f (Inhabited.default.{u1} α (Unique.inhabited.{u1} α _inst_1))))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} [_inst_1 : Unique.{u2} α] (f : α -> β), Eq.{imax u2 u1} (α -> β) f (Function.const.{u1, u2} β α (f (Inhabited.default.{u2} α (Unique.instInhabited.{u2} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align eq_const_of_unique eq_const_of_uniqueₓ'. -/
theorem eq_const_of_unique [Unique α] (f : α → β) : f = Function.const α (f default) :=
  by
  ext x
  rw [Subsingleton.elim x default]
#align eq_const_of_unique eq_const_of_unique

#print heq_const_of_unique /-
theorem heq_const_of_unique [Unique α] {β : α → Sort v} (f : ∀ a, β a) :
    HEq f (Function.const α (f default)) :=
  Function.hfunext rfl fun i _ _ => by rw [Subsingleton.elim i default]
#align heq_const_of_unique heq_const_of_unique
-/

namespace Function

variable {f : α → β}

/- warning: function.injective.subsingleton -> Function.Injective.subsingleton is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {f : α -> β}, (Function.Injective.{u1, u2} α β f) -> (forall [_inst_1 : Subsingleton.{u2} β], Subsingleton.{u1} α)
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {f : α -> β}, (Function.Injective.{u2, u1} α β f) -> (forall [_inst_1 : Subsingleton.{u1} β], Subsingleton.{u2} α)
Case conversion may be inaccurate. Consider using '#align function.injective.subsingleton Function.Injective.subsingletonₓ'. -/
/-- If the codomain of an injective function is a subsingleton, then the domain
is a subsingleton as well. -/
protected theorem Injective.subsingleton (hf : Injective f) [Subsingleton β] : Subsingleton α :=
  ⟨fun x y => hf <| Subsingleton.elim _ _⟩
#align function.injective.subsingleton Function.Injective.subsingleton

/- warning: function.surjective.subsingleton -> Function.Surjective.subsingleton is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {f : α -> β} [_inst_1 : Subsingleton.{u1} α], (Function.Surjective.{u1, u2} α β f) -> (Subsingleton.{u2} β)
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}} {f : α -> β} [_inst_1 : Subsingleton.{u2} α], (Function.Surjective.{u2, u1} α β f) -> (Subsingleton.{u1} β)
Case conversion may be inaccurate. Consider using '#align function.surjective.subsingleton Function.Surjective.subsingletonₓ'. -/
/-- If the domain of a surjective function is a subsingleton, then the codomain is a subsingleton as
well. -/
protected theorem Surjective.subsingleton [Subsingleton α] (hf : Surjective f) : Subsingleton β :=
  ⟨hf.Forall₂.2 fun x y => congr_arg f <| Subsingleton.elim x y⟩
#align function.surjective.subsingleton Function.Surjective.subsingleton

#print Function.Surjective.unique /-
/-- If the domain of a surjective function is a singleton,
then the codomain is a singleton as well. -/
protected def Surjective.unique (hf : Surjective f) [Unique α] : Unique β :=
  @Unique.mk' _ ⟨f default⟩ hf.Subsingleton
#align function.surjective.unique Function.Surjective.unique
-/

#print Function.Injective.unique /-
/-- If `α` is inhabited and admits an injective map to a subsingleton type, then `α` is `unique`. -/
protected def Injective.unique [Inhabited α] [Subsingleton β] (hf : Injective f) : Unique α :=
  @Unique.mk' _ _ hf.Subsingleton
#align function.injective.unique Function.Injective.unique
-/

#print Function.Surjective.uniqueOfSurjectiveConst /-
/-- If a constant function is surjective, then the codomain is a singleton. -/
def Surjective.uniqueOfSurjectiveConst (α : Type _) {β : Type _} (b : β)
    (h : Function.Surjective (Function.const α b)) : Unique β :=
  @uniqueOfSubsingleton _ (subsingleton_of_forall_eq b <| h.forall.mpr fun _ => rfl) b
#align function.surjective.unique_of_surjective_const Function.Surjective.uniqueOfSurjectiveConst
-/

end Function

/- warning: unique.bijective -> Unique.bijective is a dubious translation:
lean 3 declaration is
  forall {A : Sort.{u1}} {B : Sort.{u2}} [_inst_1 : Unique.{u1} A] [_inst_2 : Unique.{u2} B] {f : A -> B}, Function.Bijective.{u1, u2} A B f
but is expected to have type
  forall {A : Sort.{u2}} {B : Sort.{u1}} [_inst_1 : Unique.{u2} A] [_inst_2 : Unique.{u1} B] {f : A -> B}, Function.Bijective.{u2, u1} A B f
Case conversion may be inaccurate. Consider using '#align unique.bijective Unique.bijectiveₓ'. -/
theorem Unique.bijective {A B} [Unique A] [Unique B] {f : A → B} : Function.Bijective f :=
  by
  rw [Function.bijective_iff_has_inverse]
  refine' ⟨default, _, _⟩ <;> intro x <;> simp
#align unique.bijective Unique.bijective

namespace Option

#print Option.subsingleton_iff_isEmpty /-
/-- `option α` is a `subsingleton` if and only if `α` is empty. -/
theorem subsingleton_iff_isEmpty {α} : Subsingleton (Option α) ↔ IsEmpty α :=
  ⟨fun h => ⟨fun x => Option.noConfusion <| @Subsingleton.elim _ h x none⟩, fun h =>
    ⟨fun x y => Option.casesOn x (Option.casesOn y rfl fun x => h.elim x) fun x => h.elim x⟩⟩
#align option.subsingleton_iff_is_empty Option.subsingleton_iff_isEmpty
-/

instance {α} [IsEmpty α] : Unique (Option α) :=
  @Unique.mk' _ _ (subsingleton_iff_isEmpty.2 ‹_›)

end Option

section Subtype

#print Unique.subtypeEq /-
instance Unique.subtypeEq (y : α) : Unique { x // x = y }
    where
  default := ⟨y, rfl⟩
  uniq := fun ⟨x, hx⟩ => by simpa using hx
#align unique.subtype_eq Unique.subtypeEq
-/

#print Unique.subtypeEq' /-
instance Unique.subtypeEq' (y : α) : Unique { x // y = x }
    where
  default := ⟨y, rfl⟩
  uniq := fun ⟨x, hx⟩ => by simpa using hx.symm
#align unique.subtype_eq' Unique.subtypeEq'
-/

end Subtype


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot

Intervals

Naming conventions:
  `i`: infinite
  `o`: open
  `c`: closed

Each interval has the name `I` + letter for left side + letter for right side

TODO: This is just the beginning; a lot of rules are missing
-/
import data.set.lattice algebra.order algebra.order_functions
import tactic.linarith

namespace set

open set

section intervals
variables {α : Type*} [preorder α] {a a₁ a₂ b b₁ b₂ x : α}

/-- Left-open right-open interval -/
def Ioo (a b : α) := {x | a < x ∧ x < b}

/-- Left-closed right-open interval -/
def Ico (a b : α) := {x | a ≤ x ∧ x < b}

/-- Left-infinite right-open interval -/
def Iio (a : α) := {x | x < a}

/-- Left-closed right-closed interval -/
def Icc (a b : α) := {x | a ≤ x ∧ x ≤ b}

/-- Left-infinite right-closed interval -/
def Iic (b : α) := {x | x ≤ b}

/-- Left-open right-closed interval -/
def Ioc (a b : α) := {x | a < x ∧ x ≤ b}

/-- Left-closed right-infinite interval -/
def Ici (a : α) := {x | a ≤ x}

/-- Left-open right-infinite interval -/
def Ioi (a : α) := {x | a < x}

@[simp] lemma mem_Ioo : x ∈ Ioo a b ↔ a < x ∧ x < b := iff.rfl
@[simp] lemma mem_Ico : x ∈ Ico a b ↔ a ≤ x ∧ x < b := iff.rfl
@[simp] lemma mem_Iio : x ∈ Iio b ↔ x < b := iff.rfl
@[simp] lemma mem_Icc : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b := iff.rfl
@[simp] lemma mem_Iic : x ∈ Iic b ↔ x ≤ b := iff.rfl
@[simp] lemma mem_Ioc : x ∈ Ioc a b ↔ a < x ∧ x ≤ b := iff.rfl
@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := iff.rfl
@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := iff.rfl

@[simp] lemma Ioo_eq_empty (h : b ≤ a) : Ioo a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨h₁, h₂⟩, not_le_of_lt (lt_trans h₁ h₂) h

@[simp] lemma Ico_eq_empty (h : b ≤ a) : Ico a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨h₁, h₂⟩, not_le_of_lt (lt_of_le_of_lt h₁ h₂) h

@[simp] lemma Icc_eq_empty (h : b < a) : Icc a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨h₁, h₂⟩, not_lt_of_le (le_trans h₁ h₂) h

@[simp] lemma Ioc_eq_empty (h : b ≤ a) : Ioc a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨h₁, h₂⟩, not_lt_of_le (le_trans h₂ h) h₁

@[simp] lemma Ioo_self (a : α) : Ioo a a = ∅ := Ioo_eq_empty $ le_refl _
@[simp] lemma Ico_self (a : α) : Ico a a = ∅ := Ico_eq_empty $ le_refl _

lemma Iio_ne_empty [no_bot_order α] (a : α) : Iio a ≠ ∅ :=
ne_empty_iff_exists_mem.2 (no_bot a)

lemma Ioi_ne_empty [no_top_order α] (a : α) : Ioi a ≠ ∅ :=
ne_empty_iff_exists_mem.2 (no_top a)

lemma Iic_ne_empty (b : α) : Iic b ≠ ∅ :=
ne_empty_iff_exists_mem.2 ⟨b, le_refl b⟩

lemma Ici_ne_empty (a : α) : Ici a ≠ ∅ :=
ne_empty_iff_exists_mem.2 ⟨a, le_refl a⟩

lemma Ioo_subset_Ioo (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Ioo a₁ b₁ ⊆ Ioo a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨lt_of_le_of_lt h₁ hx₁, lt_of_lt_of_le hx₂ h₂⟩

lemma Ioo_subset_Ioo_left (h : a₁ ≤ a₂) : Ioo a₂ b ⊆ Ioo a₁ b :=
Ioo_subset_Ioo h (le_refl _)

lemma Ioo_subset_Ioo_right (h : b₁ ≤ b₂) : Ioo a b₁ ⊆ Ioo a b₂ :=
Ioo_subset_Ioo (le_refl _) h

lemma Ico_subset_Ico (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨le_trans h₁ hx₁, lt_of_lt_of_le hx₂ h₂⟩

lemma Ico_subset_Ico_left (h : a₁ ≤ a₂) : Ico a₂ b ⊆ Ico a₁ b :=
Ico_subset_Ico h (le_refl _)

lemma Ico_subset_Ico_right (h : b₁ ≤ b₂) : Ico a b₁ ⊆ Ico a b₂ :=
Ico_subset_Ico (le_refl _) h

lemma Icc_subset_Icc (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Icc a₁ b₁ ⊆ Icc a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨le_trans h₁ hx₁, le_trans hx₂ h₂⟩

lemma Icc_subset_Icc_left (h : a₁ ≤ a₂) : Icc a₂ b ⊆ Icc a₁ b :=
Icc_subset_Icc h (le_refl _)

lemma Icc_subset_Icc_right (h : b₁ ≤ b₂) : Icc a b₁ ⊆ Icc a b₂ :=
Icc_subset_Icc (le_refl _) h

lemma Ico_subset_Ioo_left (h₁ : a₁ < a₂) : Ico a₂ b ⊆ Ioo a₁ b :=
λ x, and.imp_left $ lt_of_lt_of_le h₁

lemma Icc_subset_Ico_right (h₁ : b₁ < b₂) : Icc a b₁ ⊆ Ico a b₂ :=
λ x, and.imp_right $ λ h₂, lt_of_le_of_lt h₂ h₁

lemma Ioo_subset_Ico_self : Ioo a b ⊆ Ico a b := λ x, and.imp_left le_of_lt

lemma Ico_subset_Icc_self : Ico a b ⊆ Icc a b := λ x, and.imp_right le_of_lt

lemma Ioo_subset_Icc_self : Ioo a b ⊆ Icc a b :=
subset.trans Ioo_subset_Ico_self Ico_subset_Icc_self

lemma Ico_subset_Iio_self : Ioo a b ⊆ Iio b := λ x, and.right

lemma Icc_subset_Icc_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Icc a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, ⟨(h ⟨le_refl _, h₁⟩).1, (h ⟨h₁, le_refl _⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨le_trans h hx, le_trans hx' h'⟩⟩

lemma Icc_subset_Ioo_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioo a₂ b₂ ↔ a₂ < a₁ ∧ b₁ < b₂ :=
⟨λ h, ⟨(h ⟨le_refl _, h₁⟩).1, (h ⟨h₁, le_refl _⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨lt_of_lt_of_le h hx, lt_of_le_of_lt hx' h'⟩⟩

lemma Icc_subset_Ico_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ < b₂ :=
⟨λ h, ⟨(h ⟨le_refl _, h₁⟩).1, (h ⟨h₁, le_refl _⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨le_trans h hx, lt_of_le_of_lt hx' h'⟩⟩

lemma Icc_subset_Ioc_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioc a₂ b₂ ↔ a₂ < a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, ⟨(h ⟨le_refl _, h₁⟩).1, (h ⟨h₁, le_refl _⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨lt_of_lt_of_le h hx, le_trans hx' h'⟩⟩

lemma Icc_subset_Iio_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Iio b₂ ↔ b₁ < b₂ :=
⟨λ h, h ⟨h₁, le_refl _⟩, λ h x ⟨hx, hx'⟩, lt_of_le_of_lt hx' h⟩

lemma Icc_subset_Ioi_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioi a₂ ↔ a₂ < a₁ :=
⟨λ h, h ⟨le_refl _, h₁⟩, λ h x ⟨hx, hx'⟩, lt_of_lt_of_le h hx⟩

lemma Icc_subset_Iic_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Iic b₂ ↔ b₁ ≤ b₂ :=
⟨λ h, h ⟨h₁, le_refl _⟩, λ h x ⟨hx, hx'⟩, le_trans hx' h⟩

lemma Icc_subset_Ici_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ici a₂ ↔ a₂ ≤ a₁ :=
⟨λ h, h ⟨le_refl _, h₁⟩, λ h x ⟨hx, hx'⟩, le_trans h hx⟩
end intervals

section partial_order
variables {α : Type*} [partial_order α] {a b : α}

@[simp] lemma Icc_self (a : α) : Icc a a = {a} :=
set.ext $ by simp [Icc, le_antisymm_iff, and_comm]

lemma Ico_diff_Ioo_eq_singleton (h : a < b) : Ico a b \ Ioo a b = {a} :=
set.ext $ λ x, begin
  simp, split,
  { rintro ⟨⟨ax, xb⟩, h⟩,
    exact eq.symm (classical.by_contradiction
      (λ ne, h (lt_of_le_of_ne ax ne) xb)) },
  { rintro rfl, exact ⟨⟨le_refl _, h⟩, (lt_irrefl x).elim⟩ }
end

lemma Icc_diff_Ico_eq_singleton (h : a ≤ b) : Icc a b \ Ico a b = {b} :=
set.ext $ λ x, begin
  simp, split,
  { rintro ⟨⟨ax, xb⟩, h⟩,
    exact classical.by_contradiction
      (λ ne, h ax (lt_of_le_of_ne xb ne)) },
  { rintro rfl, exact ⟨⟨h, le_refl _⟩, λ _, lt_irrefl x⟩ }
end

end partial_order

section linear_order
variables {α : Type*} [linear_order α] {a a₁ a₂ b b₁ b₂ : α}

lemma Ioo_eq_empty_iff [densely_ordered α] : Ioo a b = ∅ ↔ b ≤ a :=
⟨λ eq, le_of_not_lt $ λ h,
  let ⟨x, h₁, h₂⟩ := dense h in
  eq_empty_iff_forall_not_mem.1 eq x ⟨h₁, h₂⟩,
Ioo_eq_empty⟩

lemma Ico_eq_empty_iff : Ico a b = ∅ ↔ b ≤ a :=
⟨λ eq, le_of_not_lt $ λ h, eq_empty_iff_forall_not_mem.1 eq a ⟨le_refl _, h⟩,
 Ico_eq_empty⟩

lemma Icc_eq_empty_iff : Icc a b = ∅ ↔ b < a :=
⟨λ eq, lt_of_not_ge $ λ h, eq_empty_iff_forall_not_mem.1 eq a ⟨le_refl _, h⟩,
 Icc_eq_empty⟩

lemma Ico_subset_Ico_iff (h₁ : a₁ < b₁) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, have a₂ ≤ a₁ ∧ a₁ < b₂ := h ⟨le_refl _, h₁⟩,
  ⟨this.1, le_of_not_lt $ λ h', lt_irrefl b₂ (h ⟨le_of_lt this.2, h'⟩).2⟩,
 λ ⟨h₁, h₂⟩, Ico_subset_Ico h₁ h₂⟩

lemma Ioo_subset_Ioo_iff [densely_ordered α] (h₁ : a₁ < b₁) :
  Ioo a₁ b₁ ⊆ Ioo a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, begin
  rcases dense h₁ with ⟨x, xa, xb⟩,
  split; refine le_of_not_lt (λ h', _),
  { have ab := lt_trans (h ⟨xa, xb⟩).1 xb,
    exact lt_irrefl _ (h ⟨h', ab⟩).1 },
  { have ab := lt_trans xa (h ⟨xa, xb⟩).2,
    exact lt_irrefl _ (h ⟨ab, h'⟩).2 }
end, λ ⟨h₁, h₂⟩, Ioo_subset_Ioo h₁ h₂⟩

lemma Ico_eq_Ico_iff (h : a₁ < b₁ ∨ a₂ < b₂) : Ico a₁ b₁ = Ico a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
⟨λ e, begin
  simp [subset.antisymm_iff] at e, simp [le_antisymm_iff],
  cases h; simp [Ico_subset_Ico_iff h] at e;
    [ rcases e with ⟨⟨h₁, h₂⟩, e'⟩, rcases e with ⟨e', ⟨h₁, h₂⟩⟩ ];
    have := (Ico_subset_Ico_iff (lt_of_le_of_lt h₁ $ lt_of_lt_of_le h h₂)).1 e';
    tauto
end, λ ⟨h₁, h₂⟩, by rw [h₁, h₂]⟩

end linear_order

section decidable_linear_order
variables {α : Type*} [decidable_linear_order α] {a a₁ a₂ b b₁ b₂ : α}

@[simp] lemma Ico_diff_Iio {a b c : α} : Ico a b \ Iio c = Ico (max a c) b :=
set.ext $ by simp [Ico, Iio, iff_def, max_le_iff] {contextual:=tt}

@[simp] lemma Ico_inter_Iio {a b c : α} : Ico a b ∩ Iio c = Ico a (min b c) :=
set.ext $ by simp [Ico, Iio, iff_def, lt_min_iff] {contextual:=tt}

lemma Ioo_inter_Ioo {a b c d : α} : Ioo a b ∩ Ioo c d = Ioo (max a c) (min b d) :=
set.ext $ by simp [iff_def, Ioo, lt_min_iff, max_lt_iff] {contextual := tt}

end decidable_linear_order

section ordered_comm_group

variables {α : Type*} [ordered_comm_group α]

lemma image_neg_Iio (r : α) : image (λz, -z) (Iio r) = Ioi (-r) :=
begin
  apply set.ext,
  intros z,
  apply iff.intro,
  { intros hz,
    apply exists.elim hz,
    intros z' hz',
    rw [←hz'.2],
    simp at *,
    exact hz'.1 },
  { intros hz,
    simp at *,
    use -z,
    simp [hz],
    exact neg_lt.1 hz }
end

lemma image_neg_Iic (r : α)  : image (λz, -z) (Iic r) = Ici (-r) :=
begin
  apply set.ext,
  intros z,
  apply iff.intro,
  { intros hz,
    apply exists.elim hz,
    intros z' hz',
    rw [←hz'.2],
    simp at *,
    exact hz'.1 },
  { intros hz,
    simp at *,
    use -z,
    simp [hz],
    exact neg_le.1 hz }
end

end ordered_comm_group

end set


/-
Copyright (c) 2020 Alena Gusakov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov, Arthur Paulino, Kyle Miller
-/
import combinatorics.simple_graph.subgraph

/-!
# Matchings

A *matching* for a simple graph is a set of disjoint pairs of adjacent vertices, and the set of all
the vertices in a matching is called its *support* (and sometimes the vertices in the support are
said to be *saturated* by the matching). A *perfect matching* is a matching whose support contains
every vertex of the graph.

In this module, we represent a matching as a subgraph whose vertices are each incident to at most
one edge, and the edges of the subgraph represent the paired vertices.

## Main definitions

* `simple_graph.subgraph.is_matching`: `M.is_matching` means that `M` is a matching of its
  underlying graph.
  denoted `M.is_matching`.

* `simple_graph.subgraph.is_perfect_matching` defines when a subgraph `M` of a simple graph is a
  perfect matching, denoted `M.is_perfect_matching`.

## TODO

* https://github.com/leanprover-community/mathlib/pull/10210#pullrequestreview-806303684

* Lemma stating that the existence of a perfect matching on `G` implies that
  the cardinality of `V` is even (assuming it's finite)

* Tutte's Theorem

* Hall's Marriage Theorem (see combinatorics.hall)
-/

universe u

namespace simple_graph
variables {V : Type u} {G : simple_graph V} (M : subgraph G)

namespace subgraph

/--
The subgraph `M` of `G` is a matching if every vertex of `M` is incident to exactly one edge in `M`.
We say that the vertices in `M.support` are *matched* or *saturated*.
-/
def is_matching : Prop := ∀ ⦃v⦄, v ∈ M.verts → ∃! w, M.adj v w

/--
The subgraph `M` of `G` is a perfect matching on `G` if it's a matching and every vertex `G` is
matched.
-/
def is_perfect_matching : Prop := M.is_matching ∧ M.is_spanning

lemma is_matching.support_eq_verts {M : subgraph G} (h : M.is_matching) : M.support = M.verts :=
begin
  refine M.support_subset_verts.antisymm (λ v hv, _),
  obtain ⟨w, hvw, -⟩ := h hv,
  exact ⟨_, hvw⟩,
end

lemma is_perfect_matching_iff : M.is_perfect_matching ↔ ∀ v, ∃! w, M.adj v w :=
begin
  refine ⟨_, λ hm, ⟨λ v hv, hm v, λ v, _⟩⟩,
  { rintro ⟨hm, hs⟩ v,
    exact hm (hs v) },
  { obtain ⟨w, hw, -⟩ := hm v,
    exact M.edge_vert hw }
end

end subgraph

end simple_graph


import ..submatroids.pseudominor
import ..constructions.direct_sum

/- Here we prove Edmonds' matroid intersection theorem: given two matroids `M₁` and `M₂` on `α`, the
  largest set that is independent in both matroids has size equal to the min of `M₁.r X + M₂.r Xᶜ`,
  taken over all `X ⊆ E`. We also derive Rado's theorem as a corollary. -/

open_locale classical

open matroid set

variables {E : Type*} [finite E] {M M₁ M₂ : matroid E} {I A : set E}

section intersection

/-- the easy direction of matroid intersection; the rank in `M₁` of `A` plus the rank in `M₂` of
  `Aᶜ` is an upper bound for the size of a common independent set of `M₁` and `M₂` . -/
theorem common_ind_le_r_add_r_compl (hI₁ : M₁.indep I) (hI₂ : M₂.indep I) (A : set E) :
  I.ncard ≤ M₁.r A + M₂.r Aᶜ :=
begin
  rw [←ncard_inter_add_ncard_diff_eq_ncard I A, ←(hI₁.inter_right A).r, ←(hI₂.diff A).r,
    diff_eq_compl_inter],
  exact add_le_add (M₁.r_inter_right_le_r I A) (M₂.r_inter_left_le_r Aᶜ I),
end

/-- A common independent set attaining the bound must intersect `A` and `Aᶜ` in bases in the
  respective matroids -/
lemma common_ind_eq_spec (hI₁ : M₁.indep I) (hI₂ : M₂.indep I) {A : set E}
(h : M₁.r A + M₂.r Aᶜ ≤ I.ncard) :
  M₁.basis (I ∩ A) A ∧ M₂.basis (I ∩ Aᶜ) Aᶜ :=
begin
  have h₁i := hI₁.inter_right A,
  have h₂i := hI₂.inter_right Aᶜ,
  simp_rw [basis_iff_indep_card, ←h₁i.r, ←h₂i.r],
  rw [←ncard_inter_add_ncard_diff_eq_ncard I A, diff_eq_compl_inter, inter_comm Aᶜ,
    ←h₁i.r, ←h₂i.r] at h,
  refine ⟨⟨hI₁.inter_right A, inter_subset_right _ _, _⟩,
    ⟨hI₂.inter_right _,inter_subset_right _ _,_⟩⟩;
  linarith [M₁.r_inter_right_le_r I A, M₂.r_inter_right_le_r I Aᶜ],
end

/-- The hard direction of matroid intersection : existence -/
lemma exists_common_ind (M₁ M₂ : matroid E) :
  ∃ I X, M₁.indep I ∧ M₂.indep I ∧ I.ncard = M₁.r X + M₂.r Xᶜ :=
begin
  -- Suppose not. Then we get strict inequality for all choices of I, X.
  by_contra' hcon,
  have hcon' : ∀ I X, M₁.indep I → M₂.indep I → I.ncard < M₁.r X + M₂.r Xᶜ, from
    λ I X hI₁ hI₂, lt_of_le_of_ne (common_ind_le_r_add_r_compl hI₁ hI₂ X) (hcon I X hI₁ hI₂),

  -- Construct a minimal counterexample (wrt the number of nonloops of `M₁`)
  obtain ⟨M,hM,hpmin⟩ := finite.exists_minimal_wrt (ncard ∘ matroid.nonloops)
    { M | ∃ M', _} (to_finite _) ⟨M₁, ⟨M₂, hcon'⟩⟩,

  clear hcon hcon' M₁ M₂,
  obtain ⟨M₁,M₂,hcon⟩ := ⟨M,hM⟩,

  -- There is a common nonloop of `M₁` and `M₂`, otherwise the result is easy
  have hne : ∃ e, ¬M₁.loop e ∧ ¬M₂.loop e,
  { by_contra' he,
    simp_rw [loop_iff_mem_cl_empty, ←mem_compl_iff, ←subset_def] at he,
    specialize hcon ∅ (M₁.cl ∅) M₁.empty_indep M₂.empty_indep,
    rw [ncard_empty, r_cl, r_empty, zero_add] at hcon,
    exact (hcon.trans_le (M₂.r_mono he)).ne (by rw [r_cl, r_empty])},

  obtain ⟨e, he₁,he₂⟩ := hne,

  -- Projecting/loopifying `e` gives non-counterexamples (by minimality), so there exist pairs
  -- with equality in these minors.
  have hd' := ncard_lt_ncard (strict_pminor_of_loopify_nonloop he₁).nonloops_ssubset_nonloops,
  refine hd'.ne.symm (hpmin (M₁ ⟍ {e}) ⟨M₂ ⟍ {e},_⟩ hd'.le),
  by_contra' hd,
  obtain ⟨Id,Xd, hId₁, hId₂, hId⟩ := hd,

  have hc' := ncard_lt_ncard (strict_pminor_of_project_nonloop he₁).nonloops_ssubset_nonloops,
  refine hc'.ne.symm (hpmin (M₁ ⟋ {e}) ⟨M₂ ⟋ {e},_⟩ hc'.le),
  by_contra' hc,
  obtain ⟨Ic,Xc, hIc₁, hIc₂, hIc⟩ := hc,

  -- Use these pairs to get rank lower bounds ...
  have hi := (hId.trans_lt (hcon _ ((Xc ∩ Xd) \ {e})
    (indep_of_loopify_indep hId₁) (indep_of_loopify_indep hId₂))),

  have hic : (Xc ∩ Xd \ {e})ᶜ = (insert e (Xcᶜ ∪ Xdᶜ)),
  { apply compl_injective,
    simp_rw [←union_singleton, compl_union, compl_compl, diff_eq_compl_inter, inter_comm {e}ᶜ]},

  simp_rw [r_loopify, hic] at hi,
  zify at hIc hId hcon,

  have hu := hcon (insert e Ic) (insert e (Xc ∪ Xd))
    (by rwa ← indep_project_singleton_iff he₁ (not_mem_of_indep_project_singleton hIc₁))
    (by rwa ← indep_project_singleton_iff he₂ (not_mem_of_indep_project_singleton hIc₁)),

  have huc : (insert e (Xc ∪ Xd))ᶜ = Xcᶜ ∩ Xdᶜ \ {e},
  { apply compl_injective,
    simp_rw [diff_eq_compl_inter, compl_inter, compl_compl, singleton_union]},

  simp_rw [ncard_insert_of_not_mem (not_mem_of_indep_project_singleton hIc₁),
    nat.cast_add, nat.cast_one, huc] at hu,

  rw [coe_r_project_singleton he₁, coe_r_project_singleton he₂] at hIc,

  -- ... and contradict them with submodularity bounds.
  have sm1 := M₁.r_submod (insert e Xc) (Xd \ {e}),
  have sm2 := M₂.r_submod (insert e Xcᶜ) (Xdᶜ \ {e}),

  rw [insert_union, insert_union_distrib, insert_diff_singleton, ←insert_union_distrib,
    insert_inter_of_not_mem (not_mem_diff_singleton _ _), ←inter_diff_assoc] at sm1 sm2,

  linarith,
end

/-- We can choose a minimizing pair `I,X` where `X` is a flat of `M₁` -/
lemma exists_common_ind_with_flat_left (M₁ M₂ : matroid E) :
  ∃ I X, M₁.indep I ∧ M₂.indep I ∧ I.ncard = M₁.r X + M₂.r Xᶜ ∧ M₁.flat X :=
begin
  obtain ⟨I,X₀, h₀⟩ := exists_common_ind M₁ M₂,
  rw [←M₁.r_cl X₀] at h₀,
  refine ⟨I,M₁.cl X₀,h₀.1, h₀.2.1, le_antisymm _ _, M₁.cl_flat _⟩,
  { apply common_ind_le_r_add_r_compl h₀.1 h₀.2.1 },
  rw h₀.2.2,
  simp only [add_le_add_iff_left],
  exact M₂.r_mono (compl_subset_compl.mpr (subset_cl _ _)),
end

lemma exists_common_ind_with_flat_right (M₁ M₂ : matroid E) :
  ∃ I X, M₁.indep I ∧ M₂.indep I ∧ I.ncard = M₁.r X + M₂.r Xᶜ ∧ M₂.flat Xᶜ :=
begin
  obtain ⟨I,X₀,h₀,h₁,hX₀,hF⟩ := exists_common_ind_with_flat_left M₂ M₁,
  exact ⟨I, X₀ᶜ,h₁,h₀,by rwa [add_comm, compl_compl],by rwa compl_compl⟩,
end

/-- The cardinality of a largest common independent set of matroids `M₁,M₂`.
  Is `find_greatest` really the right way to define this?  -/
noncomputable def max_common_ind (M₁ M₂ : matroid E) :=
nat.find_greatest (λ n, ∃ I, M₁.indep I ∧ M₂.indep I ∧ I.ncard = n) ((univ : set E).ncard)

lemma max_common_ind_eq_iff (M₁ M₂ : matroid E) {n : ℕ} :
  max_common_ind M₁ M₂ = n ↔ (∃ I, M₁.indep I ∧ M₂.indep I ∧ n ≤ I.ncard) ∧
    (∀ I, M₁.indep I → M₂.indep I → I.ncard ≤ n)  :=
begin
  rw [max_common_ind, nat.find_greatest_eq_iff],
  obtain (rfl | n) := n,
  { simp only [nat.nat_zero_eq_zero, zero_le', ne.def, eq_self_iff_true, not_true, ncard_eq_zero,
    exists_eq_right_right, is_empty.forall_iff, not_exists, not_and, true_and, le_zero_iff,
    and_true],
    split,
    {
      refine λ h, ⟨⟨_, M₁.empty_indep, M₂.empty_indep⟩, λ I hI₁ hI₂, _⟩,
      suffices hcI : ¬(0 < I.ncard), by rwa [not_lt, le_zero_iff, ncard_eq_zero] at hcI,
      exact λ hcI, h hcI (ncard_mono (subset_univ _)) I hI₁ hI₂ rfl},
    refine λ h n hpos hn I hI₁ hI₂ hcard, _,
    rw [←hcard, h.2 I hI₁ hI₂] at hpos,
    simpa using hpos},

  simp only [ne.def, nat.succ_ne_zero, not_false_iff, forall_true_left, not_exists, not_and,
    nat.succ_eq_add_one],
  split,
  { rintro ⟨hn, ⟨I, hI₁, hI₂, hIcard⟩, h'⟩,
    refine ⟨⟨I, hI₁, hI₂, hIcard.symm.le⟩, λ J hJ₁ hJ₂, _⟩,
    by_contra' hJcard,
    exact h' hJcard (ncard_mono (subset_univ _)) J hJ₁ hJ₂ rfl},
  simp only [and_imp, forall_exists_index],
  refine λ I hI₁ hI₂ hIcard h, ⟨_,⟨I, hI₁,hI₂,_⟩ ,λ n' hn' hn'' J hJ₁ hJ₂ hJcard, _⟩,
  { rw ←(h I hI₁ hI₂).antisymm hIcard, exact ncard_mono (subset_univ _)},
  { rw ←(h I hI₁ hI₂).antisymm hIcard},
  subst hJcard,
  exact (h J hJ₁ hJ₂).not_lt hn',
end

theorem matroid_intersection_minmax (M₁ M₂ : matroid E) :
  max_common_ind M₁ M₂ = ⨅ X, M₁.r X + M₂.r Xᶜ :=
begin
  rw [max_common_ind_eq_iff],
  obtain ⟨I, X, hI₁, hI₂, heq⟩ := exists_common_ind M₁ M₂,
  refine ⟨⟨I, hI₁, hI₂, (cinfi_le' _ _).trans_eq heq.symm⟩, λ J hJ₁ hJ₂, _ ⟩,
  exact (le_cinfi_iff (order_bot.bdd_below _)).mpr (common_ind_le_r_add_r_compl hJ₁ hJ₂),
end

end intersection

section rado

variables {ι : Type*} [finite ι]

lemma rado_necessary {f : E → ι} {x : ι → E} (hx : ∀ i, f (x i) = i) (h_ind : M.indep (range x))
(S : set ι) :
  S.ncard ≤ M.r (f ⁻¹' S) :=
begin
  have hS := (h_ind.subset (image_subset_range x S)).r,
  rw [ncard_image_of_injective _ (λ i j hij, by rw [←hx i, hij, hx j] : x.injective)] at hS,
  rw ←hS,
  refine M.r_mono _,
  rintro f ⟨i, hi, rfl⟩,
  rwa [mem_preimage, hx],
end

lemma rado_sufficient (f : E → ι) (h : ∀ (S : set ι), S.ncard ≤ M.r (f ⁻¹' S)) :
  ∃ (x : ι → E), (∀ i, f (x i) = i) ∧ M.indep (range x) :=
begin
  set M' := partition_matroid_on f 1 with hM',
  obtain ⟨I, X, hI₁, hI₂, hIX, hF⟩ := exists_common_ind_with_flat_right M M',
  obtain ⟨hIb₁,hIb₂⟩ := common_ind_eq_spec hI₁ hI₂ hIX.symm.le,

  have h_inj : inj_on f I,
  { refine λ a ha b hb hab, by_contra (λ (hne : a ≠ b), _),
    have hcard := (partition_matroid_on_indep_iff.mp hI₂) (f a),
    rw [pi.one_apply, ncard_le_one_iff] at hcard,
    exact hne (hcard ⟨ha, (by simp)⟩ ⟨hb, by simp [hab]⟩)},

  have hXc := (h (f '' Xᶜ)ᶜ).trans (M.r_mono _ : _ ≤ M.r X), swap,
  { simp only [preimage_subset_iff, mem_compl_iff, mem_image, not_exists, not_and, not_imp_not],
    exact λ a h, h _ rfl},

  simp only [partition_matroid_on_one_r_eq, pi.one_apply] at hIX,
  have hineq := (add_le_add_right hXc _).trans_eq hIX.symm,
  rw [add_comm, ncard_add_ncard_compl, ←ncard_univ, ←ncard_image_of_inj_on h_inj] at hineq,
  have himage := eq_of_subset_of_ncard_le (subset_univ _) hineq,

  have hinv : ∀ i, ∃ e ∈ I, f e = i,
  { simp_rw [←mem_image_iff_bex, himage], exact mem_univ},

  choose x hx using hinv,
  refine ⟨x, λi, (hx i).2, hI₁.subset _⟩,
  rintro e ⟨i,hi,rfl⟩,
  exact (hx i).1,
end

/-- Rado's theorem: Given a partition `f : E → ι` of the ground set `E` of a matroid `M`, there is a
  transversal of `f` that is independent in `M` if and only if the rank of the preimage of every set
  `S` in `ι` is at least its cardinality. -/
theorem rado_iff {M : matroid E} {f : E → ι} :
  (∃ (x : ι → E), (∀ i, f (x i) = i) ∧ M.indep (range x)) ↔ ∀ S, ncard S ≤ M.r (f ⁻¹' S) :=
⟨λ h S, exists.elim h (λ x hx, rado_necessary hx.1 hx.2 _) , rado_sufficient _⟩

end rado


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import order.antichain

/-!
# Minimal/maximal elements of a set

This file defines minimal and maximal of a set with respect to an arbitrary relation.

## Main declarations

* `maximals r s`: Maximal elements of `s` with respect to `r`.
* `minimals r s`: Minimal elements of `s` with respect to `r`.

## TODO

Do we need a `finset` version?
-/

open function set

variables {α : Type*} (r r₁ r₂ : α → α → Prop) (s t : set α) (a : α)

/-- Turns a set into an antichain by keeping only the "maximal" elements. -/
def maximals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r a b → a = b}

/-- Turns a set into an antichain by keeping only the "maximal" elements. -/
def minimals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r b a → a = b}

lemma maximals_subset : maximals r s ⊆ s := sep_subset _ _
lemma minimals_subset : minimals r s ⊆ s := sep_subset _ _

@[simp] lemma maximals_empty : maximals r ∅ = ∅ := sep_empty _
@[simp] lemma minimals_empty : minimals r ∅ = ∅ := sep_empty _

@[simp] lemma maximals_singleton : maximals r {a} = {a} :=
(maximals_subset _ _).antisymm $ singleton_subset_iff.2 $ ⟨rfl, λ b hb _, hb.symm⟩

@[simp] lemma minimals_singleton : minimals r {a} = {a} := maximals_singleton _ _

lemma maximals_swap : maximals (swap r) s = minimals r s := rfl
lemma minimals_swap : minimals (swap r) s = maximals r s := rfl

lemma maximals_antichain : is_antichain r (maximals r s) := λ a ha b hb hab h, hab $ ha.2 hb.1 h
lemma minimals_antichain : is_antichain r (minimals r s) := (maximals_antichain _ _).swap

lemma maximals_eq_minimals [is_symm α r] : maximals r s = minimals r s :=
by { congr, ext a b, exact comm }

variables {r r₁ r₂ s t a}

lemma set.subsingleton.maximals_eq (h : s.subsingleton) : maximals r s = s :=
h.induction_on (minimals_empty _) (maximals_singleton _)

lemma set.subsingleton.minimals_eq (h : s.subsingleton) : minimals r s = s := h.maximals_eq

lemma maximals_mono (h : ∀ a b, r₁ a b → r₂ a b) : maximals r₂ s ⊆ maximals r₁ s :=
λ a ha, ⟨ha.1, λ b hb, ha.2 hb ∘ h _ _⟩

lemma minimals_mono (h : ∀ a b, r₁ a b → r₂ a b) : minimals r₂ s ⊆ minimals r₁ s :=
λ a ha, ⟨ha.1, λ b hb, ha.2 hb ∘ h _ _⟩

lemma maximals_union : maximals r (s ∪ t) ⊆ maximals r s ∪ maximals r t :=
begin
  intros a ha,
  obtain h | h := ha.1,
  { exact or.inl ⟨h, λ b hb, ha.2 $ or.inl hb⟩ },
  { exact or.inr ⟨h, λ b hb, ha.2 $ or.inr hb⟩ }
end

lemma minimals_union : minimals r (s ∪ t) ⊆ minimals r s ∪ minimals r t := maximals_union

lemma maximals_inter_subset : maximals r s ∩ t ⊆ maximals r (s ∩ t) :=
λ a ha, ⟨⟨ha.1.1, ha.2⟩, λ b hb, ha.1.2 hb.1⟩

lemma minimals_inter_subset : minimals r s ∩ t ⊆ minimals r (s ∩ t) := maximals_inter_subset

lemma inter_maximals_subset : s ∩ maximals r t ⊆ maximals r (s ∩ t) :=
λ a ha, ⟨⟨ha.1, ha.2.1⟩, λ b hb, ha.2.2 hb.2⟩

lemma inter_minimals_subset : s ∩ minimals r t ⊆ minimals r (s ∩ t) := inter_maximals_subset

lemma _root_.is_antichain.maximals_eq (h : is_antichain r s) : maximals r s = s :=
(maximals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b, h.eq ha⟩

lemma _root_.is_antichain.minimals_eq (h : is_antichain r s) : minimals r s = s :=
(minimals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b, h.eq' ha⟩

@[simp] lemma maximals_idem : maximals r (maximals r s) = maximals r s :=
(maximals_antichain _ _).maximals_eq

@[simp] lemma minimals_idem : minimals r (minimals r s) = minimals r s := maximals_idem

/-- If `maximals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
lemma is_antichain.max_maximals (ht : is_antichain r t) (h : maximals r s ⊆ t)
  (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ maximals r s, r b a) :
  maximals r s = t :=
begin
  refine h.antisymm (λ a ha, _),
  obtain ⟨b, hb, hr⟩ := hs ha,
  rwa of_not_not (λ hab, ht (h hb) ha (ne.symm hab) hr),
end

/-- If `minimals r s` is included in but *shadows* the antichain `t`, then it is actually
equal to `t`. -/
lemma is_antichain.max_minimals (ht : is_antichain r t) (h : minimals r s ⊆ t)
  (hs : ∀ ⦃a⦄, a ∈ t → ∃ b ∈ minimals r s, r a b) :
  minimals r s = t :=
begin
  refine h.antisymm (λ a ha, _),
  obtain ⟨b, hb, hr⟩ := hs ha,
  rwa of_not_not (λ hab, ht ha (h hb) hab hr),
end

variables [partial_order α]

lemma is_least.mem_minimals (h : is_least s a) : a ∈ minimals (≤) s :=
⟨h.1, λ b hb, (h.2 hb).antisymm⟩

lemma is_greatest.mem_maximals (h : is_greatest s a) : a ∈ maximals (≤) s :=
⟨h.1, λ b hb, (h.2 hb).antisymm'⟩

lemma is_least.minimals_eq (h : is_least s a) : minimals (≤) s = {a} :=
eq_singleton_iff_unique_mem.2 ⟨h.mem_minimals, λ b hb, hb.2 h.1 $ h.2 hb.1⟩

lemma is_greatest.maximals_eq (h : is_greatest s a) : maximals (≤) s = {a} :=
eq_singleton_iff_unique_mem.2 ⟨h.mem_maximals, λ b hb, hb.2 h.1 $ h.2 hb.1⟩


import Myint.Add

namespace myint

def myneg (m : myint) : myint :=
  myint.mk m.y m.x

instance : Neg myint where
  neg := myneg

theorem neg_eq_myneg (m : myint) : -m = myneg m := rfl

def mysub (m n : myint) : myint :=
  m + myneg n

instance : Sub myint where
  sub := mysub

theorem sub_eq_mysub (m n : myint) : m - n = mysub m n := rfl
theorem sub_eq_plusneg (m n : myint) : m - n = m + (-n) := rfl

-- This proves that -m is an additive inverse of m and an identity is 0.
theorem neg_is_inv (m : myint) : m + (-m) ≈ 0 := by
  rw [neg_eq_myneg]
  rw [equiv_is_myequal]
  rw [myneg]
  rw [myequal]
  rw [add_x, add_y]
  rw [destruct_x m.y m.x]
  rw [destruct_y m.y m.x]
  rw [mynat.add_comm m.x m.y]
  rw [zerox, zeroy]

theorem negneg_eq_self (m : myint) : -(-m) ≈ m := by
  rw [neg_eq_myneg]
  rw [neg_eq_myneg]
  rw [equiv_is_myequal]
  rw [myneg]
  rw [myneg]
  rw [destruct_y]
  rw [destruct_x m.y m.x]
  rw [myequal]
  rw [destruct_x]
  rw [destruct_y]
  rw [mynat.add_comm]

example : (5 : myint) - (2 : myint) ≈ (3 : myint) := by
  have : (3 : myint) ≈ (3 : myint) := rfl
  have : (3 : myint) ≈ (3 : myint) + (0 : myint) := rfl
  have : (3 : myint) ≈ (3 : myint) + (2 - 2 : myint) := by
    rw [sub_eq_plusneg]
    have htinv : 0 ≈ (2 + -2) := symm (neg_is_inv 2)
    have hleft : 3 + 0 ≈ 3 + (2 + -2) := add_left 3 0 (2 + -2) htinv
    have happ : 3 ≈ (3 + (2 + -2)) := trans this hleft
    exact happ
  rw [sub_eq_plusneg] at this
  have htrans : 3 ≈ (3 + 2 + -2) := trans
    this
    (symm (add_assoc (3 : myint) (2 : myint) (-2 : myint)))
  have : (3 : myint) + (2 : myint) ≈ (5 : myint) := by
    apply if_x_and_y_equal_then_equiv
    rw [add_x]
    rw [add_y]
    apply And.intro
    case a.left =>
      repeat rw [default_nat_has_same_x]
      repeat rw [mynat.myofnat]
      rw [mynat.mynat_zero_eq_zero]
      repeat rw [mynat.add_succ]
      rw [mynat.add_zero]
    case a.right =>
      repeat rw [default_nat_has_no_y]
      rfl
  have : (3 : myint) + (2 : myint) + (-2 : myint) ≈ (5 : myint) + (-2 : myint) :=
    (add_right _ _ (-2)) this
  have : (3 : myint) ≈ (5 : myint) + (-2 : myint) := trans htrans this
  have : (5 : myint) + (-2 : myint) ≈ (3 : myint) := symm this
  rw [equiv_is_myequal]
  rw [sub_eq_plusneg]
  exact this

theorem sub_right (a b t : myint) : a ≈ b → a - t ≈ b - t := by
  rw [sub_eq_plusneg]
  exact add_right a b (-t)

theorem add_right_cancel (a t b : myint) : a + t ≈ b + t → a ≈ b := by
  intro h
  have hmt := add_right (a+t) (b+t) (-t) h
  have hassoc := symm (add_assoc a t (-t))
  rw [← equiv_is_myequal] at hassoc
  have ha := trans hassoc hmt
  rw [← equiv_is_myequal] at ha
  have hb := trans ha (add_assoc b t (-t))
  rw [← equiv_is_myequal] at hb
  have hni := neg_is_inv t
  have hb0 := trans hb (add_left b (t + -t) 0 hni)
  rw [← equiv_is_myequal] at hb0
  have hb1 := trans hb0 (add_zero b)
  rw [← equiv_is_myequal] at hb1
  have ha0 := trans (symm (add_left a (t + -t) 0 hni)) hb1
  have ha1 := symm ha0
  have ha2 := trans ha1 (add_zero a)
  exact symm ha2

theorem add_left_cancel (t a b : myint) : t + a ≈ t + b → a ≈ b := by
  have hhelp := add_right_cancel a t b
  intro h
  have := trans (trans (add_comm a t) h) (add_comm t b)
  exact hhelp this

theorem add_right_cancel_iff (t a b : myint) : a + t ≈ b + t ↔ a ≈ b := by
  apply Iff.intro
  . exact add_right_cancel a t b
  . intro h
    exact add_right a b t h

end myint


import .love01_definitions_and_statements_demo

/-! # LoVe Demo 2: Backward Proofs

A __tactic__ operates on a proof goal and either proves it or creates new
subgoals. Tactics are a __backward__ proof mechanism: They start from the goal
and work towards the available hypotheses and lemmas. -/

set_option pp.beta true

namespace LoVe

/-! ## Tactic Mode

Syntax of tactical proofs:

    begin
      _tactic₁_,
      …,
      _tacticN_
    end -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
begin
  intros a b,
  intros ha hb,
  apply ha
end

#check fst_of_two_props
/-! ## Basic Tactics

`intro`(`s`) moves `∀`-quantified variables, or the assumptions of
implications `→`, from the goal's conclusion (after `⊢`) into the goal's
hypotheses (before `⊢`).

`apply` matches the goal's conclusion with the conclusion of the specified lemma
and adds the lemma's hypotheses as new goals. -/

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
begin
  apply ha
end

/-! Terminal tactic syntax:

    by _tactic_

abbreviates

    begin
      _tactic_
    end -/

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
by apply ha

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  apply hbc,
  apply hab,
  assumption,
end

/-! `exact` matches the goal's conclusion with the specified lemma, closing the
goal. We can often use `apply` in such situations, but `exact` communicates our
intentions better. -/

lemma fst_of_two_props₄ (a b : Prop) (ha : a) (hb : b) :
  a :=
by exact ha

/-! `assumption` finds a hypothesis from the local context that matches the
goal's conclusion and applies it to prove the goal. -/

lemma fst_of_two_props₅ (a b : Prop) (ha : a) (hb : b) :
  a :=
by assumption

/-! `refl` proves `l = r`, where the two sides are equal up to computation.
Computation means unfolding of definitions, β-reduction (application of λ to an
argument), `let`, and more. -/

lemma α_example {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
begin
  refl
end

lemma α_example₂ {α β : Type} (f : α → β) :
  (λx, f x) = (λy, f y) :=
by refl

lemma β_example {α β : Type} (f : α → β) (a : α) :
  (λx, f x) a = f a :=
by refl

def double (n : ℕ) : ℕ :=
n + n

lemma δ_example :
  double 5 = 5 + 5 :=
by refl

lemma ζ_example :
  (let n : ℕ := 2 in n + n) = 4 :=
by refl

lemma η_example {α β : Type} (f : α → β) :
  (λx, f x) = f :=
by refl

lemma ι_example {α β : Type} (a : α) (b : β) :
  prod.fst (a, b) = a :=
by refl

/-! ## Reasoning about Logical Connectives and Quantifiers

Introduction rules: -/

#check true.intro
#check not.intro
#check and.intro
#check or.intro_left
#check or.intro_right
#check iff.intro
#check exists.intro

/-! Elimination rules: -/

#check false.elim
#check and.elim_left
#check and.elim_right
#check or.elim
#check iff.elim_left
#check iff.elim_right
#check exists.elim

/-! Definition of `¬` and related lemmas: -/

#print not
#check not_def
#check classical.em
#check classical.by_contradiction

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

/-! The `{ … }` combinator focuses on the first subgoal. The tactic inside must
fully prove it. -/

lemma and_swap₂ :
  ∀a b : Prop, a ∧ b → b ∧ a :=
begin
  intros a b hab,
  apply and.intro,
  { exact and.elim_right hab },
  { exact and.elim_left hab }
end

/-! Notice above how we pass the hypothesis `hab` directly to the lemmas
`and.elim_right` and `and.elim_left`, instead of waiting for the lemmas's
assumptions to appear as new subgoals. This is a small forward step in an
otherwise backward proof. -/

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
begin
  intros hab,
  apply or.elim hab,
  { intros ha,
    exact or.intro_right _ ha },
  { intros hb,
    exact or.intro_left _ hb }
end

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
begin
  intros hab ha,
  apply hab,
  exact ha
end

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
begin
  intro ha,
  apply not.intro,
  intro hna,
  apply hna,
  exact ha
end

lemma not_not_intro₂ (a : Prop) :
  a → ¬¬ a :=
begin
  intros ha hna,
  apply hna,
  exact ha
end

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
begin
  apply exists.intro 0,
  refl
end

/-! ## Reasoning about Equality -/

#check eq.refl
#check eq.symm
#check eq.trans
#check eq.subst

/-! The above rules can be used directly: -/

lemma cong_fst_arg {α : Type} (a a' b : α)
    (f : α → α → α) (ha : a = a') :
  f a b = f a' b :=
begin
  cc
end

lemma cong_two_args {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  apply eq.subst ha,
  apply eq.subst hb,
  apply eq.refl
end

/-! `rewrite` applies a single equation as a left-to-right rewrite rule, once.
To apply an equation right-to-left, prefix its name with `←`. -/

lemma cong_two_args₂ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
begin
  rw ha,
  rw hb
end

lemma a_proof_of_negation₃ (a : Prop) :
  a → ¬¬ a :=
begin
  rewrite not_def,
  rewrite not_def,
  intro ha,
  apply not.intro,
  intro hna,
  apply hna,
  exact ha
end

/-! `simp` applies a standard set of rewrite rules (the __simp set__)
exhaustively. The set can be extended using the `@[simp]` attribute. Lemmas can
be temporarily added to the simp set with the syntax
`simp [_lemma₁_, …, _lemmaN_]`. -/

lemma cong_two_args_etc {α : Type} (a a' b b' : α)
    (g : α → α → ℕ → α) (ha : a = a') (hb : b = b') :
  g a b (1 + 1) = g a' b' 2 :=
by simp [ha, hb]

/-! `cc` applies __congruence closure__ to derive new equalities. -/

lemma cong_two_args₃ {α : Type} (a a' b b' : α)
    (f : α → α → α) (ha : a = a') (hb : b = b') :
  f a b = f a' b' :=
by cc

/-! `cc` can also reason up to associativity and commutativity of `+`, `*`,
and other binary operators. -/

lemma cong_assoc_comm (a a' b c : ℝ) (f : ℝ → ℝ)
    (ha : a = a') :
  f (a + b + c) = f (c + b + a') :=
by cc

/-! ## Proofs by Mathematical Induction

`induction` performs induction on the specified variable. It gives rise to one
subgoal per constructor. -/

lemma add_zero (n : ℕ) :
  add 0 n = n :=
begin
  induction n,
  { refl },
  { simp [add, n_ih] }
end

lemma add_succ (m n : ℕ) :
  add (nat.succ m) n = nat.succ (add m n) :=
begin
  induction n,
  { refl },
  { simp [add, n_ih] }
end

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
begin
  induction n,
  { simp [add, add_zero] },
  { simp [add, add_succ, n_ih] }
end

lemma add_assoc (l m n : ℕ) :
  add (add l m) n = add l (add m n) :=
begin
  induction n,
  { refl },
  { simp [add, n_ih] }
end

/-! `cc` is extensible. We can register `add` as a commutative and associative
operator using the type class instance mechanism (explained in lecture 11). This
is useful for the `cc` invocation below. -/

@[instance] def add.is_commutative : is_commutative ℕ add :=
{ comm := add_comm }

@[instance] def add.is_associative : is_associative ℕ add :=
{ assoc := add_assoc }

lemma mul_add (l m n : ℕ) :
  mul l (add m n) = add (mul l m) (mul l n) :=
begin
  induction n,
  { refl },
  { simp [add, mul, n_ih],
    cc }
end

/-! ## Cleanup Tactics

`rename` changes the name of a variable or hypothesis.

`clear` removes unused variables or hypotheses. -/

lemma cleanup_example (a b c : Prop) (ha : a) (hb : b)
    (hab : a → b) (hbc : b → c) :
  c :=
begin
  clear ha hab a,
  apply hbc,
  clear hbc c,
  rename hb h,
  exact h
end

end LoVe


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.measure.measure_space_def

/-!
# Almost everywhere disjoint sets

We say that sets `s` and `t` are `μ`-a.e. disjoint (see `measure_theory.ae_disjoint`) if their
intersection has measure zero. This assumption can be used instead of `disjoint` in most theorems in
measure theory.
-/

open set function

namespace measure_theory

variables {ι α : Type*} {m : measurable_space α} (μ : measure α)

/-- Two sets are said to be `μ`-a.e. disjoint if their intersection has measure zero. -/
def ae_disjoint (s t : set α) := μ (s ∩ t) = 0

variables {μ} {s t u v : set α}

/-- If `s : ι → set α` is a countable family of pairwise a.e. disjoint sets, then there exists a
family of measurable null sets `t i` such that `s i \ t i` are pairwise disjoint. -/
lemma exists_null_pairwise_disjoint_diff [countable ι] {s : ι → set α}
  (hd : pairwise (ae_disjoint μ on s)) :
  ∃ t : ι → set α, (∀ i, measurable_set (t i)) ∧ (∀ i, μ (t i) = 0) ∧
    pairwise (disjoint on (λ i, s i \ t i)) :=
begin
  refine ⟨λ i, to_measurable μ (s i ∩ ⋃ j ∈ ({i}ᶜ : set ι), s j),
    λ i, measurable_set_to_measurable _ _, λ i, _, _⟩,
  { simp only [measure_to_measurable, inter_Union],
    exact (measure_bUnion_null_iff $ to_countable _).2 (λ j hj, hd (ne.symm hj)) },
  { simp only [pairwise, disjoint_left, on_fun, mem_diff, not_and, and_imp, not_not],
    intros i j hne x hi hU hj,
    replace hU : x ∉ s i ∩ ⋃ j ≠ i, s j := λ h, hU (subset_to_measurable _ _ h),
    simp only [mem_inter_iff, mem_Union, not_and, not_exists] at hU,
    exact (hU hi j hne.symm hj).elim }
end

namespace ae_disjoint

protected lemma eq (h : ae_disjoint μ s t) : μ (s ∩ t) = 0 := h

@[symm] protected lemma symm (h : ae_disjoint μ s t) : ae_disjoint μ t s :=
by rwa [ae_disjoint, inter_comm]

protected lemma symmetric : symmetric (ae_disjoint μ) := λ s t h, h.symm

protected lemma comm : ae_disjoint μ s t ↔ ae_disjoint μ t s := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma _root_.disjoint.ae_disjoint (h : disjoint s t) : ae_disjoint μ s t :=
by rw [ae_disjoint, disjoint_iff_inter_eq_empty.1 h, measure_empty]

protected lemma _root_.pairwise.ae_disjoint {f : ι → set α} (hf : pairwise (disjoint on f)) :
  pairwise (ae_disjoint μ on f) :=
hf.mono $ λ i j h, h.ae_disjoint

protected lemma _root_.set.pairwise_disjoint.ae_disjoint {f : ι → set α} {s : set ι}
  (hf : s.pairwise_disjoint f) :
  s.pairwise (ae_disjoint μ on f) :=
hf.mono' $ λ i j h, h.ae_disjoint

lemma mono_ae (h : ae_disjoint μ s t) (hu : u ≤ᵐ[μ] s) (hv : v ≤ᵐ[μ] t) : ae_disjoint μ u v :=
measure_mono_null_ae (hu.inter hv) h

protected lemma mono (h : ae_disjoint μ s t) (hu : u ⊆ s) (hv : v ⊆ t) : ae_disjoint μ u v :=
h.mono_ae hu.eventually_le hv.eventually_le

protected lemma congr (h : ae_disjoint μ s t) (hu : u =ᵐ[μ] s) (hv : v =ᵐ[μ] t) :
  ae_disjoint μ u v :=
h.mono_ae (filter.eventually_eq.le hu) (filter.eventually_eq.le hv)

@[simp] lemma Union_left_iff [countable ι] {s : ι → set α} :
  ae_disjoint μ (⋃ i, s i) t ↔ ∀ i, ae_disjoint μ (s i) t :=
by simp only [ae_disjoint, Union_inter, measure_Union_null_iff]

@[simp] lemma Union_right_iff [countable ι] {t : ι → set α} :
  ae_disjoint μ s (⋃ i, t i) ↔ ∀ i, ae_disjoint μ s (t i) :=
by simp only [ae_disjoint, inter_Union, measure_Union_null_iff]

@[simp] lemma union_left_iff : ae_disjoint μ (s ∪ t) u ↔ ae_disjoint μ s u ∧ ae_disjoint μ t u :=
by simp [union_eq_Union, and.comm]

@[simp] lemma union_right_iff : ae_disjoint μ s (t ∪ u) ↔ ae_disjoint μ s t ∧ ae_disjoint μ s u :=
by simp [union_eq_Union, and.comm]

lemma union_left (hs : ae_disjoint μ s u) (ht : ae_disjoint μ t u) : ae_disjoint μ (s ∪ t) u :=
union_left_iff.mpr ⟨hs, ht⟩

lemma union_right (ht : ae_disjoint μ s t) (hu : ae_disjoint μ s u) : ae_disjoint μ s (t ∪ u) :=
union_right_iff.2 ⟨ht, hu⟩

lemma diff_ae_eq_left (h : ae_disjoint μ s t) : (s \ t : set α) =ᵐ[μ] s :=
@diff_self_inter _ s t ▸ diff_null_ae_eq_self h

lemma diff_ae_eq_right (h : ae_disjoint μ s t) : (t \ s : set α) =ᵐ[μ] t := h.symm.diff_ae_eq_left

lemma measure_diff_left (h : ae_disjoint μ s t) : μ (s \ t) = μ s := measure_congr h.diff_ae_eq_left

lemma measure_diff_right (h : ae_disjoint μ s t) : μ (t \ s) = μ t :=
measure_congr h.diff_ae_eq_right

/-- If `s` and `t` are `μ`-a.e. disjoint, then `s \ u` and `t` are disjoint for some measurable null
set `u`. -/
lemma exists_disjoint_diff (h : ae_disjoint μ s t) :
  ∃ u, measurable_set u ∧ μ u = 0 ∧ disjoint (s \ u) t :=
⟨to_measurable μ (s ∩ t), measurable_set_to_measurable _ _, (measure_to_measurable _).trans h,
  disjoint_sdiff_self_left.mono_left $ λ x hx, ⟨hx.1, λ hxt, hx.2 $
    subset_to_measurable _ _ ⟨hx.1, hxt⟩⟩⟩

lemma of_null_right (h : μ t = 0) : ae_disjoint μ s t :=
measure_mono_null (inter_subset_right _ _) h

lemma of_null_left (h : μ s = 0) : ae_disjoint μ s t := (of_null_right h).symm

end ae_disjoint

lemma ae_disjoint_compl_left : ae_disjoint μ sᶜ s := (@disjoint_compl_left _ _ s).ae_disjoint
lemma ae_disjoint_compl_right : ae_disjoint μ s sᶜ := (@disjoint_compl_right _ _ s).ae_disjoint

end measure_theory