/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module linear_algebra.matrix.transvection
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basis
import Mathbin.Data.Matrix.Dmatrix
import Mathbin.LinearAlgebra.Matrix.Determinant
import Mathbin.LinearAlgebra.Matrix.Reindex
import Mathbin.Tactic.FieldSimp

/-!
# Transvections

Transvections are matrices of the form `1 + std_basis_matrix i j c`, where `std_basis_matrix i j c`
is the basic matrix with a `c` at position `(i, j)`. Multiplying by such a transvection on the left
(resp. on the right) amounts to adding `c` times the `j`-th row to to the `i`-th row
(resp `c` times the `i`-th column to the `j`-th column). Therefore, they are useful to present
algorithms operating on rows and columns.

Transvections are a special case of *elementary matrices* (according to most references, these also
contain the matrices exchanging rows, and the matrices multiplying a row by a constant).

We show that, over a field, any matrix can be written as `L ⬝ D ⬝ L'`, where `L` and `L'` are
products of transvections and `D` is diagonal. In other words, one can reduce a matrix to diagonal
form by operations on its rows and columns, a variant of Gauss' pivot algorithm.

## Main definitions and results

* `transvection i j c` is the matrix equal to `1 + std_basis_matrix i j c`.
* `transvection_struct n R` is a structure containing the data of `i, j, c` and a proof that
  `i ≠ j`. These are often easier to manipulate than straight matrices, especially in inductive
  arguments.

* `exists_list_transvec_mul_diagonal_mul_list_transvec` states that any matrix `M` over a field can
  be written in the form `t_1 ⬝ ... ⬝ t_k ⬝ D ⬝ t'_1 ⬝ ... ⬝ t'_l`, where `D` is diagonal and
  the `t_i`, `t'_j` are transvections.

* `diagonal_transvection_induction` shows that a property which is true for diagonal matrices and
  transvections, and invariant under product, is true for all matrices.
* `diagonal_transvection_induction_of_det_ne_zero` is the same statement over invertible matrices.

## Implementation details

The proof of the reduction results is done inductively on the size of the matrices, reducing an
`(r + 1) × (r + 1)` matrix to a matrix whose last row and column are zeroes, except possibly for
the last diagonal entry. This step is done as follows.

If all the coefficients on the last row and column are zero, there is nothing to do. Otherwise,
one can put a nonzero coefficient in the last diagonal entry by a row or column operation, and then
subtract this last diagonal entry from the other entries in the last row and column to make them
vanish.

This step is done in the type `fin r ⊕ unit`, where `fin r` is useful to choose arbitrarily some
order in which we cancel the coefficients, and the sum structure is useful to use the formalism of
block matrices.

To proceed with the induction, we reindex our matrices to reduce to the above situation.
-/

universe u₁ u₂

namespace Matrix

open Matrix

variable (n p : Type _) (R : Type u₂) {𝕜 : Type _} [Field 𝕜]

variable [DecidableEq n] [DecidableEq p]

variable [CommRing R]

section Transvection

variable {R n} (i j : n)

/-- The transvection matrix `transvection i j c` is equal to the identity plus `c` at position
`(i, j)`. Multiplying by it on the left (as in `transvection i j c ⬝ M`) corresponds to adding
`c` times the `j`-th line of `M` to its `i`-th line. Multiplying by it on the right corresponds
to adding `c` times the `i`-th column to the `j`-th column. -/
def transvection (c : R) : Matrix n n R :=
  1 + Matrix.stdBasisMatrix i j c
#align matrix.transvection Matrix.transvection

@[simp]
theorem transvection_zero : transvection i j (0 : R) = 1 := by simp [transvection]
#align matrix.transvection_zero Matrix.transvection_zero

section

/-- A transvection matrix is obtained from the identity by adding `c` times the `j`-th row to
the `i`-th row. -/
theorem updateRow_eq_transvection [Finite n] (c : R) :
    updateRow (1 : Matrix n n R) i ((1 : Matrix n n R) i + c • (1 : Matrix n n R) j) =
      transvection i j c :=
  by
  cases nonempty_fintype n
  ext (a b)
  by_cases ha : i = a; by_cases hb : j = b
  ·
    simp only [update_row, transvection, ha, hb, Function.update_same, std_basis_matrix.apply_same,
      Pi.add_apply, one_apply_eq, Pi.smul_apply, mul_one, Algebra.id.smul_eq_mul]
  ·
    simp only [update_row, transvection, ha, hb, std_basis_matrix.apply_of_ne, Function.update_same,
      Pi.add_apply, Ne.def, not_false_iff, Pi.smul_apply, and_false_iff, one_apply_ne,
      Algebra.id.smul_eq_mul, MulZeroClass.mul_zero]
  ·
    simp only [update_row, transvection, ha, Ne.symm ha, std_basis_matrix.apply_of_ne, add_zero,
      Algebra.id.smul_eq_mul, Function.update_noteq, Ne.def, not_false_iff, DMatrix.add_apply,
      Pi.smul_apply, MulZeroClass.mul_zero, false_and_iff]
#align matrix.update_row_eq_transvection Matrix.updateRow_eq_transvection

variable [Fintype n]

theorem transvection_mul_transvection_same (h : i ≠ j) (c d : R) :
    transvection i j c ⬝ transvection i j d = transvection i j (c + d) := by
  simp [transvection, Matrix.add_mul, Matrix.mul_add, h, h.symm, add_smul, add_assoc,
    std_basis_matrix_add]
#align matrix.transvection_mul_transvection_same Matrix.transvection_mul_transvection_same

@[simp]
theorem transvection_mul_apply_same (b : n) (c : R) (M : Matrix n n R) :
    (transvection i j c ⬝ M) i b = M i b + c * M j b := by simp [transvection, Matrix.add_mul]
#align matrix.transvection_mul_apply_same Matrix.transvection_mul_apply_same

@[simp]
theorem mul_transvection_apply_same (a : n) (c : R) (M : Matrix n n R) :
    (M ⬝ transvection i j c) a j = M a j + c * M a i := by
  simp [transvection, Matrix.mul_add, mul_comm]
#align matrix.mul_transvection_apply_same Matrix.mul_transvection_apply_same

@[simp]
theorem transvection_mul_apply_of_ne (a b : n) (ha : a ≠ i) (c : R) (M : Matrix n n R) :
    (transvection i j c ⬝ M) a b = M a b := by simp [transvection, Matrix.add_mul, ha]
#align matrix.transvection_mul_apply_of_ne Matrix.transvection_mul_apply_of_ne

@[simp]
theorem mul_transvection_apply_of_ne (a b : n) (hb : b ≠ j) (c : R) (M : Matrix n n R) :
    (M ⬝ transvection i j c) a b = M a b := by simp [transvection, Matrix.mul_add, hb]
#align matrix.mul_transvection_apply_of_ne Matrix.mul_transvection_apply_of_ne

@[simp]
theorem det_transvection_of_ne (h : i ≠ j) (c : R) : det (transvection i j c) = 1 := by
  rw [← update_row_eq_transvection i j, det_update_row_add_smul_self _ h, det_one]
#align matrix.det_transvection_of_ne Matrix.det_transvection_of_ne

end

variable (R n)

/-- A structure containing all the information from which one can build a nontrivial transvection.
This structure is easier to manipulate than transvections as one has a direct access to all the
relevant fields. -/
@[nolint has_nonempty_instance]
structure TransvectionStruct where
  (i j : n)
  hij : i ≠ j
  c : R
#align matrix.transvection_struct Matrix.TransvectionStruct

instance [Nontrivial n] : Nonempty (TransvectionStruct n R) :=
  by
  choose x y hxy using exists_pair_ne n
  exact ⟨⟨x, y, hxy, 0⟩⟩

namespace TransvectionStruct

variable {R n}

/-- Associating to a `transvection_struct` the corresponding transvection matrix. -/
def toMatrix (t : TransvectionStruct n R) : Matrix n n R :=
  transvection t.i t.j t.c
#align matrix.transvection_struct.to_matrix Matrix.TransvectionStruct.toMatrix

@[simp]
theorem toMatrix_mk (i j : n) (hij : i ≠ j) (c : R) :
    TransvectionStruct.toMatrix ⟨i, j, hij, c⟩ = transvection i j c :=
  rfl
#align matrix.transvection_struct.to_matrix_mk Matrix.TransvectionStruct.toMatrix_mk

@[simp]
protected theorem det [Fintype n] (t : TransvectionStruct n R) : det t.toMatrix = 1 :=
  det_transvection_of_ne _ _ t.hij _
#align matrix.transvection_struct.det Matrix.TransvectionStruct.det

@[simp]
theorem det_toMatrix_prod [Fintype n] (L : List (TransvectionStruct n 𝕜)) :
    det (L.map toMatrix).Prod = 1 := by
  induction' L with t L IH
  · simp
  · simp [IH]
#align matrix.transvection_struct.det_to_matrix_prod Matrix.TransvectionStruct.det_toMatrix_prod

/-- The inverse of a `transvection_struct`, designed so that `t.inv.to_matrix` is the inverse of
`t.to_matrix`. -/
@[simps]
protected def inv (t : TransvectionStruct n R) : TransvectionStruct n R
    where
  i := t.i
  j := t.j
  hij := t.hij
  c := -t.c
#align matrix.transvection_struct.inv Matrix.TransvectionStruct.inv

section

variable [Fintype n]

theorem inv_mul (t : TransvectionStruct n R) : t.inv.toMatrix ⬝ t.toMatrix = 1 :=
  by
  rcases t with ⟨⟩
  simp [to_matrix, transvection_mul_transvection_same, t_hij]
#align matrix.transvection_struct.inv_mul Matrix.TransvectionStruct.inv_mul

theorem mul_inv (t : TransvectionStruct n R) : t.toMatrix ⬝ t.inv.toMatrix = 1 :=
  by
  rcases t with ⟨⟩
  simp [to_matrix, transvection_mul_transvection_same, t_hij]
#align matrix.transvection_struct.mul_inv Matrix.TransvectionStruct.mul_inv

theorem reverse_inv_prod_mul_prod (L : List (TransvectionStruct n R)) :
    (L.reverse.map (toMatrix ∘ TransvectionStruct.inv)).Prod ⬝ (L.map toMatrix).Prod = 1 :=
  by
  induction' L with t L IH
  · simp
  · suffices
      (L.reverse.map (to_matrix ∘ transvection_struct.inv)).Prod ⬝ (t.inv.to_matrix ⬝ t.to_matrix) ⬝
          (L.map to_matrix).Prod =
        1
      by simpa [Matrix.mul_assoc]
    simpa [inv_mul] using IH
#align matrix.transvection_struct.reverse_inv_prod_mul_prod Matrix.TransvectionStruct.reverse_inv_prod_mul_prod

theorem prod_mul_reverse_inv_prod (L : List (TransvectionStruct n R)) :
    (L.map toMatrix).Prod ⬝ (L.reverse.map (toMatrix ∘ TransvectionStruct.inv)).Prod = 1 :=
  by
  induction' L with t L IH
  · simp
  · suffices
      t.to_matrix ⬝
            ((L.map to_matrix).Prod ⬝ (L.reverse.map (to_matrix ∘ transvection_struct.inv)).Prod) ⬝
          t.inv.to_matrix =
        1
      by simpa [Matrix.mul_assoc]
    simp_rw [IH, Matrix.mul_one, t.mul_inv]
#align matrix.transvection_struct.prod_mul_reverse_inv_prod Matrix.TransvectionStruct.prod_mul_reverse_inv_prod

end

variable (p)

open Sum

/-- Given a `transvection_struct` on `n`, define the corresponding `transvection_struct` on `n ⊕ p`
using the identity on `p`. -/
def sumInl (t : TransvectionStruct n R) : TransvectionStruct (Sum n p) R
    where
  i := inl t.i
  j := inl t.j
  hij := by simp [t.hij]
  c := t.c
#align matrix.transvection_struct.sum_inl Matrix.TransvectionStruct.sumInl

theorem toMatrix_sumInl (t : TransvectionStruct n R) :
    (t.sumInl p).toMatrix = fromBlocks t.toMatrix 0 0 1 :=
  by
  cases t
  ext (a b)
  cases a <;> cases b
  · by_cases h : a = b <;> simp [transvection_struct.sum_inl, transvection, h, std_basis_matrix]
  · simp [transvection_struct.sum_inl, transvection]
  · simp [transvection_struct.sum_inl, transvection]
  · by_cases h : a = b <;> simp [transvection_struct.sum_inl, transvection, h]
#align matrix.transvection_struct.to_matrix_sum_inl Matrix.TransvectionStruct.toMatrix_sumInl

@[simp]
theorem sumInl_toMatrix_prod_mul [Fintype n] [Fintype p] (M : Matrix n n R)
    (L : List (TransvectionStruct n R)) (N : Matrix p p R) :
    (L.map (toMatrix ∘ sumInl p)).Prod ⬝ fromBlocks M 0 0 N =
      fromBlocks ((L.map toMatrix).Prod ⬝ M) 0 0 N :=
  by
  induction' L with t L IH
  · simp
  · simp [Matrix.mul_assoc, IH, to_matrix_sum_inl, from_blocks_multiply]
#align matrix.transvection_struct.sum_inl_to_matrix_prod_mul Matrix.TransvectionStruct.sumInl_toMatrix_prod_mul

@[simp]
theorem mul_sumInl_toMatrix_prod [Fintype n] [Fintype p] (M : Matrix n n R)
    (L : List (TransvectionStruct n R)) (N : Matrix p p R) :
    fromBlocks M 0 0 N ⬝ (L.map (toMatrix ∘ sumInl p)).Prod =
      fromBlocks (M ⬝ (L.map toMatrix).Prod) 0 0 N :=
  by
  induction' L with t L IH generalizing M N
  · simp
  · simp [IH, to_matrix_sum_inl, from_blocks_multiply]
#align matrix.transvection_struct.mul_sum_inl_to_matrix_prod Matrix.TransvectionStruct.mul_sumInl_toMatrix_prod

variable {p}

/-- Given a `transvection_struct` on `n` and an equivalence between `n` and `p`, define the
corresponding `transvection_struct` on `p`. -/
def reindexEquiv (e : n ≃ p) (t : TransvectionStruct n R) : TransvectionStruct p R
    where
  i := e t.i
  j := e t.j
  hij := by simp [t.hij]
  c := t.c
#align matrix.transvection_struct.reindex_equiv Matrix.TransvectionStruct.reindexEquiv

variable [Fintype n] [Fintype p]

theorem toMatrix_reindexEquiv (e : n ≃ p) (t : TransvectionStruct n R) :
    (t.reindexEquiv e).toMatrix = reindexAlgEquiv R e t.toMatrix :=
  by
  cases t
  ext (a b)
  simp only [reindex_equiv, transvection, mul_boole, Algebra.id.smul_eq_mul, to_matrix_mk,
    submatrix_apply, reindex_apply, DMatrix.add_apply, Pi.smul_apply, reindex_alg_equiv_apply]
  by_cases ha : e t_i = a <;> by_cases hb : e t_j = b <;> by_cases hab : a = b <;>
    simp [ha, hb, hab, ← e.apply_eq_iff_eq_symm_apply, std_basis_matrix]
#align matrix.transvection_struct.to_matrix_reindex_equiv Matrix.TransvectionStruct.toMatrix_reindexEquiv

theorem toMatrix_reindexEquiv_prod (e : n ≃ p) (L : List (TransvectionStruct n R)) :
    (L.map (toMatrix ∘ reindexEquiv e)).Prod = reindexAlgEquiv R e (L.map toMatrix).Prod :=
  by
  induction' L with t L IH
  · simp
  · simp only [to_matrix_reindex_equiv, IH, Function.comp_apply, List.prod_cons, mul_eq_mul,
      reindex_alg_equiv_apply, List.map]
    exact (reindex_alg_equiv_mul _ _ _ _).symm
#align matrix.transvection_struct.to_matrix_reindex_equiv_prod Matrix.TransvectionStruct.toMatrix_reindexEquiv_prod

end TransvectionStruct

end Transvection

/-!
# Reducing matrices by left and right multiplication by transvections

In this section, we show that any matrix can be reduced to diagonal form by left and right
multiplication by transvections (or, equivalently, by elementary operations on lines and columns).
The main step is to kill the last row and column of a matrix in `fin r ⊕ unit` with nonzero last
coefficient, by subtracting this coefficient from the other ones. The list of these operations is
recorded in `list_transvec_col M` and `list_transvec_row M`. We have to analyze inductively how
these operations affect the coefficients in the last row and the last column to conclude that they
have the desired effect.

Once this is done, one concludes the reduction by induction on the size
of the matrices, through a suitable reindexing to identify any fintype with `fin r ⊕ unit`.
-/

namespace Pivot

variable {R} {r : ℕ} (M : Matrix (Sum (Fin r) Unit) (Sum (Fin r) Unit) 𝕜)

open Sum Unit Fin TransvectionStruct

/-- A list of transvections such that multiplying on the left with these transvections will replace
the last column with zeroes. -/
def listTransvecCol : List (Matrix (Sum (Fin r) Unit) (Sum (Fin r) Unit) 𝕜) :=
  List.ofFn fun i : Fin r =>
    transvection (inl i) (inr unit) <| -M (inl i) (inr unit) / M (inr unit) (inr unit)
#align matrix.pivot.list_transvec_col Matrix.Pivot.listTransvecCol

/-- A list of transvections such that multiplying on the right with these transvections will replace
the last row with zeroes. -/
def listTransvecRow : List (Matrix (Sum (Fin r) Unit) (Sum (Fin r) Unit) 𝕜) :=
  List.ofFn fun i : Fin r =>
    transvection (inr unit) (inl i) <| -M (inr unit) (inl i) / M (inr unit) (inr unit)
#align matrix.pivot.list_transvec_row Matrix.Pivot.listTransvecRow

/-- Multiplying by some of the matrices in `list_transvec_col M` does not change the last row. -/
theorem listTransvecCol_mul_last_row_drop (i : Sum (Fin r) Unit) {k : ℕ} (hk : k ≤ r) :
    (((listTransvecCol M).drop k).Prod ⬝ M) (inr unit) i = M (inr unit) i :=
  by
  apply Nat.decreasingInduction' _ hk
  ·
    simp only [list_transvec_col, List.length_ofFn, Matrix.one_mul, List.drop_eq_nil_of_le,
      List.prod_nil]
  · intro n hn hk IH
    have hn' : n < (list_transvec_col M).length := by simpa [list_transvec_col] using hn
    rw [← List.cons_nthLe_drop_succ hn']
    simpa [list_transvec_col, Matrix.mul_assoc]
#align matrix.pivot.list_transvec_col_mul_last_row_drop Matrix.Pivot.listTransvecCol_mul_last_row_drop

/-- Multiplying by all the matrices in `list_transvec_col M` does not change the last row. -/
theorem listTransvecCol_mul_last_row (i : Sum (Fin r) Unit) :
    ((listTransvecCol M).Prod ⬝ M) (inr unit) i = M (inr unit) i := by
  simpa using list_transvec_col_mul_last_row_drop M i (zero_le _)
#align matrix.pivot.list_transvec_col_mul_last_row Matrix.Pivot.listTransvecCol_mul_last_row

/-- Multiplying by all the matrices in `list_transvec_col M` kills all the coefficients in the
last column but the last one. -/
theorem listTransvecCol_mul_last_col (hM : M (inr unit) (inr unit) ≠ 0) (i : Fin r) :
    ((listTransvecCol M).Prod ⬝ M) (inl i) (inr unit) = 0 :=
  by
  suffices H :
    ∀ k : ℕ,
      k ≤ r →
        (((list_transvec_col M).drop k).Prod ⬝ M) (inl i) (inr star) =
          if k ≤ i then 0 else M (inl i) (inr star)
  · simpa only [if_true, List.drop.equations._eqn_1] using H 0 (zero_le _)
  intro k hk
  apply Nat.decreasingInduction' _ hk
  · simp only [list_transvec_col, List.length_ofFn, Matrix.one_mul, List.drop_eq_nil_of_le,
      List.prod_nil]
    rw [if_neg]
    simpa only [not_le] using i.2
  · intro n hn hk IH
    have hn' : n < (list_transvec_col M).length := by simpa [list_transvec_col] using hn
    let n' : Fin r := ⟨n, hn⟩
    rw [← List.cons_nthLe_drop_succ hn']
    have A :
      (list_transvec_col M).nthLe n hn' =
        transvection (inl n') (inr star) (-M (inl n') (inr star) / M (inr star) (inr star)) :=
      by simp [list_transvec_col]
    simp only [Matrix.mul_assoc, A, Matrix.mul_eq_mul, List.prod_cons]
    by_cases h : n' = i
    · have hni : n = i := by
        cases i
        simp only [Fin.mk_eq_mk] at h
        simp [h]
      rw [h, transvection_mul_apply_same, IH, list_transvec_col_mul_last_row_drop _ _ hn, ← hni]
      field_simp [hM]
    · have hni : n ≠ i := by
        rintro rfl
        cases i
        simpa using h
      simp only [transvection_mul_apply_of_ne, Ne.def, not_false_iff, Ne.symm h]
      rw [IH]
      rcases le_or_lt (n + 1) i with (hi | hi)
      · simp only [hi, n.le_succ.trans hi, if_true]
      · rw [if_neg, if_neg]
        · simpa only [hni.symm, not_le, or_false_iff] using Nat.lt_succ_iff_lt_or_eq.1 hi
        · simpa only [not_le] using hi
#align matrix.pivot.list_transvec_col_mul_last_col Matrix.Pivot.listTransvecCol_mul_last_col

/-- Multiplying by some of the matrices in `list_transvec_row M` does not change the last column. -/
theorem mul_listTransvecRow_last_col_take (i : Sum (Fin r) Unit) {k : ℕ} (hk : k ≤ r) :
    (M ⬝ ((listTransvecRow M).take k).Prod) i (inr unit) = M i (inr unit) :=
  by
  induction' k with k IH
  · simp only [Matrix.mul_one, List.take_zero, List.prod_nil]
  · have hkr : k < r := hk
    let k' : Fin r := ⟨k, hkr⟩
    have :
      (list_transvec_row M).get? k =
        ↑(transvection (inr Unit.unit) (inl k')
            (-M (inr Unit.unit) (inl k') / M (inr Unit.unit) (inr Unit.unit))) :=
      by
      simp only [list_transvec_row, List.ofFnNthVal, hkr, dif_pos, List.get?_ofFn]
      rfl
    simp only [List.take_succ, ← Matrix.mul_assoc, this, List.prod_append, Matrix.mul_one,
      Matrix.mul_eq_mul, List.prod_cons, List.prod_nil, Option.to_list_some]
    rw [mul_transvection_apply_of_ne, IH hkr.le]
    simp only [Ne.def, not_false_iff]
#align matrix.pivot.mul_list_transvec_row_last_col_take Matrix.Pivot.mul_listTransvecRow_last_col_take

/-- Multiplying by all the matrices in `list_transvec_row M` does not change the last column. -/
theorem mul_listTransvecRow_last_col (i : Sum (Fin r) Unit) :
    (M ⬝ (listTransvecRow M).Prod) i (inr unit) = M i (inr unit) :=
  by
  have A : (list_transvec_row M).length = r := by simp [list_transvec_row]
  rw [← List.take_length (list_transvec_row M), A]
  simpa using mul_list_transvec_row_last_col_take M i le_rfl
#align matrix.pivot.mul_list_transvec_row_last_col Matrix.Pivot.mul_listTransvecRow_last_col

/-- Multiplying by all the matrices in `list_transvec_row M` kills all the coefficients in the
last row but the last one. -/
theorem mul_listTransvecRow_last_row (hM : M (inr unit) (inr unit) ≠ 0) (i : Fin r) :
    (M ⬝ (listTransvecRow M).Prod) (inr unit) (inl i) = 0 :=
  by
  suffices H :
    ∀ k : ℕ,
      k ≤ r →
        (M ⬝ ((list_transvec_row M).take k).Prod) (inr star) (inl i) =
          if k ≤ i then M (inr star) (inl i) else 0
  · have A : (list_transvec_row M).length = r := by simp [list_transvec_row]
    rw [← List.take_length (list_transvec_row M), A]
    have : ¬r ≤ i := by simp
    simpa only [this, ite_eq_right_iff] using H r le_rfl
  intro k hk
  induction' k with n IH
  · simp only [if_true, Matrix.mul_one, List.take_zero, zero_le', List.prod_nil]
  · have hnr : n < r := hk
    let n' : Fin r := ⟨n, hnr⟩
    have A :
      (list_transvec_row M).get? n =
        ↑(transvection (inr Unit.unit) (inl n')
            (-M (inr Unit.unit) (inl n') / M (inr Unit.unit) (inr Unit.unit))) :=
      by
      simp only [list_transvec_row, List.ofFnNthVal, hnr, dif_pos, List.get?_ofFn]
      rfl
    simp only [List.take_succ, A, ← Matrix.mul_assoc, List.prod_append, Matrix.mul_one,
      Matrix.mul_eq_mul, List.prod_cons, List.prod_nil, Option.to_list_some]
    by_cases h : n' = i
    · have hni : n = i := by
        cases i
        simp only [Fin.mk_eq_mk] at h
        simp only [h, coe_mk]
      have : ¬n.succ ≤ i := by simp only [← hni, n.lt_succ_self, not_le]
      simp only [h, mul_transvection_apply_same, List.take, if_false,
        mul_list_transvec_row_last_col_take _ _ hnr.le, hni.le, this, if_true, IH hnr.le]
      field_simp [hM]
    · have hni : n ≠ i := by
        rintro rfl
        cases i
        simpa using h
      simp only [IH hnr.le, Ne.def, mul_transvection_apply_of_ne, not_false_iff, Ne.symm h]
      rcases le_or_lt (n + 1) i with (hi | hi)
      · simp [hi, n.le_succ.trans hi, if_true]
      · rw [if_neg, if_neg]
        · simpa only [not_le] using hi
        · simpa only [hni.symm, not_le, or_false_iff] using Nat.lt_succ_iff_lt_or_eq.1 hi
#align matrix.pivot.mul_list_transvec_row_last_row Matrix.Pivot.mul_listTransvecRow_last_row

/-- Multiplying by all the matrices either in `list_transvec_col M` and `list_transvec_row M` kills
all the coefficients in the last row but the last one. -/
theorem listTransvecCol_mul_mul_listTransvecRow_last_col (hM : M (inr unit) (inr unit) ≠ 0)
    (i : Fin r) :
    ((listTransvecCol M).Prod ⬝ M ⬝ (listTransvecRow M).Prod) (inr unit) (inl i) = 0 :=
  by
  have : list_transvec_row M = list_transvec_row ((list_transvec_col M).Prod ⬝ M) := by
    simp [list_transvec_row, list_transvec_col_mul_last_row]
  rw [this]
  apply mul_list_transvec_row_last_row
  simpa [list_transvec_col_mul_last_row] using hM
#align matrix.pivot.list_transvec_col_mul_mul_list_transvec_row_last_col Matrix.Pivot.listTransvecCol_mul_mul_listTransvecRow_last_col

/-- Multiplying by all the matrices either in `list_transvec_col M` and `list_transvec_row M` kills
all the coefficients in the last column but the last one. -/
theorem listTransvecCol_mul_mul_listTransvecRow_last_row (hM : M (inr unit) (inr unit) ≠ 0)
    (i : Fin r) :
    ((listTransvecCol M).Prod ⬝ M ⬝ (listTransvecRow M).Prod) (inl i) (inr unit) = 0 :=
  by
  have : list_transvec_col M = list_transvec_col (M ⬝ (list_transvec_row M).Prod) := by
    simp [list_transvec_col, mul_list_transvec_row_last_col]
  rw [this, Matrix.mul_assoc]
  apply list_transvec_col_mul_last_col
  simpa [mul_list_transvec_row_last_col] using hM
#align matrix.pivot.list_transvec_col_mul_mul_list_transvec_row_last_row Matrix.Pivot.listTransvecCol_mul_mul_listTransvecRow_last_row

/-- Multiplying by all the matrices either in `list_transvec_col M` and `list_transvec_row M` turns
the matrix in block-diagonal form. -/
theorem isTwoBlockDiagonal_listTransvecCol_mul_mul_listTransvecRow
    (hM : M (inr unit) (inr unit) ≠ 0) :
    IsTwoBlockDiagonal ((listTransvecCol M).Prod ⬝ M ⬝ (listTransvecRow M).Prod) :=
  by
  constructor
  · ext (i j)
    have : j = star := by simp only [eq_iff_true_of_subsingleton]
    simp [to_blocks₁₂, this, list_transvec_col_mul_mul_list_transvec_row_last_row M hM]
  · ext (i j)
    have : i = star := by simp only [eq_iff_true_of_subsingleton]
    simp [to_blocks₂₁, this, list_transvec_col_mul_mul_list_transvec_row_last_col M hM]
#align matrix.pivot.is_two_block_diagonal_list_transvec_col_mul_mul_list_transvec_row Matrix.Pivot.isTwoBlockDiagonal_listTransvecCol_mul_mul_listTransvecRow

/-- There exist two lists of `transvection_struct` such that multiplying by them on the left and
on the right makes a matrix block-diagonal, when the last coefficient is nonzero. -/
theorem exists_isTwoBlockDiagonal_of_ne_zero (hM : M (inr unit) (inr unit) ≠ 0) :
    ∃ L L' : List (TransvectionStruct (Sum (Fin r) Unit) 𝕜),
      IsTwoBlockDiagonal ((L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod) :=
  by
  let L : List (transvection_struct (Sum (Fin r) Unit) 𝕜) :=
    List.ofFn fun i : Fin r =>
      ⟨inl i, inr star, by simp, -M (inl i) (inr star) / M (inr star) (inr star)⟩
  let L' : List (transvection_struct (Sum (Fin r) Unit) 𝕜) :=
    List.ofFn fun i : Fin r =>
      ⟨inr star, inl i, by simp, -M (inr star) (inl i) / M (inr star) (inr star)⟩
  refine' ⟨L, L', _⟩
  have A : L.map to_matrix = list_transvec_col M := by simp [L, list_transvec_col, (· ∘ ·)]
  have B : L'.map to_matrix = list_transvec_row M := by simp [L, list_transvec_row, (· ∘ ·)]
  rw [A, B]
  exact is_two_block_diagonal_list_transvec_col_mul_mul_list_transvec_row M hM
#align matrix.pivot.exists_is_two_block_diagonal_of_ne_zero Matrix.Pivot.exists_isTwoBlockDiagonal_of_ne_zero

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- There exist two lists of `transvection_struct` such that multiplying by them on the left and
on the right makes a matrix block-diagonal. -/
theorem exists_isTwoBlockDiagonal_list_transvec_mul_mul_list_transvec
    (M : Matrix (Sum (Fin r) Unit) (Sum (Fin r) Unit) 𝕜) :
    ∃ L L' : List (TransvectionStruct (Sum (Fin r) Unit) 𝕜),
      IsTwoBlockDiagonal ((L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod) :=
  by
  by_cases H : is_two_block_diagonal M
  · refine' ⟨List.nil, List.nil, by simpa using H⟩
  -- we have already proved this when the last coefficient is nonzero
  by_cases hM : M (inr star) (inr star) ≠ 0
  · exact exists_is_two_block_diagonal_of_ne_zero M hM
  -- when the last coefficient is zero but there is a nonzero coefficient on the last row or the
  -- last column, we will first put this nonzero coefficient in last position, and then argue as
  -- above.
  push_neg  at hM
  simp [not_and_or, is_two_block_diagonal, to_blocks₁₂, to_blocks₂₁, ← Matrix.ext_iff] at H
  have : ∃ i : Fin r, M (inl i) (inr star) ≠ 0 ∨ M (inr star) (inl i) ≠ 0 :=
    by
    cases H
    · contrapose! H
      rintro i ⟨⟩
      exact (H i).1
    · contrapose! H
      rintro ⟨⟩ j
      exact (H j).2
  rcases this with ⟨i, h | h⟩
  · let M' := transvection (inr Unit.unit) (inl i) 1 ⬝ M
    have hM' : M' (inr star) (inr star) ≠ 0 := by simpa [M', hM]
    rcases exists_is_two_block_diagonal_of_ne_zero M' hM' with ⟨L, L', hLL'⟩
    rw [Matrix.mul_assoc] at hLL'
    refine' ⟨L ++ [⟨inr star, inl i, by simp, 1⟩], L', _⟩
    simp only [List.map_append, List.prod_append, Matrix.mul_one, to_matrix_mk, List.prod_cons,
      List.prod_nil, mul_eq_mul, List.map, Matrix.mul_assoc (L.map to_matrix).Prod]
    exact hLL'
  · let M' := M ⬝ transvection (inl i) (inr star) 1
    have hM' : M' (inr star) (inr star) ≠ 0 := by simpa [M', hM]
    rcases exists_is_two_block_diagonal_of_ne_zero M' hM' with ⟨L, L', hLL'⟩
    refine' ⟨L, ⟨inl i, inr star, by simp, 1⟩::L', _⟩
    simp only [← Matrix.mul_assoc, to_matrix_mk, List.prod_cons, mul_eq_mul, List.map]
    rw [Matrix.mul_assoc (L.map to_matrix).Prod]
    exact hLL'
#align matrix.pivot.exists_is_two_block_diagonal_list_transvec_mul_mul_list_transvec Matrix.Pivot.exists_isTwoBlockDiagonal_list_transvec_mul_mul_list_transvec

/-- Inductive step for the reduction: if one knows that any size `r` matrix can be reduced to
diagonal form by elementary operations, then one deduces it for matrices over `fin r ⊕ unit`. -/
theorem exists_list_transvec_mul_mul_list_transvec_eq_diagonal_induction
    (IH :
      ∀ M : Matrix (Fin r) (Fin r) 𝕜,
        ∃ (L₀ L₀' : List (TransvectionStruct (Fin r) 𝕜))(D₀ : Fin r → 𝕜),
          (L₀.map toMatrix).Prod ⬝ M ⬝ (L₀'.map toMatrix).Prod = diagonal D₀)
    (M : Matrix (Sum (Fin r) Unit) (Sum (Fin r) Unit) 𝕜) :
    ∃ (L L' : List (TransvectionStruct (Sum (Fin r) Unit) 𝕜))(D : Sum (Fin r) Unit → 𝕜),
      (L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod = diagonal D :=
  by
  rcases exists_is_two_block_diagonal_list_transvec_mul_mul_list_transvec M with ⟨L₁, L₁', hM⟩
  let M' := (L₁.map to_matrix).Prod ⬝ M ⬝ (L₁'.map to_matrix).Prod
  let M'' := to_blocks₁₁ M'
  rcases IH M'' with ⟨L₀, L₀', D₀, h₀⟩
  set c := M' (inr star) (inr star) with hc
  refine'
    ⟨L₀.map (sum_inl Unit) ++ L₁, L₁' ++ L₀'.map (sum_inl Unit),
      Sum.elim D₀ fun _ => M' (inr star) (inr star), _⟩
  suffices
    (L₀.map (to_matrix ∘ sum_inl Unit)).Prod ⬝ M' ⬝ (L₀'.map (to_matrix ∘ sum_inl Unit)).Prod =
      diagonal (Sum.elim D₀ fun _ => c)
    by simpa [M', Matrix.mul_assoc, c]
  have : M' = from_blocks M'' 0 0 (diagonal fun _ => c) :=
    by
    rw [← from_blocks_to_blocks M']
    congr
    · exact hM.1
    · exact hM.2
    · ext (⟨⟩⟨⟩)
      rw [hc, to_blocks₂₂, of_apply]
      rfl
  rw [this]
  simp [h₀]
#align matrix.pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal_induction Matrix.Pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal_induction

variable {n p} [Fintype n] [Fintype p]

/-- Reduction to diagonal form by elementary operations is invariant under reindexing. -/
theorem reindex_exists_list_transvec_mul_mul_list_transvec_eq_diagonal (M : Matrix p p 𝕜)
    (e : p ≃ n)
    (H :
      ∃ (L L' : List (TransvectionStruct n 𝕜))(D : n → 𝕜),
        (L.map toMatrix).Prod ⬝ Matrix.reindexAlgEquiv 𝕜 e M ⬝ (L'.map toMatrix).Prod =
          diagonal D) :
    ∃ (L L' : List (TransvectionStruct p 𝕜))(D : p → 𝕜),
      (L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod = diagonal D :=
  by
  rcases H with ⟨L₀, L₀', D₀, h₀⟩
  refine' ⟨L₀.map (reindex_equiv e.symm), L₀'.map (reindex_equiv e.symm), D₀ ∘ e, _⟩
  have : M = reindex_alg_equiv 𝕜 e.symm (reindex_alg_equiv 𝕜 e M) := by
    simp only [Equiv.symm_symm, submatrix_submatrix, reindex_apply, submatrix_id_id,
      Equiv.symm_comp_self, reindex_alg_equiv_apply]
  rw [this]
  simp only [to_matrix_reindex_equiv_prod, List.map_map, reindex_alg_equiv_apply]
  simp only [← reindex_alg_equiv_apply, ← reindex_alg_equiv_mul, h₀]
  simp only [Equiv.symm_symm, reindex_apply, submatrix_diagonal_equiv, reindex_alg_equiv_apply]
#align matrix.pivot.reindex_exists_list_transvec_mul_mul_list_transvec_eq_diagonal Matrix.Pivot.reindex_exists_list_transvec_mul_mul_list_transvec_eq_diagonal

/-- Any matrix can be reduced to diagonal form by elementary operations. Formulated here on `Type 0`
because we will make an induction using `fin r`.
See `exists_list_transvec_mul_mul_list_transvec_eq_diagonal` for the general version (which follows
from this one and reindexing). -/
theorem exists_list_transvec_mul_mul_list_transvec_eq_diagonal_aux (n : Type) [Fintype n]
    [DecidableEq n] (M : Matrix n n 𝕜) :
    ∃ (L L' : List (TransvectionStruct n 𝕜))(D : n → 𝕜),
      (L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod = diagonal D :=
  by
  induction' hn : Fintype.card n with r IH generalizing n M
  · refine' ⟨List.nil, List.nil, fun _ => 1, _⟩
    ext (i j)
    rw [Fintype.card_eq_zero_iff] at hn
    exact hn.elim' i
  · have e : n ≃ Sum (Fin r) Unit :=
      by
      refine' Fintype.equivOfCardEq _
      rw [hn]
      convert(@Fintype.card_sum (Fin r) Unit _ _).symm
      simp
    apply reindex_exists_list_transvec_mul_mul_list_transvec_eq_diagonal M e
    apply
      exists_list_transvec_mul_mul_list_transvec_eq_diagonal_induction fun N =>
        IH (Fin r) N (by simp)
#align matrix.pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal_aux Matrix.Pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal_aux

/-- Any matrix can be reduced to diagonal form by elementary operations. -/
theorem exists_list_transvec_mul_mul_list_transvec_eq_diagonal (M : Matrix n n 𝕜) :
    ∃ (L L' : List (TransvectionStruct n 𝕜))(D : n → 𝕜),
      (L.map toMatrix).Prod ⬝ M ⬝ (L'.map toMatrix).Prod = diagonal D :=
  by
  have e : n ≃ Fin (Fintype.card n) := Fintype.equivOfCardEq (by simp)
  apply reindex_exists_list_transvec_mul_mul_list_transvec_eq_diagonal M e
  apply exists_list_transvec_mul_mul_list_transvec_eq_diagonal_aux
#align matrix.pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal Matrix.Pivot.exists_list_transvec_mul_mul_list_transvec_eq_diagonal

/-- Any matrix can be written as the product of transvections, a diagonal matrix, and
transvections.-/
theorem exists_list_transvec_mul_diagonal_mul_list_transvec (M : Matrix n n 𝕜) :
    ∃ (L L' : List (TransvectionStruct n 𝕜))(D : n → 𝕜),
      M = (L.map toMatrix).Prod ⬝ diagonal D ⬝ (L'.map toMatrix).Prod :=
  by
  rcases exists_list_transvec_mul_mul_list_transvec_eq_diagonal M with ⟨L, L', D, h⟩
  refine' ⟨L.reverse.map transvection_struct.inv, L'.reverse.map transvection_struct.inv, D, _⟩
  suffices
    M =
      (L.reverse.map (to_matrix ∘ transvection_struct.inv)).Prod ⬝ (L.map to_matrix).Prod ⬝ M ⬝
        ((L'.map to_matrix).Prod ⬝ (L'.reverse.map (to_matrix ∘ transvection_struct.inv)).Prod)
    by simpa [← h, Matrix.mul_assoc]
  rw [reverse_inv_prod_mul_prod, prod_mul_reverse_inv_prod, Matrix.one_mul, Matrix.mul_one]
#align matrix.pivot.exists_list_transvec_mul_diagonal_mul_list_transvec Matrix.Pivot.exists_list_transvec_mul_diagonal_mul_list_transvec

end Pivot

open Pivot TransvectionStruct

variable {n} [Fintype n]

/-- Induction principle for matrices based on transvections: if a property is true for all diagonal
matrices, all transvections, and is stable under product, then it is true for all matrices. This is
the useful way to say that matrices are generated by diagonal matrices and transvections.

We state a slightly more general version: to prove a property for a matrix `M`, it suffices to
assume that the diagonal matrices we consider have the same determinant as `M`. This is useful to
obtain similar principles for `SLₙ` or `GLₙ`. -/
theorem diagonal_transvection_induction (P : Matrix n n 𝕜 → Prop) (M : Matrix n n 𝕜)
    (hdiag : ∀ D : n → 𝕜, det (diagonal D) = det M → P (diagonal D))
    (htransvec : ∀ t : TransvectionStruct n 𝕜, P t.toMatrix) (hmul : ∀ A B, P A → P B → P (A ⬝ B)) :
    P M :=
  by
  rcases exists_list_transvec_mul_diagonal_mul_list_transvec M with ⟨L, L', D, h⟩
  have PD : P (diagonal D) := hdiag D (by simp [h])
  suffices H :
    ∀ (L₁ L₂ : List (transvection_struct n 𝕜)) (E : Matrix n n 𝕜),
      P E → P ((L₁.map to_matrix).Prod ⬝ E ⬝ (L₂.map to_matrix).Prod)
  · rw [h]
    apply H L L'
    exact PD
  intro L₁ L₂ E PE
  induction' L₁ with t L₁ IH
  · simp only [Matrix.one_mul, List.prod_nil, List.map]
    induction' L₂ with t L₂ IH generalizing E
    · simpa
    · simp only [← Matrix.mul_assoc, List.prod_cons, mul_eq_mul, List.map]
      apply IH
      exact hmul _ _ PE (htransvec _)
  · simp only [Matrix.mul_assoc, List.prod_cons, mul_eq_mul, List.map] at IH⊢
    exact hmul _ _ (htransvec _) IH
#align matrix.diagonal_transvection_induction Matrix.diagonal_transvection_induction

/-- Induction principle for invertible matrices based on transvections: if a property is true for
all invertible diagonal matrices, all transvections, and is stable under product of invertible
matrices, then it is true for all invertible matrices. This is the useful way to say that
invertible matrices are generated by invertible diagonal matrices and transvections. -/
theorem diagonal_transvection_induction_of_det_ne_zero (P : Matrix n n 𝕜 → Prop) (M : Matrix n n 𝕜)
    (hMdet : det M ≠ 0) (hdiag : ∀ D : n → 𝕜, det (diagonal D) ≠ 0 → P (diagonal D))
    (htransvec : ∀ t : TransvectionStruct n 𝕜, P t.toMatrix)
    (hmul : ∀ A B, det A ≠ 0 → det B ≠ 0 → P A → P B → P (A ⬝ B)) : P M :=
  by
  let Q : Matrix n n 𝕜 → Prop := fun N => det N ≠ 0 ∧ P N
  have : Q M := by
    apply diagonal_transvection_induction Q M
    · intro D hD
      have detD : det (diagonal D) ≠ 0 := by
        rw [hD]
        exact hMdet
      exact ⟨detD, hdiag _ detD⟩
    · intro t
      exact ⟨by simp, htransvec t⟩
    · intro A B QA QB
      exact ⟨by simp [QA.1, QB.1], hmul A B QA.1 QB.1 QA.2 QB.2⟩
  exact this.2
#align matrix.diagonal_transvection_induction_of_det_ne_zero Matrix.diagonal_transvection_induction_of_det_ne_zero

end Matrix


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module group_theory.perm.via_embedding
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Perm.Basic
import Mathbin.Logic.Equiv.Set

/-!
# `equiv.perm.via_embedding`, a noncomputable analogue of `equiv.perm.via_fintype_embedding`.

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

variable {α β : Type _}

namespace Equiv

namespace Perm

variable (e : Perm α) (ι : α ↪ β)

open Classical

#print Equiv.Perm.viaEmbedding /-
/-- Noncomputable version of `equiv.perm.via_fintype_embedding` that does not assume `fintype` -/
noncomputable def viaEmbedding : Perm β :=
  extendDomain e (ofInjective ι.1 ι.2)
#align equiv.perm.via_embedding Equiv.Perm.viaEmbedding
-/

#print Equiv.Perm.viaEmbedding_apply /-
theorem viaEmbedding_apply (x : α) : e.viaEmbedding ι (ι x) = ι (e x) :=
  extendDomain_apply_image e (ofInjective ι.1 ι.2) x
#align equiv.perm.via_embedding_apply Equiv.Perm.viaEmbedding_apply
-/

#print Equiv.Perm.viaEmbedding_apply_of_not_mem /-
theorem viaEmbedding_apply_of_not_mem (x : β) (hx : x ∉ Set.range ι) : e.viaEmbedding ι x = x :=
  extendDomain_apply_not_subtype e (ofInjective ι.1 ι.2) hx
#align equiv.perm.via_embedding_apply_of_not_mem Equiv.Perm.viaEmbedding_apply_of_not_mem
-/

#print Equiv.Perm.viaEmbeddingHom /-
/-- `via_embedding` as a group homomorphism -/
noncomputable def viaEmbeddingHom : Perm α →* Perm β :=
  extendDomainHom (ofInjective ι.1 ι.2)
#align equiv.perm.via_embedding_hom Equiv.Perm.viaEmbeddingHom
-/

/- warning: equiv.perm.via_embedding_hom_apply -> Equiv.Perm.viaEmbeddingHom_apply is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.Perm.{succ u1} α) (ι : Function.Embedding.{succ u1, succ u2} α β), Eq.{succ u2} (Equiv.Perm.{succ u2} β) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (fun (_x : MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) => (Equiv.Perm.{succ u1} α) -> (Equiv.Perm.{succ u2} β)) (MonoidHom.hasCoeToFun.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (Equiv.Perm.viaEmbeddingHom.{u1, u2} α β ι) e) (Equiv.Perm.viaEmbedding.{u1, u2} α β e ι)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.Perm.{succ u1} α) (ι : Function.Embedding.{succ u1, succ u2} α β), Eq.{succ u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} α) => Equiv.Perm.{succ u2} β) e) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (Equiv.Perm.{succ u1} α) (fun (_x : Equiv.Perm.{succ u1} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u1} α) => Equiv.Perm.{succ u2} β) _x) (MulHomClass.toFunLike.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} α) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α))))) (MulOneClass.toMul.{u2} (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (MonoidHomClass.toMulHomClass.{max u1 u2, u1, u2} (MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β)))) (MonoidHom.monoidHomClass.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))))) (Equiv.Perm.viaEmbeddingHom.{u1, u2} α β ι) e) (Equiv.Perm.viaEmbedding.{u1, u2} α β e ι)
Case conversion may be inaccurate. Consider using '#align equiv.perm.via_embedding_hom_apply Equiv.Perm.viaEmbeddingHom_applyₓ'. -/
theorem viaEmbeddingHom_apply : viaEmbeddingHom ι e = viaEmbedding e ι :=
  rfl
#align equiv.perm.via_embedding_hom_apply Equiv.Perm.viaEmbeddingHom_apply

/- warning: equiv.perm.via_embedding_hom_injective -> Equiv.Perm.viaEmbeddingHom_injective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (ι : Function.Embedding.{succ u1, succ u2} α β), Function.Injective.{succ u1, succ u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (fun (_x : MonoidHom.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) => (Equiv.Perm.{succ u1} α) -> (Equiv.Perm.{succ u2} β)) (MonoidHom.hasCoeToFun.{u1, u2} (Equiv.Perm.{succ u1} α) (Equiv.Perm.{succ u2} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} α) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} α) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} α) (Equiv.Perm.permGroup.{u1} α)))) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} β) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} β) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} β) (Equiv.Perm.permGroup.{u2} β))))) (Equiv.Perm.viaEmbeddingHom.{u1, u2} α β ι))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (ι : Function.Embedding.{succ u2, succ u1} α β), Function.Injective.{succ u2, succ u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (MonoidHom.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α)))) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β))))) (Equiv.Perm.{succ u2} α) (fun (_x : Equiv.Perm.{succ u2} α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : Equiv.Perm.{succ u2} α) => Equiv.Perm.{succ u1} β) _x) (MulHomClass.toFunLike.{max u2 u1, u2, u1} (MonoidHom.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α)))) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β))))) (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (MulOneClass.toMul.{u2} (Equiv.Perm.{succ u2} α) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α))))) (MulOneClass.toMul.{u1} (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β))))) (MonoidHomClass.toMulHomClass.{max u2 u1, u2, u1} (MonoidHom.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α)))) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β))))) (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α)))) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β)))) (MonoidHom.monoidHomClass.{u2, u1} (Equiv.Perm.{succ u2} α) (Equiv.Perm.{succ u1} β) (Monoid.toMulOneClass.{u2} (Equiv.Perm.{succ u2} α) (DivInvMonoid.toMonoid.{u2} (Equiv.Perm.{succ u2} α) (Group.toDivInvMonoid.{u2} (Equiv.Perm.{succ u2} α) (Equiv.Perm.permGroup.{u2} α)))) (Monoid.toMulOneClass.{u1} (Equiv.Perm.{succ u1} β) (DivInvMonoid.toMonoid.{u1} (Equiv.Perm.{succ u1} β) (Group.toDivInvMonoid.{u1} (Equiv.Perm.{succ u1} β) (Equiv.Perm.permGroup.{u1} β))))))) (Equiv.Perm.viaEmbeddingHom.{u2, u1} α β ι))
Case conversion may be inaccurate. Consider using '#align equiv.perm.via_embedding_hom_injective Equiv.Perm.viaEmbeddingHom_injectiveₓ'. -/
theorem viaEmbeddingHom_injective : Function.Injective (viaEmbeddingHom ι) :=
  extendDomainHom_injective (ofInjective ι.1 ι.2)
#align equiv.perm.via_embedding_hom_injective Equiv.Perm.viaEmbeddingHom_injective

end Perm

end Equiv


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.finite_limits
import Mathlib.order.complete_lattice
import Mathlib.PostPort

universes u

namespace Mathlib

namespace category_theory.limits.complete_lattice

protected instance has_finite_limits_of_semilattice_inf_top {α : Type u} [semilattice_inf_top α] :
    has_finite_limits α :=
  fun (J : Type u) (𝒥₁ : small_category J) (𝒥₂ : fin_category J) =>
    has_limits_of_shape.mk
      fun (F : J ⥤ α) =>
        has_limit.mk
          (limit_cone.mk
            (cone.mk (finset.inf finset.univ (functor.obj F))
              (nat_trans.mk fun (j : J) => hom_of_le (finset.inf_le (fintype.complete j))))
            (is_limit.mk
              fun (s : cone F) =>
                hom_of_le
                  (finset.le_inf
                    fun (j : J) (_x : j ∈ finset.univ) =>
                      plift.down (ulift.down (nat_trans.app (cone.π s) j)))))

protected instance has_finite_colimits_of_semilattice_sup_bot {α : Type u} [semilattice_sup_bot α] :
    has_finite_colimits α :=
  fun (J : Type u) (𝒥₁ : small_category J) (𝒥₂ : fin_category J) =>
    has_colimits_of_shape.mk
      fun (F : J ⥤ α) =>
        has_colimit.mk
          (colimit_cocone.mk
            (cocone.mk (finset.sup finset.univ (functor.obj F))
              (nat_trans.mk fun (i : J) => hom_of_le (finset.le_sup (fintype.complete i))))
            (is_colimit.mk
              fun (s : cocone F) =>
                hom_of_le
                  (finset.sup_le
                    fun (j : J) (_x : j ∈ finset.univ) =>
                      plift.down (ulift.down (nat_trans.app (cocone.ι s) j)))))

/--
The limit cone over any functor into a complete lattice.
-/
def limit_cone {α : Type u} {J : Type u} [small_category J] [complete_lattice α] (F : J ⥤ α) :
    limit_cone F :=
  limit_cone.mk (cone.mk (infi (functor.obj F)) (nat_trans.mk fun (j : J) => hom_of_le sorry))
    (is_limit.mk fun (s : cone F) => hom_of_le sorry)

/--
The colimit cocone over any functor into a complete lattice.
-/
def colimit_cocone {α : Type u} {J : Type u} [small_category J] [complete_lattice α] (F : J ⥤ α) :
    colimit_cocone F :=
  colimit_cocone.mk (cocone.mk (supr (functor.obj F)) (nat_trans.mk fun (j : J) => hom_of_le sorry))
    (is_colimit.mk fun (s : cocone F) => hom_of_le sorry)

-- It would be nice to only use the `Inf` half of the complete lattice, but

-- this seems not to have been described separately.

protected instance has_limits_of_complete_lattice {α : Type u} [complete_lattice α] :
    has_limits α :=
  has_limits.mk
    fun (J : Type u) (𝒥 : small_category J) =>
      has_limits_of_shape.mk fun (F : J ⥤ α) => has_limit.mk (limit_cone F)

protected instance has_colimits_of_complete_lattice {α : Type u} [complete_lattice α] :
    has_colimits α :=
  has_colimits.mk
    fun (J : Type u) (𝒥 : small_category J) =>
      has_colimits_of_shape.mk fun (F : J ⥤ α) => has_colimit.mk (colimit_cocone F)

/--
The limit of a functor into a complete lattice is the infimum of the objects in the image.
-/
def limit_iso_infi {α : Type u} {J : Type u} [small_category J] [complete_lattice α] (F : J ⥤ α) :
    limit F ≅ infi (functor.obj F) :=
  is_limit.cone_point_unique_up_to_iso (limit.is_limit F) (limit_cone.is_limit (limit_cone F))

@[simp] theorem limit_iso_infi_hom {α : Type u} {J : Type u} [small_category J] [complete_lattice α]
    (F : J ⥤ α) (j : J) :
    iso.hom (limit_iso_infi F) ≫ hom_of_le (infi_le (functor.obj F) j) = limit.π F j :=
  of_as_true trivial

@[simp] theorem limit_iso_infi_inv {α : Type u} {J : Type u} [small_category J] [complete_lattice α]
    (F : J ⥤ α) (j : J) :
    iso.inv (limit_iso_infi F) ≫ limit.π F j = hom_of_le (infi_le (functor.obj F) j) :=
  rfl

/--
The colimit of a functor into a complete lattice is the supremum of the objects in the image.
-/
def colimit_iso_supr {α : Type u} {J : Type u} [small_category J] [complete_lattice α] (F : J ⥤ α) :
    colimit F ≅ supr (functor.obj F) :=
  is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F)
    (colimit_cocone.is_colimit (colimit_cocone F))

@[simp] theorem colimit_iso_supr_hom {α : Type u} {J : Type u} [small_category J]
    [complete_lattice α] (F : J ⥤ α) (j : J) :
    colimit.ι F j ≫ iso.hom (colimit_iso_supr F) = hom_of_le (le_supr (functor.obj F) j) :=
  rfl

@[simp] theorem colimit_iso_supr_inv {α : Type u} {J : Type u} [small_category J]
    [complete_lattice α] (F : J ⥤ α) (j : J) :
    hom_of_le (le_supr (functor.obj F) j) ≫ iso.inv (colimit_iso_supr F) = colimit.ι F j :=
  of_as_true trivial

end Mathlib


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.uniform_space.complete_separated
! leanprover-community/mathlib commit 0a0ec35061ed9960bf0e7ffb0335f44447b58977
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.UniformSpace.Cauchy
import Mathbin.Topology.UniformSpace.Separation
import Mathbin.Topology.DenseEmbedding

/-!
# Theory of complete separated uniform spaces.

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

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

open Filter

open Topology Filter

variable {α : Type _}

#print IsComplete.isClosed /-
--In a separated space, a complete set is closed
theorem IsComplete.isClosed [UniformSpace α] [SeparatedSpace α] {s : Set α} (h : IsComplete s) :
    IsClosed s :=
  isClosed_iff_clusterPt.2 fun a ha => by
    let f := 𝓝[s] a
    have : Cauchy f := cauchy_nhds.mono' ha inf_le_left
    rcases h f this inf_le_right with ⟨y, ys, fy⟩
    rwa [(tendsto_nhds_unique' ha inf_le_left fy : a = y)]
#align is_complete.is_closed IsComplete.isClosed
-/

namespace DenseInducing

open Filter

variable [TopologicalSpace α] {β : Type _} [TopologicalSpace β]

variable {γ : Type _} [UniformSpace γ] [CompleteSpace γ] [SeparatedSpace γ]

/- warning: dense_inducing.continuous_extend_of_cauchy -> DenseInducing.continuous_extend_of_cauchy is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {β : Type.{u2}} [_inst_2 : TopologicalSpace.{u2} β] {γ : Type.{u3}} [_inst_3 : UniformSpace.{u3} γ] [_inst_4 : CompleteSpace.{u3} γ _inst_3] [_inst_5 : SeparatedSpace.{u3} γ _inst_3] {e : α -> β} {f : α -> γ} (de : DenseInducing.{u1, u2} α β _inst_1 _inst_2 e), (forall (b : β), Cauchy.{u3} γ _inst_3 (Filter.map.{u1, u3} α γ f (Filter.comap.{u1, u2} α β e (nhds.{u2} β _inst_2 b)))) -> (Continuous.{u2, u3} β γ _inst_2 (UniformSpace.toTopologicalSpace.{u3} γ _inst_3) (DenseInducing.extend.{u1, u2, u3} α β γ _inst_1 _inst_2 e (UniformSpace.toTopologicalSpace.{u3} γ _inst_3) de f))
but is expected to have type
  forall {α : Type.{u3}} [_inst_1 : TopologicalSpace.{u3} α] {β : Type.{u2}} [_inst_2 : TopologicalSpace.{u2} β] {γ : Type.{u1}} [_inst_3 : UniformSpace.{u1} γ] [_inst_4 : CompleteSpace.{u1} γ _inst_3] [_inst_5 : SeparatedSpace.{u1} γ _inst_3] {e : α -> β} {f : α -> γ} (de : DenseInducing.{u3, u2} α β _inst_1 _inst_2 e), (forall (b : β), Cauchy.{u1} γ _inst_3 (Filter.map.{u3, u1} α γ f (Filter.comap.{u3, u2} α β e (nhds.{u2} β _inst_2 b)))) -> (Continuous.{u2, u1} β γ _inst_2 (UniformSpace.toTopologicalSpace.{u1} γ _inst_3) (DenseInducing.extend.{u3, u2, u1} α β γ _inst_1 _inst_2 e (UniformSpace.toTopologicalSpace.{u1} γ _inst_3) de f))
Case conversion may be inaccurate. Consider using '#align dense_inducing.continuous_extend_of_cauchy DenseInducing.continuous_extend_of_cauchyₓ'. -/
theorem continuous_extend_of_cauchy {e : α → β} {f : α → γ} (de : DenseInducing e)
    (h : ∀ b : β, Cauchy (map f (comap e <| 𝓝 b))) : Continuous (de.extend f) :=
  de.continuous_extend fun b => CompleteSpace.complete (h b)
#align dense_inducing.continuous_extend_of_cauchy DenseInducing.continuous_extend_of_cauchy

end DenseInducing


import .modular_group
import .action

lemma mul_pos_iff {α : Type*} [linear_ordered_ring α] (a b : α) :
  0 < a * b ↔ (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) :=
iff.intro  pos_and_pos_or_neg_and_neg_of_mul_pos $ assume h,
match h with
| or.inl ⟨ha, hb⟩ := mul_pos ha hb
| or.inr ⟨ha, hb⟩ := mul_pos_of_neg_of_neg ha hb
end

@[simp] lemma not_one_lt_zero {α : Type*} [linear_ordered_semiring α] : ¬ (1:α) < 0 :=
not_lt_of_gt zero_lt_one

namespace int

theorem mul_eq_one {m n : ℤ} :
  m * n = 1 ↔ m = 1 ∧ n = 1 ∨ m = -1 ∧ n = -1 :=
⟨λ H, or.cases_on (int.units_eq_one_or ⟨m, n, H, by rwa [mul_comm] at H⟩)
  (λ H1, have H2 : m = 1, from units.ext_iff.1 H1,
    or.inl ⟨H2, by rwa [H2, one_mul] at H⟩)
  (λ H1, have H2 : m = -1, from units.ext_iff.1 H1,
    or.inr ⟨H2, by rwa [H2, neg_one_mul, neg_eq_iff_neg_eq, eq_comm] at H⟩),
by simp [or_imp_distrib] {contextual := tt}⟩

lemma nat_abs_lt_nat_abs (i k : ℤ) (hi : 0 ≤ i) (h : i < abs k) : nat_abs i < nat_abs k :=
coe_nat_lt.1 $ by rwa [nat_abs_of_nonneg hi, ← int.abs_eq_nat_abs]

end int

namespace SL2Z_M

def S : SL2Z := ⟨0, -1, 1, 0, rfl⟩
def T : SL2Z := ⟨1, 1, 0, 1, rfl⟩

@[simp, SL2Z] lemma S_a : S.a = 0 := rfl
@[simp, SL2Z] lemma S_b : S.b = -1 := rfl
@[simp, SL2Z] lemma S_c : S.c = 1 := rfl
@[simp, SL2Z] lemma S_d : S.d = 0 := rfl
@[simp, SL2Z] lemma T_a : T.a = 1 := rfl
@[simp, SL2Z] lemma T_b : T.b = 1 := rfl
@[simp, SL2Z] lemma T_c : T.c = 0 := rfl
@[simp, SL2Z] lemma T_d : T.d = 1 := rfl

variable {m : ℤ}

local notation `Mat` := integral_matrices_with_determinant

@[simp, SL2Z] lemma S_mul_a (A : Mat m) : (SL2Z_M m S A).a = -A.c := by simp [SL2Z_M]
@[simp, SL2Z] lemma S_mul_b (A : Mat m) : (SL2Z_M m S A).b = -A.d := by simp [SL2Z_M]
@[simp, SL2Z] lemma S_mul_c (A : Mat m) : (SL2Z_M m S A).c = A.a := by simp [SL2Z_M]
@[simp, SL2Z] lemma S_mul_d (A : Mat m) : (SL2Z_M m S A).d = A.b := by simp [SL2Z_M]
@[simp, SL2Z] lemma T_mul_a (A : Mat m) : (SL2Z_M m T A).a = A.a + A.c := by simp [SL2Z_M]
@[simp, SL2Z] lemma T_mul_b (A : Mat m) : (SL2Z_M m T A).b = A.b + A.d := by simp [SL2Z_M]
@[simp, SL2Z] lemma T_mul_c (A : Mat m) : (SL2Z_M m T A).c = A.c := by simp [SL2Z_M]
@[simp, SL2Z] lemma T_mul_d (A : Mat m) : (SL2Z_M m T A).d = A.d := by simp [SL2Z_M]

lemma T_pow_aux (n : ℤ) : (T^n).a = 1 ∧ (T^n).b = n ∧ (T^n).c = 0 ∧ (T^n).d = 1 :=
int.induction_on n dec_trivial
  (λ i, by simp [gpow_add] {contextual:=tt})
  (λ i, by simp [gpow_add] {contextual:=tt})
@[simp, SL2Z] lemma T_pow_a (n : ℤ) : (T^n).a = 1 := (T_pow_aux n).1
@[simp, SL2Z] lemma T_pow_b (n : ℤ) : (T^n).b = n := (T_pow_aux n).2.1
@[simp, SL2Z] lemma T_pow_c (n : ℤ) : (T^n).c = 0 := (T_pow_aux n).2.2.1
@[simp, SL2Z] lemma T_pow_d (n : ℤ) : (T^n).d = 1 := (T_pow_aux n).2.2.2

@[simp, SL2Z] lemma S_mul_S : S * S = -1 := rfl

attribute [elab_as_eliminator] nat.strong_induction_on

def reps (m : ℤ) : set (Mat m) :=
{A : Mat m | A.c = 0 ∧ 0 < A.a ∧ 0 ≤ A.b ∧ int.nat_abs A.b < int.nat_abs A.d }

theorem reduce_aux (m : ℤ) (A : Mat m) (H : int.nat_abs (A.c) ≠ 0) :
  int.nat_abs (SL2Z_M m S (SL2Z_M m (T^(-(A.a/A.c))) A)).c < int.nat_abs A.c :=
begin
  have H2 : A.c ≠ 0, from mt (λ H2, show int.nat_abs (A.c) = 0, by rw H2; refl) H,
  simp only [one_mul, zero_mul, add_zero] with SL2Z,
  rw [neg_mul_eq_neg_mul_symm, mul_comm, ← sub_eq_add_neg, ← int.mod_def],
  rw [← int.coe_nat_lt, int.nat_abs_of_nonneg (int.mod_nonneg _ H2)],
  rw [← int.abs_eq_nat_abs],
  exact int.mod_lt _ H2
end

def reduce_step (A : Mat m) : Mat m := SL2Z_M m S (SL2Z_M m (T^(-(A.a/A.c))) A)

@[elab_as_eliminator]
def reduce_rec (m : ℤ) {C : Mat m → Sort*}
  (h₀ : ∀A:Mat m, A.c = 0 → C A)
  (h₁ : ∀A:Mat m, int.nat_abs A.c ≠ 0 → C (reduce_step A) → C A) :
  ∀A, C A | A :=
if hc : int.nat_abs A.c = 0 then h₀ A (int.eq_zero_of_nat_abs_eq_zero hc)
else
  have int.nat_abs (reduce_step A).c < int.nat_abs A.c, from reduce_aux m A hc,
  h₁ A hc (reduce_rec (reduce_step A))
using_well_founded
  { rel_tac := λ _ _, `[exact ⟨_, measure_wf (int.nat_abs ∘ integral_matrices_with_determinant.c)⟩]}

/-- correct if m ≠ 0 -/
def reduce (m : ℤ) : Mat m → Mat m | A :=
if hc : int.nat_abs A.c = 0
then if ha : 0 < A.a
  then SL2Z_M m (T^(-(A.b/A.d))) A
  else SL2Z_M m (T^(-(-A.b/ -A.d))) (SL2Z_M m S (SL2Z_M m S A))
else
  have int.nat_abs (reduce_step A).c < int.nat_abs A.c, from reduce_aux m A hc,
  reduce (reduce_step A)
using_well_founded
  { rel_tac := λ _ _, `[exact ⟨_, measure_wf (int.nat_abs ∘ integral_matrices_with_determinant.c)⟩]}

@[simp] theorem reduce_eq1 (m : ℤ) {A : Mat m} (hc : int.nat_abs A.c = 0) (ha : 0 < A.a) :
  reduce m A = SL2Z_M m (T^(-(A.b/A.d))) A :=
by rw [reduce.equations._eqn_1 _ _, if_pos hc, if_pos ha]; refl

@[simp] theorem reduce_eq2 (m : ℤ) {A : Mat m} (hc : int.nat_abs A.c = 0) (ha : ¬ 0 < A.a) :
  reduce m A = SL2Z_M m (T^(-(-A.b/ -A.d))) (SL2Z_M m S (SL2Z_M m S A)) :=
by rw [reduce.equations._eqn_1 _ _, if_pos hc, if_neg ha]; refl

@[simp] theorem reduce_eq3 (m : ℤ) {A : Mat m} (h : int.nat_abs A.c ≠ 0) :
  reduce m A = reduce m (reduce_step A) :=
by rw [reduce.equations._eqn_1 _ _, if_neg h]

theorem reduce_spec (m : ℤ) : ∀A : Mat m, ∃ S, SL2Z_M m S A = reduce m A :=
begin
  refine reduce_rec m _ _,
  { intros A hc,
    by_cases ha : 0 < A.a,
    { simp [*], exact ⟨_, rfl⟩ },
    { simp [*, (is_monoid_action.mul (SL2Z_M m) _ _ _).symm], exact ⟨_, rfl⟩ } },
  { rintros A hc ⟨S, eq⟩,
    rw [reduce_eq3 m hc, ← eq, reduce_step, ← is_monoid_action.mul (SL2Z_M m), ← is_monoid_action.mul (SL2Z_M m)],
    exact ⟨_, rfl⟩ }
end

theorem reduce_mem_reps (m : ℤ) (hm : m ≠ 0) : ∀(A : Mat m), reduce m A ∈ reps m :=
begin
  refine reduce_rec m (assume A (c_eq : A.c = 0), _) (assume A hc ih, _),
  { have hd : A.d ≠ 0, { intro d_eq, apply hm, rw [← A.det, d_eq, c_eq, mul_zero, mul_zero, sub_zero] },
    have eq : ∀b d, b + -(b / d * d) = b % d, { intros, rw [← sub_eq_add_neg, mul_comm, ← int.mod_def] },
    have h : ∀(a b : ℤ), 0 < a → 0 < a ∧ 0 ≤ b % A.d ∧ int.nat_abs (b % A.d) < int.nat_abs A.d :=
      assume a b ha, ⟨ha, int.mod_nonneg _ hd, int.nat_abs_lt_nat_abs _ _ (int.mod_nonneg _ hd) (int.mod_lt _ hd)⟩,
    by_cases ha : 0 < A.a,
    { simpa [reduce_eq1, reps, c_eq, ha, eq] using h _ _ ha },
    { have a_ne : A.a ≠ 0,
      { intro a_eq, apply hm, rw [← A.det, a_eq, c_eq, zero_mul, mul_zero, sub_zero] },
      have a_pos : -A.a > 0 := neg_pos_of_neg (lt_of_le_of_ne (le_of_not_gt ha) a_ne),
      simpa [reduce_eq2, reps, c_eq, ha, eq] using h _ _ a_pos } },
  { rwa [reduce_eq3 m hc] }
end

@[elab_as_eliminator]
protected theorem induction_on {C : Mat m → Prop} (A : Mat m) (mne0 : m ≠ 0)
  (h0 : ∀{A:Mat m}, A.c = 0 → A.a * A.d = m → 0 < A.a → 0 ≤ A.b → int.nat_abs A.b < int.nat_abs A.d → C A)
  (hS : ∀ B, C B → C (SL2Z_M m S B)) (hT : ∀ B, C B → C (SL2Z_M m T B)) :
  C A :=
have S_eq : ∀ B, (SL2Z_M m S (SL2Z_M m S (SL2Z_M m S (SL2Z_M m S B)))) = B,
  by intro b; ext; simp,
have hS' : ∀{B}, C (SL2Z_M m S B) → C B, from
  λ B ih, have h : _ := (hS _ $ hS _ $ hS _ ih), by rwa S_eq B at h,
have eq : ∀ B,
  (SL2Z_M m S $ SL2Z_M m S $ SL2Z_M m S $ SL2Z_M m T $ SL2Z_M m S $ SL2Z_M m T $ SL2Z_M m S B) =
    SL2Z_M m T⁻¹ B,
  by intro b; repeat {rw [←is_monoid_action.mul (SL2Z_M m)]}; congr,
have hT_inv : ∀ B, C B → C (SL2Z_M m T⁻¹ B), from
  λ B ih, have h : _ := (hS _ $ hS _ $ hS _ $ hT _ $ hS _ $ hT _ $ hS _ ih), by rwa eq at h,
have hT' : ∀B, C (SL2Z_M m T B) → C B,
{ assume B ih,
  have h := hT_inv (SL2Z_M m T B) ih,
  rwa [←is_monoid_action.mul (SL2Z_M m), mul_left_inv, is_monoid_action.one (SL2Z_M m)] at h },
have hT_inv' : ∀ B, C (SL2Z_M m T⁻¹ B) → C B,
{ assume B ih,
  have H := hT (SL2Z_M m T⁻¹ B) ih,
  rwa [←is_monoid_action.mul (SL2Z_M m), mul_right_inv, is_monoid_action.one (SL2Z_M m)] at H },
have hTpow' : ∀{B} {n:ℤ}, C (SL2Z_M m (T^n) B) → C B,
{ refine assume B n, int.induction_on n (λh, _) (λi ih1 ih2, ih1 $ hT' _ _) (λi ih1 ih2, ih1 $ hT_inv' _ _),
  { rwa [gpow_zero, is_monoid_action.one (SL2Z_M m)] at h },
  { rwa [add_comm, gpow_add, gpow_one, is_monoid_action.mul (SL2Z_M m)] at ih2 },
  { rwa [sub_eq_neg_add, gpow_add, gpow_neg_one, is_monoid_action.mul (SL2Z_M m)] at ih2 } },
have h_reduce : C (reduce m A),
{ rcases reduce_mem_reps m mne0 A with ⟨H1, H2, H3, H4⟩,
  refine h0 H1 _ H2 H3 H4,
  simpa only [H1, mul_zero, sub_zero] using (reduce m A).det },
suffices ∀A : Mat m, C (reduce m A) → C A, from this _ h_reduce,
begin
  refine reduce_rec m _ _,
  { assume A c_eq ih,
    by_cases ha : 0 < A.a,
    { simp [reduce_eq1, c_eq, ha, -gpow_neg] at ih, exact hTpow' ih },
    { simp [reduce_eq2, c_eq, ha] at ih, exact (hS' $ hS' $ hTpow' ih) } },
  { assume A hc ih hA,
    rw [reduce_eq3 m hc] at hA,
    exact (hTpow' $ hS' $ ih hA) }
end

theorem reps_unique (m : ℤ) (hm : m ≠ 0) :
  ∀(M : SL2Z) (A B : Mat m), A ∈ reps m → B ∈ reps m → SL2Z_M m M A = B → A = B :=
begin
  rintros ⟨a, b, c, d, _⟩ ⟨e, f, g, h, _⟩ ⟨i, j, k, l, _⟩
    ⟨g_eq, e_pos, f_nonneg, f_bound⟩ ⟨k_eq, H6, f'_nonneg, f'_bound⟩ B_eq,
  rcases integral_matrices_with_determinant.mk.inj B_eq with ⟨i_eq, j_eq, ce_0, _⟩, clear B_eq,
  dsimp only at *,
  subst g_eq, subst k_eq, subst j_eq, subst i_eq,
  have : c = 0, { simp at ce_0, rcases ce_0 with rfl | rfl, { refl }, exact (irrefl _ e_pos).elim },
  subst this,
  have : a = 1, { by_contradiction, simp [*, int.mul_eq_one, mul_pos_iff, neg_pos, not_lt_of_gt e_pos] at * },
  subst this,
  by_cases hb : b ≠ 0; by_cases hh : h ≠ 0; cases_matching* [_ ∧ _, _ ∨ _]; subst_vars;
    simp [*, neg_pos, int.coe_nat_lt.symm, (int.abs_eq_nat_abs _).symm] at *,
  { rw [abs_of_nonneg f_nonneg] at f_bound,
    rw [abs_of_nonneg f'_nonneg] at f'_bound,
    rw [← int.mod_eq_of_lt f'_nonneg f'_bound, ← int.mod_eq_of_lt f_nonneg f_bound],
    simp }
end

variable (m)

instance reps.fintype_pos (m:ℕ+) : fintype (reps m) :=
fintype.of_equiv {v : fin (m+1) × fin (m+1) × fin (m+1) // v.1.1 * v.2.2.1 = m ∧ v.2.1.1 < v.2.2.1}
{ to_fun := λ A, ⟨⟨A.1.1.1, A.1.2.1.1, 0, A.1.2.2.1, by rw [mul_zero, sub_zero, ← int.coe_nat_mul, A.2.1, coe_coe]⟩,
    rfl, int.coe_nat_pos.2 $ nat.pos_of_ne_zero $ λ H, ne_of_gt m.2 $ A.2.1.symm.trans $ by rw [H, zero_mul],
    trivial, by simp only [int.nat_abs_of_nat, A.2.2]⟩,
  inv_fun := λ A, ⟨(⟨int.nat_abs A.1.a, nat.lt_succ_of_le $ nat.le_of_dvd m.2 ⟨int.nat_abs A.1.d,
      by have := A.1.det; simp only [A.2.1, mul_zero, sub_zero] at this;
      rw [← int.nat_abs_mul, this, coe_coe, int.nat_abs_of_nat]⟩⟩,
    ⟨int.nat_abs A.1.b, nat.lt_succ_of_le $ le_trans (le_of_lt A.2.2.2.2) $ nat.le_of_dvd m.2 ⟨int.nat_abs A.1.a,
      by have := A.1.det; simp only [A.2.1, mul_zero, sub_zero] at this;
      rw [mul_comm, ← int.nat_abs_mul, this, coe_coe, int.nat_abs_of_nat]⟩⟩,
    ⟨int.nat_abs A.1.d, nat.lt_succ_of_le $ nat.le_of_dvd m.2 ⟨int.nat_abs A.1.a,
      by have := A.1.det; simp only [A.2.1, mul_zero, sub_zero] at this;
      rw [mul_comm, ← int.nat_abs_mul, this, coe_coe, int.nat_abs_of_nat]⟩⟩),
    by have := A.1.det; simp only [A.2.1, mul_zero, sub_zero] at this;
      rw [← int.nat_abs_mul, this, coe_coe, int.nat_abs_of_nat],
    A.2.2.2.2⟩,
  left_inv := λ ⟨⟨⟨a, ha⟩, ⟨b, hb⟩, ⟨d, hd⟩⟩, H1, H2⟩, subtype.eq $ prod.ext
    (fin.eq_of_veq $ int.nat_abs_of_nat _) $ prod.ext
    (fin.eq_of_veq $ int.nat_abs_of_nat _)
    (fin.eq_of_veq $ int.nat_abs_of_nat _),
  right_inv := λ ⟨⟨a, b, c, d, H1⟩, H2, H3, H4, H5⟩, subtype.eq $
    integral_matrices_with_determinant.ext _ _ _
      (int.nat_abs_of_nonneg $ le_of_lt H3) (int.nat_abs_of_nonneg H4) (eq.symm H2) $
      int.nat_abs_of_nonneg $ le_of_not_lt $ λ H6, not_le_of_lt m.2 $
      int.coe_nat_le.1 $ show (m:ℤ) ≤ 0,
      by dsimp only at H2 H3 H4 H5;
        rw [H2, mul_zero, sub_zero] at H1;
        rw ← H1;
      from mul_nonpos_of_nonneg_of_nonpos (le_of_lt H3) (le_of_lt H6), }

def reps.fintype : Π m : ℤ, m ≠ 0 → fintype (reps m)
| (int.of_nat $ n+1) H := reps.fintype_pos ⟨n+1, nat.zero_lt_succ n⟩
| 0 H := (H rfl).elim
| -[1+ n] H := fintype.of_equiv (reps (⟨n+1, nat.zero_lt_succ _⟩:pnat))
{ to_fun := λ A, ⟨⟨A.1.a, A.1.b, A.1.c, -A.1.d,
      by have := A.1.det; rw [A.2.1, mul_zero, sub_zero] at this ⊢;
      rw [mul_neg_eq_neg_mul_symm, this]; refl⟩,
    A.2.1, A.2.2.1, A.2.2.2.1, trans_rel_left _ A.2.2.2.2 $ eq.symm $ int.nat_abs_neg _⟩,
  inv_fun := λ A, ⟨⟨A.1.a, A.1.b, A.1.c, -A.1.d,
      by have := A.1.det; rw [A.2.1, mul_zero, sub_zero] at this ⊢;
      rw [mul_neg_eq_neg_mul_symm, this]; refl⟩,
    A.2.1, A.2.2.1, A.2.2.2.1, trans_rel_left _ A.2.2.2.2 $ eq.symm $ int.nat_abs_neg _⟩,
  left_inv := λ ⟨⟨a, b, c, d, H1⟩, H2⟩, subtype.eq $
    integral_matrices_with_determinant.ext _ _ _ rfl rfl rfl (neg_neg _),
  right_inv := λ ⟨⟨a, b, c, d, H1⟩, H2⟩, subtype.eq $
    integral_matrices_with_determinant.ext _ _ _ rfl rfl rfl (neg_neg _) }

def π : reps m → quotient (action_rel $ SL2Z_M m) :=
  λ A, (@quotient.mk _ (action_rel $ SL2Z_M m)) A

section
set_option eqn_compiler.zeta true
def reps_equiv (hm : m ≠ 0) : quotient (action_rel (SL2Z_M m)) ≃ reps m :=
by letI := action_rel (SL2Z_M m); from
{ to_fun := λ x, quotient.lift_on x (λ A, (⟨reduce m A, reduce_mem_reps m hm A⟩ : reps m)) $ λ A B ⟨M, H⟩,
    let ⟨MA, HA⟩ := reduce_spec m A in
    let ⟨MB, HB⟩ := reduce_spec m B in
    subtype.eq $ reps_unique m hm (MB * M * MA⁻¹) _ _ (reduce_mem_reps m hm A) (reduce_mem_reps m hm B) $
    by simp only [is_monoid_action.mul (SL2Z_M m)];
    rw [← HA, ← is_monoid_action.mul (SL2Z_M m) MA⁻¹, inv_mul_self];
    rw [is_monoid_action.one (SL2Z_M m), H, HB],
  inv_fun := λ A, ⟦A.1⟧,
  left_inv := λ x, quotient.induction_on x $ λ A, quotient.sound $
    let ⟨MA, HA⟩ := reduce_spec m A in
    ⟨MA⁻¹, show SL2Z_M m MA⁻¹ (reduce m A) = A,
    by rw [← HA, ← is_monoid_action.mul (SL2Z_M m) MA⁻¹, inv_mul_self];
    rw [is_monoid_action.one (SL2Z_M m)]⟩,
  right_inv := λ A, subtype.eq $
    let ⟨MA, HA⟩ := reduce_spec m A in
    reps_unique m hm MA⁻¹ _ _ (reduce_mem_reps m hm A) A.2 $
    show SL2Z_M m MA⁻¹ (reduce m A) = A,
    by rw [← HA, ← is_monoid_action.mul (SL2Z_M m) MA⁻¹, inv_mul_self];
    rw [is_monoid_action.one (SL2Z_M m)] }
end

protected def decidable_eq (hm : m ≠ 0) : decidable_eq (quotient (action_rel (SL2Z_M m))) :=
equiv.decidable_eq (reps_equiv m hm)

def finiteness (hm : m ≠ 0) : fintype (quotient $ action_rel $ SL2Z_M m) :=
@fintype.of_equiv _ _ (reps.fintype m hm) (reps_equiv m hm).symm

end SL2Z_M


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky, Chris Hughes

! This file was ported from Lean 3 source module data.list.duplicate
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Nodup

/-!
# List duplicates

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

## Main definitions

* `list.duplicate x l : Prop` is an inductive property that holds when `x` is a duplicate in `l`

## Implementation details

In this file, `x ∈+ l` notation is shorthand for `list.duplicate x l`.

-/

variable {α : Type _}

namespace List

#print List.Duplicate /-
/-- Property that an element `x : α` of `l : list α` can be found in the list more than once. -/
inductive Duplicate (x : α) : List α → Prop
  | cons_mem {l : List α} : x ∈ l → duplicate (x :: l)
  | cons_duplicate {y : α} {l : List α} : duplicate l → duplicate (y :: l)
#align list.duplicate List.Duplicate
-/

-- mathport name: «expr ∈+ »
local infixl:50 " ∈+ " => List.Duplicate

variable {l : List α} {x : α}

#print List.Mem.duplicate_cons_self /-
theorem Mem.duplicate_cons_self (h : x ∈ l) : x ∈+ x :: l :=
  Duplicate.cons_mem h
#align list.mem.duplicate_cons_self List.Mem.duplicate_cons_self
-/

#print List.Duplicate.duplicate_cons /-
theorem Duplicate.duplicate_cons (h : x ∈+ l) (y : α) : x ∈+ y :: l :=
  Duplicate.cons_duplicate h
#align list.duplicate.duplicate_cons List.Duplicate.duplicate_cons
-/

#print List.Duplicate.mem /-
theorem Duplicate.mem (h : x ∈+ l) : x ∈ l :=
  by
  induction' h with l' h y l' h hm
  · exact mem_cons_self _ _
  · exact mem_cons_of_mem _ hm
#align list.duplicate.mem List.Duplicate.mem
-/

#print List.Duplicate.mem_cons_self /-
theorem Duplicate.mem_cons_self (h : x ∈+ x :: l) : x ∈ l :=
  by
  cases' h with _ h _ _ h
  · exact h
  · exact h.mem
#align list.duplicate.mem_cons_self List.Duplicate.mem_cons_self
-/

#print List.duplicate_cons_self_iff /-
@[simp]
theorem duplicate_cons_self_iff : x ∈+ x :: l ↔ x ∈ l :=
  ⟨Duplicate.mem_cons_self, Mem.duplicate_cons_self⟩
#align list.duplicate_cons_self_iff List.duplicate_cons_self_iff
-/

#print List.Duplicate.ne_nil /-
theorem Duplicate.ne_nil (h : x ∈+ l) : l ≠ [] := fun H => (mem_nil_iff x).mp (H ▸ h.Mem)
#align list.duplicate.ne_nil List.Duplicate.ne_nil
-/

#print List.not_duplicate_nil /-
@[simp]
theorem not_duplicate_nil (x : α) : ¬x ∈+ [] := fun H => H.ne_nil rfl
#align list.not_duplicate_nil List.not_duplicate_nil
-/

#print List.Duplicate.ne_singleton /-
theorem Duplicate.ne_singleton (h : x ∈+ l) (y : α) : l ≠ [y] :=
  by
  induction' h with l' h z l' h hm
  · simp [ne_nil_of_mem h]
  · simp [ne_nil_of_mem h.mem]
#align list.duplicate.ne_singleton List.Duplicate.ne_singleton
-/

#print List.not_duplicate_singleton /-
@[simp]
theorem not_duplicate_singleton (x y : α) : ¬x ∈+ [y] := fun H => H.ne_singleton _ rfl
#align list.not_duplicate_singleton List.not_duplicate_singleton
-/

#print List.Duplicate.elim_nil /-
theorem Duplicate.elim_nil (h : x ∈+ []) : False :=
  not_duplicate_nil x h
#align list.duplicate.elim_nil List.Duplicate.elim_nil
-/

#print List.Duplicate.elim_singleton /-
theorem Duplicate.elim_singleton {y : α} (h : x ∈+ [y]) : False :=
  not_duplicate_singleton x y h
#align list.duplicate.elim_singleton List.Duplicate.elim_singleton
-/

#print List.duplicate_cons_iff /-
theorem duplicate_cons_iff {y : α} : x ∈+ y :: l ↔ y = x ∧ x ∈ l ∨ x ∈+ l :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · cases' h with _ hm _ _ hm
    · exact Or.inl ⟨rfl, hm⟩
    · exact Or.inr hm
  · rcases h with (⟨rfl | h⟩ | h)
    · simpa
    · exact h.cons_duplicate
#align list.duplicate_cons_iff List.duplicate_cons_iff
-/

#print List.Duplicate.of_duplicate_cons /-
theorem Duplicate.of_duplicate_cons {y : α} (h : x ∈+ y :: l) (hx : x ≠ y) : x ∈+ l := by
  simpa [duplicate_cons_iff, hx.symm] using h
#align list.duplicate.of_duplicate_cons List.Duplicate.of_duplicate_cons
-/

#print List.duplicate_cons_iff_of_ne /-
theorem duplicate_cons_iff_of_ne {y : α} (hne : x ≠ y) : x ∈+ y :: l ↔ x ∈+ l := by
  simp [duplicate_cons_iff, hne.symm]
#align list.duplicate_cons_iff_of_ne List.duplicate_cons_iff_of_ne
-/

#print List.Duplicate.mono_sublist /-
theorem Duplicate.mono_sublist {l' : List α} (hx : x ∈+ l) (h : l <+ l') : x ∈+ l' :=
  by
  induction' h with l₁ l₂ y h IH l₁ l₂ y h IH
  · exact hx
  · exact (IH hx).duplicate_cons _
  · rw [duplicate_cons_iff] at hx⊢
    rcases hx with (⟨rfl, hx⟩ | hx)
    · simp [h.subset hx]
    · simp [IH hx]
#align list.duplicate.mono_sublist List.Duplicate.mono_sublist
-/

#print List.duplicate_iff_sublist /-
/-- The contrapositive of `list.nodup_iff_sublist`. -/
theorem duplicate_iff_sublist : x ∈+ l ↔ [x, x] <+ l :=
  by
  induction' l with y l IH
  · simp
  · by_cases hx : x = y
    · simp [hx, cons_sublist_cons_iff, singleton_sublist]
    · rw [duplicate_cons_iff_of_ne hx, IH]
      refine' ⟨sublist_cons_of_sublist y, fun h => _⟩
      cases h
      · assumption
      · contradiction
#align list.duplicate_iff_sublist List.duplicate_iff_sublist
-/

#print List.nodup_iff_forall_not_duplicate /-
theorem nodup_iff_forall_not_duplicate : Nodup l ↔ ∀ x : α, ¬x ∈+ l := by
  simp_rw [nodup_iff_sublist, duplicate_iff_sublist]
#align list.nodup_iff_forall_not_duplicate List.nodup_iff_forall_not_duplicate
-/

#print List.exists_duplicate_iff_not_nodup /-
theorem exists_duplicate_iff_not_nodup : (∃ x : α, x ∈+ l) ↔ ¬Nodup l := by
  simp [nodup_iff_forall_not_duplicate]
#align list.exists_duplicate_iff_not_nodup List.exists_duplicate_iff_not_nodup
-/

#print List.Duplicate.not_nodup /-
theorem Duplicate.not_nodup (h : x ∈+ l) : ¬Nodup l := fun H =>
  nodup_iff_forall_not_duplicate.mp H _ h
#align list.duplicate.not_nodup List.Duplicate.not_nodup
-/

#print List.duplicate_iff_two_le_count /-
theorem duplicate_iff_two_le_count [DecidableEq α] : x ∈+ l ↔ 2 ≤ count x l := by
  simp [duplicate_iff_sublist, le_count_iff_replicate_sublist]
#align list.duplicate_iff_two_le_count List.duplicate_iff_two_le_count
-/

#print List.decidableDuplicate /-
instance decidableDuplicate [DecidableEq α] (x : α) : ∀ l : List α, Decidable (x ∈+ l)
  | [] => isFalse (not_duplicate_nil x)
  | y :: l =>
    match decidable_duplicate l with
    | is_true h => isTrue (h.duplicate_cons y)
    | is_false h =>
      if hx : y = x ∧ x ∈ l then isTrue (hx.left.symm ▸ hx.right.duplicate_cons_self)
      else isFalse (by simpa [duplicate_cons_iff, h] using hx)
#align list.decidable_duplicate List.decidableDuplicate
-/

end List


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.equiv.mul_add logic.function.basic group_theory.subgroup
/-!
# Semidirect product

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`φ` from `G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* G ⋉[φ] N` and
`inr : G →* G ⋉[φ] N`, and `lift` can be used to define maps `G ⋉[φ] N →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `G ⋉[φ] N` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/
variables (G : Type*) (N : Type*) {H : Type*} [group N] [group G] [group H]

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
@[ext, derive decidable_eq]
structure lsemidirect_product (φ : G →* mul_aut N) :=
(left : G) (right : N)

attribute [pp_using_anonymous_constructor] lsemidirect_product

notation G` ⋉[`:35 φ:35`] `:0 N :35 := lsemidirect_product G N φ

namespace lsemidirect_product

variables {N G} {φ : G →* mul_aut N}

private def one_aux : G ⋉[φ] N := ⟨1, 1⟩
private def mul_aux (a b : G ⋉[φ] N) : G ⋉[φ] N := ⟨a.left * b.left, φ b.1⁻¹ a.2 * b.2⟩
private def inv_aux (a : G ⋉[φ] N) : G ⋉[φ] N := ⟨a.1⁻¹, φ a.1 a.2⁻¹⟩
private lemma mul_assoc_aux (a b c : G ⋉[φ] N) : mul_aux (mul_aux a b) c = mul_aux a (mul_aux b c) :=
by simp [mul_aux, mul_assoc, mul_equiv.map_mul]
private lemma mul_one_aux (a : G ⋉[φ] N) : mul_aux a one_aux = a :=
by cases a; simp [mul_aux, one_aux]
private lemma one_mul_aux (a : G ⋉[φ] N) : mul_aux one_aux a = a :=
by cases a; simp [mul_aux, one_aux]
private lemma mul_left_inv_aux (a : G ⋉[φ] N) : mul_aux (inv_aux a) a = one_aux :=
by simp only [mul_aux, inv_aux, one_aux, ← mul_equiv.map_mul, mul_left_inv]; simp; admit

instance : group (G ⋉[φ] N) :=
{ one := one_aux,
  inv := inv_aux,
  mul := mul_aux,
  mul_assoc := mul_assoc_aux,
  one_mul := one_mul_aux,
  mul_one := mul_one_aux,
  mul_left_inv := mul_left_inv_aux }

instance : inhabited (G ⋉[φ] N) := ⟨1⟩

@[simp] lemma one_left : (1 : G ⋉[φ] N).left = 1 := rfl
@[simp] lemma one_right : (1 : G ⋉[φ] N).right = 1 := rfl
@[simp] lemma inv_left (a : G ⋉[φ] N) : (a⁻¹).left = a.left⁻¹ := rfl
@[simp] lemma inv_right (a : G ⋉[φ] N) : (a⁻¹).right = φ a.left a.right⁻¹ := rfl
@[simp] lemma mul_left (a b : G ⋉[φ] N) : (a * b).left = a.left * b.left := rfl
@[simp] lemma mul_right (a b : G ⋉[φ] N) : (a * b).right = φ b.left⁻¹ a.right * b.right := rfl

/-- The canonical map `N →* G ⋉[φ] N` sending `n` to `⟨n, 1⟩` -/
def inl : G →* G ⋉[φ] N :=
{ to_fun := λ g, ⟨g, 1⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inl (g : G) : (inl g : G ⋉[φ] N).left = g := rfl
@[simp] lemma right_inl (g : G) : (inl g : G ⋉[φ] N).right = 1 := rfl

lemma inl_injective : function.injective (inl : G → G ⋉[φ] N) :=
function.injective_iff_has_left_inverse.2 ⟨left, left_inl⟩

@[simp] lemma inl_inj {g₁ g₂ : G} : (inl g₁ : G ⋉[φ] N) = inl g₂ ↔ g₁ = g₂ :=
inl_injective.eq_iff

/-- The canonical map `G →* G ⋉[φ] N` sending `g` to `⟨1, g⟩` -/
def inr : N →* G ⋉[φ] N :=
{ to_fun := λ n, ⟨1, n⟩,
  map_one' := rfl,
  map_mul' := by intros; ext; simp }

@[simp] lemma left_inr (n : N) : (inr n : G ⋉[φ] N).left = 1 := rfl
@[simp] lemma right_inr (n : N) : (inr n : G ⋉[φ] N).right = n := rfl

lemma inr_injective : function.injective (inr : N → G ⋉[φ] N) :=
function.injective_iff_has_left_inverse.2 ⟨right, right_inr⟩

@[simp] lemma inr_inj {n₁ n₂ : N} : (inr n₁ : G ⋉[φ] N) = inr n₂ ↔ n₁ = n₂ :=
inr_injective.eq_iff

lemma inr_aut (g : G) (n : N) : (inr (φ g n) : G ⋉[φ] N) = inl g * inr n * inl g⁻¹ :=
by ext; simp

lemma inl_aut_inv (g : G) (n : N) : (inr ((φ g)⁻¹ n) : G ⋉[φ] N) = inl g⁻¹ * inr n * inl g :=
by rw [← monoid_hom.map_inv, inr_aut, inv_inv]

lemma inl_left_mul_inr_right (x : G ⋉[φ] N) : inl x.left * inr x.right = x :=
by ext; simp

/-- The canonical projection map `G ⋉[φ] N →* G`, as a group hom. -/
def left_hom : G ⋉[φ] N →* G :=
{ to_fun := lsemidirect_product.left,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

@[simp] lemma left_hom_eq_left : (left_hom :  G ⋉[φ] N → G) = left := rfl

@[simp] lemma left_hom_comp_inr : (left_hom : G ⋉[φ] N →* G).comp inr = 1 :=
by ext; simp [left_hom]

@[simp] lemma right_hom_comp_inl : (left_hom : G ⋉[φ] N →* G).comp inl = monoid_hom.id _ :=
by ext; simp [left_hom]

@[simp] lemma left_hom_inr (n : N) : left_hom (inr n : G ⋉[φ] N) = 1 :=
by simp [left_hom]

@[simp] lemma left_hom_inl (g : G) : left_hom (inl g : G ⋉[φ] N) = g :=
by simp [left_hom]

lemma left_hom_surjective : function.surjective (left_hom : G ⋉[φ] N → G) :=
function.surjective_iff_has_right_inverse.2 ⟨inl, left_hom_inl⟩

lemma range_inr_eq_ker_left_hom : (inr : N →* G ⋉[φ] N).range = left_hom.ker :=
le_antisymm
  (λ _, by simp [monoid_hom.mem_ker, eq_comm] {contextual := tt})
  (λ x hx, ⟨x.right, by ext; simp [*, monoid_hom.mem_ker] at *⟩)

section lift
variables (f₁ : N →* H) (f₂ : G →* H)
  (h : ∀ g, f₁.comp (φ g).to_monoid_hom = (mul_aut.conj (f₂ g)).to_monoid_hom.comp f₁)

/-- Define a group hom `G ⋉[φ] N →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift  (f₁ : G →* H) (f₂ : N →* H)
  (h : ∀ g, f₂.comp (φ g).to_monoid_hom = (mul_aut.conj (f₁ g)).to_monoid_hom.comp f₂) :
  G ⋉[φ] N →* H :=
{ to_fun := λ a, f₁ a.1 * f₂ a.2,
  map_one' := by simp,
  map_mul' := λ a b, begin
    have := λ n g, monoid_hom.ext_iff.1 (h n) g,
    simp only [mul_aut.conj_apply, monoid_hom.comp_apply, mul_equiv.to_monoid_hom_apply] at this,
    simp [this, mul_assoc],
  end }

@[simp] lemma lift_inl (n : N) : lift f₁ f₂ h (inl n) = f₁ n := by simp [lift]
@[simp] lemma lift_comp_inl : (lift f₁ f₂ h).comp inl = f₁ := by ext; simp

@[simp] lemma lift_inr (g : G) : lift f₁ f₂ h (inr g) = f₂ g := by simp [lift]
@[simp] lemma lift_comp_inr : (lift f₁ f₂ h).comp inr = f₂ := by ext; simp

lemma left_mul_right (x : G ⋉[φ] N) :
  inl x.left * inr x.right = x := by ext; simp

lemma lift_unique (F : G ⋉[φ] N →* H) :
  F = lift (F.comp inl) (F.comp inr) (λ _, by ext; simp [inl_aut]) :=
begin
  ext,
  simp only [lift, monoid_hom.comp_apply, monoid_hom.coe_mk],
  rw [← F.map_mul, inl_left_mul_inr_right],
end

end lift

end lsemidirect_product


import data.set.image

variables {α β : Type*}

open set

namespace set

@[simp] lemma preimage_mem_singleton_true (s : set α) : (∈ s) ⁻¹' {true} = s := by { ext, simp }
@[simp] lemma preimage_mem_singleton_false (s : set α) : (∈ s) ⁻¹' {false} = sᶜ := by { ext, simp }

@[simp] lemma preimage_symm_diff (f : α → β) (s t : set β) :
  f ⁻¹' (s ∆ t) = (f ⁻¹' s) ∆ (f ⁻¹' t) :=
by simp [symm_diff]

end set

namespace function
variables {f : α → α}

protected lemma involutive.preimage (hf : involutive f) : involutive (preimage f) :=
hf.right_inverse.preimage_preimage

end function


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

The Schröder-Bernstein theorem, and well ordering of cardinals.
-/
import order.fixed_points
import order.zorn

open set classical
open_locale classical

universes u v

namespace function
namespace embedding

section antisymm
variables {α : Type u} {β : Type v}

theorem schroeder_bernstein {f : α → β} {g : β → α}
  (hf : function.injective f) (hg : function.injective g) : ∃h:α→β, bijective h :=
let s : set α := lfp $ λs, (g '' (f '' s)ᶜ)ᶜ in
have hs : s = (g '' (f '' s)ᶜ)ᶜ,
  from lfp_eq $ assume s t h,
    compl_subset_compl.mpr $ image_subset _ $
    compl_subset_compl.mpr $ image_subset _ h,

have hns : sᶜ = g '' (f '' s)ᶜ,
  from compl_injective $ by simp [hs.symm],

let g' := λa, @inv_fun β ⟨f a⟩ α g a in
have g'g : g' ∘ g = id,
  from funext $ assume b, @left_inverse_inv_fun _ ⟨f (g b)⟩ _ _ hg b,
have hg'ns : g' '' sᶜ = (f '' s)ᶜ,
  by rw [hns, ←image_comp, g'g, image_id],

let h := λa, if a ∈ s then f a else g' a in

have h '' univ = univ,
  from calc h '' univ = h '' s ∪ h '' sᶜ : by rw [←image_union, union_compl_self]
    ... = f '' s ∪ g' '' sᶜ :
      congr (congr_arg (∪)
        (image_congr $ by simp [h, if_pos] {contextual := tt}))
        (image_congr $ by simp [h, if_neg] {contextual := tt})
    ... = univ : by rw [hg'ns, union_compl_self],
have surjective h,
  from assume b,
  have b ∈ h '' univ, by rw [this]; trivial,
  let ⟨a, _, eq⟩ := this in
  ⟨a, eq⟩,

have split : ∀x∈s, ∀y∉s, h x = h y → false,
  from assume x hx y hy eq,
  have y ∈ g '' (f '' s)ᶜ, by rwa [←hns],
  let ⟨y', hy', eq_y'⟩ := this in
  have f x = y',
    from calc f x = g' y : by simp [h, hx, hy, if_pos, if_neg] at eq; assumption
      ... = (g' ∘ g) y' : by simp [(∘), eq_y']
      ... = _ : by simp [g'g],
  have y' ∈ f '' s, from this ▸ mem_image_of_mem _ hx,
  hy' this,
have function.injective h,
  from assume x y eq,
  by_cases
    (assume hx : x ∈ s, by_cases
      (assume hy : y ∈ s, by simp [h, hx, hy, if_pos, if_neg] at eq; exact hf eq)
      (assume hy : y ∉ s, (split x hx y hy eq).elim))
    (assume hx : x ∉ s, by_cases
      (assume hy : y ∈ s, (split y hy x hx eq.symm).elim)
      (assume hy : y ∉ s,
        have x ∈ g '' (f '' s)ᶜ, by rwa [←hns],
        let ⟨x', hx', eqx⟩ := this in
        have y ∈ g '' (f '' s)ᶜ, by rwa [←hns],
        let ⟨y', hy', eqy⟩ := this in
        have g' x = g' y, by simp [h, hx, hy, if_pos, if_neg] at eq; assumption,
        have (g' ∘ g) x' = (g' ∘ g) y', by simp [(∘), eqx, eqy, this],
        have x' = y', by rwa [g'g] at this,
        calc x = g x' : eqx.symm
          ... = g y' : by rw [this]
          ... = y : eqy)),

⟨h, ‹function.injective h›, ‹function.surjective h›⟩

theorem antisymm : (α ↪ β) → (β ↪ α) → nonempty (α ≃ β)
| ⟨e₁, h₁⟩ ⟨e₂, h₂⟩ :=
  let ⟨f, hf⟩ := schroeder_bernstein h₁ h₂ in
  ⟨equiv.of_bijective f hf⟩

end antisymm

section wo
parameters {ι : Type u} {β : ι → Type v}

@[reducible] private def sets := {s : set (∀ i, β i) |
  ∀ (x ∈ s) (y ∈ s) i, (x : ∀ i, β i) i = y i → x = y}

theorem min_injective (I : nonempty ι) : ∃ i, nonempty (∀ j, β i ↪ β j) :=
let ⟨s, hs, ms⟩ := show ∃s∈sets, ∀a∈sets, s ⊆ a → a = s, from
  zorn.zorn_subset sets (λ c hc hcc, ⟨⋃₀ c,
    λ x ⟨p, hpc, hxp⟩ y ⟨q, hqc, hyq⟩ i hi, (hcc.total hpc hqc).elim
      (λ h, hc hqc x (h hxp) y hyq i hi) (λ h, hc hpc x hxp y (h hyq) i hi),
  λ _, subset_sUnion_of_mem⟩) in
let ⟨i, e⟩ := show ∃ i, ∀ y, ∃ x ∈ s, (x : ∀ i, β i) i = y, from
  classical.by_contradiction $ λ h,
  have h : ∀ i, ∃ y, ∀ x ∈ s, (x : ∀ i, β i) i ≠ y,
    by simpa only [not_exists, not_forall] using h,
  let ⟨f, hf⟩ := axiom_of_choice h in
  have f ∈ s, from
    have insert f s ∈ sets := λ x hx y hy, begin
      cases hx; cases hy, {simp [hx, hy]},
      { subst x, exact λ i e, (hf i y hy e.symm).elim },
      { subst y, exact λ i e, (hf i x hx e).elim },
      { exact hs x hx y hy }
    end, ms _ this (subset_insert f s) ▸ mem_insert _ _,
  let ⟨i⟩ := I in hf i f this rfl in
let ⟨f, hf⟩ := axiom_of_choice e in
⟨i, ⟨λ j, ⟨λ a, f a j, λ a b e',
  let ⟨sa, ea⟩ := hf a, ⟨sb, eb⟩ := hf b in
  by rw [← ea, ← eb, hs _ sa _ sb _ e']⟩⟩⟩

end wo

theorem total {α : Type u} {β : Type v} : nonempty (α ↪ β) ∨ nonempty (β ↪ α) :=
match @min_injective bool (λ b, cond b (ulift α) (ulift.{(max u v) v} β)) ⟨tt⟩ with
| ⟨tt, ⟨h⟩⟩ := let ⟨f, hf⟩ := h ff in or.inl ⟨embedding.congr equiv.ulift equiv.ulift ⟨f, hf⟩⟩
| ⟨ff, ⟨h⟩⟩ := let ⟨f, hf⟩ := h tt in or.inr ⟨embedding.congr equiv.ulift equiv.ulift ⟨f, hf⟩⟩
end

end embedding
end function


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import measure_theory.measurable_space
import measure_theory.borel_space

noncomputable theory
open set
open measure_theory
open measurable_space
open borel_space

namespace portmanteau

section portmanteau_topological_lemmas

variables {α : Type*} [topological_space α]

lemma meas_eq_various_of_null_bdry (μ : @measure_theory.measure α (borel α)) (E : set α) :
  (μ(frontier E) = 0) → (μ(interior E) = μ(E)) ∧ (μ(closure E) = μ(E)) :=
begin
  intro hEnullbdry ,
  have ineq_E_le_Ecl := @measure_mono α (borel(α)) μ E (closure E) subset_closure ,
  have ineq_Eint_le_E := @measure_mono α (borel(α)) μ (interior E) E interior_subset ,
  have surpr := @measure_union_le α (borel(α)) μ (interior E) (frontier E) ,
  rw ← closure_eq_interior_union_frontier at surpr ,
  simp [hEnullbdry] at surpr ,
  have mono := @measure_mono α (borel(α)) μ (interior E) (closure E) interior_subset_closure ,
  have key := le_antisymm mono surpr ,
  split ,
  { apply le_antisymm ,
    { assumption , } ,
    rw key ,
    assumption , } ,
  { apply le_antisymm ,
    { rw ← key ,
      assumption , } ,
    assumption , } ,
end

lemma open_imp_borel {γ : Type*} [top_γ : topological_space γ]
  {G : set γ} : is_open G → (borel γ).measurable_set' G
    := measurable_set_generate_from

lemma closed_imp_borel {γ : Type*} [top_γ : topological_space γ]
  {F : set γ} : is_closed F → (borel γ).measurable_set' F :=
begin
  set G := Fᶜ with hG ,
  have FeqGc := compl_compl F ,
  rw ← hG at FeqGc ,
  intro hFclosed ,
  have Gmble := open_imp_borel (is_open_compl_iff.mpr hFclosed) ,
  rw ← FeqGc ,
  exact (borel γ).measurable_set_compl G Gmble ,
end

lemma compl_frontier {γ : Type*} [topological_space γ] (A : set γ) :
  (frontier A)ᶜ = (interior A) ∪ (interior (Aᶜ)) :=
begin
  have fact := @closure_eq_compl_interior_compl γ _ Aᶜ ,
  rw compl_compl at fact ,
  suffices : frontier A = (interior A)ᶜ ∩ (interior (Aᶜ))ᶜ ,
  { rw this ,
    rw compl_inter (interior A)ᶜ (interior (Aᶜ))ᶜ ,
    repeat {rw compl_compl ,} , } ,
  rw [←frontier_compl A , ←fact] ,
  exact diff_eq (closure (Aᶜ)) (interior (Aᶜ)) ,
end

lemma interior_preimage {β γ : Type*}
  [topological_space β] [topological_space γ]
  (G : set γ) (f : β → γ) (hf : continuous f) :
    f⁻¹' (interior G) ⊆ interior (f⁻¹'(G)) :=
begin
  apply interior_maximal ,
  { have Gint_ss_G : (interior G) ⊆ G := interior_subset ,
    exact preimage_mono Gint_ss_G , } ,
  { have interior_open : is_open (interior G) := is_open_interior ,
    exact continuous_def.mp hf (interior G) interior_open , } ,
end

lemma frontier_preimage {β γ : Type*}
  [topological_space β] [topological_space γ]
  (A : set γ) (f : β → γ) (hf : continuous f) :
    frontier (f⁻¹'(A)) ⊆ f⁻¹'(frontier A) :=
begin
  apply (@compl_subset_compl β (f⁻¹'(frontier A)) (frontier (f⁻¹'(A)))).mp,
  rw [compl_frontier _ , ←preimage_compl , compl_frontier _ , preimage_union ] ,
  have one := @interior_preimage β γ _ _ A f hf ,
  have two := @interior_preimage β γ _ _ (Aᶜ) f hf ,
  exact union_subset_union one two ,
end

end portmanteau_topological_lemmas

end portmanteau