/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Jacob Gross

Filters, following Hölzl, Immler, and Huffman, "Type classes and filters for mathematical
analysis in Isabelle/HOL".
-/
import data.set.function logic.identities algebra.complete_lattice
namespace set
open classical

structure filter (A : Type) :=
(sets           : set (set A))
(univ_mem_sets  : univ ∈ sets)
(inter_closed   : ∀ {a b}, a ∈ sets → b ∈ sets → a ∩ b ∈ sets)
(is_mono        : ∀ {a b}, a ⊆ b → a ∈ sets → b ∈ sets)

attribute filter.sets [coercion]

namespace filter -- i.e. set.filter

variable {A : Type}
variables {P Q : A → Prop}
variables {F₁ : filter A} {F₂ : filter A} {F : filter A}

definition eventually (P : A → Prop) (F : filter A) : Prop :=
P ∈ F

-- TODO: notation for eventually?
-- notation `forallf` binders `∈` F `,` r:(scoped:1 P, P) := eventually r F
-- notation `'∀f` binders `∈` F `,` r:(scoped:1 P, P) := eventually r F

theorem eventually_true (F : filter A) : eventually (λx, true) F :=
!filter.univ_mem_sets

theorem eventually_of_forall (F : filter A) (H : ∀ x, P x) : eventually P F :=
by rewrite [eq_univ_of_forall H]; apply eventually_true

theorem eventually_mono (H₁ : eventually P F) (H₂ : ∀x, P x → Q x) : eventually Q F :=
!filter.is_mono H₂ H₁

theorem eventually_congr (H : ∀ x, P x ↔ Q x) (H' : eventually P F) : eventually Q F :=
have P = Q, from ext H,
using this, by rewrite -this; exact H'

theorem eventually_and (H₁ : eventually P F) (H₂ : eventually Q F) :
  eventually (λ x, P x ∧ Q x) F :=
!filter.inter_closed H₁ H₂

theorem eventually_of_eventually_and_left {P Q : A → Prop} {F : filter A}
    (H : eventually (λ x, P x ∧ Q x) F) :
  eventually P F :=
!filter.is_mono (λ x HPQ, and.elim_left HPQ) H

theorem eventually_of_eventually_and_right {P Q : A → Prop} {F : filter A}
    (H : eventually (λ x, P x ∧ Q x) F) :
  eventually Q F :=
!filter.is_mono (λ x HPQ, and.elim_right HPQ) H

theorem eventually_mp (H₁ : eventually (λx, P x → Q x) F) (H₂ : eventually P F) :
  eventually Q F :=
have ∀ x, (P x → Q x) ∧ P x → Q x, from take x, assume H, and.left H (and.right H),
eventually_mono (eventually_and H₁ H₂) this

theorem eventually_mpr (H₁ : eventually P F) (H₂ : eventually (λx, P x → Q x) F) :
  eventually Q F := eventually_mp H₂ H₁

variables (P Q F)
theorem eventually_and_iff : eventually (λ x, P x ∧ Q x) F ↔ eventually P F ∧ eventually Q F :=
iff.intro
  (assume H, and.intro
    (eventually_mpr H (eventually_of_forall F (take x, and.left)))
    (eventually_mpr H (eventually_of_forall F (take x, and.right))))
  (assume H, eventually_and (and.left H) (and.right H))
variables {P Q F}

-- TODO: port eventually_ball_finite_distrib, etc.

theorem eventually_choice {B : Type} [nonemptyB : nonempty B] {R : A → B → Prop} {F : filter A}
  (H : eventually (λ x, ∃ y, R x y) F) : ∃ f, eventually (λ x, R x (f x)) F :=
let f := λ x, epsilon (λ y, R x y) in
exists.intro f
  (eventually_mono H
    (take x, suppose ∃ y, R x y,
      show R x (f x), from epsilon_spec this))

theorem exists_not_of_not_eventually (H : ¬ eventually P F) : ∃ x, ¬ P x :=
exists_not_of_not_forall (assume H', H (eventually_of_forall F H'))

theorem eventually_iff_mp (H₁ : eventually (λ x, P x ↔ Q x) F) (H₂ : eventually P F) :
  eventually Q F :=
eventually_mono (eventually_and H₁ H₂) (λ x H, iff.mp (and.left H) (and.right H))

theorem eventually_iff_mpr (H₁ : eventually (λ x, P x ↔ Q x) F) (H₂ : eventually Q F) :
  eventually P F :=
eventually_mono (eventually_and H₁ H₂) (λ x H, iff.mpr (and.left H) (and.right H))

theorem eventually_iff_iff (H : eventually (λ x, P x ↔ Q x) F) : eventually P F ↔ eventually Q F :=
iff.intro (eventually_iff_mp H) (eventually_iff_mpr H)

/- frequently -/

definition frequently (P : A → Prop) (F : filter A) : Prop := ¬ eventually (λ x, ¬ P x) F

theorem not_frequently_of_eventually : eventually (λ x, ¬ P x) F → ¬ frequently P F :=
not_not_intro

theorem frequently_mono (H₁ : frequently P F) (H₂ : ∀ x, P x → Q x) : frequently Q F :=
 not.mto (λ H, eventually_mono H ( λ x, not.mto (H₂ x)))  H₁

theorem frequently_mp (ev : eventually (λ x, P x → Q x) F) :
  frequently P F → frequently Q F :=
not.mto (λ H, eventually_mp (eventually_mono ev (λ x HPQ, not.mto HPQ)) H)

theorem not_frequently_false : ¬ frequently (λ x, false) F :=
begin
  apply not_not_intro,
  apply eventually_congr,
  intro x, apply iff.symm not_false_iff,
  exact eventually_true F
end

section
  open classical

  theorem not_frequently_iff  : ¬ frequently P F ↔ eventually (λ x, ¬ P x) F :=
  by unfold frequently; rewrite not_not_iff

  theorem exists_of_frequently : frequently P F → ∃ x, P x :=
  assume H, obtain x Hx, from !exists_not_of_not_eventually H,
  show _, from exists.intro x (not_not_elim Hx)

  theorem frequently_inl (H : frequently P F) : frequently (λx, P x ∨ Q x) F :=
  assume H' : eventually (λx, ¬ (P x ∨ Q x)) F,
  have (λx, ¬ (P x ∨ Q x)) = λ x, ¬ P x ∧ ¬ Q x,
    by apply funext; intro x; rewrite not_or_iff_not_and_not,
  show false, by rewrite this at H'; exact H (eventually_of_eventually_and_left H')

  theorem frequently_inr (H : frequently Q F) : frequently (λx, P x ∨ Q x) F :=
  begin
    apply frequently_mp,
    apply eventually_of_forall,
    intro x, apply or.swap,
    exact frequently_inl H
  end
end

/- filters form a lattice under ⊇ -/

protected theorem eq : sets F₁ = sets F₂ → F₁ = F₂ :=
begin
  cases F₁ with s₁ u₁ i₁ m₁, cases F₂ with s₂ u₂ i₂ m₂, esimp,
  intro eqs₁s₂, revert [u₁, i₁, m₁, u₂, i₂, m₂],
  subst s₁, intros, exact rfl
end

namespace complete_lattice
  definition le [reducible] (F₁ F₂ : filter A) := F₁ ⊇ F₂
  local infix `≤`:50 := le

  definition ge [reducible] (F₁ F₂ : filter A) := F₁ ⊆ F₂
  local infix `≥`:50 := ge

  theorem le_refl (F : filter A) : F ≤ F := subset.refl _

  theorem le_trans {F₁ F₂ F₃ : filter A} (H₁ : F₁ ≤ F₂) (H₂ : F₂ ≤ F₃) : F₁ ≤ F₃ :=
  subset.trans H₂ H₁

  theorem le_antisymm (H₁ : F₁ ≤ F₂) (H₂ : F₂ ≤ F₁) : F₁ = F₂ :=
  filter.eq (eq_of_subset_of_subset H₂ H₁)

  definition sup (F₁ F₂ : filter A) : filter A :=
  ⦃ filter,
    sets          := F₁ ∩ F₂,
    univ_mem_sets := and.intro (filter.univ_mem_sets F₁) (filter.univ_mem_sets F₂),
    inter_closed  := abstract
                       λ a b Ha Hb,
                       and.intro
                         (filter.inter_closed F₁ (and.left Ha) (and.left Hb))
                         (filter.inter_closed F₂ (and.right Ha) (and.right Hb))
                       end,
    is_mono       := abstract
                       λ a b Hsub Ha,
                       and.intro
                         (filter.is_mono F₁ Hsub (and.left Ha))
                         (filter.is_mono F₂ Hsub (and.right Ha))
                       end
  ⦄
  local infix ` ⊔ `:65 := sup

  definition inf (F₁ F₂ : filter A) : filter A :=
  ⦃ filter,
    sets          := {r | ∃₀ s ∈ F₁, ∃₀ t ∈ F₂, r ⊇ s ∩ t},
    univ_mem_sets := abstract
                       bounded_exists.intro (univ_mem_sets F₁)
                         (bounded_exists.intro (univ_mem_sets F₂)
                           (by rewrite univ_inter; apply subset.refl))
                     end,
    inter_closed  := abstract
                       λ a b Ha Hb,
                       obtain a₁ [a₁F₁ [a₂ [a₂F₂ (Ha' : a ⊇ a₁ ∩ a₂)]]], from Ha,
                       obtain b₁ [b₁F₁ [b₂ [b₂F₂ (Hb' : b ⊇ b₁ ∩ b₂)]]], from Hb,
                       have a₁ ∩ b₁ ∩ (a₂ ∩ b₂) = a₁ ∩ a₂ ∩ (b₁ ∩ b₂),
                         by rewrite [*inter_assoc, inter_left_comm b₁],
                       have a ∩ b ⊇ a₁ ∩ b₁ ∩ (a₂ ∩ b₂),
                         begin
                           rewrite this,
                           apply subset_inter,
                             {apply subset.trans,
                               apply inter_subset_left,
                               exact Ha'},
                           apply subset.trans,
                           apply inter_subset_right,
                           exact Hb'
                         end,
                       bounded_exists.intro (inter_closed F₁ a₁F₁ b₁F₁)
                         (bounded_exists.intro (inter_closed F₂ a₂F₂ b₂F₂)
                                                  this)
                     end,
    is_mono       := abstract
                       λ a b Hsub Ha,
                       obtain a₁ [a₁F₁ [a₂ [a₂F₂ (Ha' : a ⊇ a₁ ∩ a₂)]]], from Ha,
                       bounded_exists.intro a₁F₁
                         (bounded_exists.intro a₂F₂ (subset.trans Ha' Hsub))
                     end
  ⦄
  infix `⊓`:70 := inf

  definition Sup (S : set (filter A)) : filter A :=
  ⦃ filter,
    sets          := ⋂ F ∈ S, sets F,
    univ_mem_sets := λ F FS, univ_mem_sets F,
    inter_closed  := abstract
                       λ a b Ha Hb F FS,
                         inter_closed F (Ha F FS) (Hb F FS)
                     end,
    is_mono       := abstract
                       λ a b asubb Ha F FS,
                         is_mono F asubb (Ha F FS)
                     end
  ⦄
  local prefix `⨆ `:65 := Sup

  definition Inf (S : set (filter A)) : filter A :=
  Sup {F | ∀ G, G ∈ S → G ≥ F}

  local prefix `⨅ `:70 := Inf

  theorem le_sup_left (F₁ F₂ : filter A) : F₁ ≤ F₁ ⊔ F₂ :=
  inter_subset_left _ _

  theorem le_sup_right (F₁ F₂ : filter A) : F₂ ≤ F₁ ⊔ F₂ :=
  inter_subset_right _ _

  theorem sup_le (H₁ : F₁ ≤ F) (H₂ : F₂ ≤ F) : F₁ ⊔ F₂ ≤ F :=
  subset_inter H₁ H₂

  theorem inf_le_left (F₁ F₂ : filter A) : F₁ ⊓ F₂ ≤ F₁ :=
  take s, suppose s ∈ F₁,
    bounded_exists.intro `s ∈ F₁`
      (bounded_exists.intro (univ_mem_sets F₂) (by rewrite inter_univ; apply subset.refl))

  theorem inf_le_right (F₁ F₂ : filter A) : F₁ ⊓ F₂ ≤ F₂ :=
  take s, suppose s ∈ F₂,
    bounded_exists.intro (univ_mem_sets F₁)
      (bounded_exists.intro `s ∈ F₂` (by rewrite univ_inter; apply subset.refl))

  theorem le_inf (H₁ : F ≤ F₁) (H₂ : F ≤ F₂) : F ≤ F₁ ⊓ F₂ :=
  take s : set A, suppose (s ∈ (F₁ ⊓ F₂ : set (set A))),
  obtain a₁ [a₁F₁ [a₂ [a₂F₂ (Hsub : s ⊇ a₁ ∩ a₂)]]], from this,
  have a₁ ∈ F, from H₁ a₁F₁,
  have a₂ ∈ F, from H₂ a₂F₂,
  show s ∈ F, from is_mono F Hsub (inter_closed F `a₁ ∈ F` `a₂ ∈ F`)

  theorem Sup_le {F : filter A} {S : set (filter A)} (H : ∀₀ G ∈ S, G ≤ F) : ⨆ S ≤ F :=
  λ s Fs G GS, H GS Fs

  theorem le_Sup {F : filter A} {S : set (filter A)} (FS : F ∈ S) : F ≤ ⨆ S :=
  λ s sInfS, sInfS F FS

  theorem le_Inf {F : filter A} {S : set (filter A)} (H : ∀₀ G ∈ S, F ≤ G) : F ≤ ⨅ S :=
  le_Sup H

  theorem Inf_le {F : filter A} {S : set (filter A)} (FS : F ∈ S) : ⨅ S ≤ F :=
  Sup_le (λ G GS, GS F FS)
end complete_lattice

protected definition complete_lattice [trans_instance] : complete_lattice (filter A) :=
⦃ complete_lattice,
  le           := complete_lattice.le,
  le_refl      := complete_lattice.le_refl,
  le_trans     := @complete_lattice.le_trans A,
  le_antisymm  := @complete_lattice.le_antisymm A,
  inf          := complete_lattice.inf,
  le_inf       := @complete_lattice.le_inf A,
  inf_le_left  := @complete_lattice.inf_le_left A,
  inf_le_right := @complete_lattice.inf_le_right A,
  sup          := complete_lattice.sup,
  sup_le       := @complete_lattice.sup_le A,
  le_sup_left  := complete_lattice.le_sup_left,
  le_sup_right := complete_lattice.le_sup_right,
  Inf          := complete_lattice.Inf,
  Inf_le       := @complete_lattice.Inf_le A,
  le_Inf       := @complete_lattice.le_Inf A,
  Sup          := complete_lattice.Sup,
  Sup_le       := @complete_lattice.Sup_le A,
  le_Sup       := @complete_lattice.le_Sup A
⦄

protected theorem subset_of_le {F₁ F₂ : filter A} (H : F₁ ≤ F₂) : sets F₂ ⊆ sets F₁ := H

protected theorem le_of_subset {F₁ F₂ : filter A} (H : sets F₂ ⊆ sets F₁) : F₁ ≤ F₂ := H

theorem sets_Sup (S : set (filter A)) : sets (⨆ S) = ⋂ F ∈ S, sets F := rfl

theorem sets_sup (F₁ F₂ : filter A) : sets (F₁ ⊔ F₂) = sets F₁ ∩ sets F₂ := rfl

theorem sets_inf (F₁ F₂ : filter A) : sets (F₁ ⊓ F₂) = {r | ∃₀ s ∈ F₁, ∃₀ t ∈ F₂, r ⊇ s ∩ t} := rfl

/- eventually and lattice operations -/

theorem eventually_of_le (H₁ : eventually P F₁) (H₂ : F₂ ≤ F₁) : eventually P F₂ :=
filter.subset_of_le H₂ H₁

theorem le_of_forall_eventually (H : ∀ P, eventually P F₁ → eventually P F₂) : F₂ ≤ F₁ := H

theorem eventually_Sup_iff (P : A → Prop) (S : set (filter A)) :
  eventually P (⨆ S) ↔ ∀₀ F ∈ S, eventually P F :=
by rewrite [↑eventually, sets_Sup]

theorem eventually_Sup {P : A → Prop} {S : set (filter A)} (H : ∀₀ F ∈ S, eventually P F) :
  eventually P (⨆ S) :=
iff.mpr (eventually_Sup_iff P S) H

theorem eventually_of_eventually_Sup {P : A → Prop} {S : set (filter A)}
    (H : eventually P (⨆ S)) {F : filter A} (FS : F ∈ S) :
  eventually P F :=
iff.mp (eventually_Sup_iff P S) H F FS

theorem eventually_sup_iff (P : A → Prop) (F₁ F₂ : filter A) :
  eventually P (F₁ ⊔ F₂) ↔ eventually P F₁ ∧ eventually P F₂ :=
by rewrite [↑eventually, sets_sup]

theorem eventually_sup {P : A → Prop} {F₁ F₂ : filter A}
    (H₁ : eventually P F₁) (H₂ : eventually P F₂) :
  eventually P (F₁ ⊔ F₂) :=
iff.mpr (eventually_sup_iff P F₁ F₂) (and.intro H₁ H₂)

theorem eventually_of_eventually_sup_left {P : A → Prop} {F₁ F₂ : filter A}
    (H : eventually P (F₁ ⊔ F₂)) : eventually P F₁ :=
and.left (iff.mp (eventually_sup_iff P F₁ F₂) H)

theorem eventually_of_eventually_sup_right {P : A → Prop} {F₁ F₂ : filter A}
    (H : eventually P (F₁ ⊔ F₂)) : eventually P F₂ :=
and.right (iff.mp (eventually_sup_iff P F₁ F₂) H)

theorem eventually_inf_iff (P : A → Prop) (F₁ F₂ : filter A) :
  eventually P (F₁ ⊓ F₂) ↔ (∃ S, eventually S F₁ ∧ ∃ T, eventually T F₂ ∧ (P ⊇ S ∩ T)) :=
by rewrite [↑eventually, sets_inf]

theorem eventually_inf {P : A → Prop} {F₁ F₂ : filter A}
   {S : A → Prop} (HS : eventually S F₁) (T : A → Prop) (HT : eventually T F₂) (HP : P ⊇ S ∩ T) :
  eventually P (F₁ ⊓ F₂) :=
iff.mpr (eventually_inf_iff P F₁ F₂)
  (exists.intro S (and.intro HS (exists.intro T (and.intro HT HP))))

theorem exists_of_eventually_inf {P : A → Prop} {F₁ F₂ : filter A} (H : eventually P (F₁ ⊓ F₂)) :
  ∃ S, eventually S F₁ ∧ ∃ T, eventually T F₂ ∧ (P ⊇ S ∩ T) :=
iff.mp (eventually_inf_iff P F₁ F₂) H

/- top and bot -/

protected definition bot (A : Type) : filter A :=
⦃ filter,
  sets           := univ,
  univ_mem_sets  := trivial,
  inter_closed := λ a b Ha Hb, trivial,
  is_mono        := λ a b Ha Hsub, trivial
⦄

protected definition top (A : Type) : filter A :=
⦃ filter,
  sets          := '{univ},
  univ_mem_sets := !or.inl rfl,
  inter_closed  := abstract
                     λ a b Ha Hb,
                     by rewrite [*!mem_singleton_iff at *]; substvars; exact !inter_univ
                   end,
  is_mono       := abstract
                     λ a b Hsub Ha,
                     begin
                       rewrite [mem_singleton_iff at Ha], subst [Ha],
                       exact or.inl (eq_univ_of_univ_subset Hsub)
                     end
                   end
⦄

protected theorem bot_eq : ⊥ = filter.bot A :=
le.antisymm !bot_le
  begin
    apply le_of_forall_eventually,
    intro P H,
    unfold eventually,
    apply mem_univ
  end

protected theorem top_eq : ⊤ = filter.top A :=
le.antisymm
  (le_of_forall_eventually
    (λ P H,
      have P = univ, from eq_of_mem_singleton H,
      by rewrite this; apply eventually_true ⊤))
  !le_top

theorem sets_bot_eq : sets ⊥ = (univ : set (set A)) :=
by rewrite filter.bot_eq

theorem sets_top_eq : sets ⊤ = ('{univ} : set (set A)) :=
by rewrite filter.top_eq

theorem eventually_bot (P : A → Prop) : eventually P ⊥ :=
by rewrite [↑eventually, sets_bot_eq]; apply mem_univ

theorem eventually_top_of_forall (H : ∀ x, P x) : eventually P ⊤ :=
by rewrite [↑eventually, sets_top_eq, mem_singleton_iff]; exact eq_univ_of_forall H

theorem forall_of_eventually_top : eventually P ⊤ → ∀ x, P x :=
by rewrite [↑eventually, sets_top_eq, mem_singleton_iff]; intro H x; rewrite H; exact trivial

theorem eventually_top_iff (P : A → Prop) : eventually P top ↔ ∀ x, P x :=
iff.intro forall_of_eventually_top eventually_top_of_forall

/- filter generated by a collection of sets -/

inductive sets_generated_by {A : Type} (B : set (set A)) : set A → Prop :=
| generators_mem : ∀ ⦃s : set A⦄, s ∈ B → sets_generated_by B s
| univ_mem : sets_generated_by B univ
| inter_mem : ∀ {a b}, sets_generated_by B a → sets_generated_by B b → sets_generated_by B (a ∩ b)
| mono : ∀ {a b}, a ⊆ b → sets_generated_by B a → sets_generated_by B b

definition filter_generated_by [reducible] {A : Type} (B : set (set A)) : filter A :=
⦃filter,
  sets            := sets_generated_by B,
  univ_mem_sets   := sets_generated_by.univ_mem B,
  inter_closed    := @sets_generated_by.inter_mem A B,
  is_mono         := @sets_generated_by.mono A B ⦄

theorem generators_subset_generated_by (B : set (set A)) : B ⊆ filter_generated_by B :=
λ s H, sets_generated_by.generators_mem H

theorem sets_generated_by_initial {B : set (set A)} {F : filter A} (H : B ⊆ sets F) :
  sets_generated_by B ⊆ F :=
begin
  intro s Hs,
  induction Hs with s sB s t os ot soA toA S SB SOA,
    {exact H sB},
    {exact filter.univ_mem_sets F},
    {exact filter.inter_closed F soA toA},
   exact filter.is_mono F SOA v_0
end

theorem le_filter_generated_by {B : set (set A)} {F : filter A}
    (H : B ⊆ sets F) : F ≤ filter_generated_by B :=
sets_generated_by_initial H

/- principal filter -/

definition principal (s : set A) : filter A := filter_generated_by '{s}

theorem mem_principal (s : set A) : s ∈ principal s :=
!generators_subset_generated_by !mem_singleton

theorem eventually_principal {s : set A} {P : A → Prop} (H : s ⊆ P) : eventually P (principal s) :=
!filter.is_mono H !mem_principal

theorem subset_of_eventually_principal {s : set A} {P : A → Prop}
  (H : eventually P (principal s)) : s ⊆ P :=
begin
  induction H with s' Ps' a b Ha Hb ssuba ssubb a b asubb Ha ssuba,
    {rewrite [eq_of_mem_singleton Ps']; exact subset.refl s},
    {exact subset_univ s},
    {exact subset_inter ssuba ssubb},
    {exact subset.trans ssuba asubb}
end

theorem eventually_principal_iff (s P : set A) : eventually P (principal s) ↔ (s ⊆ P) :=
iff.intro subset_of_eventually_principal eventually_principal

theorem sets_principal (s : set A) : sets (principal s) = { t | s ⊆ t } :=
ext (take P, eventually_principal_iff s P)

theorem principal_empty : principal (∅ : set A) = ⊥ :=
begin
  apply filter.eq,
  rewrite [sets_principal, sets_bot_eq],
  show { t | ∅ ⊆ t} = univ, from ext (take x, iff.intro
    (assume H, trivial)
    (assume H, empty_subset x))
end

theorem principal_univ_eq : principal (@univ A) = ⊤ :=
begin
  apply filter.eq,
  rewrite [sets_principal, sets_top_eq],
  show { t | univ ⊆ t} = '{univ}, from ext (take x, iff.intro
    (assume H : univ ⊆ x, mem_singleton_of_eq (!eq_univ_of_univ_subset H))
    (assume H : x ∈ '{univ}, by rewrite [eq_of_mem_singleton H]; apply subset.refl))
end

theorem principal_le_principal {s t : set A} (H : s ⊆ t) : principal s ≤ principal t :=
begin
  apply filter.le_of_subset,
  rewrite *sets_principal,
  show { u | t ⊆ u } ⊆ { u | s ⊆ u }, from
    take u, suppose t ⊆ u, subset.trans H this
end

theorem subset_of_principal_le_principal {s t : set A} (H : principal s ≤ principal t) : s ⊆ t :=
begin
  note H' := filter.subset_of_le H,
  revert H', rewrite *sets_principal,
  intro H',
  exact H' (subset.refl t)
end

theorem principal_refines_principal_iff {s t : set A} : principal s ≤ principal t ↔ s ⊆ t :=
iff.intro subset_of_principal_le_principal principal_le_principal

theorem principal_sup_principal {s t : set A} : principal s ⊔ principal t = principal (s ∪ t) :=
begin
  apply filter.eq,
  rewrite [sets_sup, *sets_principal],
  apply ext, intro u, apply iff.intro,
    exact (suppose s ⊆ u ∧ t ⊆ u,
      show s ∪ t ⊆ u, from union_subset (and.left this) (and.right this)),
  exact suppose s ∪ t ⊆ u,
    and.intro (subset.trans (subset_union_left _ _) this)
              (subset.trans (subset_union_right _ _) this)
end

theorem principal_inf_principal {s t : set A} : principal s ⊓ principal t = principal (s ∩ t) :=
begin
  apply filter.eq,
  rewrite [sets_inf, *sets_principal],
  apply ext, intro u, apply iff.intro,
    {intro H,
      show s ∩ t ⊆ u, from
        obtain s' [(ss' : s ⊆ s') [t' [(tt' : t ⊆ t') (Hu : s' ∩ t' ⊆ u)]]], from H,
        take x, assume H', Hu (and.intro (ss' (and.left H')) (tt' (and.right H')))},
  {intro H',
    exact exists.intro s (and.intro (subset.refl s) (exists.intro t
           (and.intro (subset.refl t) H')))}
end

end filter
end set


import tactic
import data.set.basic

-- This is just Coursework 2 but cleaned up substantially!

/--
An ideal of R consists of a nonempty subset of R which is closed under addition, additive inverses,
and multiplication by elements of R.
-/
@[nolint has_inhabited_instance]
structure myideal (R : Type) [comm_ring R] :=
  (iset : set R)
  (not_empty : iset.nonempty)
  (r_mul_mem' {x r}: x ∈ iset → r * x ∈ iset)
  (add_mem' {x y} : x ∈ iset → y ∈ iset → (x + y) ∈ iset)
  (neg_mem' {x} : x ∈ iset → -x ∈ iset)

attribute [ext] myideal

namespace myideal

variables {R : Type} [comm_ring R] (I : myideal R)
instance : has_mem R (myideal R) :=
{ mem := λ x i , x ∈ i.iset}

instance : has_coe (myideal R) (set R) :=
{coe := λ x, x.iset}

instance : has_subset (myideal R) :=
{ subset := λ x y, x.iset ⊆ y.iset }

theorem add_mem {x y : R}: x ∈ I → y ∈ I → x + y ∈ I := by apply add_mem'

theorem neg_mem {x : R} : x ∈ I → -x ∈ I := by apply neg_mem'

theorem r_mul_mem {x r : R} : x ∈ I → r * x ∈ I := by apply r_mul_mem'
end myideal

variables {R : Type} [comm_ring R]

/--
An integral domain has no zero divisors.
-/
class integral_domain (R: Type) extends comm_ring R :=
(hzd: ∀ (x y : R), x * y = 0 → x = 0 ∨ y = 0)

/--
A principal ideal is of the form aR for some a ∈ R
-/
def principal_ideal (x : R) : myideal R :=
{
  iset := { i : R | ∃(v:R), i = x * v},
  not_empty := begin
    rw set.nonempty_def,
    use x,
    use 1,
    rw mul_one,
  end,
  r_mul_mem' := begin
    intro i,
    intro j,
    intro h,
    cases h,
    use (j * h_w),
    rw h_h,
    ring,
  end,
  add_mem' := begin
    intros i j hi hj,
    cases hi,
    cases hj,
    use hi_w + hj_w,
    rw mul_add,
    rw hi_h, rw hj_h,
  end,
  neg_mem' := begin
    intros i hi,
    cases hi,
    use -hi_w,
    rw hi_h,
    ring,
  end
}
/--
An integral domain is a PID iff every ideal is principal.
-/
class pid (R: Type) extends integral_domain R :=
(hpid : ∀(I : myideal R), ∃ (x : R), I = principal_ideal x)

--1 ∈ I → I = R
lemma one_mem_ideal_R {I : myideal R} : (1:R) ∈ I → coe I = {x : R | true} :=
begin
  intro h,
  ext,
  split,
  intro, triv,
  intro h2,
  rw ←mul_one x,
  apply myideal.r_mul_mem,
  exact h,
end

lemma zero_mem_ideal {I : myideal R} : (0:R) ∈ I :=
begin
  have h := myideal.not_empty I,
  rw set.nonempty at h,
  cases h with x hx,
  have h2 : x + (-x) = 0,
  ring,
  rw ←h2,
  apply myideal.add_mem I,
  exact hx,
  apply myideal.neg_mem I,
  exact hx,
end

/--
The sum of two ideals is also an ideal.
-/
def sum_ideal (I J : myideal R) : myideal R :=
{ iset := {r : R | ∃ (i ∈ I) (j ∈ J), r = i + j},
  not_empty := begin
    have h1 := myideal.not_empty I,
    have h2 := myideal.not_empty J,
    rw set.nonempty at h1 h2 ⊢,
    cases h1,
    cases h2,
    use h1_w + h2_w,
    use h1_w, split, exact h1_h,
    use h2_w, split, exact h2_h,
    refl,
  end,
  r_mul_mem' := begin
    intros x r h,
    cases h with i h2,
    cases h2 with hi h2,
    cases h2 with j h2,
    cases h2 with hj h2,
    rw h2,
    rw mul_add,
    use r * i,
    split,
      apply myideal.r_mul_mem,
      exact hi,
    use r * j,
    split,
      apply myideal.r_mul_mem,
      exact hj,
    refl,
  end,
  add_mem' := begin
    intros x y hxm hym,
    cases hxm with xi hxi,
    cases hxi with hxi h2,
    cases h2 with xj hxj,
    cases hxj with hxj hx,
    cases hym with yi hyi,
    cases hyi with hyi h2,
    cases h2 with yj hyj,
    cases hyj with hyj hy,
    use xi + yi,
    split,
    apply myideal.add_mem, exact hxi, exact hyi,
    use xj + yj,
    split,
    apply myideal.add_mem, exact hxj, exact hyj,
    rw hy,
    rw hx,
    ring,
  end,
  neg_mem' := begin
    intros x h,
    cases h with i hi,
    cases hi with hi h2,
    cases h2 with j h2,
    cases h2 with hj h2,
    use -i,
    split,
    apply myideal.neg_mem,
    exact hi,
    use -j,
    split,
    apply myideal.neg_mem,
    exact hj,
    rw h2, ring,
  end
}

namespace myring
/--
An element r of R is irreducible iff it is not a unit and
for all factorisations x * y = r, x or y is a unit.
-/
def irreducible (r : R) : Prop :=
  ¬is_unit r ∧ ∀(x y : R), x * y = r → is_unit x ∨ is_unit y

/--
  Two elements a b are associates iff a = b * c for some unit c.
-/
def associates (a b : R) : Prop :=
  ∃ (c : R), is_unit c ∧ b = a * c

notation a ` ~ ` b := associates a b
end myring
open myring

lemma r_prod_unit_r_unit (r a : R) (hpu : is_unit (r * a)) :
  is_unit r :=
begin
  have h2:=  is_unit.exists_right_inv hpu,
  cases h2,
  rw is_unit_iff_exists_inv',
  use a * h2_w, rw mul_comm, rw ← mul_assoc, exact h2_h,
end

lemma unit_mul_irr_is_irr (r a : R) (hirr :irreducible r) (hu: is_unit a) :
 irreducible (a * r) :=
begin
  split,
  {
    by_contra,
    cases hirr,
    apply hirr_left,
    apply r_prod_unit_r_unit r a,
    rw mul_comm,
    exact h
  },
  {
    intros x y h,
    have h2 : ∃ (b : R), r = (b * x) * y,
      rw is_unit_iff_exists_inv at hu,
      cases hu with c h3,
      use c, rw mul_assoc, rw h,
      ring_nf, rw mul_assoc, rw h3, rw mul_one,
    cases hirr,
    cases h2 with b hb,
    specialize hirr_right (b * x) y,
    rw eq_comm at hb,
    have h3 := hirr_right hb,
    cases h3,
    left,
      rw mul_comm at h3,
      apply r_prod_unit_r_unit x b,
      exact h3,
    right,
    exact h3,
  }
end

/--
  For some a and b, a divides b iff there is a c ∈ R such that a * c = b
-/
def divisible (a b: R) : Prop :=
  ∃ (c : R), b = a * c

notation a ` \ ` b := divisible a b

lemma assoc_sym (a b : R) : a ~ b → b ~ a:=
begin
  intro h,
  cases h with u h2,
  cases h2 with hunit h3,
  rw is_unit_iff_exists_inv at hunit,
  cases hunit with uinv huinv,
  use uinv,
  split,
    rw is_unit_iff_exists_inv,
    use u,
    rw mul_comm,
    exact huinv,
  rw h3,
  rw mul_assoc,
  rw huinv,
  rw mul_one,
end

variables (S : Type) [integral_domain S]

lemma symm_divisible_associates_int_domain (a b : S) : a \ b → b \ a → a ~ b:=
begin
  intros h1 h2,
  cases h1 with x hx,
  cases h2 with y hy,
  by_cases a ≠ 0,
  {
    rw hx at hy,
    apply_fun λ x, x + (-a) at hy,
    rw add_neg_self at hy,
    rw ←mul_one (-a) at hy,
    rw neg_mul_comm a 1 at hy,
    rw mul_assoc at hy,
    rw ←mul_add at hy,
    have hint := _inst_2.hzd,
    specialize hint a (x * y + (-1)),
    have h2 : a = 0 ∨ x * y + -1 = 0,
    exact hint (eq.symm hy),
    cases h2,
    exfalso, apply h, exact h2,
    apply_fun λ x, x + 1 at h2,
    rw zero_add at h2,
    rw add_assoc at h2,
    rw neg_add_self at h2,
    rw add_zero at h2,
    use x,
    split,
    rw is_unit_iff_exists_inv,
    use y,
    exact h2,
    exact hx,
  },
  {
    use 1,
    split,
    exact is_unit_one,
    rw not_ne_iff at h,
    rw h at hx,
    rw hx,
    rw h,
    rw zero_mul,
    rw zero_mul,
  }
end

lemma generators_associate_if_ideals_eq (a b : S) :
  principal_ideal a = principal_ideal b → a ~ b :=
begin
  intro h,
  have h1 : a ∈ principal_ideal a,
    use 1, rw mul_one,
  have h2 : b ∈ principal_ideal b,
    use 1, rw mul_one,
  rw h at h1,
  rw ←h at h2,
  apply symm_divisible_associates_int_domain,
  exact h2,
  exact h1,
end

/--
In a dividing sequence, each term is divisible by the next term.
-/
def dividing_sequence (f : ℕ → R) : Prop :=
∀ (n : ℕ),  f (n + 1) \ f n

/--
A unique factorisation domain (UFD) is an integral domain such that:
  All infinite dividing sequences 'stabilise': past some n ∈ ℕ, all terms are associate.#check
  All irreducible elements are prime.
-/
class ufd (R : Type) extends integral_domain R :=
(hseq : ∀(f : ℕ → R), dividing_sequence f → ∃ (m : ℕ), ∀(q : ℕ), m ≤ q → f q ~ f (q + 1))
(hpi : ∀ (p: R), irreducible p →∀ (a b: R), p \ (a*b) → p \ a ∨ p \ b )

/--
In an ascending ideal chain, each ideal is contained in the next one.
-/
def asc_ideal_chain (i : ℕ → myideal R) : Prop :=
  ∀ (n : ℕ), i n ⊆ i (n + 1)

lemma asc_ideal_chain_add (i : ℕ → myideal R) :
asc_ideal_chain i → ∀(n : ℕ), ∀ (m : ℕ),  i n ⊆  i (m+n) :=
begin
  intros h n m,
  induction m,
  rw zero_add, refl,
  specialize h (m_n + n),
  rw nat.succ_eq_add_one,

  change (i n).iset ⊆ (i (m_n + n)).iset at m_ih,
  change (i (m_n + n)).iset ⊆ (i (m_n + n + 1)).iset at h,
  change (i n).iset ⊆ (i (m_n + 1 + n)).iset,
  apply set.subset.trans,
  exact m_ih,
  nth_rewrite_rhs 1 add_comm,
  rw add_assoc,
  nth_rewrite_rhs 0 add_comm,
  exact h,
end

lemma asc_ideal_chain_ind (i : ℕ → myideal R) :
asc_ideal_chain i ↔ ∀(n : ℕ), ∀ (m : ℕ),  n ≤ m → i n ⊆ i m :=
begin
  split,
  {
    intros h n m h2,
    have h3 : ∃ (r: ℕ), n + r = m,
      use m - n,
      linarith,
    cases h3 with s hs,
    rw ←hs,
    rw add_comm,
    apply asc_ideal_chain_add,
    exact h,
  },
  {
    intros h n,
    specialize h n (n+1),
    apply h,
    norm_num,
  }
end

theorem pid_is_noetherian (P : Type) [pid P]
(i :ℕ →  myideal P) (hinc : asc_ideal_chain i)  :
∃(r : ℕ), ∀(s : ℕ ), r ≤ s → i s = i (s + 1)
 :=
begin
  let S := set.Union (λ (x : ℕ), myideal.iset (i x)),
  let si := myideal.mk S,
  let sii : myideal P,
  apply si,
  {
    rw set.nonempty,
    let i0 := i 0,
    have hne := myideal.not_empty i0,
    rw set.nonempty at hne,
    cases hne with x0 hx0,
    use x0,
    rw set.mem_Union,
    use 0, exact hx0,
  },
  {
    intros x r h,
    rw set.mem_Union at h ⊢,
    cases h,
    use h_w,
    apply myideal.r_mul_mem',
    exact h_h,
  },{
    intros x y h1 h2,
    rw set.mem_Union at h1 h2 ⊢,
    cases h1 with i1 hi1,
    cases h2 with i2 hi2,
    by_cases i1 ≤ i2,
    {
      have h3 := ((asc_ideal_chain_ind i).mp) hinc,
      specialize h3 i1 i2,
      have h4 := h3 h,
      use i2,
      apply myideal.add_mem',
      apply set.mem_of_subset_of_mem h4,
      exact hi1,
      exact hi2,
    },
    {
      have hbt : i2 ≤ i1,
        rw le_iff_lt_or_eq,
        left,
        push_neg at h,
        exact h,
      have h3 := ((asc_ideal_chain_ind i).mp) hinc,
      specialize h3 i2 i1,
      have h4 := h3 hbt,
      use i1,
      apply myideal.add_mem',
      exact hi1,
      apply set.mem_of_subset_of_mem h4,
      exact hi2,
    }
  },{
    intros x h,
    rw set.mem_Union at h ⊢,
    cases h with b hb,
    use b,
    apply myideal.neg_mem',
    exact hb,
  },
  have hpid := pid.hpid sii,
  cases hpid with a ha,
  have hasi : a ∈ sii,
    rw ha,
    change ∃(v:P), a = a * v,
    use 1,
    rw mul_one,
  change a ∈ sii.iset at hasi,
  rw set.mem_Union at hasi,
  cases hasi with q hq,
  use q,
  intro s,
  intro hsq,
  have hisq : (i q).iset = S,
  {
    ext,
    split,
      intro h,
      rw set.mem_Union,
      use q, exact h,
    intro h,
    change x ∈ sii.iset at h,
    rw ha at h,
    cases h,
    rw mul_comm at h_h,
    rw h_h,
    apply myideal.r_mul_mem',
    exact hq,
  },
  apply myideal.ext,
  apply set.subset.antisymm,
  specialize hinc s,
  exact hinc,
  apply @set.subset.trans _ (i (s + 1)).iset (i q).iset,
  rw hisq,
  exact set.subset_Union (λ (x : ℕ), myideal.iset (i x)) (s + 1),
  rw asc_ideal_chain_ind at hinc,
  specialize hinc q s,
  apply hinc,
  exact hsq,
end

theorem pid_irreducible_is_prime (P : Type) [pid P] (p : P) (hirr : irreducible p) :
  ∀ (a b : P), p \ (a * b) → p \ a ∨  p \ b :=
begin

  intros a b h,
  let I := sum_ideal (principal_ideal a) (principal_ideal p),
  have hpid := pid.hpid I,
  cases hpid with d hd,
  have hpi: p ∈ I,
    use 0,
    split,
    exact zero_mem_ideal,
    use p,
    split,
    use 1,
    rw mul_one,
    rw zero_add,
  rw hd at hpi,
  cases hpi with r hdr,
  cases hirr,
  specialize hirr_right d r,
  have hut := hirr_right (eq_comm.mpr hdr),
  cases hut,
  {
    right,
    have hone : (1:P) ∈ I,
      rw is_unit_iff_exists_inv at hut,
      rw hd,
      cases hut with di hdi,
      use di,
      rw hdi,
    cases hone with u h2,
    cases h2 with hu h2,
    cases h2 with v h2,
    cases h2 with hv h2,
    cases hu with s hs,
    cases hv with t ht,
    rw hs at h2,
    rw ht at h2,
    apply_fun λ x, b*x at h2,
    rw mul_one at h2,
    rw mul_add at h2,
    rw h2,
    rw ← mul_assoc,
    rw mul_comm b a,
    cases h with q hq,
    rw hq,
    use q * s + b * t,
    ring,
  },{
    have hai : a ∈ I,
      use a,
      split,
      use 1,
      rw mul_one,
      use 0,
      split,
      exact zero_mem_ideal,
      rw add_zero,
    rw hd at hai,
    cases hai with e he,
    rw is_unit_iff_exists_inv at hut,
    cases hut with ri hri,
    apply_fun λ x, x * ri at hdr,
    rw mul_assoc at hdr,
    rw hri at hdr,
    rw mul_one at hdr,
    rw ←hdr at he,
    left,
    use (ri * e),
    rw ← mul_assoc,
    exact he,
  }
end
namespace pid
@[priority 100]
instance (P : Type) [pid P]: ufd P:=
{
  hseq := begin
    intro f,
    intro h,
    let i := λ(x : ℕ), principal_ideal (f x),
    have hinc : asc_ideal_chain i,
      intro n,
      change principal_ideal (f n) ⊆ principal_ideal (f (n+1)),
      specialize h n,
      cases h with y hy,
      rw hy,
      intros x h2,
      cases h2 with z hz,
      use y * z,
      rw ← mul_assoc,
      exact hz,
    have hnoet := pid_is_noetherian P,
    specialize hnoet i,
    have hstab := hnoet hinc,
    cases hstab with m hm,
    use m,
    intro q,
    specialize hm q,
    intro hmq,
    have hiqs := hm hmq,
    apply generators_associate_if_ideals_eq,
    exact hiqs,
  end,
  hpi := pid_irreducible_is_prime P
}
end pid
#lint


import data.finset

-- Formula for the Number of Combinations

open finset

theorem t058 {α} : Π (n : ℕ) (s : finset α),
  card (powerset_len n s) = nat.choose (card s) n
:= finset.card_powerset_len


/-
Copyright (c) 2021 Filippo A. E. Nuccio. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Filippo A. E. Nuccio, Eric Wieser

! This file was ported from Lean 3 source module data.matrix.kronecker
! leanprover-community/mathlib commit 945bc74ecd6c7435f33e080af142c1cfe8d2e289
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Matrix.Basic
import Mathbin.Data.Matrix.Block
import Mathbin.LinearAlgebra.Matrix.Determinant
import Mathbin.LinearAlgebra.Matrix.NonsingularInverse
import Mathbin.LinearAlgebra.TensorProduct
import Mathbin.RingTheory.TensorProduct

/-!
# Kronecker product of matrices

This defines the [Kronecker product](https://en.wikipedia.org/wiki/Kronecker_product).

## Main definitions

* `matrix.kronecker_map`: A generalization of the Kronecker product: given a map `f : α → β → γ`
  and matrices `A` and `B` with coefficients in `α` and `β`, respectively, it is defined as the
  matrix with coefficients in `γ` such that
  `kronecker_map f A B (i₁, i₂) (j₁, j₂) = f (A i₁ j₁) (B i₁ j₂)`.
* `matrix.kronecker_map_bilinear`: when `f` is bilinear, so is `kronecker_map f`.

## Specializations

* `matrix.kronecker`: An alias of `kronecker_map (*)`. Prefer using the notation.
* `matrix.kronecker_bilinear`: `matrix.kronecker` is bilinear

* `matrix.kronecker_tmul`: An alias of `kronecker_map (⊗ₜ)`. Prefer using the notation.
* `matrix.kronecker_tmul_bilinear`: `matrix.tmul_kronecker` is bilinear

## Notations

These require `open_locale kronecker`:

* `A ⊗ₖ B` for `kronecker_map (*) A B`. Lemmas about this notation use the token `kronecker`.
* `A ⊗ₖₜ B` and `A ⊗ₖₜ[R] B` for `kronecker_map (⊗ₜ) A B`.  Lemmas about this notation use the token
  `kronecker_tmul`.

-/

namespace Matrix

open Matrix

variable {R α α' β β' γ γ' : Type _}

variable {l m n p : Type _} {q r : Type _} {l' m' n' p' : Type _}

section KroneckerMap

/- warning: matrix.kronecker_map -> Matrix.kroneckerMap is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} {l : Type.{u4}} {m : Type.{u5}} {n : Type.{u6}} {p : Type.{u7}}, (α -> β -> γ) -> (Matrix.{u4, u5, u1} l m α) -> (Matrix.{u6, u7, u2} n p β) -> (Matrix.{max u4 u6, max u5 u7, u3} (Prod.{u4, u6} l n) (Prod.{u5, u7} m p) γ)
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u4}} {γ : Type.{u5}} {l : Type.{u6}} {m : Type.{u7}} {n : Type.{u1}} {p : Type.{u2}}, (α -> β -> γ) -> (Matrix.{u6, u7, u3} l m α) -> (Matrix.{u1, u2, u4} n p β) -> (Matrix.{max u6 u1, max u7 u2, u5} (Prod.{u6, u1} l n) (Prod.{u7, u2} m p) γ)
Case conversion may be inaccurate. Consider using '#align matrix.kronecker_map Matrix.kroneckerMapₓ'. -/
/-- Produce a matrix with `f` applied to every pair of elements from `A` and `B`. -/
@[simp]
def kroneckerMap (f : α → β → γ) (A : Matrix l m α) (B : Matrix n p β) : Matrix (l × n) (m × p) γ
  | i, j => f (A i.1 j.1) (B i.2 j.2)
#align matrix.kronecker_map Matrix.kroneckerMap

theorem kroneckerMap_transpose (f : α → β → γ) (A : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f Aᵀ Bᵀ = (kroneckerMap f A B)ᵀ :=
  ext fun i j => rfl
#align matrix.kronecker_map_transpose Matrix.kroneckerMap_transpose

theorem kroneckerMap_map_left (f : α' → β → γ) (g : α → α') (A : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f (A.map g) B = kroneckerMap (fun a b => f (g a) b) A B :=
  ext fun i j => rfl
#align matrix.kronecker_map_map_left Matrix.kroneckerMap_map_left

theorem kroneckerMap_map_right (f : α → β' → γ) (g : β → β') (A : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f A (B.map g) = kroneckerMap (fun a b => f a (g b)) A B :=
  ext fun i j => rfl
#align matrix.kronecker_map_map_right Matrix.kroneckerMap_map_right

theorem kroneckerMap_map (f : α → β → γ) (g : γ → γ') (A : Matrix l m α) (B : Matrix n p β) :
    (kroneckerMap f A B).map g = kroneckerMap (fun a b => g (f a b)) A B :=
  ext fun i j => rfl
#align matrix.kronecker_map_map Matrix.kroneckerMap_map

@[simp]
theorem kroneckerMap_zero_left [Zero α] [Zero γ] (f : α → β → γ) (hf : ∀ b, f 0 b = 0)
    (B : Matrix n p β) : kroneckerMap f (0 : Matrix l m α) B = 0 :=
  ext fun i j => hf _
#align matrix.kronecker_map_zero_left Matrix.kroneckerMap_zero_left

@[simp]
theorem kroneckerMap_zero_right [Zero β] [Zero γ] (f : α → β → γ) (hf : ∀ a, f a 0 = 0)
    (A : Matrix l m α) : kroneckerMap f A (0 : Matrix n p β) = 0 :=
  ext fun i j => hf _
#align matrix.kronecker_map_zero_right Matrix.kroneckerMap_zero_right

theorem kroneckerMap_add_left [Add α] [Add γ] (f : α → β → γ)
    (hf : ∀ a₁ a₂ b, f (a₁ + a₂) b = f a₁ b + f a₂ b) (A₁ A₂ : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f (A₁ + A₂) B = kroneckerMap f A₁ B + kroneckerMap f A₂ B :=
  ext fun i j => hf _ _ _
#align matrix.kronecker_map_add_left Matrix.kroneckerMap_add_left

theorem kroneckerMap_add_right [Add β] [Add γ] (f : α → β → γ)
    (hf : ∀ a b₁ b₂, f a (b₁ + b₂) = f a b₁ + f a b₂) (A : Matrix l m α) (B₁ B₂ : Matrix n p β) :
    kroneckerMap f A (B₁ + B₂) = kroneckerMap f A B₁ + kroneckerMap f A B₂ :=
  ext fun i j => hf _ _ _
#align matrix.kronecker_map_add_right Matrix.kroneckerMap_add_right

theorem kroneckerMap_smul_left [SMul R α] [SMul R γ] (f : α → β → γ) (r : R)
    (hf : ∀ a b, f (r • a) b = r • f a b) (A : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f (r • A) B = r • kroneckerMap f A B :=
  ext fun i j => hf _ _
#align matrix.kronecker_map_smul_left Matrix.kroneckerMap_smul_left

theorem kroneckerMap_smul_right [SMul R β] [SMul R γ] (f : α → β → γ) (r : R)
    (hf : ∀ a b, f a (r • b) = r • f a b) (A : Matrix l m α) (B : Matrix n p β) :
    kroneckerMap f A (r • B) = r • kroneckerMap f A B :=
  ext fun i j => hf _ _
#align matrix.kronecker_map_smul_right Matrix.kroneckerMap_smul_right

theorem kroneckerMap_diagonal_diagonal [Zero α] [Zero β] [Zero γ] [DecidableEq m] [DecidableEq n]
    (f : α → β → γ) (hf₁ : ∀ b, f 0 b = 0) (hf₂ : ∀ a, f a 0 = 0) (a : m → α) (b : n → β) :
    kroneckerMap f (diagonal a) (diagonal b) = diagonal fun mn => f (a mn.1) (b mn.2) :=
  by
  ext (⟨i₁, i₂⟩⟨j₁, j₂⟩)
  simp [diagonal, apply_ite f, ite_and, ite_apply, apply_ite (f (a i₁)), hf₁, hf₂]
#align matrix.kronecker_map_diagonal_diagonal Matrix.kroneckerMap_diagonal_diagonal

theorem kroneckerMap_diagonal_right [Zero β] [Zero γ] [DecidableEq n] (f : α → β → γ)
    (hf : ∀ a, f a 0 = 0) (A : Matrix l m α) (b : n → β) :
    kroneckerMap f A (diagonal b) = blockDiagonal fun i => A.map fun a => f a (b i) :=
  by
  ext (⟨i₁, i₂⟩⟨j₁, j₂⟩)
  simp [diagonal, block_diagonal, apply_ite (f (A i₁ j₁)), hf]
#align matrix.kronecker_map_diagonal_right Matrix.kroneckerMap_diagonal_right

theorem kroneckerMap_diagonal_left [Zero α] [Zero γ] [DecidableEq l] (f : α → β → γ)
    (hf : ∀ b, f 0 b = 0) (a : l → α) (B : Matrix m n β) :
    kroneckerMap f (diagonal a) B =
      Matrix.reindex (Equiv.prodComm _ _) (Equiv.prodComm _ _)
        (blockDiagonal fun i => B.map fun b => f (a i) b) :=
  by
  ext (⟨i₁, i₂⟩⟨j₁, j₂⟩)
  simp [diagonal, block_diagonal, apply_ite f, ite_apply, hf]
#align matrix.kronecker_map_diagonal_left Matrix.kroneckerMap_diagonal_left

@[simp]
theorem kroneckerMap_one_one [Zero α] [Zero β] [Zero γ] [One α] [One β] [One γ] [DecidableEq m]
    [DecidableEq n] (f : α → β → γ) (hf₁ : ∀ b, f 0 b = 0) (hf₂ : ∀ a, f a 0 = 0)
    (hf₃ : f 1 1 = 1) : kroneckerMap f (1 : Matrix m m α) (1 : Matrix n n β) = 1 :=
  (kroneckerMap_diagonal_diagonal _ hf₁ hf₂ _ _).trans <| by simp only [hf₃, diagonal_one]
#align matrix.kronecker_map_one_one Matrix.kroneckerMap_one_one

theorem kroneckerMap_reindex (f : α → β → γ) (el : l ≃ l') (em : m ≃ m') (en : n ≃ n') (ep : p ≃ p')
    (M : Matrix l m α) (N : Matrix n p β) :
    kroneckerMap f (reindex el em M) (reindex en ep N) =
      reindex (el.prodCongr en) (em.prodCongr ep) (kroneckerMap f M N) :=
  by
  ext (⟨i, i'⟩⟨j, j'⟩)
  rfl
#align matrix.kronecker_map_reindex Matrix.kroneckerMap_reindex

theorem kroneckerMap_reindex_left (f : α → β → γ) (el : l ≃ l') (em : m ≃ m') (M : Matrix l m α)
    (N : Matrix n n' β) :
    kroneckerMap f (Matrix.reindex el em M) N =
      reindex (el.prodCongr (Equiv.refl _)) (em.prodCongr (Equiv.refl _)) (kroneckerMap f M N) :=
  kroneckerMap_reindex _ _ _ (Equiv.refl _) (Equiv.refl _) _ _
#align matrix.kronecker_map_reindex_left Matrix.kroneckerMap_reindex_left

theorem kroneckerMap_reindex_right (f : α → β → γ) (em : m ≃ m') (en : n ≃ n') (M : Matrix l l' α)
    (N : Matrix m n β) :
    kroneckerMap f M (reindex em en N) =
      reindex ((Equiv.refl _).prodCongr em) ((Equiv.refl _).prodCongr en) (kroneckerMap f M N) :=
  kroneckerMap_reindex _ (Equiv.refl _) (Equiv.refl _) _ _ _ _
#align matrix.kronecker_map_reindex_right Matrix.kroneckerMap_reindex_right

theorem kroneckerMap_assoc {δ ξ ω ω' : Type _} (f : α → β → γ) (g : γ → δ → ω) (f' : α → ξ → ω')
    (g' : β → δ → ξ) (A : Matrix l m α) (B : Matrix n p β) (D : Matrix q r δ) (φ : ω ≃ ω')
    (hφ : ∀ a b d, φ (g (f a b) d) = f' a (g' b d)) :
    (reindex (Equiv.prodAssoc l n q) (Equiv.prodAssoc m p r)).trans (Equiv.mapMatrix φ)
        (kroneckerMap g (kroneckerMap f A B) D) =
      kroneckerMap f' A (kroneckerMap g' B D) :=
  ext fun i j => hφ _ _ _
#align matrix.kronecker_map_assoc Matrix.kroneckerMap_assoc

theorem kroneckerMap_assoc₁ {δ ξ ω : Type _} (f : α → β → γ) (g : γ → δ → ω) (f' : α → ξ → ω)
    (g' : β → δ → ξ) (A : Matrix l m α) (B : Matrix n p β) (D : Matrix q r δ)
    (h : ∀ a b d, g (f a b) d = f' a (g' b d)) :
    reindex (Equiv.prodAssoc l n q) (Equiv.prodAssoc m p r)
        (kroneckerMap g (kroneckerMap f A B) D) =
      kroneckerMap f' A (kroneckerMap g' B D) :=
  ext fun i j => h _ _ _
#align matrix.kronecker_map_assoc₁ Matrix.kroneckerMap_assoc₁

/-- When `f` is bilinear then `matrix.kronecker_map f` is also bilinear. -/
@[simps]
def kroneckerMapBilinear [CommSemiring R] [AddCommMonoid α] [AddCommMonoid β] [AddCommMonoid γ]
    [Module R α] [Module R β] [Module R γ] (f : α →ₗ[R] β →ₗ[R] γ) :
    Matrix l m α →ₗ[R] Matrix n p β →ₗ[R] Matrix (l × n) (m × p) γ :=
  LinearMap.mk₂ R (kroneckerMap fun r s => f r s) (kroneckerMap_add_left _ <| f.map_add₂)
    (fun r => kroneckerMap_smul_left _ _ <| f.map_smul₂ _)
    (kroneckerMap_add_right _ fun a => (f a).map_add) fun r =>
    kroneckerMap_smul_right _ _ fun a => (f a).map_smul r
#align matrix.kronecker_map_bilinear Matrix.kroneckerMapBilinear

/-- `matrix.kronecker_map_bilinear` commutes with `⬝` if `f` commutes with `*`.

This is primarily used with `R = ℕ` to prove `matrix.mul_kronecker_mul`. -/
theorem kroneckerMapBilinear_mul_mul [CommSemiring R] [Fintype m] [Fintype m']
    [NonUnitalNonAssocSemiring α] [NonUnitalNonAssocSemiring β] [NonUnitalNonAssocSemiring γ]
    [Module R α] [Module R β] [Module R γ] (f : α →ₗ[R] β →ₗ[R] γ)
    (h_comm : ∀ a b a' b', f (a * b) (a' * b') = f a a' * f b b') (A : Matrix l m α)
    (B : Matrix m n α) (A' : Matrix l' m' β) (B' : Matrix m' n' β) :
    kroneckerMapBilinear f (A ⬝ B) (A' ⬝ B') =
      kroneckerMapBilinear f A A' ⬝ kroneckerMapBilinear f B B' :=
  by
  ext (⟨i, i'⟩⟨j, j'⟩)
  simp only [kronecker_map_bilinear_apply_apply, mul_apply, ← Finset.univ_product_univ,
    Finset.sum_product, kronecker_map]
  simp_rw [f.map_sum, LinearMap.sum_apply, LinearMap.map_sum, h_comm]
#align matrix.kronecker_map_bilinear_mul_mul Matrix.kroneckerMapBilinear_mul_mul

/-- `trace` distributes over `matrix.kronecker_map_bilinear`.

This is primarily used with `R = ℕ` to prove `matrix.trace_kronecker`. -/
theorem trace_kroneckerMapBilinear [CommSemiring R] [Fintype m] [Fintype n] [AddCommMonoid α]
    [AddCommMonoid β] [AddCommMonoid γ] [Module R α] [Module R β] [Module R γ]
    (f : α →ₗ[R] β →ₗ[R] γ) (A : Matrix m m α) (B : Matrix n n β) :
    trace (kroneckerMapBilinear f A B) = f (trace A) (trace B) := by
  simp_rw [Matrix.trace, Matrix.diag, kronecker_map_bilinear_apply_apply, LinearMap.map_sum₂,
    map_sum, ← Finset.univ_product_univ, Finset.sum_product, kronecker_map]
#align matrix.trace_kronecker_map_bilinear Matrix.trace_kroneckerMapBilinear

/-- `determinant` of `matrix.kronecker_map_bilinear`.

This is primarily used with `R = ℕ` to prove `matrix.det_kronecker`. -/
theorem det_kroneckerMapBilinear [CommSemiring R] [Fintype m] [Fintype n] [DecidableEq m]
    [DecidableEq n] [CommRing α] [CommRing β] [CommRing γ] [Module R α] [Module R β] [Module R γ]
    (f : α →ₗ[R] β →ₗ[R] γ) (h_comm : ∀ a b a' b', f (a * b) (a' * b') = f a a' * f b b')
    (A : Matrix m m α) (B : Matrix n n β) :
    det (kroneckerMapBilinear f A B) =
      det (A.map fun a => f a 1) ^ Fintype.card n * det (B.map fun b => f 1 b) ^ Fintype.card m :=
  calc
    det (kroneckerMapBilinear f A B) =
        det (kroneckerMapBilinear f A 1 ⬝ kroneckerMapBilinear f 1 B) :=
      by rw [← kronecker_map_bilinear_mul_mul f h_comm, Matrix.mul_one, Matrix.one_mul]
    _ =
        det (blockDiagonal fun _ => A.map fun a => f a 1) *
          det (blockDiagonal fun _ => B.map fun b => f 1 b) :=
      by
      rw [det_mul, ← diagonal_one, ← diagonal_one, kronecker_map_bilinear_apply_apply,
        kronecker_map_diagonal_right _ fun _ => _, kronecker_map_bilinear_apply_apply,
        kronecker_map_diagonal_left _ fun _ => _, det_reindex_self]
      · exact LinearMap.map_zero₂ _ _
      · exact map_zero _
    _ = _ := by simp_rw [det_block_diagonal, Finset.prod_const, Finset.card_univ]

#align matrix.det_kronecker_map_bilinear Matrix.det_kroneckerMapBilinear

end KroneckerMap

/-! ### Specialization to `matrix.kronecker_map (*)` -/

section Kronecker

open Matrix

/-- The Kronecker product. This is just a shorthand for `kronecker_map (*)`. Prefer the notation
`⊗ₖ` rather than this definition. -/
@[simp]
def kronecker [Mul α] : Matrix l m α → Matrix n p α → Matrix (l × n) (m × p) α :=
  kroneckerMap (· * ·)
#align matrix.kronecker Matrix.kronecker

-- mathport name: matrix.kronecker_map.mul
scoped[Kronecker] infixl:100 " ⊗ₖ " => Matrix.kroneckerMap (· * ·)

@[simp]
theorem kronecker_apply [Mul α] (A : Matrix l m α) (B : Matrix n p α) (i₁ i₂ j₁ j₂) :
    (A ⊗ₖ B) (i₁, i₂) (j₁, j₂) = A i₁ j₁ * B i₂ j₂ :=
  rfl
#align matrix.kronecker_apply Matrix.kronecker_apply

/-- `matrix.kronecker` as a bilinear map. -/
def kroneckerBilinear [CommSemiring R] [Semiring α] [Algebra R α] :
    Matrix l m α →ₗ[R] Matrix n p α →ₗ[R] Matrix (l × n) (m × p) α :=
  kroneckerMapBilinear (LinearMap.Algebra.lmul R α)
#align matrix.kronecker_bilinear Matrix.kroneckerBilinear

/-! What follows is a copy, in order, of every `matrix.kronecker_map` lemma above that has
hypotheses which can be filled by properties of `*`. -/

@[simp]
theorem zero_kronecker [MulZeroClass α] (B : Matrix n p α) : (0 : Matrix l m α) ⊗ₖ B = 0 :=
  kroneckerMap_zero_left _ MulZeroClass.zero_mul B
#align matrix.zero_kronecker Matrix.zero_kronecker

@[simp]
theorem kronecker_zero [MulZeroClass α] (A : Matrix l m α) : A ⊗ₖ (0 : Matrix n p α) = 0 :=
  kroneckerMap_zero_right _ MulZeroClass.mul_zero A
#align matrix.kronecker_zero Matrix.kronecker_zero

theorem add_kronecker [Distrib α] (A₁ A₂ : Matrix l m α) (B : Matrix n p α) :
    (A₁ + A₂) ⊗ₖ B = A₁ ⊗ₖ B + A₂ ⊗ₖ B :=
  kroneckerMap_add_left _ add_mul _ _ _
#align matrix.add_kronecker Matrix.add_kronecker

theorem kronecker_add [Distrib α] (A : Matrix l m α) (B₁ B₂ : Matrix n p α) :
    A ⊗ₖ (B₁ + B₂) = A ⊗ₖ B₁ + A ⊗ₖ B₂ :=
  kroneckerMap_add_right _ mul_add _ _ _
#align matrix.kronecker_add Matrix.kronecker_add

theorem smul_kronecker [Monoid R] [Monoid α] [MulAction R α] [IsScalarTower R α α] (r : R)
    (A : Matrix l m α) (B : Matrix n p α) : (r • A) ⊗ₖ B = r • A ⊗ₖ B :=
  kroneckerMap_smul_left _ _ (fun _ _ => smul_mul_assoc _ _ _) _ _
#align matrix.smul_kronecker Matrix.smul_kronecker

theorem kronecker_smul [Monoid R] [Monoid α] [MulAction R α] [SMulCommClass R α α] (r : R)
    (A : Matrix l m α) (B : Matrix n p α) : A ⊗ₖ (r • B) = r • A ⊗ₖ B :=
  kroneckerMap_smul_right _ _ (fun _ _ => mul_smul_comm _ _ _) _ _
#align matrix.kronecker_smul Matrix.kronecker_smul

theorem diagonal_kronecker_diagonal [MulZeroClass α] [DecidableEq m] [DecidableEq n] (a : m → α)
    (b : n → α) : diagonal a ⊗ₖ diagonal b = diagonal fun mn => a mn.1 * b mn.2 :=
  kroneckerMap_diagonal_diagonal _ MulZeroClass.zero_mul MulZeroClass.mul_zero _ _
#align matrix.diagonal_kronecker_diagonal Matrix.diagonal_kronecker_diagonal

theorem kronecker_diagonal [MulZeroClass α] [DecidableEq n] (A : Matrix l m α) (b : n → α) :
    A ⊗ₖ diagonal b = blockDiagonal fun i => MulOpposite.op (b i) • A :=
  kroneckerMap_diagonal_right _ MulZeroClass.mul_zero _ _
#align matrix.kronecker_diagonal Matrix.kronecker_diagonal

theorem diagonal_kronecker [MulZeroClass α] [DecidableEq l] (a : l → α) (B : Matrix m n α) :
    diagonal a ⊗ₖ B =
      Matrix.reindex (Equiv.prodComm _ _) (Equiv.prodComm _ _) (blockDiagonal fun i => a i • B) :=
  kroneckerMap_diagonal_left _ MulZeroClass.zero_mul _ _
#align matrix.diagonal_kronecker Matrix.diagonal_kronecker

@[simp]
theorem one_kronecker_one [MulZeroOneClass α] [DecidableEq m] [DecidableEq n] :
    (1 : Matrix m m α) ⊗ₖ (1 : Matrix n n α) = 1 :=
  kroneckerMap_one_one _ MulZeroClass.zero_mul MulZeroClass.mul_zero (one_mul _)
#align matrix.one_kronecker_one Matrix.one_kronecker_one

theorem kronecker_one [MulZeroOneClass α] [DecidableEq n] (A : Matrix l m α) :
    A ⊗ₖ (1 : Matrix n n α) = blockDiagonal fun i => A :=
  (kronecker_diagonal _ _).trans <| congr_arg _ <| funext fun _ => Matrix.ext fun _ _ => mul_one _
#align matrix.kronecker_one Matrix.kronecker_one

theorem one_kronecker [MulZeroOneClass α] [DecidableEq l] (B : Matrix m n α) :
    (1 : Matrix l l α) ⊗ₖ B =
      Matrix.reindex (Equiv.prodComm _ _) (Equiv.prodComm _ _) (blockDiagonal fun i => B) :=
  (diagonal_kronecker _ _).trans <|
    congr_arg _ <| congr_arg _ <| funext fun _ => Matrix.ext fun _ _ => one_mul _
#align matrix.one_kronecker Matrix.one_kronecker

theorem mul_kronecker_mul [Fintype m] [Fintype m'] [CommSemiring α] (A : Matrix l m α)
    (B : Matrix m n α) (A' : Matrix l' m' α) (B' : Matrix m' n' α) :
    (A ⬝ B) ⊗ₖ (A' ⬝ B') = A ⊗ₖ A' ⬝ B ⊗ₖ B' :=
  kroneckerMapBilinear_mul_mul (LinearMap.Algebra.lmul ℕ α).toLinearMap mul_mul_mul_comm A B A' B'
#align matrix.mul_kronecker_mul Matrix.mul_kronecker_mul

@[simp]
theorem kronecker_assoc [Semigroup α] (A : Matrix l m α) (B : Matrix n p α) (C : Matrix q r α) :
    reindex (Equiv.prodAssoc l n q) (Equiv.prodAssoc m p r) (A ⊗ₖ B ⊗ₖ C) = A ⊗ₖ (B ⊗ₖ C) :=
  kroneckerMap_assoc₁ _ _ _ _ A B C mul_assoc
#align matrix.kronecker_assoc Matrix.kronecker_assoc

theorem trace_kronecker [Fintype m] [Fintype n] [Semiring α] (A : Matrix m m α) (B : Matrix n n α) :
    trace (A ⊗ₖ B) = trace A * trace B :=
  trace_kroneckerMapBilinear (LinearMap.Algebra.lmul ℕ α).toLinearMap _ _
#align matrix.trace_kronecker Matrix.trace_kronecker

theorem det_kronecker [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] [CommRing R]
    (A : Matrix m m R) (B : Matrix n n R) :
    det (A ⊗ₖ B) = det A ^ Fintype.card n * det B ^ Fintype.card m :=
  by
  refine'
    (det_kronecker_map_bilinear (LinearMap.Algebra.lmul ℕ R).toLinearMap mul_mul_mul_comm _ _).trans
      _
  congr 3
  · ext (i j)
    exact mul_one _
  · ext (i j)
    exact one_mul _
#align matrix.det_kronecker Matrix.det_kronecker

theorem inv_kronecker [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n] [CommRing R]
    (A : Matrix m m R) (B : Matrix n n R) : (A ⊗ₖ B)⁻¹ = A⁻¹ ⊗ₖ B⁻¹ :=
  by
  -- handle the special cases where either matrix is not invertible
  by_cases hA : IsUnit A.det;
  swap
  · cases isEmpty_or_nonempty n
    · exact Subsingleton.elim _ _
    have hAB : ¬IsUnit (A ⊗ₖ B).det :=
      by
      refine' mt (fun hAB => _) hA
      rw [det_kronecker] at hAB
      exact (isUnit_pow_iff Fintype.card_ne_zero).mp (isUnit_of_mul_isUnit_left hAB)
    rw [nonsing_inv_apply_not_is_unit _ hA, zero_kronecker, nonsing_inv_apply_not_is_unit _ hAB]
  by_cases hB : IsUnit B.det; swap
  · cases isEmpty_or_nonempty m
    · exact Subsingleton.elim _ _
    have hAB : ¬IsUnit (A ⊗ₖ B).det :=
      by
      refine' mt (fun hAB => _) hB
      rw [det_kronecker] at hAB
      exact (isUnit_pow_iff Fintype.card_ne_zero).mp (isUnit_of_mul_isUnit_right hAB)
    rw [nonsing_inv_apply_not_is_unit _ hB, kronecker_zero, nonsing_inv_apply_not_is_unit _ hAB]
  -- otherwise follows trivially from `mul_kronecker_mul`
  · apply inv_eq_right_inv
    rw [← mul_kronecker_mul, ← one_kronecker_one, mul_nonsing_inv _ hA, mul_nonsing_inv _ hB]
#align matrix.inv_kronecker Matrix.inv_kronecker

end Kronecker

/-! ### Specialization to `matrix.kronecker_map (⊗ₜ)` -/

section KroneckerTmul

variable (R)

open TensorProduct

open Matrix TensorProduct

section Module

variable [CommSemiring R] [AddCommMonoid α] [AddCommMonoid β] [AddCommMonoid γ]

variable [Module R α] [Module R β] [Module R γ]

/-- The Kronecker tensor product. This is just a shorthand for `kronecker_map (⊗ₜ)`.
Prefer the notation `⊗ₖₜ` rather than this definition. -/
@[simp]
def kroneckerTmul : Matrix l m α → Matrix n p β → Matrix (l × n) (m × p) (α ⊗[R] β) :=
  kroneckerMap (· ⊗ₜ ·)
#align matrix.kronecker_tmul Matrix.kroneckerTmul

-- mathport name: matrix.kronecker_map.tmul
scoped[Kronecker] infixl:100 " ⊗ₖₜ " => Matrix.kroneckerMap (· ⊗ₜ ·)

-- mathport name: matrix.kronecker_map.tmul'
scoped[Kronecker]
  notation:100 x " ⊗ₖₜ[" R "] " y:100 => Matrix.kroneckerMap (TensorProduct.tmul R) x y

@[simp]
theorem kronecker_tmul_apply (A : Matrix l m α) (B : Matrix n p β) (i₁ i₂ j₁ j₂) :
    (A ⊗ₖₜ B) (i₁, i₂) (j₁, j₂) = A i₁ j₁ ⊗ₜ[R] B i₂ j₂ :=
  rfl
#align matrix.kronecker_tmul_apply Matrix.kronecker_tmul_apply

/-- `matrix.kronecker` as a bilinear map. -/
def kroneckerTmulBilinear :
    Matrix l m α →ₗ[R] Matrix n p β →ₗ[R] Matrix (l × n) (m × p) (α ⊗[R] β) :=
  kroneckerMapBilinear (TensorProduct.mk R α β)
#align matrix.kronecker_tmul_bilinear Matrix.kroneckerTmulBilinear

/-! What follows is a copy, in order, of every `matrix.kronecker_map` lemma above that has
hypotheses which can be filled by properties of `⊗ₜ`. -/

@[simp]
theorem zero_kronecker_tmul (B : Matrix n p β) : (0 : Matrix l m α) ⊗ₖₜ[R] B = 0 :=
  kroneckerMap_zero_left _ (zero_tmul α) B
#align matrix.zero_kronecker_tmul Matrix.zero_kronecker_tmul

@[simp]
theorem kronecker_tmul_zero (A : Matrix l m α) : A ⊗ₖₜ[R] (0 : Matrix n p β) = 0 :=
  kroneckerMap_zero_right _ (tmul_zero β) A
#align matrix.kronecker_tmul_zero Matrix.kronecker_tmul_zero

theorem add_kronecker_tmul (A₁ A₂ : Matrix l m α) (B : Matrix n p α) :
    (A₁ + A₂) ⊗ₖₜ[R] B = A₁ ⊗ₖₜ B + A₂ ⊗ₖₜ B :=
  kroneckerMap_add_left _ add_tmul _ _ _
#align matrix.add_kronecker_tmul Matrix.add_kronecker_tmul

theorem kronecker_tmul_add (A : Matrix l m α) (B₁ B₂ : Matrix n p α) :
    A ⊗ₖₜ[R] (B₁ + B₂) = A ⊗ₖₜ B₁ + A ⊗ₖₜ B₂ :=
  kroneckerMap_add_right _ tmul_add _ _ _
#align matrix.kronecker_tmul_add Matrix.kronecker_tmul_add

theorem smul_kronecker_tmul (r : R) (A : Matrix l m α) (B : Matrix n p α) :
    (r • A) ⊗ₖₜ[R] B = r • A ⊗ₖₜ B :=
  kroneckerMap_smul_left _ _ (fun _ _ => smul_tmul' _ _ _) _ _
#align matrix.smul_kronecker_tmul Matrix.smul_kronecker_tmul

theorem kronecker_tmul_smul (r : R) (A : Matrix l m α) (B : Matrix n p α) :
    A ⊗ₖₜ[R] (r • B) = r • A ⊗ₖₜ B :=
  kroneckerMap_smul_right _ _ (fun _ _ => tmul_smul _ _ _) _ _
#align matrix.kronecker_tmul_smul Matrix.kronecker_tmul_smul

theorem diagonal_kronecker_tmul_diagonal [DecidableEq m] [DecidableEq n] (a : m → α) (b : n → α) :
    diagonal a ⊗ₖₜ[R] diagonal b = diagonal fun mn => a mn.1 ⊗ₜ b mn.2 :=
  kroneckerMap_diagonal_diagonal _ (zero_tmul _) (tmul_zero _) _ _
#align matrix.diagonal_kronecker_tmul_diagonal Matrix.diagonal_kronecker_tmul_diagonal

theorem kronecker_tmul_diagonal [DecidableEq n] (A : Matrix l m α) (b : n → α) :
    A ⊗ₖₜ[R] diagonal b = blockDiagonal fun i => A.map fun a => a ⊗ₜ[R] b i :=
  kroneckerMap_diagonal_right _ (tmul_zero _) _ _
#align matrix.kronecker_tmul_diagonal Matrix.kronecker_tmul_diagonal

theorem diagonal_kronecker_tmul [DecidableEq l] (a : l → α) (B : Matrix m n α) :
    diagonal a ⊗ₖₜ[R] B =
      Matrix.reindex (Equiv.prodComm _ _) (Equiv.prodComm _ _)
        (blockDiagonal fun i => B.map fun b => a i ⊗ₜ[R] b) :=
  kroneckerMap_diagonal_left _ (zero_tmul _) _ _
#align matrix.diagonal_kronecker_tmul Matrix.diagonal_kronecker_tmul

@[simp]
theorem kronecker_tmul_assoc (A : Matrix l m α) (B : Matrix n p β) (C : Matrix q r γ) :
    reindex (Equiv.prodAssoc l n q) (Equiv.prodAssoc m p r)
        (((A ⊗ₖₜ[R] B) ⊗ₖₜ[R] C).map (TensorProduct.assoc _ _ _ _)) =
      A ⊗ₖₜ[R] B ⊗ₖₜ[R] C :=
  ext fun i j => assoc_tmul _ _ _
#align matrix.kronecker_tmul_assoc Matrix.kronecker_tmul_assoc

theorem trace_kronecker_tmul [Fintype m] [Fintype n] (A : Matrix m m α) (B : Matrix n n β) :
    trace (A ⊗ₖₜ[R] B) = trace A ⊗ₜ[R] trace B :=
  trace_kroneckerMapBilinear (TensorProduct.mk R α β) _ _
#align matrix.trace_kronecker_tmul Matrix.trace_kronecker_tmul

end Module

section Algebra

open Kronecker

open Algebra.TensorProduct

section Semiring

variable [CommSemiring R] [Semiring α] [Semiring β] [Algebra R α] [Algebra R β]

@[simp]
theorem one_kronecker_tmul_one [DecidableEq m] [DecidableEq n] :
    (1 : Matrix m m α) ⊗ₖₜ[R] (1 : Matrix n n α) = 1 :=
  kroneckerMap_one_one _ (zero_tmul _) (tmul_zero _) rfl
#align matrix.one_kronecker_tmul_one Matrix.one_kronecker_tmul_one

theorem mul_kronecker_tmul_mul [Fintype m] [Fintype m'] (A : Matrix l m α) (B : Matrix m n α)
    (A' : Matrix l' m' β) (B' : Matrix m' n' β) : (A ⬝ B) ⊗ₖₜ[R] (A' ⬝ B') = A ⊗ₖₜ A' ⬝ B ⊗ₖₜ B' :=
  kroneckerMapBilinear_mul_mul (TensorProduct.mk R α β) tmul_mul_tmul A B A' B'
#align matrix.mul_kronecker_tmul_mul Matrix.mul_kronecker_tmul_mul

end Semiring

section CommRing

variable [CommRing R] [CommRing α] [CommRing β] [Algebra R α] [Algebra R β]

theorem det_kronecker_tmul [Fintype m] [Fintype n] [DecidableEq m] [DecidableEq n]
    (A : Matrix m m α) (B : Matrix n n β) :
    det (A ⊗ₖₜ[R] B) = (det A ^ Fintype.card n) ⊗ₜ[R] (det B ^ Fintype.card m) :=
  by
  refine' (det_kronecker_map_bilinear (TensorProduct.mk R α β) tmul_mul_tmul _ _).trans _
  simp (config := { eta := false }) only [mk_apply, ← include_left_apply, ← include_right_apply]
  simp only [← AlgHom.mapMatrix_apply, ← AlgHom.map_det]
  simp only [include_left_apply, include_right_apply, tmul_pow, tmul_mul_tmul, one_pow,
    _root_.mul_one, _root_.one_mul]
#align matrix.det_kronecker_tmul Matrix.det_kronecker_tmul

end CommRing

end Algebra

-- insert lemmas specific to `kronecker_tmul` below this line
end KroneckerTmul

end Matrix


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

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

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

In this file, we start with a small filtered category `J` and a functor `F : J ⥤ Group`.
We show that the colimit of `F ⋙ forget₂ Group Mon` (in `Mon`) carries the structure of a group,
thereby showing that the forgetful functor `forget₂ Group Mon` preserves filtered colimits. In
particular, this implies that `forget Group` preserves filtered colimits. Similarly for `AddGroup`,
`CommGroup` and `AddCommGroup`.

-/

universes v u

noncomputable theory
open_locale classical

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

namespace Group.filtered_colimits

section

open Mon.filtered_colimits (colimit_one_eq colimit_mul_mk_eq)

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

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

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

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

/-- The "unlifted" version of taking inverses in the colimit. -/
@[to_additive "The \"unlifted\" version of negation in the colimit."]
def colimit_inv_aux (x : Σ j, F.obj j) : G :=
G.mk ⟨x.1, x.2 ⁻¹⟩

@[to_additive]
lemma colimit_inv_aux_eq_of_rel (x y : Σ j, F.obj j)
  (h : types.filtered_colimit.rel (F ⋙ forget Group) x y) :
  colimit_inv_aux x = colimit_inv_aux y :=
begin
  apply G.mk_eq,
  obtain ⟨k, f, g, hfg⟩ := h,
  use [k, f, g],
  rw [monoid_hom.map_inv, monoid_hom.map_inv, inv_inj],
  exact hfg,
end

/-- Taking inverses in the colimit. See also `colimit_inv_aux`. -/
@[to_additive "Negation in the colimit. See also `colimit_neg_aux`."]
instance colimit_has_inv : has_inv G :=
{ inv := λ x, begin
   refine quot.lift (colimit_inv_aux F) _ x,
  intros x y h,
  apply colimit_inv_aux_eq_of_rel,
  apply types.filtered_colimit.rel_of_quot_rel,
  exact h,
end }

@[simp, to_additive]
lemma colimit_inv_mk_eq (x : Σ j, F.obj j) : (G.mk x) ⁻¹ = G.mk ⟨x.1, x.2 ⁻¹⟩ := rfl

@[to_additive]
instance colimit_group : group G :=
{ mul_left_inv := λ x, begin
    apply quot.induction_on x, clear x, intro x,
    cases x with j x,
    erw [colimit_inv_mk_eq,
      colimit_mul_mk_eq (F ⋙ forget₂ Group Mon.{max v u}) ⟨j, _⟩ ⟨j, _⟩ j (𝟙 j) (𝟙 j),
      colimit_one_eq (F ⋙ forget₂ Group Mon.{max v u}) j],
    dsimp,
    simp only [category_theory.functor.map_id, id_apply, mul_left_inv],
  end,
  .. G.monoid,
  .. colimit_has_inv }

/-- The bundled group giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive group giving the filtered colimit of a diagram."]
def colimit : Group := Group.of G

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

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

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

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

end

end Group.filtered_colimits

namespace CommGroup.filtered_colimits

section

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

/--
The colimit of `F ⋙ forget₂ CommGroup Group` in the category `Group`.
In the following, we will show that this has the structure of a _commutative_ group.
-/
@[to_additive "The colimit of `F ⋙ forget₂ AddCommGroup AddGroup` in the category `AddGroup`.
In the following, we will show that this has the structure of a _commutative_ additive group."]
abbreviation G : Group := Group.filtered_colimits.colimit (F ⋙ forget₂ CommGroup Group.{max v u})

@[to_additive]
instance colimit_comm_group : comm_group G :=
{ ..G.group,
  ..CommMon.filtered_colimits.colimit_comm_monoid (F ⋙ forget₂ CommGroup CommMon.{max v u}) }

/-- The bundled commutative group giving the filtered colimit of a diagram. -/
@[to_additive "The bundled additive commutative group giving the filtered colimit of a diagram."]
def colimit : CommGroup := CommGroup.of G

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

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

@[to_additive forget₂_AddGroup_preserves_filtered_colimits]
instance forget₂_Group_preserves_filtered_colimits :
  preserves_filtered_colimits (forget₂ CommGroup Group.{u}) :=
{ preserves_filtered_colimits := λ J _ _, by exactI
  { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone
      (colimit_cocone_is_colimit.{u u} F)
      (Group.filtered_colimits.colimit_cocone_is_colimit
        (F ⋙ forget₂ CommGroup Group.{u})) } }

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

end

end CommGroup.filtered_colimits


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Anne Baanen

A typeclass for the two-sided multiplicative inverse.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.char_zero
import Mathlib.algebra.char_p.basic
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

/-!
# Invertible elements

This file defines a typeclass `invertible a` for elements `a` with a
multiplicative inverse.

The intent of the typeclass is to provide a way to write e.g. `⅟2` in a ring
like `ℤ[1/2]` where some inverses exist but there is no general `⁻¹` operator;
or to specify that a field has characteristic `≠ 2`.
It is the `Type`-valued analogue to the `Prop`-valued `is_unit`.

This file also includes some instances of `invertible` for specific numbers in
characteristic zero. Some more cases are given as a `def`, to be included only
when needed. To construct instances for concrete numbers,
`invertible_of_nonzero` is a useful definition.

## Notation

 * `⅟a` is `invertible.inv_of a`, the inverse of `a`

## Implementation notes

The `invertible` class lives in `Type`, not `Prop`, to make computation easier.
If multiplication is associative, `invertible` is a subsingleton anyway.

The `simp` normal form tries to normalize `⅟a` to `a ⁻¹`. Otherwise, it pushes
`⅟` inside the expression as much as possible.

## Tags

invertible, inverse element, inv_of, a half, one half, a third, one third, ½, ⅓

-/

/-- `invertible a` gives a two-sided multiplicative inverse of `a`. -/
class invertible {α : Type u} [Mul α] [HasOne α] (a : α) where
  inv_of : α
  inv_of_mul_self : inv_of * a = 1
  mul_inv_of_self : a * inv_of = 1

notation:1024 "⅟" => Mathlib.invertible.inv_of

-- This notation has the same precedence as `has_inv.inv`.

@[simp] theorem inv_of_mul_self {α : Type u} [Mul α] [HasOne α] (a : α) [invertible a] :
    ⅟ * a = 1 :=
  invertible.inv_of_mul_self

@[simp] theorem mul_inv_of_self {α : Type u} [Mul α] [HasOne α] (a : α) [invertible a] :
    a * ⅟ = 1 :=
  invertible.mul_inv_of_self

@[simp] theorem inv_of_mul_self_assoc {α : Type u} [monoid α] (a : α) (b : α) [invertible a] :
    ⅟ * (a * b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (⅟ * (a * b) = b)) (Eq.symm (mul_assoc ⅟ a b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⅟ * a * b = b)) (inv_of_mul_self a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * b = b)) (one_mul b))) (Eq.refl b)))

@[simp] theorem mul_inv_of_self_assoc {α : Type u} [monoid α] (a : α) (b : α) [invertible a] :
    a * (⅟ * b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (⅟ * b) = b)) (Eq.symm (mul_assoc a ⅟ b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * ⅟ * b = b)) (mul_inv_of_self a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * b = b)) (one_mul b))) (Eq.refl b)))

@[simp] theorem mul_inv_of_mul_self_cancel {α : Type u} [monoid α] (a : α) (b : α) [invertible b] :
    a * ⅟ * b = a :=
  sorry

@[simp] theorem mul_mul_inv_of_self_cancel {α : Type u} [monoid α] (a : α) (b : α) [invertible b] :
    a * b * ⅟ = a :=
  sorry

theorem inv_of_eq_right_inv {α : Type u} [monoid α] {a : α} {b : α} [invertible a]
    (hac : a * b = 1) : ⅟ = b :=
  left_inv_eq_right_inv (inv_of_mul_self a) hac

theorem invertible_unique {α : Type u} [monoid α] (a : α) (b : α) (h : a = b) [invertible a]
    [invertible b] : ⅟ = ⅟ :=
  inv_of_eq_right_inv
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * ⅟ = 1)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (b * ⅟ = 1)) (mul_inv_of_self b))) (Eq.refl 1)))

protected instance invertible.subsingleton {α : Type u} [monoid α] (a : α) :
    subsingleton (invertible a) :=
  subsingleton.intro fun (_x : invertible a) => sorry

/-- An `invertible` element is a unit. -/
def unit_of_invertible {α : Type u} [monoid α] (a : α) [invertible a] : units α :=
  units.mk a ⅟ sorry sorry

@[simp] theorem unit_of_invertible_val {α : Type u} [monoid α] (a : α) [invertible a] :
    ↑(unit_of_invertible a) = a :=
  rfl

@[simp] theorem unit_of_invertible_inv {α : Type u} [monoid α] (a : α) [invertible a] :
    ↑(unit_of_invertible a⁻¹) = ⅟ :=
  rfl

theorem is_unit_of_invertible {α : Type u} [monoid α] (a : α) [invertible a] : is_unit a :=
  Exists.intro (unit_of_invertible a) rfl

/-- Each element of a group is invertible. -/
def invertible_of_group {α : Type u} [group α] (a : α) : invertible a :=
  invertible.mk (a⁻¹) (inv_mul_self a) (mul_inv_self a)

@[simp] theorem inv_of_eq_group_inv {α : Type u} [group α] (a : α) [invertible a] : ⅟ = (a⁻¹) :=
  inv_of_eq_right_inv (mul_inv_self a)

/-- `1` is the inverse of itself -/
def invertible_one {α : Type u} [monoid α] : invertible 1 := invertible.mk 1 sorry sorry

@[simp] theorem inv_of_one {α : Type u} [monoid α] [invertible 1] : ⅟ = 1 :=
  inv_of_eq_right_inv (mul_one 1)

/-- `-⅟a` is the inverse of `-a` -/
def invertible_neg {α : Type u} [ring α] (a : α) [invertible a] : invertible (-a) :=
  invertible.mk (-⅟) sorry sorry

@[simp] theorem inv_of_neg {α : Type u} [ring α] (a : α) [invertible a] [invertible (-a)] :
    ⅟ = -⅟ :=
  sorry

@[simp] theorem one_sub_inv_of_two {α : Type u} [ring α] [invertible (bit0 1)] : 1 - ⅟ = ⅟ := sorry

/-- `a` is the inverse of `⅟a`. -/
protected instance invertible_inv_of {α : Type u} [HasOne α] [Mul α] {a : α} [invertible a] :
    invertible ⅟ :=
  invertible.mk a (mul_inv_of_self a) (inv_of_mul_self a)

@[simp] theorem inv_of_inv_of {α : Type u} [monoid α] {a : α} [invertible a] [invertible ⅟] :
    ⅟ = a :=
  inv_of_eq_right_inv (inv_of_mul_self a)

/-- `⅟b * ⅟a` is the inverse of `a * b` -/
def invertible_mul {α : Type u} [monoid α] (a : α) (b : α) [invertible a] [invertible b] :
    invertible (a * b) :=
  invertible.mk (⅟ * ⅟) sorry sorry

@[simp] theorem inv_of_mul {α : Type u} [monoid α] (a : α) (b : α) [invertible a] [invertible b]
    [invertible (a * b)] : ⅟ = ⅟ * ⅟ :=
  sorry

/--
If `r` is invertible and `s = r`, then `s` is invertible.
-/
def invertible.copy {α : Type u} [monoid α] {r : α} (hr : invertible r) (s : α) (hs : s = r) :
    invertible s :=
  invertible.mk ⅟ sorry sorry

theorem commute_inv_of {M : Type u_1} [HasOne M] [Mul M] (m : M) [invertible m] : commute m ⅟ :=
  Eq.trans (mul_inv_of_self m) (Eq.symm (inv_of_mul_self m))

protected instance invertible_pow {M : Type u_1} [monoid M] (m : M) [invertible m] (n : ℕ) :
    invertible (m ^ n) :=
  invertible.mk (⅟ ^ n) sorry sorry

theorem nonzero_of_invertible {α : Type u} [group_with_zero α] (a : α) [invertible a] : a ≠ 0 :=
  sorry

/-- `a⁻¹` is an inverse of `a` if `a ≠ 0` -/
def invertible_of_nonzero {α : Type u} [group_with_zero α] {a : α} (h : a ≠ 0) : invertible a :=
  invertible.mk (a⁻¹) (inv_mul_cancel h) (mul_inv_cancel h)

@[simp] theorem inv_of_eq_inv {α : Type u} [group_with_zero α] (a : α) [invertible a] : ⅟ = (a⁻¹) :=
  inv_of_eq_right_inv (mul_inv_cancel (nonzero_of_invertible a))

@[simp] theorem inv_mul_cancel_of_invertible {α : Type u} [group_with_zero α] (a : α)
    [invertible a] : a⁻¹ * a = 1 :=
  inv_mul_cancel (nonzero_of_invertible a)

@[simp] theorem mul_inv_cancel_of_invertible {α : Type u} [group_with_zero α] (a : α)
    [invertible a] : a * (a⁻¹) = 1 :=
  mul_inv_cancel (nonzero_of_invertible a)

@[simp] theorem div_mul_cancel_of_invertible {α : Type u} [group_with_zero α] (a : α) (b : α)
    [invertible b] : a / b * b = a :=
  div_mul_cancel a (nonzero_of_invertible b)

@[simp] theorem mul_div_cancel_of_invertible {α : Type u} [group_with_zero α] (a : α) (b : α)
    [invertible b] : a * b / b = a :=
  mul_div_cancel a (nonzero_of_invertible b)

@[simp] theorem div_self_of_invertible {α : Type u} [group_with_zero α] (a : α) [invertible a] :
    a / a = 1 :=
  div_self (nonzero_of_invertible a)

/-- `b / a` is the inverse of `a / b` -/
def invertible_div {α : Type u} [group_with_zero α] (a : α) (b : α) [invertible a] [invertible b] :
    invertible (a / b) :=
  invertible.mk (b / a) sorry sorry

@[simp] theorem inv_of_div {α : Type u} [group_with_zero α] (a : α) (b : α) [invertible a]
    [invertible b] [invertible (a / b)] : ⅟ = b / a :=
  sorry

/-- `a` is the inverse of `a⁻¹` -/
def invertible_inv {α : Type u} [group_with_zero α] {a : α} [invertible a] : invertible (a⁻¹) :=
  invertible.mk a sorry sorry

/--
Monoid homs preserve invertibility.
-/
def invertible.map {R : Type u_1} {S : Type u_2} [monoid R] [monoid S] (f : R →* S) (r : R)
    [invertible r] : invertible (coe_fn f r) :=
  invertible.mk (coe_fn f ⅟) sorry sorry

/-- A natural number `t` is invertible in a field `K` if the charactistic of `K` does not divide
`t`. -/
def invertible_of_ring_char_not_dvd {K : Type u_1} [field K] {t : ℕ} (not_dvd : ¬ring_char K ∣ t) :
    invertible ↑t :=
  invertible_of_nonzero sorry

/-- A natural number `t` is invertible in a field `K` of charactistic `p` if `p` does not divide
`t`. -/
def invertible_of_char_p_not_dvd {K : Type u_1} [field K] {p : ℕ} [char_p K p] {t : ℕ}
    (not_dvd : ¬p ∣ t) : invertible ↑t :=
  invertible_of_nonzero sorry

protected instance invertible_of_pos {K : Type u_1} [field K] [char_zero K] (n : ℕ)
    [h : fact (0 < n)] : invertible ↑n :=
  invertible_of_nonzero sorry

protected instance invertible_succ {α : Type u} [division_ring α] [char_zero α] (n : ℕ) :
    invertible ↑(Nat.succ n) :=
  invertible_of_nonzero sorry

/-!
A few `invertible n` instances for small numerals `n`. Feel free to add your own
number when you need its inverse.
-/

protected instance invertible_two {α : Type u} [division_ring α] [char_zero α] :
    invertible (bit0 1) :=
  invertible_of_nonzero sorry

protected instance invertible_three {α : Type u} [division_ring α] [char_zero α] :
    invertible (bit1 1) :=
  invertible_of_nonzero sorry

end Mathlib


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

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

/-!
# Indexed product of uniform spaces
-/

noncomputable section

open Uniformity Topology

section

open Filter UniformSpace

universe u

variable {ι : Type _} (α : ι → Type u) [U : ∀ i, UniformSpace (α i)]

instance Pi.uniformSpace : UniformSpace (∀ i, α i) :=
  UniformSpace.ofCoreEq (⨅ i, UniformSpace.comap (fun a : ∀ i, α i => a i) (U i)).toCore
      Pi.topologicalSpace <|
    Eq.symm toTopologicalSpace_infᵢ
#align Pi.uniform_space Pi.uniformSpace

theorem Pi.uniformity : 𝓤 (∀ i, α i) = ⨅ i : ι, (Filter.comap fun a => (a.1 i, a.2 i)) <| 𝓤 (α i) :=
  infᵢ_uniformity
#align Pi.uniformity Pi.uniformity

variable {α}

theorem uniformContinuous_pi {β : Type _} [UniformSpace β] {f : β → ∀ i, α i} :
    UniformContinuous f ↔ ∀ i, UniformContinuous fun x => f x i := by
  -- porting note: required `Function.comp` to close
  simp only [UniformContinuous, Pi.uniformity, tendsto_infᵢ, tendsto_comap_iff, Function.comp]
#align uniform_continuous_pi uniformContinuous_pi

variable (α)

theorem Pi.uniformContinuous_proj (i : ι) : UniformContinuous fun a : ∀ i : ι, α i => a i :=
  uniformContinuous_pi.1 uniformContinuous_id i
#align Pi.uniform_continuous_proj Pi.uniformContinuous_proj

instance Pi.complete [∀ i, CompleteSpace (α i)] : CompleteSpace (∀ i, α i) :=
  ⟨by
    intro f hf
    haveI := hf.1
    have : ∀ i, ∃ x : α i, Filter.map (fun a : ∀ i, α i => a i) f ≤ 𝓝 x :=
      by
      intro i
      have key : Cauchy (map (fun a : ∀ i : ι, α i => a i) f) :=
        hf.map (Pi.uniformContinuous_proj α i)
      exact cauchy_iff_exists_le_nhds.1 key
    choose x hx using this
    use x
    rwa [nhds_pi, le_pi]⟩
#align Pi.complete Pi.complete

instance Pi.separated [∀ i, SeparatedSpace (α i)] : SeparatedSpace (∀ i, α i) :=
  separated_def.2 fun x y H => by
    ext i
    -- porting note: should be `eq_ofSeparated_ofUniformContinuous`?
    apply eq_of_separated_of_uniformContinuous (Pi.uniformContinuous_proj α i)
    apply H
#align Pi.separated Pi.separated

end