------------------------------------------------------------------------
-- Las relaciones de equivalencia son isomorfas a las particiones
------------------------------------------------------------------------

import tactic

-- =====================================================================
-- § Visión general                                                   --
-- =====================================================================

-- En esta teoría, definiremos las particiones de `A` y construiremos
-- algunas interfaz (es decir, probaremos algunas
-- proposiciones). Definiremos las clases de equivalencia y haremos lo
-- mismo. Finalmente, demostraremos que existe una biyección entre
-- relaciones de equivalencia en `A` y particiones de` A`.
--
-- En Lean se tiene las siguiente definiciones:
--    reflexive R := ∀ (x : A), R x x
--    symmetric R := ∀ ⦃x y : A⦄, R x y → R y x
--    transitive R := ∀ ⦃x y z : A⦄, R x y → R y z → R x z
--    equivalence R := reflexive R ∧ symmetric R ∧ transitive R
-- donde `A` un tipo y `R: A → A → Prop` es una relación binaria en `A`.

-- =====================================================================
-- § Particiones                                                      --
-- =====================================================================

-- =====================================================================
-- §§ Definición de una partición                                     --
-- =====================================================================

-- Sea `A` un tipo. Una partición en `A` es una estructura con los
-- siguientes  componentes:
-- 1) Un conjunto de subconjuntos de A. Dichos subconjuntos se llaman
--   los bloques de la partición.
-- 2) Una hipótesis (es decir, una prueba) de que los bloques no están vacíos.
-- 3) Una hipótesis de que cada término de tipo A está en uno de los bloques.
-- 4) Una hipótesis de que dos bloques con intersección no vacía son iguales.

-- ---------------------------------------------------------------------
-- Ejercicio 1. Definir la estructura `particion` tal que `particion A`
-- es el tipo de las particiones sobre `A`.
-- ---------------------------------------------------------------------

@[ext] structure particion (A : Type) :=
(Bloques    : set (set A))
(Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
(Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
(Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)

-- Notaciones
-- + `P : particion A` expresa que `P` es una partición de `A`.
-- + `Bloques P` es el conjunto de los bloque de P.
-- + `Hno_vacios P` prueba que los bloques de `P` son no vacíos.
-- + `Hrecubren P` prueba que los bloque de `P` recubren a `A`.
-- + `Hdisjuntos p` prueba que los bloques de `P` son disjuntos entre sí

-- ---------------------------------------------------------------------
-- Ejercicio 2. Abrir el espacio de nombre `particion`.
-- ---------------------------------------------------------------------

namespace particion

-- ---------------------------------------------------------------------
-- Ejercicio 3. Definir las siguientes variables
-- + A para un tipo
-- + P para las particiones sobre A
-- + X e Y para subconjuntos de A.
-- ---------------------------------------------------------------------

variable  {A : Type}
variable  {P : particion A}
variables {X Y : set A}

-- ---------------------------------------------------------------------
-- Ejercicio 4. Demostrar que si dos bloques de una partición tienen un
-- elemento en común, entonces son iguales.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply Hdisjuntos P,
  { exact hX, },
  { exact hY, },
  { rw set.nonempty_def,
    use a,
    split,
    { exact haX, },
    { exact haY, }},
end

-- 2ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply Hdisjuntos P,
  { exact hX, },
  { exact hY, },
  { use a,
    exact ⟨haX, haY⟩, },
end

-- 3ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
begin
  apply Hdisjuntos P,
  { exact hX, },
  { exact hY, },
  { exact ⟨a, haX, haY⟩, },
end

-- 4ª demostración
lemma iguales_si_comun
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
Hdisjuntos P X Y hX hY ⟨a, haX, haY⟩

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que si dos bloques de una partición tienen
-- elementos comunes, entonces los elementos de uno también pertenecen
-- al otro.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a b : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  (hbX : b ∈ X)
  : b ∈ Y :=
begin
  convert hbX,
  apply iguales_si_comun hY hX haY,
  exact haX,
end

-- 2ª demostración
example
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a b : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  (hbX : b ∈ X)
  : b ∈ Y :=
begin
  have hXY : X = Y := iguales_si_comun hX hY haX haY,
  rw ← hXY,
  exact hbX,
end

-- 3ª demostración
lemma pertenece_si_pertenece
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a b : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  (hbX : b ∈ X)
  : b ∈ Y :=
begin
  convert hbX,
  exact iguales_si_comun hY hX haY haX,
end

-- ---------------------------------------------------------------------
-- Ejercicio 6. Demostrar que si P es una partición sobre A, entonces
-- para cada elemento a de A hay algún bloque X de P tal que a ∈ X.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (a : A)
  : ∃ X, X ∈ Bloques P ∧ a ∈ X :=
begin
  rcases Hrecubren P a with ⟨X, hX, haX⟩,
  use X,
  exact ⟨hX, haX⟩,
end

-- 2ª demostración
example
  (a : A)
  : ∃ X, X ∈ Bloques P ∧ a ∈ X :=
begin
  rcases Hrecubren P a with ⟨X, hX, haX⟩,
  exact ⟨X, hX, haX⟩,
end

-- 3ª demostración
lemma pertenece_bloque
  (a : A)
  : ∃ X : set A, X ∈ Bloques P ∧ a ∈ X :=
begin
  obtain ⟨X, hX, haX⟩ := Hrecubren P a,
  use X,
  exact ⟨hX, haX⟩,
end

-- ---------------------------------------------------------------------
-- Ejercicio 7. Cerrar el espacio de nombres `particion`.
-- ---------------------------------------------------------------------

end particion

-- =====================================================================
-- § Relaciones de equivalencia                                      --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio 8. Abrir la sección `clases_de_equivalencia`.
-- ---------------------------------------------------------------------

section clases_de_equivalencia

-- =====================================================================
-- §§ Definición de relaciones de equivalencia                        --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio 9. Definir las siguientes variables
-- + A para un tipo
-- + R para las relaciones binarias en A.
-- ---------------------------------------------------------------------

variable {A : Type}
variable (R : A → A → Prop)

-- ---------------------------------------------------------------------
-- Ejercicio 10. Definir la función
--    clase : A → set A
-- tal que (clase a) es el conjunto de los elementos relacionados con a
-- (mediante R). Se dice que `clase a` es la clase de a.
-- ---------------------------------------------------------------------

def clase (a : A) :=
  {b : A | R b a}

-- =====================================================================
-- § Lemas elementales de las clases                   --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio 11. Demostrar que
--    b ∈ clase R a ↔ R b a
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
begin
  unfold clase,
  dsimp,
  refl,
end

-- 2ª demostración
lemma pertenece_clase_syss
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio 12. Definir como hipótesis hR el que R es una relación de
-- equivalencia y usarla en el resto de la sección.
-- ---------------------------------------------------------------------

variables {R} (hR : equivalence R)
include hR

-- ---------------------------------------------------------------------
-- Ejercicio 13. Demostrar que
--    a ∈ clase R a
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (a : A)
  : a ∈ clase R a :=
begin
  rw pertenece_clase_syss,
  suffices h : reflexive R,
  { exact h a, },
  { rcases hR with ⟨h2, -, -⟩,
    exact h2, },
end

-- 2ª demostración
example
  (a : A)
  : a ∈ clase R a :=
begin
  rw pertenece_clase_syss,
  suffices h : reflexive R,
  { exact h a, },
  { exact hR.1, },
end

-- 3ª demostración
example
  (a : A)
  : a ∈ clase R a :=
begin
  rw pertenece_clase_syss,
  rcases hR with ⟨hrefl, -, -⟩,
  exact hrefl a,
end

-- 4ª demostración
example
  (a : A)
  : a ∈ clase R a :=
begin
  obtain ⟨hrefl, -, -⟩ := hR,
  rw pertenece_clase_syss,
  apply hrefl,
end

-- 5ª demostración
example
  (a : A)
  : a ∈ clase R a :=
begin
  rw pertenece_clase_syss,
  apply hR.1,
end

-- 6ª demostración
lemma pertenece_clase_propia
  (a : A)
  : a ∈ clase R a :=
(pertenece_clase_syss R).mpr (hR.1 a)

-- ---------------------------------------------------------------------
-- Ejercicio 14. Demostrar que
--    a ∈ clase R b → clase R a ⊆ clase R b
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {a b : A}
  : a ∈ clase R b → clase R a ⊆ clase R b :=
begin
  intro hab,
  intros z hza,
  rw pertenece_clase_syss at hab hza ⊢,
  obtain ⟨-, -, htrans⟩ := hR,
  exact htrans hza hab,
end

-- 2ª demostración
example
  {a b : A}
  : a ∈ clase R b → clase R a ⊆ clase R b :=
begin
  intros hab z hza,
  exact hR.2.2 hza hab,
end

-- 3ª demostración
lemma subclase_si_pertenece
  {a b : A}
  : a ∈ clase R b → clase R a ⊆ clase R b :=
λ hab z hza, hR.2.2 hza hab

-- ---------------------------------------------------------------------
-- Ejercicio 15. Demostrar que
--    a ∈ clase R b → clase R a = clase R b
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  apply set.subset.antisymm,
  { apply subclase_si_pertenece hR hab, },
  { apply subclase_si_pertenece hR,
    rcases hR with ⟨-, hsymm, -⟩,
    exact hsymm hab }
end

-- 2ª demostración
example
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  apply set.subset.antisymm,
  { exact subclase_si_pertenece hR hab, },
  { exact subclase_si_pertenece hR (hR.2.1 hab), }
end

-- 3ª demostración
example
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  exact set.subset.antisymm
         (subclase_si_pertenece hR hab)
         (subclase_si_pertenece hR (hR.2.1 hab))
end

-- 4ª demostración
lemma clases_iguales_si_pertenece
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
λ hab, set.subset.antisymm
        (subclase_si_pertenece hR hab)
        (subclase_si_pertenece hR (hR.2.1 hab))

-- ---------------------------------------------------------------------
-- Ejercicio 16. Cerrar la sección `clases_de_equivalencia`.
-- ---------------------------------------------------------------------

end clases_de_equivalencia

-- =====================================================================
-- § El teorema                                                       --
-- =====================================================================

-- Sea `A` un tipo. Existe una biyección entre las relaciones de
-- equivalencia en `A` y particiones de `A`. Lo demostraremos
-- escribiendo una dfunción en cada dirección y probando que las
-- funciones son inversas.

-- ---------------------------------------------------------------------
-- Ejercicio 17. Abrir el espacio de nombre `particion`.
-- ---------------------------------------------------------------------

open particion

-- ---------------------------------------------------------------------
-- Ejercicio 18. Definir las variables
-- + A para tipos y
-- + R para relaciones binarias en A.
-- ---------------------------------------------------------------------

variable {A : Type}
variable (R : A → A → Prop)

-- ---------------------------------------------------------------------
-- Ejercicio 19. Definir la función
--    clases : (A → A → Prop) → set (set A)
-- tal que (clases R) es el conjunto de las clases de R.
-- ---------------------------------------------------------------------

def clases : (A → A → Prop) → set (set A) :=
  λ R, {B : set A | ∃ x : A, B = clase R x}

-- ---------------------------------------------------------------------
-- Ejercicio 20. Demostrar que si R es una relación de equivalencia,
-- entonces las clases de R son no vacías.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  intros X hX,
  unfold clases at hX,
  dsimp at hX,
  cases hX with a ha,
  rw ha,
  rw set.nonempty_def,
  use a,
  rw pertenece_clase_syss,
  rcases hR with ⟨hrefl, -, -⟩,
  exact hrefl a,
end

-- 2ª demostración
lemma clases_no_vacias
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  rintros _ ⟨a, rfl⟩,
  use a,
  rw pertenece_clase_syss,
  apply hR.1,
end

-- ---------------------------------------------------------------------
-- Ejercicio 21. Demostrar que si R es una relación de equivalencia en A,
-- entonces las clases de R recubren a A; es decir, para cada elemento a
-- de A existe una clase X de R tal que a ∈ X.
-- ---------------------------------------------------------------------

-- 1ª demostración,
example
  (hR: equivalence R)
  : ∀ a, ∃ X ∈ clases R, a ∈ X :=
begin
  intro a,
  use clase R a,
  split,
  { unfold clases,
    dsimp,
    use a, },
  { exact pertenece_clase_propia hR a, },
end

-- 2ª demostración,
lemma clases_recubren
  (hR: equivalence R)
  : ∀ a, ∃ X ∈ clases R, a ∈ X :=
begin
  intro a,
  use clase R a,
  split,
  { use a, },
  { exact hR.1 a, },
end

-- ---------------------------------------------------------------------
-- Ejercicio 22. Demostrar que si R es una relación de equivalencia,
-- entonces las clases de R son disjuntas; es decir, si dos clases de R
-- son no disjuntas, entonces son iguales.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (hR: equivalence R)
  : ∀ X Y ∈ clases R, (X ∩ Y : set A).nonempty → X = Y :=
begin
  intros X Y hX hY hXY,
  unfold clases at hX hY,
  dsimp at hX hY,
  cases hX with a ha,
  cases hY with b hb,
  rw [ha, hb] at *,
  rw set.nonempty_def at hXY,
  cases hXY with c hc,
  cases hc with hca hcb,
  apply clases_iguales_si_pertenece hR,
  apply hR.2.2 _ hcb,
  apply hR.2.1,
  exact hca,
end

-- 2ª demostración
example
  (hR: equivalence R)
  : ∀ X Y ∈ clases R, (X ∩ Y : set A).nonempty → X = Y :=
begin
  intros X Y hX hY hXY,
  cases hX with a ha,
  cases hY with b hb,
  rw [ha, hb] at *,
  rw set.nonempty_def at hXY,
  cases hXY with c hc,
  cases hc with hca hcb,
  apply clases_iguales_si_pertenece hR,
  apply hR.2.2 _ hcb,
  apply hR.2.1,
  exact hca,
end

-- 3ª demostración
example
  (hR: equivalence R)
  : ∀ X Y ∈ clases R, (X ∩ Y : set A).nonempty → X = Y :=
begin
  rintros X Y ⟨a, rfl⟩ ⟨b, rfl⟩ ⟨c, hca, hcb⟩,
  apply clases_iguales_si_pertenece hR,
  apply hR.2.2 _ hcb,
  apply hR.2.1,
  exact hca,
end

-- 4ª demostración
lemma clases_disjuntas
  (hR: equivalence R)
  : ∀ X Y ∈ clases R, (X ∩ Y : set A).nonempty → X = Y :=
begin
  rintros X Y ⟨a, rfl⟩ ⟨b, rfl⟩ ⟨c, hca, hcb⟩,
  exact clases_iguales_si_pertenece hR (hR.2.2 (hR.2.1 hca) hcb),
end

-- ---------------------------------------------------------------------
-- Ejercicio 23. Definir la función
--    cociente : {R : A → A → Prop // equivalence R} → particion A
-- tal que (cociente R) es el conjunto cociente  de la relación de
-- equivalencia R.
-- ---------------------------------------------------------------------

def cociente : {R : A → A → Prop // equivalence R} → particion A :=
  λ R, { Bloques    := {B : set A | ∃ x : A, B = clase R.1 x},
         Hno_vacios := clases_no_vacias R.1 R.2,
         Hrecubren  := clases_recubren R.1 R.2,
         Hdisjuntos := clases_disjuntas R.1 R.2, }

-- ---------------------------------------------------------------------
-- Ejercicio 24. Definir P como una variable sobre los conjuntos de
-- conjuntos de A.
-- ---------------------------------------------------------------------

variable (P : set (set A))

-- ---------------------------------------------------------------------
-- Ejercicio 25. Definir la función
--    relacion : (particion A) → (A → A → Prop)
-- tal que (relacion P) es la relación correspondiente a la partición P.
-- ---------------------------------------------------------------------

def relacion : (particion A) → (A → A → Prop) :=
  λ P a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X

-- ---------------------------------------------------------------------
-- Ejercicio 26. Demostrar que la relación correspondiente a la
-- partición P es reflexiva.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (P : particion A)
  : reflexive (relacion P) :=
begin
  rw reflexive,
  intro a,
  unfold relacion,
  intros X hXC haX,
  exact haX,
end

-- 2ª demostración
example
  (P : particion A)
  : reflexive (relacion P) :=
begin
  intro a,
  intros X hXC haX,
  exact haX,
end

-- 3ª demostración
example
  (P : particion A)
  : reflexive (relacion P) :=
begin
  intros a X hXC haX,
  exact haX,
end

-- 4ª demostración
lemma reflexiva
  (P : particion A)
  : reflexive (relacion P) :=
λ a X hXC haX, haX

-- ---------------------------------------------------------------------
-- Ejercicio 37. Demostrar que la relación correspondiente a la parición
-- P es simétrica
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (P : particion A)
  : symmetric (relacion P) :=
begin
  rw symmetric,
  intros a b hab,
  unfold relacion at *,
  intros X hX hbX,
  obtain ⟨Y, hY, haY⟩ := Hrecubren P a,
  specialize hab Y hY haY,
  exact pertenece_si_pertenece hY hX hab hbX haY,
end

-- 2ª demostración
example
  (P : particion A)
  : symmetric (relacion P) :=
begin
  intros a b hab,
  intros X hX hbX,
  obtain ⟨Y, hY, haY⟩ := Hrecubren P a,
  specialize hab Y hY haY,
  exact pertenece_si_pertenece hY hX hab hbX haY,
end

-- 3ª demostración
lemma simetrica
  (P : particion A)
  : symmetric (relacion P) :=
begin
  intros a b h X hX hbX,
  obtain ⟨Y, hY, haY⟩ := Hrecubren P a,
  specialize h Y hY haY,
  exact pertenece_si_pertenece hY hX h hbX haY,
end

-- ---------------------------------------------------------------------
-- Ejercicio 28. Demostrar que la relación correspondiente a la relación P
-- es transitiva.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  unfold transitive,
  intros a b c hab hbc,
  unfold relacion at *,
  intros X hX haX,
  apply hbc,
  { exact hX, },
  { apply hab,
    { exact hX, },
    { exact haX, }},
end

-- 2ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  intros a b c hab hbc,
  intros X hX haX,
  apply hbc X hX,
  apply hab X hX,
  exact haX,
end

-- 3ª demostración
example
  (P : particion A)
  : transitive (relacion P) :=
begin
  intros a b c hab hbc X hX haX,
  exact hbc X hX (hab X hX haX),
end

-- 4ª demostración
lemma transitiva
  (P : particion A)
  : transitive (relacion P) :=
λ a b c hab hbc X hX haX, hbc X hX (hab X hX haX)

-- ---------------------------------------------------------------------
-- Ejercicio 29. Definir la función
--    relacionP : particion A → {R : A → A → Prop // equivalence R}
-- ---------------------------------------------------------------------

def relacionP : particion A → {R : A → A → Prop // equivalence R} :=
  λ P, ⟨λ a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X,
        ⟨reflexiva P, simetrica P, transitiva P⟩⟩

-- ---------------------------------------------------------------------
-- Ejercicio 30. Demostrar que relacionP es inversa por la izquierda de
-- cociente.
-- ---------------------------------------------------------------------

-- 1ª demostración
example :
  function.left_inverse relacionP (@cociente A) :=
begin
  unfold function.left_inverse,
  intro S,
  cases S with R hR,
  unfold relacionP cociente relacion,
  simp,
  ext a b,
  split,
  { intros hab,
    apply hR.2.1,
    unfold clase at hab,
    dsimp at hab,
    apply hab,
    apply hR.1, },
  { intros hab c hac,
    unfold clase at *,
    dsimp at *,
    apply hR.2.2 (hR.2.1 hab) hac, },
end

-- 2ª demostración
example :
  function.left_inverse relacionP (@cociente A) :=
begin
  rintro ⟨R, hR⟩,
  simp [relacionP, cociente],
  ext a b,
  split,
  { intros hab,
    apply hR.2.1,
    apply hab,
    apply hR.1, },
  { intros hab c hac,
    apply hR.2.2 (hR.2.1 hab) hac, },
end

-- 3ª demostración
example :
  function.left_inverse relacionP (@cociente A) :=
begin
  rintro ⟨R, hR⟩,
  simp [relacionP, cociente],
  ext a b,
  split,
  { intros hab,
    exact hR.2.1 (hab a (hR.1 a)), },
  { intros hab c hac,
    exact hR.2.2 (hR.2.1 hab) hac, },
end

-- 4ª demostración
example :
  function.left_inverse relacionP (@cociente A) :=
begin
  rintro ⟨R, hR⟩,
  simp [relacionP, cociente],
  ext a b,
  split,
  { exact λ hab, hR.2.1 (hab a (hR.1 a)), },
  { exact λ hab c hac, hR.2.2 (hR.2.1 hab) hac, },
end

-- 5ª demostración
example :
  function.left_inverse relacionP (@cociente A) :=
begin
  rintro ⟨R, hR⟩,
  simp [relacionP, cociente],
  ext a b,
  exact ⟨λ hab, hR.2.1 (hab a (hR.1 a)),
         λ hab c hac, hR.2.2 (hR.2.1 hab) hac⟩,
end

-- 6ª demostración
lemma inversa_izq :
  function.left_inverse relacionP (@cociente A) :=
begin
  rintro ⟨R, hR⟩,
  suffices : (λ (a b : A), ∀ (c : A), a ∈ clase R c → b ∈ clase R c) = R,
  { simpa [relacionP, cociente], },
  { ext a b,
    show (∀ (c : A), a ∈ clase R c → b ∈ clase R c) ↔ R a b,
    split,
    { intros hab,
      apply hR.2.1,
      unfold clase at hab,
      dsimp at hab,
      apply hab,
      apply hR.1, },
    { intros hab c hac,
      unfold clase at *,
      dsimp at *,
      apply hR.2.2 (hR.2.1 hab) hac, }},
end

-- ---------------------------------------------------------------------
-- Ejercicio 31. Demostrar que la función cociente que aplica relaciones
-- de equivalencia en la partición del conjunto cociente es inyectiva.
-- ---------------------------------------------------------------------

lemma cociente_es_inyectiva :
  function.injective (@cociente A) :=
function.left_inverse.injective inversa_izq

-- ---------------------------------------------------------------------
-- Ejercicio 32. Demostrar que relacionP es inversa por la derecha de
-- cociente.
-- ---------------------------------------------------------------------

-- 1ª demostración
example :
  function.right_inverse relacionP (@cociente A) :=
begin
  unfold function.right_inverse,
  unfold function.left_inverse,
  intro P,
  ext X,
  simp [cociente],
  split,
  { intro h,
    cases h with a ha,
    rw ha,
    rcases Hrecubren P a with ⟨X, hX, haX⟩,
    convert hX,
    ext b,
    rw pertenece_clase_syss,
    split,
    { intro hba,
      rcases Hrecubren P b with ⟨Y, hY, hbY⟩,
      specialize hba Y hY hbY,
      convert hbY,
      exact iguales_si_comun hX hY haX hba, },
    { intros hbX Y hY hbY,
      apply pertenece_si_pertenece hX hY hbX hbY haX, }},
  { intro hX,
    rcases Hno_vacios P X hX with ⟨a, ha⟩,
    use a,
    ext b,
    split,
    { intro hbX,
      rw pertenece_clase_syss,
      intros Y hY hbY,
      exact pertenece_si_pertenece hX hY hbX hbY ha, },
    { rw pertenece_clase_syss,
      intro hba,
      rcases Hrecubren P b with ⟨Y, hY, hbY⟩,
      specialize hba Y hY hbY,
      exact pertenece_si_pertenece hY hX hba ha hbY, }}
end

-- 2ª demostración
lemma inversa_dcha :
  function.right_inverse relacionP (@cociente A) :=
begin
  intro P,
  ext X,
  show (∃ (a : A), X = clase _ a) ↔ X ∈ Bloques P,
  split,
  { rintro ⟨a, rfl⟩,
    obtain ⟨X, hX, haX⟩ := Hrecubren P a,
    convert hX,
    ext b,
    rw pertenece_clase_syss,
    split,
    { intro hba,
      obtain ⟨Y, hY, hbY⟩ := Hrecubren P b,
      specialize hba Y hY hbY,
      convert hbY,
      exact iguales_si_comun hX hY haX hba, },
    { intros hbX Y hY hbY,
      apply pertenece_si_pertenece hX hY hbX hbY haX, }},
  { intro hX,
    rcases Hno_vacios P X hX with ⟨a, ha⟩,
    use a,
    ext b,
    split,
    { intro hbX,
      rw pertenece_clase_syss,
      intros Y hY hbY,
      exact pertenece_si_pertenece hX hY hbX hbY ha, },
    { rw pertenece_clase_syss,
      intro hba,
      obtain ⟨Y, hY, hbY⟩ := Hrecubren P b,
      specialize hba Y hY hbY,
      exact pertenece_si_pertenece hY hX hba ha hbY, }}
end

-- ---------------------------------------------------------------------
-- Ejercicio 33. Demostrar que la función cociente que aplica relaciones
-- de equivalencia en la partición del conjunto cociente es suprayectiva.
-- ---------------------------------------------------------------------

lemma cociente_es_suprayectiva :
  function.surjective (@cociente A) :=
function.right_inverse.surjective inversa_dcha

-- ---------------------------------------------------------------------
-- Ejercicio 34. Demostrar que la función cociente que aplica relaciones
-- de equivalencia en la partición del conjunto cociente es biyectiva.
-- ---------------------------------------------------------------------

lemma cociente_es_biyectiva :
  function.bijective (@cociente A) :=
⟨cociente_es_inyectiva, cociente_es_suprayectiva⟩

-- ---------------------------------------------------------------------
-- Ejercicio 35. Demostrar que los tipos de las relaciones de equivalencia
-- sobre A y el de las particiones de A son isomorfos.
-- ---------------------------------------------------------------------

theorem equivalencia_particiones
  (A : Type)
  : {R : A → A → Prop // equivalence R} ≃ particion A :=
{ to_fun    := cociente,
  inv_fun   := relacionP,
  left_inv  := inversa_izq,
  right_inv := inversa_dcha, }

-- =====================================================================
-- § Referencias                                                      --
-- =====================================================================

-- + Kevin Buzzard. "Formalising mathematics : workshop 1 — logic, sets,
--   functions, relations" https://bit.ly/3kJo231
-- + Kevin Buzzard. formalising-mathematics: Part_D_relations.lean
--   https://bit.ly/3AQWY7o
-- + Kevin Buzzard. formalising-mathematics: Part_D_relations_solutions.lean
--   https://bit.ly/2WpcfgY


/-
Copyright (c) 2019 Jesse Michael Han. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author(s): Jesse Michael Han

A simplified version of the coffee can problem, from David Gries' The Science of Programming

Given a coffee can filled with finitely many black and white beans, and an infinite supply of white beans, carry out the following procedure: as long as there is more than one bean in the can,

 - Draw two beans.
 - If their colors are different, discard the white one and return the black one to the can.
 - If their colors are the same, discard both of them and add a white bean to the can.

Prove that if the number of black beans in the can is odd, then the process always ends with a black bean, and that if the number of black beans in the can is even, then the process always ends with a white bean.
-/

import tactic
import data.nat.parity

@[derive decidable_eq, derive has_reflect]
inductive beans : Type
| white : beans
| black : beans

instance : has_repr beans :=
{ repr := λ b, beans.cases_on b "white" "black" }

open beans

@[simp]def count_black : list beans → ℕ
| [] := 0
| (white::xs) := count_black xs
| (black::xs) := count_black xs + 1

@[simp]def count_white : list beans → ℕ
| [] := 0
| (white::xs) := count_white xs + 1
| (black::xs) := count_white xs

@[simp]lemma count_eq_length (xs : list beans) : count_black xs + count_white xs = xs.length :=
begin
  induction xs with x_hd x_tl ih,
    { refl },
    { cases x_hd; simp [ih.symm] }
end

def coffee : list beans → list beans
| [] := []
| [x] := [x]
| (black::white::xs) := coffee (black::xs)
| (white::black::xs) := coffee (black::xs)
| (black::black::xs) := coffee (white::xs)
| (white::white::xs) := coffee (white::xs)

@[simp]lemma coffee_singleton {x : beans} : coffee [x] = [x] :=
beans.cases_on x rfl rfl

def some_beans : list beans := [black, white, black, black, white, black, white, black, black, white, black]

#eval coffee some_beans
-- [black]

section metaprogramming

meta instance : has_to_format beans :=
{ to_format := λ b, beans.cases_on b (format.of_string "white") (format.of_string "black") }

meta def coffee_eval : list beans → tactic unit
| [] := tactic.trace "[]"
| [x] := tactic.trace format!"final state: [{x}]"
| arg@(black::white::xs) :=
  do  tactic.trace format!"current state: {arg}",
      tactic.trace "got black + white, discarding white",
      coffee_eval (black::xs)
| arg@(white::black::xs) :=
  do  tactic.trace format!"current state: {arg}",
      tactic.trace "got white + black, discarding white",
      coffee_eval (black::xs)
| arg@(black::black::xs) :=
  do  tactic.trace format!"current state: {arg}",
      tactic.trace "got black + black, discarding both and adding white",
      coffee_eval (white::xs)
| arg@(white::white::xs) :=
  do tactic.trace format!"current state: {arg}",
     tactic.trace "got white + white, discarding white",
     coffee_eval (white::xs)

@[reducible]meta def my_parser := state_t string tactic

meta def beans.of_string : my_parser beans :=
⟨ λ ⟨cs⟩, match cs with
         | [] := tactic.failed
         | (x::xs) := if x = '0' then return (white, ⟨xs⟩) else
                      if x = '1' then return (black, ⟨xs⟩) else
                      tactic.failed
         end ⟩

meta def repeat {α} : my_parser α → my_parser (list α) :=
λ p, (list.cons) <$> p <*> (repeat p <|> return [])

meta def my_parser.run {α} [has_to_tactic_format α] (p : my_parser α) (arg : string) : tactic α :=
do bs <- prod.fst <$> state_t.run p arg,
   tactic.trace bs,
   return bs

meta def parse_beans (arg : string) : tactic unit :=
do bs <- my_parser.run (repeat beans.of_string) arg,
   tactic.exact `(bs).to_expr

end metaprogramming

section test

def some_more_beans : list beans := by {parse_beans "10110001011"}

run_cmd coffee_eval some_more_beans

end test

@[simp]lemma coffee_white {x} {xs} : coffee (white::x::xs) = coffee (x::xs) :=
begin
  cases x,
    { rw coffee },
    { simp [coffee] },
end

lemma coffee_black_white {x} {xs} : coffee (x::xs) = [black] ∨ coffee (x::xs) = [white] :=
begin
  induction xs with y xs ih generalizing x,
    { cases x; simp },
    { cases x; cases y; simp [*,coffee] }
end

open nat

lemma coffee_parity_aux (xs : list beans) (k : ℕ) (H_k : k = xs.length) : even (count_black xs) ↔ even (count_black (coffee xs)) :=
begin
  revert xs H_k, apply nat.strong_induction_on k, clear k,
  intros n IH xs Hn,
  cases xs with x xs,
    { simp [coffee] },
    { cases xs with y xs,
      { simp [coffee] },
      { cases x; cases y,
          { simp [coffee] with parity_simps,
            rw ← IH (xs.length + 1) (by norm_num*),
            { simp },
            { refl }},
          { simp [coffee], rw ← IH (xs.length + 1) (by norm_num*),
            { simp },
            { refl }},
          { simp [coffee], rw ← IH (xs.length + 1) (by norm_num*),
            { simp },
            { refl }},
          { simp [coffee] with parity_simps,
            rw ← IH (xs.length + 1) (by norm_num*),
            { simp },
            { refl }}}}
end

lemma coffee_parity {xs : list beans} : even (count_black xs) ↔ even (count_black (coffee xs)) :=
coffee_parity_aux xs xs.length rfl

theorem ends_black_of_count_black_odd {x} {xs : list beans} (H_odd : ¬ (even $ count_black $ x::xs)) : coffee (x::xs) = [black] :=
by {have := @coffee_parity (x::xs), have := @coffee_black_white x xs, finish}

theorem ends_white_of_count_black_even {x} {xs : list beans} (H_even : even $ count_black $ x::xs) : coffee (x::xs) = [white] :=
by {have := @coffee_parity (x::xs), have := @coffee_black_white x xs, finish}


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los primos mayores que 2 son impares.
-- ----------------------------------------------------------------------

import data.nat.prime data.nat.parity tactic

open set nat

example : { n | prime n } ∩ { n | n > 2} ⊆ { n | ¬ even n } :=
begin
  intro n,
  simp,
  intro nprime,
  cases prime.eq_two_or_odd nprime with h h,
  { rw h,
    intro,
    linarith },
  { rw even_iff,
    rw h,
    norm_num },
end

-- Prueba
-- ======

/-
⊢ {n : ℕ | n.prime} ∩ {n : ℕ | n > 2} ⊆ {n : ℕ | ¬n.even}
  >> intro n,
n : ℕ
⊢ n ∈ {n : ℕ | n.prime} ∩ {n : ℕ | n > 2} → n ∈ {n : ℕ | ¬n.even}
  >> simp,
⊢ n.prime → 2 < n → ¬n.even
  >> intro nprime,
nprime : n.prime
⊢ 2 < n → ¬n.even
  >> cases prime.eq_two_or_odd nprime with h h,
| h : n = 2
| ⊢ 2 < n → ¬n.even
|   >> { rw h,
| ⊢ 2 < 2 → ¬2.even
|   >>   intro,
| a : 2 < 2
| ⊢ ¬2.even
|   >>   linarith },
h : n % 2 = 1
⊢ 2 < n → ¬n.even
  >> { rw even_iff,
⊢ 2 < n → ¬n % 2 = 0
  >>   rw h,
⊢ 2 < n → ¬1 = 0
  >>   norm_num },
no goals
-/

-- Comentario: Se han usado los lemas
-- + prime.eq_two_or_odd : p.prime → p = 2 ∨ p % 2 = 1
-- + even_iff : even n ↔ n % 2 = 0

variables (n p : ℕ)
-- #check @prime.eq_two_or_odd p
-- #check @even_iff n


import game.sets.sets_level03 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type --hide

/-
# Chapter 1 : Sets

## Level 4
-/

/- Axiom : ext_iff :
A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B
-/

/-

To prove that two sets are equal, one needs to use the axiom
of extensionality: two sets are equal if and only if they have
the same elements.

In Lean's maths library this axiom is called `ext_iff`.

```
lemma ext_diff : A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B
```
-/

/- Hint: A word on coding style

After a `split` statement, one goal turns into two. A good programming style
would be to use `{}` brackets to work on each goal individually, like this:
```
begin
  split,
  { insert,
    proof of,
    first goal
  },
  { insert,
    proof of,
    second goal
  }
end
```

This way you only ever have one goal to work on, and your code becomes
easier to read. After `split` you might want to write
```
{ sorry},
{ sorry}
```
so that your code has no errors while you're working on it.
-/

/- Hint : Stuck?
To prove the theorem below, remember that you can use `split` to
change the goal into two goals, corresponding to the left-right and
right-left implication, respectively. For the first goal, after
`intro h,` the equality of the two sets can be manipulated
using `rw ext_iff`.
-/

/- Hint: rewrite failures and the `simp_rw` tactic
`rw` doesn't work "under a binder". In other words, if your goal is
`⊢	∀ (x : X), x ∈ B ↔ x ∈ A ∪ B` then `rw mem_union_iff` won't work!
It's the `∀` which is blocking it. Either do `intro x` (and then
the `rw` will work), or use a more powerful rewrite tactic
called `simp_rw`, which will work

-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq B \iff A \cup B = B.$$
-/
theorem subset_iff_union_eq (A : set X) (B : set X) : A ⊆ B ↔ B = A ∪ B :=
begin
  rw subset_iff,
  split,
  intro h,
  rw ext_iff,
  simp_rw mem_union_iff,
  intro j,
  specialize h j,
  tauto!,

  intro h,
  intro k,
  intro b,
  rw h,
  left,
  exact b,

end

--begin hide
-- theorem subset_iff_union_eq' (A : set X) (B : set X) : A ⊆ B ↔ B = A ∪ B :=
-- begin
--   rw subset_iff,
--   rw ext_iff,
--   apply forall_congr,
--   intro x,
--   rw mem_union_iff,
--   tauto!,
-- end
--end hide

end xena --hide

--rw subset_iff,
  --split,
  --{ intro h,
    --rw ext_iff,
     -- can't rewrite under a binder
    --simp_rw mem_union_iff,
    --intro x,
    --specialize h x, -- or replace h := h x,
    --tauto! },
  --{ intro h,
    --intros x hA,
    --rw h,
    --rw mem_union_iff,
    --tauto!
  --}


import data.real.basic

/-
One of the earliest kind of proofs one encounters while learning mathematics is proving by
a calculation. It may not sound like a proof, but this is actually using lemmas expressing
properties of operations on numbers. It also uses the fundamental property of equality: if two
mathematical objects A and B are equal then, in any statement involving A, one can replace A
by B. This operation is called rewriting, and the Lean "tactic" for this is `rw`.

In the following exercises, we will use the following two lemmas:
  mul_assoc a b c : a * b * c = a * (b * c)
  mul_comm a b : a*b = b*a

Hence the command
  rw mul_assoc a b c,
will replace a*b*c by a*(b*c) in the current goal.

In order to replace backward, we use
  rw ← mul_assoc a b c,
replacing a*(b*c) by a*b*c in the current goal.

Of course we don't want to constantly invoke those lemmas, and we will eventually introduce
more powerful solutions.
-/

example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

-- 0001
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c,
  rw mul_assoc,
  rw mul_comm c,
end

-- 0002
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ←mul_assoc,
  rw mul_comm a,
  rw mul_assoc,
end

/-
Now let's return to the preceding example to experiment with what happens
if we don't give arguments to mul_assoc or mul_comm.
For instance, you can start the next proof with
  rw ← mul_assoc,
Try to figure out what happens.
-/

-- 0003
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ←mul_assoc,
  rw mul_comm a,
  rw mul_assoc,
end

/-
We can also perform rewriting in an assumption of the local context, using for instance
  rw mul_comm a b at hyp,
in order to replace a*b by b*a in assumption hyp.

The next example will use a third lemma:
  two_mul a : 2*a = a + a

Also we use the `exact` tactic, which allows to provide a direct proof term.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a*d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp, -- Our assumption hyp is now exactly what we have to prove
end

/-
And the next one can use:
  sub_self x : x - x = 0
-/

-- 0004
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  rw mul_comm at hyp,
  subst hyp',
  rwa sub_self at hyp,
end

/-
What is written in the two preceding example is very far away from what we would write on
paper. Let's now see how to get a more natural layout.
Inside each pair of curly braces below, the goal is to prove equality with the preceding line.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b : by { rw hyp }
  ... = d*a + a*d  : by { rw hyp' }
  ... = a*d + a*d  : by { rw mul_comm d a }
  ... = 2*(a*d)    : by { rw two_mul }
  ... = 2*a*d      : by { rw mul_assoc },
end

/-
Let's note there is no comma at the end of each line of calculation. `calc` is really one
command, and the comma comes only after it's fully done.

From a practical point of view, when writing such a proof, it is convenient to:
* pause the tactic state view update in VScode by clicking the Pause icon button
  in the top right corner of the Lean Goal buffer
* write the full calculation, ending each line with ": by {}"
* resume tactic state update by clicking the Play icon button and fill in proofs between
  curly braces.

Let's return to the other example using this method.
-/

-- 0005
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  calc c = b*a -d : hyp
  ... = a*b - d   : by rw mul_comm
  ... = d - d     : by rw ←hyp'
  ... = 0         : sub_self _,
end

/-
The preceding proofs have exhausted our supply of "mul_comm" patience. Now it's time
to get the computer to work harder. The `ring` tactic will prove any goal that follows by
applying only the axioms of commutative (semi-)rings, in particular commutativity and
associativity of addition and multiplication, as well as distributivity.

We also note that curly braces are not necessary when we write a single tactic proof, so
let's get rid of them.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b   : by rw hyp
     ... = d*a + a*d : by rw hyp'
     ... = 2*a*d     : by ring,
end

/-
Of course we can use `ring` outside of `calc`. Let's do the next one in one line.
-/

-- 0006
example (a b c : ℝ) : a * (b * c) = b * (a * c) := by ring

/-
This is too much fun. Let's do it again.
-/

-- 0007
example (a b : ℝ) : (a + b) + a = 2*a + b := by ring

/-
Maybe this is cheating. Let's try to do the next computation without ring.
We could use:
pow_two x : x^2 = x*x
mul_sub a b c : a*(b-c) = a*b - a*c
add_mul a b c : (a+b)*c = a*c + b*c
add_sub a b c : a + (b - c) = (a + b) - c
sub_sub a b c : a - b - c = a - (b + c)
add_zero a : a + 0 = a
-/

-- 0008
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 :=
begin
  calc
    (a + b) * (a - b) = a * (a - b) + b * (a - b)       : by rw add_mul
    ...               = a * a - a * b + (b * a - b * b) : by repeat {rw mul_sub}
    ...               = a^2 - a * b + (b * a - b^2)     : by repeat {rw ←pow_two}
    ...               = a^2 - a * b + b * a - b^2       : by rw add_sub
    ...               = a^2 - a * b + a * b - b^2       : by rw mul_comm b
    ...               = a^2 - b^2                       : by rw sub_add_cancel
end

/- Let's stick to ring in the end. -/


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import order.bounds
import data.set.intervals.image_preimage

/-!
# Intervals without endpoints ordering

In any decidable linear order `α`, we define the set of elements lying between two elements `a` and
`b` as `Icc (min a b) (max a b)`.

`Icc a b` requires the assumption `a ≤ b` to be meaningful, which is sometimes inconvenient. The
interval as defined in this file is always the set of things lying between `a` and `b`, regardless
of the relative order of `a` and `b`.

For real numbers, `Icc (min a b) (max a b)` is the same as `segment ℝ a b`.

## Notation

We use the localized notation `[a, b]` for `interval a b`. One can open the locale `interval` to
make the notation available.

-/

universe u
open_locale pointwise

namespace set

section linear_order

variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ c x : α}

/-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
def interval (a b : α) := Icc (min a b) (max a b)

localized "notation `[`a `, ` b `]` := set.interval a b" in interval

@[simp] lemma interval_of_le (h : a ≤ b) : [a, b] = Icc a b :=
by rw [interval, min_eq_left h, max_eq_right h]

@[simp] lemma interval_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
by { rw [interval, min_eq_right h, max_eq_left h] }

lemma interval_swap (a b : α) : [a, b] = [b, a] :=
by rw [interval, interval, min_comm, max_comm]

lemma interval_of_lt (h : a < b) : [a, b] = Icc a b :=
interval_of_le (le_of_lt h)

lemma interval_of_gt (h : b < a) : [a, b] = Icc b a :=
interval_of_ge (le_of_lt h)

lemma interval_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a :=
interval_of_gt (lt_of_not_ge h)

lemma interval_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b :=
interval_of_lt (lt_of_not_ge h)

@[simp] lemma interval_self : [a, a] = {a} :=
set.ext $ by simp [le_antisymm_iff, and_comm]

@[simp] lemma nonempty_interval : set.nonempty [a, b] :=
by { simp only [interval, min_le_iff, le_max_iff, nonempty_Icc], left, left, refl }

@[simp] lemma left_mem_interval : a ∈ [a, b] :=
by { rw [interval, mem_Icc], exact ⟨min_le_left _ _, le_max_left _ _⟩ }

@[simp] lemma right_mem_interval : b ∈ [a, b] :=
by { rw interval_swap, exact left_mem_interval }

lemma Icc_subset_interval : Icc a b ⊆ [a, b] :=
by { assume x h, rwa interval_of_le, exact le_trans h.1 h.2 }

lemma Icc_subset_interval' : Icc b a ⊆ [a, b] :=
by { rw interval_swap, apply Icc_subset_interval }

lemma mem_interval_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] :=
Icc_subset_interval ⟨ha, hb⟩

lemma mem_interval_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] :=
Icc_subset_interval' ⟨hb, ha⟩

lemma not_mem_interval_of_lt (ha : c < a) (hb : c < b) : c ∉ interval a b :=
not_mem_Icc_of_lt $ lt_min_iff.mpr ⟨ha, hb⟩

lemma not_mem_interval_of_gt (ha : a < c) (hb : b < c) : c ∉ interval a b :=
not_mem_Icc_of_gt $ max_lt_iff.mpr ⟨ha, hb⟩

lemma interval_subset_interval (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
Icc_subset_Icc (le_min h₁.1 h₂.1) (max_le h₁.2 h₂.2)

lemma interval_subset_Icc (ha : a₁ ∈ Icc a₂ b₂) (hb : b₁ ∈ Icc a₂ b₂) : [a₁, b₁] ⊆ Icc a₂ b₂ :=
Icc_subset_Icc (le_min ha.1 hb.1) (max_le ha.2 hb.2)

lemma interval_subset_interval_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
iff.intro (λh, ⟨h left_mem_interval, h right_mem_interval⟩) (λ h, interval_subset_interval h.1 h.2)

lemma interval_subset_interval_iff_le :
  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
by { rw [interval, interval, Icc_subset_Icc_iff], exact min_le_max }

lemma interval_subset_interval_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] :=
interval_subset_interval h right_mem_interval

lemma interval_subset_interval_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] :=
interval_subset_interval left_mem_interval h

/-- A sort of triangle inequality. -/
lemma interval_subset_interval_union_interval : [a, c] ⊆ [a, b] ∪ [b, c] :=
begin
  rintro x hx,
  obtain hac | hac := le_total a c,
  { rw interval_of_le hac at hx,
    obtain hb | hb := le_total x b,
    { exact or.inl (mem_interval_of_le hx.1 hb) },
    { exact or.inr (mem_interval_of_le hb hx.2) } },
  { rw interval_of_ge hac at hx,
    obtain hb | hb := le_total x b,
    { exact or.inr (mem_interval_of_ge hx.1 hb) },
    { exact or.inl (mem_interval_of_ge hb hx.2) } }
end

lemma bdd_below_bdd_above_iff_subset_interval (s : set α) :
  bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ [a, b] :=
begin
  rw [bdd_below_bdd_above_iff_subset_Icc],
  split,
  { rintro ⟨a, b, h⟩, exact ⟨a, b, λ x hx, Icc_subset_interval (h hx)⟩ },
  { rintro ⟨a, b, h⟩, exact ⟨min a b, max a b, h⟩ }
end

/-- The open-closed interval with unordered bounds. -/
def interval_oc : α → α → set α := λ a b, Ioc (min a b) (max a b)

-- Below is a capital iota
localized "notation `Ι` := set.interval_oc" in interval

lemma interval_oc_of_le (h : a ≤ b) : Ι a b = Ioc a b :=
by simp [interval_oc, h]

lemma interval_oc_of_lt (h : b < a) : Ι a b = Ioc b a :=
by simp [interval_oc, le_of_lt h]

lemma forall_interval_oc_iff  {P : α → Prop} :
  (∀ x ∈ Ι a b, P x) ↔ (∀ x ∈ Ioc a b, P x) ∧ (∀ x ∈ Ioc b a, P x) :=
by { dsimp [interval_oc], cases le_total a b with hab hab ; simp [hab] }

lemma interval_oc_subset_interval_oc_of_interval_subset_interval {a b c d : α}
  (h : [a, b] ⊆ [c, d]) : Ι a b ⊆ Ι c d :=
Ioc_subset_Ioc (interval_subset_interval_iff_le.1 h).1 (interval_subset_interval_iff_le.1 h).2

lemma interval_oc_swap (a b : α) : Ι a b = Ι b a :=
by simp only [interval_oc, min_comm a b, max_comm a b]

end linear_order

open_locale interval

section ordered_add_comm_group

variables {α : Type u} [linear_ordered_add_comm_group α] (a b c x y : α)

@[simp] lemma preimage_const_add_interval : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
by simp only [interval, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]

@[simp] lemma preimage_add_const_interval : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
by simpa only [add_comm] using preimage_const_add_interval a b c

@[simp] lemma preimage_neg_interval : - [a, b] = [-a, -b] :=
by simp only [interval, preimage_neg_Icc, min_neg_neg, max_neg_neg]

@[simp] lemma preimage_sub_const_interval : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
by simp [sub_eq_add_neg]

@[simp] lemma preimage_const_sub_interval : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
by { rw [interval, interval, preimage_const_sub_Icc],
  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }

@[simp] lemma image_const_add_interval : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
by simp [add_comm]

@[simp] lemma image_add_const_interval : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
by simp

@[simp] lemma image_const_sub_interval : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]

@[simp] lemma image_sub_const_interval : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
by simp [sub_eq_add_neg, add_comm]

lemma image_neg_interval : has_neg.neg '' [a, b] = [-a, -b] := by simp

variables {a b c x y}

/-- If `[x, y]` is a subinterval of `[a, b]`, then the distance between `x` and `y`
is less than or equal to that of `a` and `b` -/
lemma abs_sub_le_of_subinterval (h : [x, y] ⊆ [a, b]) : |y - x| ≤ |b - a| :=
begin
  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
  rw [interval_subset_interval_iff_le] at h,
  exact sub_le_sub h.2 h.1,
end

/-- If `x ∈ [a, b]`, then the distance between `a` and `x` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_left_of_mem_interval (h : x ∈ [a, b]) : |x - a| ≤ |b - a| :=
abs_sub_le_of_subinterval (interval_subset_interval_left h)

/-- If `x ∈ [a, b]`, then the distance between `x` and `b` is less than or equal to
that of `a` and `b`  -/
lemma abs_sub_right_of_mem_interval (h : x ∈ [a, b]) : |b - x| ≤ |b - a| :=
abs_sub_le_of_subinterval (interval_subset_interval_right h)

end ordered_add_comm_group

section linear_ordered_field

variables {k : Type u} [linear_ordered_field k] {a : k}

@[simp] lemma preimage_mul_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
(lt_or_gt_of_ne ha).elim
  (λ ha, by simp [interval, ha, ha.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
  (λ (ha : 0 < a), by simp [interval, ha, ha.le, min_div_div_right, max_div_div_right])

@[simp] lemma preimage_const_mul_interval (ha : a ≠ 0) (b c : k) :
  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
by simp only [← preimage_mul_const_interval ha, mul_comm]

@[simp] lemma preimage_div_const_interval (ha : a ≠ 0) (b c : k) :
  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
by simp only [div_eq_mul_inv, preimage_mul_const_interval (inv_ne_zero ha), inv_inv₀]

@[simp] lemma image_mul_const_interval (a b c : k) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
if ha : a = 0 then by simp [ha] else
calc (λ x, x * a) '' [b, c] = (λ x, x * a⁻¹) ⁻¹' [b, c] :
  (units.mk0 a ha).mul_right.image_eq_preimage _
... = (λ x, x / a) ⁻¹' [b, c] : by simp only [div_eq_mul_inv]
... = [b * a, c * a] : preimage_div_const_interval ha _ _

@[simp] lemma image_const_mul_interval (a b c : k) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
by simpa only [mul_comm] using image_mul_const_interval a b c

@[simp] lemma image_div_const_interval (a b c : k) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
by simp only [div_eq_mul_inv, image_mul_const_interval]

end linear_ordered_field

end set


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

! This file was ported from Lean 3 source module data.nat.prime_fin
! leanprover-community/mathlib commit d6fad0e5bf2d6f48da9175d25c3dc5706b3834ce
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Factors
import Mathlib.Data.Set.Finite

/-!
# Prime numbers

This file contains some results about prime numbers which depend on finiteness of sets.
-/

namespace Nat

/-- A version of `Nat.exists_infinite_primes` using the `Set.Infinite` predicate. -/
theorem infinite_setOf_prime : { p | Prime p }.Infinite :=
  Set.infinite_of_not_bddAbove not_bddAbove_setOf_prime
#align nat.infinite_set_of_prime Nat.infinite_setOf_prime

/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/
theorem factors_mul_toFinset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
    (a * b).factors.toFinset = a.factors.toFinset ∪ b.factors.toFinset :=
  (List.toFinset.ext fun _ => (mem_factors_mul ha hb).trans List.mem_union.symm).trans <|
    List.toFinset_union _ _
#align nat.factors_mul_to_finset Nat.factors_mul_toFinset

theorem pow_succ_factors_toFinset (n k : ℕ) : (n ^ (k + 1)).factors.toFinset = n.factors.toFinset :=
  by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp
  induction' k with k ih
  · simp
  · rw [pow_succ', factors_mul_toFinset hn (pow_ne_zero _ hn), ih, Finset.union_idempotent]
#align nat.pow_succ_factors_to_finset Nat.pow_succ_factors_toFinset

theorem pow_factors_toFinset (n : ℕ) {k : ℕ} (hk : k ≠ 0) :
    (n ^ k).factors.toFinset = n.factors.toFinset := by
  cases k
  · simp at hk
  rw [pow_succ_factors_toFinset]
#align nat.pow_factors_to_finset Nat.pow_factors_toFinset

/-- The only prime divisor of positive prime power `p^k` is `p` itself -/
theorem prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : Prime p) :
    (p ^ k).factors.toFinset = {p} := by simp [pow_factors_toFinset p hk, factors_prime hp]
#align nat.prime_pow_prime_divisor Nat.prime_pow_prime_divisor

theorem factors_mul_toFinset_of_coprime {a b : ℕ} (hab : coprime a b) :
    (a * b).factors.toFinset = a.factors.toFinset ∪ b.factors.toFinset :=
  (List.toFinset.ext <| mem_factors_mul_of_coprime hab).trans <| List.toFinset_union _ _
#align nat.factors_mul_to_finset_of_coprime Nat.factors_mul_toFinset_of_coprime

end Nat


import data.real.basic

import tactic.suggest

import game.Completeness.level01

noncomputable theory
open_locale classical

/-
# Chapter 6 : Completeness

## Level 3

The infimum, call it y, of a set A is the greatest lower bound
of A. In lean, we define the infimum as the maximum of the lwoer bound.

Prove that for any number in a lower bounded set,
there exists an element in A such that
the element will be less than the number.

Hint: it may help to prove by contrapositive.
-/

lemma inf_lt {A : set ℝ} {x : ℝ} (hx : x is_an_inf_of A) :
  ∀ y, x < y → ∃ a ∈ A, a < y :=
begin
  -- Let `y` be any real number.
  intro y,
  -- Let's prove the contrapositive
  contrapose,
  -- The symbol `¬` means negation. Let's ask Lean to rewrite the goal without negation,
  -- pushing negation through quantifiers and inequalities
  push_neg,
  -- Let's assume the premise, calling the assumption `h`
  intro h,
  -- `h` is exactly saying `y` is a lower bound of `A` so the second part of
  -- the infimum assumption `hx` applied to `y` and `h` is exactly what we want.
  exact hx.2 y h
end


/-!

# Probability overivew

In this short file, I will give a brief overview of what probability theory
currently exists in mathlib.

The quickest indicator of what exists in mathlib is simply going into the
probability folder and look at the file names. Of course, this method doesn't
really give you a indicator of what is actually there. Also, some results
relevant to probability theory might not actually be in the probability folder,
e.g. conditional expectation. I will now list the relevant files.

`probability._`:
- `cond_count`: classical probability formulated in measure theory. Useful for
  probabilistic arguments in combinatorics.
- `conditional_expectation`: this is *not* where conditional expectaion is
  defined but the idea is that it should contain "probabilistic" results about
  the conditional expectation. There is only one result there at the moment.
- `conditional_probability`: conditioning by an event and Bayes' theorem.
  This is *not* the conditional probability defined via. the conditional
  expectation.
- `density`: defines the probability density function and the uniform
  distribution. It also contains results such as the LOTUS theorem.
- `ident_distrib`: definition of identically distributed random variables.
- `indepencence`: definition of independence (in a lot of sense); has a lot of
  useful lemmas especially should you want to prove independence via.
  π-λ systems.
- `integration`: lemmas about independence of random variables
- `moments`: moment generating functions and cumulant generating functions and
  basic lemmas about them.
- `notation`: defines probability notations (requires you to write
  `open_locale probability_theory` in the file to before you can use)
- `strong_law`: the strong law of large numbers (both the a.e. and Lᵖ versions)
- `variance`: defines variance. Also contain the Chebyshev inequality.

`probability.process._` (most of this is rather self explainitory):
- `adapted`: defines adaptedness for stochastic processes
- `filtration`: defines filtration for stochastic processes
- `hitting_time`: hitting times are a random time (a stopping time in the
  discrete time setting) and this file contains some basic results about them.
- `stopping`: defines stopping time for stochastic processes

`probability.martingale._`:
- `basic`: defines (sub/super)martingales and prove basic properties about them.
- `borel_cantelli`: proves the one-sided (sub)martingale bound and Lévy's
  generalized Borel-Cantelli lemma.
- `centering`: proves the Doob's decomposition.
- `convergence`: proves the a.e. and L¹-martingale convergence theorems.
- `optional_stopping`: optional stopping theorem and the maximal inequality.
- `upcrossing`: two variants of the Doob's upcrossing estimate used to prove
  the martingale covnergence theorems.

`probability.probability_mass_function._`:
I don't know much about this folder. I think these are finite stuff, not very
relevant to what we want to work with but a lot of "Giry monads" whatever those
are.

`measure_theory.function.conditional_expectation._`:
- `basic`: the construction of the conditional expecation. A lot of useful
  lemmas are there too though the idea is we will eventually move them out of
  there.
- `indicator`: the full-out property of conditional expectation for indicator
  functions.
- `real`: contains results about the conditional expectation of real-valued
  random variables (in contrast to Banach-space valued random variables).
  In particular, this shows that our construction is equivalent to the
  construction of the conditional expectation via. the Radon-Nikodym derivative.
  Also, it show the pull-out proerty for real-valued random variables.
  It also contains some cool bounds for real-valued random variables also,
  though we hope to generalize a lot of them once we have the conditional
  Jensen's inequality.

`measure_theory.function.uniform_integrable`: uniform integrability in both the
analyst's and the probabilist's sense (the two definitions are *not* equivalent)
and proves the Vitali's convergence theorem.

`measure_theory.function.convergence_in_measure`: convergence in measure. See
the `prob_thy` file for more details.

I am also very familiar with the `measure_theory.decomposition` folder so you
can ask me about it if you are interested in the formalization of the
Radon-Nikodym theorem.

-/


import tactic --hide
lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by {cc} --hide

/-Lemma
If $P, Q$ are logical statements then $(P \implies Q)$ is equivalent to $(¬P) ∨ Q$.
-/
lemma P_imp_Q_equiv_not_P_and_Q (P Q : Prop) : (P → Q) ↔ ¬ P ∨ Q :=
begin
  split,
  intro h,
  by_cases p : P,
  right,
  apply h,
  exact p,
  left,
  exact p,
  intros h1 h2,
  cases h1,
  exfalso,
  apply h1,
  exact h2,
  exact h1,

end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen
-/
import data.matrix.pequiv
import data.fintype.card
import group_theory.perm.fin
import group_theory.perm.sign
import algebra.algebra.basic
import tactic.ring
import linear_algebra.alternating
import linear_algebra.pi

/-!
# Determinant of a matrix

This file defines the determinant of a matrix, `matrix.det`, and its essential properties.

## Main definitions

 - `matrix.det`: the determinant of a square matrix, as a sum over permutations
 - `matrix.det_row_multilinear`: the determinant, as an `alternating_map` in the rows of the matrix

## Main results

 - `det_mul`: the determinant of `A ⬝ B` is the product of determinants
 - `det_zero_of_row_eq`: the determinant is zero if there is a repeated row
 - `det_block_diagonal`: the determinant of a block diagonal matrix is a product
   of the blocks' determinants

## Implementation notes

It is possible to configure `simp` to compute determinants. See the file
`test/matrix.lean` for some examples.

-/

universes u v w z
open equiv equiv.perm finset function

namespace matrix
open_locale matrix big_operators

variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
variables {R : Type v} [comm_ring R]

local notation `ε` σ:max := ((sign σ : ℤ ) : R)

/-- `det` is an `alternating_map` in the rows of the matrix. -/
def det_row_multilinear : alternating_map R (n → R) R n :=
((multilinear_map.mk_pi_algebra R n R).comp_linear_map (linear_map.proj)).alternatization

/-- The determinant of a matrix given by the Leibniz formula. -/
abbreviation det (M : matrix n n R) : R :=
det_row_multilinear M

lemma det_apply (M : matrix n n R) :
  M.det = ∑ σ : perm n, (σ.sign : ℤ) • ∏ i, M (σ i) i :=
multilinear_map.alternatization_apply _ M

-- This is what the old definition was. We use it to avoid having to change the old proofs below
lemma det_apply' (M : matrix n n R) :
  M.det = ∑ σ : perm n, ε σ * ∏ i, M (σ i) i :=
by simp [det_apply]

@[simp] lemma det_diagonal {d : n → R} : det (diagonal d) = ∏ i, d i :=
begin
  rw det_apply',
  refine (finset.sum_eq_single 1 _ _).trans _,
  { intros σ h1 h2,
    cases not_forall.1 (mt equiv.ext h2) with x h3,
    convert mul_zero _,
    apply finset.prod_eq_zero,
    { change x ∈ _, simp },
    exact if_neg h3 },
  { simp },
  { simp }
end

@[simp] lemma det_zero (h : nonempty n) : det (0 : matrix n n R) = 0 :=
(det_row_multilinear : alternating_map R (n → R) R n).map_zero

@[simp] lemma det_one : det (1 : matrix n n R) = 1 :=
by rw [← diagonal_one]; simp [-diagonal_one]

lemma det_eq_one_of_card_eq_zero {A : matrix n n R} (h : fintype.card n = 0) : det A = 1 :=
begin
  have perm_eq : (univ : finset (perm n)) = {1} :=
  univ_eq_singleton_of_card_one (1 : perm n) (by simp [card_univ, fintype.card_perm, h]),
  simp [det_apply, card_eq_zero.mp h, perm_eq],
end

/-- Specialize `det_eq_one_of_card_eq_zero` to `fin 0`.

This is especially useful in combination with the `det_succ_` lemmas,
for computing the determinant of a matrix given in the `![...]` notation.
-/
@[simp] lemma det_fin_zero {A : matrix (fin 0) (fin 0) R}: det A = 1 :=
det_eq_one_of_card_eq_zero (fintype.card_fin _)

/-- If `n` has only one element, the determinant of an `n` by `n` matrix is just that element.
Although `unique` implies `decidable_eq` and `fintype`, the instances might
not be syntactically equal. Thus, we need to fill in the args explicitly. -/
@[simp]
lemma det_unique {n : Type*} [unique n] [decidable_eq n] [fintype n] (A : matrix n n R) :
  det A = A (default n) (default n) :=
by simp [det_apply, univ_unique]

lemma det_eq_elem_of_card_eq_one {A : matrix n n R} (h : fintype.card n = 1) (k : n) :
  det A = A k k :=
begin
  have h1 : (univ : finset (perm n)) = {1},
  { apply univ_eq_singleton_of_card_one (1 : perm n),
    simp [card_univ, fintype.card_perm, h] },
  have h2 := univ_eq_singleton_of_card_one k h,
  simp [det_apply, h1, h2],
end

lemma det_mul_aux {M N : matrix n n R} {p : n → n} (H : ¬bijective p) :
  ∑ σ : perm n, (ε σ) * ∏ x, (M (σ x) (p x) * N (p x) x) = 0 :=
begin
  obtain ⟨i, j, hpij, hij⟩ : ∃ i j, p i = p j ∧ i ≠ j,
  { rw [← fintype.injective_iff_bijective, injective] at H,
    push_neg at H,
    exact H },
  exact sum_involution
    (λ σ _, σ * swap i j)
    (λ σ _,
      have ∏ x, M (σ x) (p x) = ∏ x, M ((σ * swap i j) x) (p x),
        from fintype.prod_equiv (swap i j) _ _ (by simp [apply_swap_eq_self hpij]),
      by simp [this, sign_swap hij, prod_mul_distrib])
    (λ σ _ _, (not_congr mul_swap_eq_iff).mpr hij)
    (λ _ _, mem_univ _)
    (λ σ _, mul_swap_involutive i j σ)
end

@[simp] lemma det_mul (M N : matrix n n R) : det (M ⬝ N) = det M * det N :=
calc det (M ⬝ N) = ∑ p : n → n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  by simp only [det_apply', mul_apply, prod_univ_sum, mul_sum,
    fintype.pi_finset_univ]; rw [finset.sum_comm]
... = ∑ p in (@univ (n → n) _).filter bijective, ∑ σ : perm n,
    ε σ * ∏ i, (M (σ i) (p i) * N (p i) i) :
  eq.symm $ sum_subset (filter_subset _ _)
    (λ f _ hbij, det_mul_aux $ by simpa using hbij)
... = ∑ τ : perm n, ∑ σ : perm n, ε σ * ∏ i, (M (σ i) (τ i) * N (τ i) i) :
  sum_bij (λ p h, equiv.of_bijective p (mem_filter.1 h).2) (λ _ _, mem_univ _)
    (λ _ _, rfl) (λ _ _ _ _ h, by injection h)
    (λ b _, ⟨b, mem_filter.2 ⟨mem_univ _, b.bijective⟩, coe_fn_injective rfl⟩)
... = ∑ σ : perm n, ∑ τ : perm n, (∏ i, N (σ i) i) * ε τ * (∏ j, M (τ j) (σ j)) :
  by simp [mul_sum, det_apply', mul_comm, mul_left_comm, prod_mul_distrib, mul_assoc]
... = ∑ σ : perm n, ∑ τ : perm n, (((∏ i, N (σ i) i) * (ε σ * ε τ)) * ∏ i, M (τ i) i) :
  sum_congr rfl (λ σ _, fintype.sum_equiv (equiv.mul_right σ⁻¹) _ _
    (λ τ,
      have ∏ j, M (τ j) (σ j) = ∏ j, M ((τ * σ⁻¹) j) j,
        by rw ← σ⁻¹.prod_comp; simp [mul_apply],
      have h : ε σ * ε (τ * σ⁻¹) = ε τ :=
        calc ε σ * ε (τ * σ⁻¹) = ε ((τ * σ⁻¹) * σ) :
          by rw [mul_comm, sign_mul (τ * σ⁻¹)]; simp
        ... = ε τ : by simp,
      by simp_rw [equiv.coe_mul_right, h]; simp [this, mul_comm, mul_assoc, mul_left_comm]))
... = det M * det N : by simp [det_apply', mul_assoc, mul_sum, mul_comm, mul_left_comm]

instance : is_monoid_hom (det : matrix n n R → R) :=
{ map_one := det_one,
  map_mul := det_mul }

/-- Transposing a matrix preserves the determinant. -/
@[simp] lemma det_transpose (M : matrix n n R) : Mᵀ.det = M.det :=
begin
  rw [det_apply', det_apply'],
  refine fintype.sum_bijective _ inv_involutive.bijective _ _ _,
  intros σ,
  rw sign_inv,
  congr' 1,
  apply fintype.prod_equiv σ,
  intros,
  simp
end

/-- Permuting the columns changes the sign of the determinant. -/
lemma det_permute (σ : perm n) (M : matrix n n R) : matrix.det (λ i, M (σ i)) = σ.sign * M.det :=
((det_row_multilinear : alternating_map R (n → R) R n).map_perm M σ).trans (by simp)

/-- Permuting rows and columns with the same equivalence has no effect. -/
@[simp]
lemma det_minor_equiv_self (e : n ≃ m) (A : matrix m m R) :
  det (A.minor e e) = det A :=
begin
  rw [det_apply', det_apply'],
  apply finset.sum_bij' (λ σ _, equiv.perm_congr e σ) _ _ (λ σ _, equiv.perm_congr e.symm σ),
  { intros σ _, ext, simp only [equiv.symm_symm, equiv.perm_congr_apply, equiv.symm_apply_apply] },
  { intros σ _, ext, simp only [equiv.symm_symm, equiv.perm_congr_apply, equiv.apply_symm_apply] },
  { intros σ _, apply finset.mem_univ },
  { intros σ _, apply finset.mem_univ },
  intros σ _,
  simp_rw [equiv.perm_congr_apply],
  rw equiv.perm.sign_perm_congr e σ,
  congr' 1,
  apply finset.prod_bij' (λ i _, e i) _ _ (λ i _, e.symm i),
  { intros, simp_rw equiv.symm_apply_apply },
  { intros, simp_rw equiv.apply_symm_apply },
  { intros, apply finset.mem_univ },
  { intros, apply finset.mem_univ },
  { intros, simp_rw equiv.symm_apply_apply, rw minor_apply, },
end

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_minor_equiv_self`; this one is unsuitable because
`matrix.reindex_apply` unfolds `reindex` first.
-/
lemma det_reindex_self (e : m ≃ n) (A : matrix m m R) : det (reindex e e A) = det A :=
det_minor_equiv_self e.symm A

/-- The determinant of a permutation matrix equals its sign. -/
@[simp] lemma det_permutation (σ : perm n) :
  matrix.det (σ.to_pequiv.to_matrix : matrix n n R) = σ.sign :=
by rw [←matrix.mul_one (σ.to_pequiv.to_matrix : matrix n n R), pequiv.to_pequiv_mul_matrix,
  det_permute, det_one, mul_one]

@[simp] lemma det_smul {A : matrix n n R} {c : R} : det (c • A) = c ^ fintype.card n * det A :=
calc det (c • A) = det (matrix.mul (diagonal (λ _, c)) A) : by rw [smul_eq_diagonal_mul]
             ... = det (diagonal (λ _, c)) * det A        : det_mul _ _
             ... = c ^ fintype.card n * det A             : by simp [card_univ]

/-- Multiplying each row by a fixed `v i` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_row (v : n → R) (A : matrix n n R) :
  det (λ i j, v j * A i j) = (∏ i, v i) * det A :=
calc det (λ i j, v j * A i j) = det (A ⬝ diagonal v) : congr_arg det $ by { ext, simp [mul_comm] }
                          ... = (∏ i, v i) * det A : by rw [det_mul, det_diagonal, mul_comm]

/-- Multiplying each column by a fixed `v j` multiplies the determinant by
the product of the `v`s. -/
lemma det_mul_column (v : n → R) (A : matrix n n R) :
  det (λ i j, v i * A i j) = (∏ i, v i) * det A :=
multilinear_map.map_smul_univ _ v A

section hom_map

variables {S : Type w} [comm_ring S]

lemma ring_hom.map_det {M : matrix n n R} {f : R →+* S} :
  f M.det = matrix.det (f.map_matrix M) :=
by simp [matrix.det_apply', f.map_sum, f.map_prod]

lemma alg_hom.map_det [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
  {M : matrix n n S} {f : S →ₐ[R] T} :
  f M.det = matrix.det ((f : S →+* T).map_matrix M) :=
by rw [← alg_hom.coe_to_ring_hom, ring_hom.map_det]

end hom_map

section det_zero
/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

lemma det_eq_zero_of_row_eq_zero {A : matrix n n R} (i : n) (h : ∀ j, A i j = 0) : det A = 0 :=
(det_row_multilinear : alternating_map R (n → R) R n).map_coord_zero i (funext h)

lemma det_eq_zero_of_column_eq_zero {A : matrix n n R} (j : n) (h : ∀ i, A i j = 0) : det A = 0 :=
by { rw ← det_transpose, exact det_eq_zero_of_row_eq_zero j h, }

variables {M : matrix n n R} {i j : n}

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq (i_ne_j : i ≠ j) (hij : M i = M j) : M.det = 0 :=
(det_row_multilinear : alternating_map R (n → R) R n).map_eq_zero_of_eq M hij i_ne_j

/-- If a matrix has a repeated column, the determinant will be zero. -/
theorem det_zero_of_column_eq (i_ne_j : i ≠ j) (hij : ∀ k, M k i = M k j) : M.det = 0 :=
by { rw [← det_transpose, det_zero_of_row_eq i_ne_j], exact funext hij }

end det_zero

lemma det_update_row_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_row M j $ u + v) = det (update_row M j u) + det (update_row M j v) :=
(det_row_multilinear : alternating_map R (n → R) R n).map_add M j u v

lemma det_update_column_add (M : matrix n n R) (j : n) (u v : n → R) :
  det (update_column M j $ u + v) = det (update_column M j u) + det (update_column M j v) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_add],
  simp [update_row_transpose, det_transpose]
end

lemma det_update_row_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_row M j $ s • u) = s * det (update_row M j u) :=
(det_row_multilinear : alternating_map R (n → R) R n).map_smul M j s u

lemma det_update_column_smul (M : matrix n n R) (j : n) (s : R) (u : n → R) :
  det (update_column M j $ s • u) = s * det (update_column M j u) :=
begin
  rw [← det_transpose, ← update_row_transpose, det_update_row_smul],
  simp [update_row_transpose, det_transpose]
end

section det_eq

/-! ### `det_eq` section

Lemmas showing the determinant is invariant under a variety of operations.
-/
lemma det_eq_of_eq_mul_det_one {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = B ⬝ C) : det A = det B :=
calc det A = det (B ⬝ C) : congr_arg _ hA
       ... = det B * det C : det_mul _ _
       ... = det B : by rw [hC, mul_one]

lemma det_eq_of_eq_det_one_mul {A B : matrix n n R}
  (C : matrix n n R) (hC : det C = 1) (hA : A = C ⬝ B) : det A = det B :=
calc det A = det (C ⬝ B) : congr_arg _ hA
       ... = det C * det B : det_mul _ _
       ... = det B : by rw [hC, one_mul]

lemma det_update_row_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_row A i (A i + A j)) = det A :=
by simp [det_update_row_add,
    det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_self (A : matrix n n R) {i j : n} (hij : i ≠ j) :
  det (update_column A i (λ k, A k i + A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
     exact det_update_row_add_self Aᵀ hij }

lemma det_update_row_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_row A i (A i + c • A j)) = det A :=
by simp [det_update_row_add, det_update_row_smul,
  det_zero_of_row_eq hij ((update_row_self).trans (update_row_ne hij.symm).symm)]

lemma det_update_column_add_smul_self (A : matrix n n R) {i j : n} (hij : i ≠ j) (c : R) :
  det (update_column A i (λ k, A k i + c • A k j)) = det A :=
by { rw [← det_transpose, ← update_row_transpose, ← det_transpose A],
      exact det_update_row_add_smul_self Aᵀ hij c }

lemma det_eq_of_forall_row_eq_smul_add_const_aux
  {A B : matrix n n R} {s : finset n} : ∀ (c : n → R) (hs : ∀ i, i ∉ s → c i = 0)
  (k : n) (hk : k ∉ s) (A_eq : ∀ i j, A i j = B i j + c i * B k j),
  det A = det B :=
begin
  revert B,
  refine s.induction_on _ _,
  { intros A c hs k hk A_eq,
    have : ∀ i, c i = 0,
    { intros i,
      specialize hs i,
      contrapose! hs,
      simp [hs] },
    congr,
    ext i j,
    rw [A_eq, this, zero_mul, add_zero], },
  { intros i s hi ih B c hs k hk A_eq,
    have hAi : A i = B i + c i • B k := funext (A_eq i),
    rw [@ih (update_row B i (A i)) (function.update c i 0), hAi,
        det_update_row_add_smul_self],
    { exact mt (λ h, show k ∈ insert i s, from h ▸ finset.mem_insert_self _ _) hk },
    { intros i' hi',
      rw function.update_apply,
      split_ifs with hi'i, { refl },
      { exact hs i' (λ h, hi' ((finset.mem_insert.mp h).resolve_left hi'i)) } },
    { exact λ h, hk (finset.mem_insert_of_mem h) },
    { intros i' j',
      rw [update_row_apply, function.update_apply],
      split_ifs with hi'i,
      { simp [hi'i] },
      rw [A_eq, update_row_ne (λ (h : k = i), hk $ h ▸ finset.mem_insert_self k s)] } }
end

/-- If you add multiples of row `B k` to other rows, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_const
  {A B : matrix n n R} (c : n → R) (k : n) (hk : c k = 0)
  (A_eq : ∀ i j, A i j = B i j + c i * B k j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_const_aux c
  (λ i, not_imp_comm.mp $ λ hi, finset.mem_erase.mpr
    ⟨mt (λ (h : i = k), show c i = 0, from h.symm ▸ hk) hi, finset.mem_univ i⟩)
  k (finset.not_mem_erase k finset.univ) A_eq

lemma det_eq_of_forall_row_eq_smul_add_pred_aux {n : ℕ} (k : fin (n + 1)) :
  ∀ (c : fin n → R) (hc : ∀ (i : fin n), k < i.succ → c i = 0)
    {M N : matrix (fin n.succ) (fin n.succ) R}
    (h0 : ∀ j, M 0 j = N 0 j)
    (hsucc : ∀ (i : fin n) j, M i.succ j = N i.succ j + c i * M i.cast_succ j),
    det M = det N :=
begin
  refine fin.induction _ (λ k ih, _) k;
    intros c hc M N h0 hsucc,
  { congr,
    ext i j,
    refine fin.cases (h0 j) (λ i, _) i,
    rw [hsucc, hc i (fin.succ_pos _), zero_mul, add_zero] },

  set M' := update_row M k.succ (N k.succ) with hM',
  have hM : M = update_row M' k.succ (M' k.succ + c k • M k.cast_succ),
  { ext i j,
    by_cases hi : i = k.succ,
    { simp [hi, hM', hsucc, update_row_self] },
    rw [update_row_ne hi, hM', update_row_ne hi] },

  have k_ne_succ : k.cast_succ ≠ k.succ := (fin.cast_succ_lt_succ k).ne,
  have M_k : M k.cast_succ = M' k.cast_succ := (update_row_ne k_ne_succ).symm,

  rw [hM, M_k, det_update_row_add_smul_self M' k_ne_succ.symm, ih (function.update c k 0)],
  { intros i hi,
    rw [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff] at hi,
    rw function.update_apply,
    split_ifs with hik, { refl },
    exact hc _ (fin.succ_lt_succ_iff.mpr (lt_of_le_of_ne hi (ne.symm hik))) },
  { rwa [hM', update_row_ne (fin.succ_ne_zero _).symm] },
  intros i j,
  rw function.update_apply,
  split_ifs with hik,
  { rw [zero_mul, add_zero, hM', hik, update_row_self] },
  rw [hM', update_row_ne ((fin.succ_injective _).ne hik), hsucc],
  by_cases hik2 : k < i,
  { simp [hc i (fin.succ_lt_succ_iff.mpr hik2)] },
  rw update_row_ne,
  apply ne_of_lt,
  rwa [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, fin.coe_succ, nat.lt_succ_iff, ← not_lt]
end

/-- If you add multiples of previous rows to the next row, the determinant doesn't change. -/
lemma det_eq_of_forall_row_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ j, A 0 j = B 0 j)
  (A_succ : ∀ (i : fin n) j, A i.succ j = B i.succ j + c i * A i.cast_succ j) :
  det A = det B :=
det_eq_of_forall_row_eq_smul_add_pred_aux (fin.last _) c
  (λ i hi, absurd hi (not_lt_of_ge (fin.le_last _)))
  A_zero A_succ

/-- If you add multiples of previous columns to the next columns, the determinant doesn't change. -/
lemma det_eq_of_forall_col_eq_smul_add_pred {n : ℕ}
  {A B : matrix (fin (n + 1)) (fin (n + 1)) R} (c : fin n → R)
  (A_zero : ∀ i, A i 0 = B i 0)
  (A_succ : ∀ i (j : fin n), A i j.succ = B i j.succ + c j * A i j.cast_succ) :
  det A = det B :=
by { rw [← det_transpose A, ← det_transpose B],
     exact det_eq_of_forall_row_eq_smul_add_pred c A_zero (λ i j, A_succ j i) }

end det_eq

@[simp] lemma det_block_diagonal {o : Type*} [fintype o] [decidable_eq o] (M : o → matrix n n R) :
  (block_diagonal M).det = ∏ k, (M k).det :=
begin
  -- Rewrite the determinants as a sum over permutations.
  simp_rw [det_apply'],
  -- The right hand side is a product of sums, rewrite it as a sum of products.
  rw finset.prod_sum,
  simp_rw [finset.mem_univ, finset.prod_attach_univ, finset.univ_pi_univ],
  -- We claim that the only permutations contributing to the sum are those that
  -- preserve their second component.
  let preserving_snd : finset (equiv.perm (n × o)) :=
    finset.univ.filter (λ σ, ∀ x, (σ x).snd = x.snd),
  have mem_preserving_snd : ∀ {σ : equiv.perm (n × o)},
    σ ∈ preserving_snd ↔ ∀ x, (σ x).snd = x.snd :=
    λ σ, finset.mem_filter.trans ⟨λ h, h.2, λ h, ⟨finset.mem_univ _, h⟩⟩,
  rw ← finset.sum_subset (finset.subset_univ preserving_snd) _,
  -- And that these are in bijection with `o → equiv.perm m`.
  rw (finset.sum_bij (λ (σ : ∀ (k : o), k ∈ finset.univ → equiv.perm n) _,
                        prod_congr_left (λ k, σ k (finset.mem_univ k))) _ _ _ _).symm,
  { intros σ _,
    rw mem_preserving_snd,
    rintros ⟨k, x⟩,
    simp },
  { intros σ _,
    rw [finset.prod_mul_distrib, ←finset.univ_product_univ, finset.prod_product, finset.prod_comm],
    simp [sign_prod_congr_left] },
  { intros σ σ' _ _ eq,
    ext x hx k,
    simp only at eq,
    have : ∀ k x, prod_congr_left (λ k, σ k (finset.mem_univ _)) (k, x) =
                  prod_congr_left (λ k, σ' k (finset.mem_univ _)) (k, x) :=
      λ k x, by rw eq,
    simp only [prod_congr_left_apply, prod.mk.inj_iff] at this,
    exact (this k x).1 },
  { intros σ hσ,
    rw mem_preserving_snd at hσ,
    have hσ' : ∀ x, (σ⁻¹ x).snd = x.snd,
    { intro x, conv_rhs { rw [← perm.apply_inv_self σ x, hσ] } },
    have mk_apply_eq : ∀ k x, ((σ (x, k)).fst, k) = σ (x, k),
    { intros k x,
      ext; simp [hσ] },
    have mk_inv_apply_eq : ∀ k x, ((σ⁻¹ (x, k)).fst, k) = σ⁻¹ (x, k),
    { intros k x,
      conv_lhs { rw ← perm.apply_inv_self σ (x, k) },
      ext; simp [hσ'] },
    refine ⟨λ k _, ⟨λ x, (σ (x, k)).fst, λ x, (σ⁻¹ (x, k)).fst, _, _⟩, _, _⟩,
    { intro x,
      simp [mk_apply_eq, mk_inv_apply_eq] },
    { intro x,
      simp [mk_apply_eq, mk_inv_apply_eq] },
    { apply finset.mem_univ },
    { ext ⟨k, x⟩; simp [hσ] } },
  { intros σ _ hσ,
    rw mem_preserving_snd at hσ,
    obtain ⟨⟨k, x⟩, hkx⟩ := not_forall.mp hσ,
    rw [finset.prod_eq_zero (finset.mem_univ (k, x)), mul_zero],
    rw [← @prod.mk.eta _ _ (σ (k, x)), block_diagonal_apply_ne],
    exact hkx }
end

/-- The determinant of a 2x2 block matrix with the lower-left block equal to zero is the product of
the determinants of the diagonal blocks. For the generalization to any number of blocks, see
`matrix.upper_block_triangular_det`. -/
lemma upper_two_block_triangular_det
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  (matrix.from_blocks A B 0 D).det = A.det * D.det :=
begin
  classical,
  simp_rw det_apply',
  convert
    (sum_subset (subset_univ ((sum_congr_hom m n).range : set (perm (m ⊕ n))).to_finset) _).symm,
  rw sum_mul_sum,
  simp_rw univ_product_univ,
  rw (sum_bij (λ (σ : perm m × perm n) _, equiv.sum_congr σ.fst σ.snd) _ _ _ _).symm,
  { intros σ₁₂ h,
    simp only [],
    erw [set.mem_to_finset, monoid_hom.mem_range],
    use σ₁₂,
    simp },
  { simp only [forall_prop_of_true, prod.forall, mem_univ],
    intros σ₁ σ₂,
    rw fintype.prod_sum_type,
    simp_rw [equiv.sum_congr_apply, sum.map_inr, sum.map_inl, from_blocks_apply₁₁,
      from_blocks_apply₂₂],
    have hr : ∀ (a b c d : R), (a * b) * (c * d) = a * c * (b * d), { intros, ac_refl },
    rw hr,
    congr,
    norm_cast,
    rw sign_sum_congr },
  { intros σ₁ σ₂ h₁ h₂,
    dsimp only [],
    intro h,
    have h2 : ∀ x, perm.sum_congr σ₁.fst σ₁.snd x = perm.sum_congr σ₂.fst σ₂.snd x,
    { intro x, exact congr_fun (congr_arg to_fun h) x },
    simp only [sum.map_inr, sum.map_inl, perm.sum_congr_apply, sum.forall] at h2,
    ext,
    { exact h2.left x },
    { exact h2.right x }},
  { intros σ hσ,
    erw [set.mem_to_finset, monoid_hom.mem_range] at hσ,
    obtain ⟨σ₁₂, hσ₁₂⟩ := hσ,
    use σ₁₂,
    rw ←hσ₁₂,
    simp },
  { intros σ hσ hσn,
    have h1 : ¬ (∀ x, ∃ y, sum.inl y = σ (sum.inl x)),
    { by_contradiction,
      rw set.mem_to_finset at hσn,
      apply absurd (mem_sum_congr_hom_range_of_perm_maps_to_inl _) hσn,
      rintros x ⟨a, ha⟩,
      rw [←ha], exact h a },
    obtain ⟨a, ha⟩ := not_forall.mp h1,
    cases hx : σ (sum.inl a) with a2 b,
    { have hn := (not_exists.mp ha) a2,
      exact absurd hx.symm hn },
    { rw [finset.prod_eq_zero (finset.mem_univ (sum.inl a)), mul_zero],
      rw [hx, from_blocks_apply₂₁], refl }}
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column 0. -/
lemma det_succ_column_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ i : fin n.succ, (-1) ^ (i : ℕ) * A i 0 *
    det (A.minor i.succ_above fin.succ) :=
begin
  rw [matrix.det_apply, finset.univ_perm_fin_succ, ← finset.univ_product_univ],
  simp only [finset.sum_map, equiv.to_embedding_apply, finset.sum_product, matrix.minor],
  refine finset.sum_congr rfl (λ i _, fin.cases _ (λ i, _) i),
  { simp only [fin.prod_univ_succ, matrix.det_apply, finset.mul_sum,
        equiv.perm.decompose_fin_symm_apply_zero, fin.coe_zero, one_mul,
        equiv.perm.decompose_fin.symm_sign, equiv.swap_self, if_true, id.def, eq_self_iff_true,
        equiv.perm.decompose_fin_symm_apply_succ, fin.succ_above_zero, equiv.coe_refl, pow_zero,
        algebra.mul_smul_comm] },
  -- `univ_perm_fin_succ` gives a different embedding of `perm (fin n)` into
  -- `perm (fin n.succ)` than the determinant of the submatrix we want,
  -- permute `A` so that we get the correct one.
  have : (-1 : R) ^ (i : ℕ) = i.cycle_range.sign,
  { simp [fin.sign_cycle_range] },
  rw [fin.coe_succ, pow_succ, this, mul_assoc, mul_assoc, mul_left_comm ↑(equiv.perm.sign _),
      ← det_permute, matrix.det_apply, finset.mul_sum, finset.mul_sum],
  -- now we just need to move the corresponding parts to the same place
  refine finset.sum_congr rfl (λ σ _, _),
  rw [equiv.perm.decompose_fin.symm_sign, if_neg (fin.succ_ne_zero i)],
  calc ((-1) * σ.sign : ℤ) • ∏ i', A (equiv.perm.decompose_fin.symm (fin.succ i, σ) i') i'
      = ((-1) * σ.sign : ℤ) • (A (fin.succ i) 0 *
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [fin.prod_univ_succ, fin.succ_above_cycle_range,
      equiv.perm.decompose_fin_symm_apply_zero, equiv.perm.decompose_fin_symm_apply_succ]
  ... = (-1) * (A (fin.succ i) 0 * (σ.sign : ℤ) •
        ∏ i', A (((fin.succ i).succ_above) (fin.cycle_range i (σ i'))) i'.succ) :
    by simp only [mul_assoc, mul_comm, neg_mul_eq_neg_mul_symm, one_mul, gsmul_eq_mul, neg_inj,
      neg_smul, fin.succ_above_cycle_range],
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row 0. -/
lemma det_succ_row_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
  det A = ∑ j : fin n.succ, (-1) ^ (j : ℕ) * A 0 j *
    det (A.minor fin.succ j.succ_above) :=
by { rw [← det_transpose A, det_succ_column_zero],
     refine finset.sum_congr rfl (λ i _, _),
     rw [← det_transpose],
     simp only [transpose_apply, transpose_minor, transpose_transpose] }

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row `i`. -/
lemma det_succ_row {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (i : fin n.succ) :
  det A = ∑ j : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.minor i.succ_above j.succ_above) :=
begin
  simp_rw [pow_add, mul_assoc, ← mul_sum],
  have : det A = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A,
  { calc det A = ↑((-1 : units ℤ) ^ (i : ℕ) * (-1 : units ℤ) ^ (i : ℕ) : units ℤ) * det A :
             by simp
           ... = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A :
             by simp [-int.units_mul_self] },
  rw [this, mul_assoc],
  congr,
  rw [← det_permute, det_succ_row_zero],
  refine finset.sum_congr rfl (λ j _, _),
  rw [mul_assoc, matrix.minor, matrix.minor],
  congr,
  { rw [equiv.perm.inv_def, fin.cycle_range_symm_zero] },
  { ext i' j',
    rw [equiv.perm.inv_def, fin.cycle_range_symm_succ] },
end

/-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column `j`. -/
lemma det_succ_column {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (j : fin n.succ) :
  det A = ∑ i : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
    det (A.minor i.succ_above j.succ_above) :=
by { rw [← det_transpose, det_succ_row _ j],
     refine finset.sum_congr rfl (λ i _, _),
     rw [add_comm, ← det_transpose, transpose_apply, transpose_minor, transpose_transpose] }

end matrix


import data.multiset data.finset .to_multiset algebra.big_operators

open classical multiset finset
local attribute [instance] prop_decidable

universe u
variable α : Type u

lemma eq_zero_iff_to_finset_eq_empty {g : multiset α} : g = 0 ↔ g.to_finset = ∅ :=
begin
  apply iff.intro,
  {
    intro h1,
    rw finset.ext,
    intro a,
    simp [*]
  },
  {
    intro h1,
    by_contradiction h2,
    rcases (exists_mem_of_ne_zero h2) with ⟨m, h3⟩,
    rw [←mem_to_finset, h1] at h3,
    have : ¬ m ∈ ∅,
      from finset.not_mem_empty m,
    contradiction
  }
end

lemma prod_ne_zero_of_forall_mem_ne_zero' {β : Type u} [has_zero α] [integral_domain β] {f : finset α } {g : α → β}
  (ha : ∀ x : α, x ≠ 0 → g x ≠ 0) (hb : (0 : β) ≠ 1) : (∀ x ∈ f, x ≠ (0 :α)) → (finset.prod f g ≠ 0) :=
begin
 apply finset.induction_on f,
  {
    simp *,
  },
  {
    intros a s h1 h2 h3,
    have h4 : (∀ (x : α), x ∈ s → x ≠ 0),
    {
      intros x h4,
      simp *,
    },
    have h5 : finset.prod s g ≠ 0,
      from h2 h4,
    have h6 : a ≠ 0,
    {
      apply h3,
      simp,
    },
    have h7 : g a ≠ 0,
      from ha _ h6,
    rw finset.prod_insert h1,
    exact mul_ne_zero h7 h5,
  }
end


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

import algebra.is_prime_pow
import number_theory.arithmetic_function
import analysis.special_functions.log.basic

/-!
# The von Mangoldt Function

In this file we define the von Mangoldt function: the function on natural numbers that returns
`log p` if the input can be expressed as `p^k` for a prime `p`.

## Main Results

The main definition for this file is

- `nat.arithmetic_function.von_mangoldt`: The von Mangoldt function `Λ`.

We then prove the classical summation property of the von Mangoldt function in
`nat.arithmetic_function.von_mangoldt_sum`, that `∑ i in n.divisors, Λ i = real.log n`, and use this
to deduce alternative expressions for the von Mangoldt function via Möbius inversion, see
`nat.arithmetic_function.sum_moebius_mul_log_eq`.

## Notation

We use the standard notation `Λ` to represent the von Mangoldt function.

-/

namespace nat
namespace arithmetic_function

open finset

open_locale arithmetic_function

/-- `log` as an arithmetic function `ℕ → ℝ`. Note this is in the `nat.arithmetic_function`
namespace to indicate that it is bundled as an `arithmetic_function` rather than being the usual
real logarithm. -/
noncomputable def log : arithmetic_function ℝ :=
⟨λ n, real.log n, by simp⟩

@[simp] lemma log_apply {n : ℕ} : log n = real.log n := rfl

/--
The `von_mangoldt` function is the function on natural numbers that returns `log p` if the input can
be expressed as `p^k` for a prime `p`.
In the case when `n` is a prime power, `min_fac` will give the appropriate prime, as it is the
smallest prime factor.

In the `arithmetic_function` locale, we have the notation `Λ` for this function.
-/
noncomputable def von_mangoldt : arithmetic_function ℝ :=
⟨λ n, if is_prime_pow n then real.log (min_fac n) else 0, if_neg not_is_prime_pow_zero⟩

localized "notation `Λ` := nat.arithmetic_function.von_mangoldt" in arithmetic_function

lemma von_mangoldt_apply {n : ℕ} :
  Λ n = if is_prime_pow n then real.log (min_fac n) else 0 := rfl

@[simp] lemma von_mangoldt_apply_one : Λ 1 = 0 := by simp [von_mangoldt_apply]

@[simp] lemma von_mangoldt_nonneg {n : ℕ} : 0 ≤ Λ n :=
begin
  rw [von_mangoldt_apply],
  split_ifs,
  { exact real.log_nonneg (one_le_cast.2 (nat.min_fac_pos n)) },
  refl
end

lemma von_mangoldt_apply_pow {n k : ℕ} (hk : k ≠ 0) : Λ (n ^ k) = Λ n :=
by simp only [von_mangoldt_apply, is_prime_pow_pow_iff hk, pow_min_fac hk]

lemma von_mangoldt_apply_prime {p : ℕ} (hp : p.prime) : Λ p = real.log p :=
by rw [von_mangoldt_apply, prime.min_fac_eq hp, if_pos (nat.prime_iff.1 hp).is_prime_pow]

lemma von_mangoldt_ne_zero_iff {n : ℕ} : Λ n ≠ 0 ↔ is_prime_pow n :=
begin
  rcases eq_or_ne n 1 with rfl | hn, { simp [not_is_prime_pow_one] },
  exact (real.log_pos (one_lt_cast.2 (min_fac_prime hn).one_lt)).ne'.ite_ne_right_iff
end

lemma von_mangoldt_pos_iff {n : ℕ} : 0 < Λ n ↔ is_prime_pow n :=
von_mangoldt_nonneg.lt_iff_ne.trans (ne_comm.trans von_mangoldt_ne_zero_iff)

lemma von_mangoldt_eq_zero_iff {n : ℕ} : Λ n = 0 ↔ ¬is_prime_pow n :=
von_mangoldt_ne_zero_iff.not_right

open_locale big_operators

lemma von_mangoldt_sum {n : ℕ} :
  ∑ i in n.divisors, Λ i = real.log n :=
begin
  refine rec_on_prime_coprime _ _ _ n,
  { simp },
  { intros p k hp,
    rw [sum_divisors_prime_pow hp, cast_pow, real.log_pow, finset.sum_range_succ', pow_zero,
      von_mangoldt_apply_one],
    simp [von_mangoldt_apply_pow (nat.succ_ne_zero _), von_mangoldt_apply_prime hp] },
  intros a b ha' hb' hab ha hb,
  simp only [von_mangoldt_apply, ←sum_filter] at ha hb ⊢,
  rw [mul_divisors_filter_prime_pow hab, filter_union,
    sum_union (disjoint_divisors_filter_prime_pow hab), ha, hb, nat.cast_mul,
    real.log_mul (cast_ne_zero.2 (pos_of_gt ha').ne') (cast_ne_zero.2 (pos_of_gt hb').ne')],
end

@[simp] lemma von_mangoldt_mul_zeta : Λ * ζ = log :=
by { ext n, rw [coe_mul_zeta_apply, von_mangoldt_sum], refl }

@[simp] lemma zeta_mul_von_mangoldt : (ζ : arithmetic_function ℝ) * Λ = log :=
by { rw [mul_comm], simp }

@[simp]

@[simp] lemma moebius_mul_log_eq_von_mangoldt : (μ : arithmetic_function ℝ) * log = Λ :=
by { rw [mul_comm], simp }

lemma sum_moebius_mul_log_eq {n : ℕ} :
  ∑ d in n.divisors, (μ d : ℝ) * log d = - Λ n :=
begin
  simp only [←log_mul_moebius_eq_von_mangoldt, mul_comm log, mul_apply, log_apply, int_coe_apply,
    ←finset.sum_neg_distrib, neg_mul_eq_mul_neg],
  rw sum_divisors_antidiagonal (λ i j, (μ i : ℝ) * -real.log j),
  have : ∑ (i : ℕ) in n.divisors, (μ i : ℝ) * -real.log (n / i : ℕ) =
         ∑ (i : ℕ) in n.divisors, ((μ i : ℝ) * real.log i - μ i * real.log n),
  { apply sum_congr rfl,
    simp only [and_imp, int.cast_eq_zero, mul_eq_mul_left_iff, ne.def, neg_inj, mem_divisors],
    intros m mn hn,
    have : (m : ℝ) ≠ 0,
    { rw [cast_ne_zero],
      rintro rfl,
      exact hn (by simpa using mn) },
    rw [nat.cast_div mn this, real.log_div (cast_ne_zero.2 hn) this, neg_sub, mul_sub] },
  rw [this, sum_sub_distrib, ←sum_mul, ←int.cast_sum, ←coe_mul_zeta_apply, eq_comm, sub_eq_self,
    moebius_mul_coe_zeta, mul_eq_zero, int.cast_eq_zero],
  rcases eq_or_ne n 1 with hn | hn;
  simp [hn],
end

lemma von_mangoldt_le_log : ∀ {n : ℕ}, Λ n ≤ real.log (n : ℝ)
| 0 := by simp
| (n+1) :=
  begin
    rw ←von_mangoldt_sum,
    exact single_le_sum (λ _ _, von_mangoldt_nonneg) (mem_divisors_self _ n.succ_ne_zero),
  end

end arithmetic_function
end nat


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

! This file was ported from Lean 3 source module ring_theory.fintype
! leanprover-community/mathlib commit 1126441d6bccf98c81214a0780c73d499f6721fe
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Units

/-!
# Some facts about finite rings
-/

open Classical

theorem card_units_lt (M₀ : Type _) [MonoidWithZero M₀] [Nontrivial M₀] [Fintype M₀] :
    Fintype.card M₀ˣ < Fintype.card M₀ :=
  Fintype.card_lt_of_injective_of_not_mem Units.val Units.ext not_isUnit_zero
#align card_units_lt card_units_lt


import analysis.special_functions.exp
import analysis.special_functions.log.basic

/- Tactics you may consider
-apply
-exact
-have
-norm_num: deals with numerical expressions
-/

open real
variables a b c d e : ℝ

#check le_refl
#check le_refl b
#check add_pos
#check add_le_add
#check add_le_add_left
#check exp_pos
#check exp_pos d
#check exp_le_exp.mpr
#check log_le_log

-- BEGIN
example (h₀ : d ≤ e) : c + exp (a + d) ≤ c + exp (a + e) :=
begin
  apply add_le_add,
    apply le_refl c,
    apply exp_le_exp.mpr,
  apply add_le_add,
   apply le_refl a,
   apply h₀,
end

example : (0 : ℝ) < 1 :=
by norm_num

example (h : a ≤ b) : log (1 + exp a) ≤ log (1 + exp b) :=
begin
  have h₀ : 0 < 1 + exp a,
  { apply add_pos,
    norm_num,
    exact exp_pos a},
  have h₁ : 0 < 1 + exp b,
  { apply add_pos,
    norm_num,
    exact exp_pos b},
  apply (log_le_log h₀ h₁).mpr,
   { apply add_le_add_left,
    apply exp_le_exp.mpr h, },
end
-- END


import game.max.level05 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter ? : Max and abs

## Level 6

In fact `max_le` can be beefed up to an iff statement.
-/

/- Hint : Tip : using `le_trans`
If your goal is `x ≤ z` and you have a hypothesis `h : y ≤ z`
then of course it will suffice to prove `x ≤ y` and then you
can use transitivity. Instead of `have hxy : x ≤ y,`, opening
a new goal and adding a new hypothesis to our list, you can
do

```
apply le_trans _ h
```

or

```
refine le_trans _ h
```

and this just reduces the goal to proving `x ≤ y` immediately.

-/

/- Lemma
If $a$, $b$, $c$ are real numbers,
then ($a\leq c$ and $b\leq c$) iff $\max(a,b)\leq c.$
-/

theorem max_le_iff {a b c : ℝ} : a ≤ c ∧ b ≤ c ↔ max a b ≤ c :=
begin
  split,
  { intro h,
    cases h with hac hbc,
    exact max_le hac hbc
  },
  { intro habc,
    split,
    { apply le_trans _ habc,
      apply le_max_left},
    { apply le_trans _ habc,
      apply le_max_right
    }
  }
end

end xena --hide

/- Hint : Solution
  split,
  { intro h,
    cases h with hac hbc,
    exact max_le hac hbc
  },
  { intro habc,
    split,
    { apply le_trans _ habc,
      apply le_max_left},
    { apply le_trans _ habc,
      apply le_max_right
    }
  }
-/