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

/-!
# Asymptotic equivalence up to a constant

In this file we define `asymptotics.is_Theta l f g` (notation: `f =Θ[l] g`) as
`f =O[l] g ∧ g =O[l] f`, then prove basic properties of this equivalence relation.
-/

open filter
open_locale topological_space

namespace asymptotics

variables {α : Type*} {β : Type*} {E : Type*} {F : Type*} {G : Type*}
  {E' : Type*} {F' : Type*} {G' : Type*}
  {E'' : Type*} {F'' : Type*} {G'' : Type*}
  {R : Type*} {R' : Type*} {𝕜 : Type*} {𝕜' : Type*}

variables [has_norm E] [has_norm F] [has_norm G]
variables [semi_normed_group E'] [semi_normed_group F'] [semi_normed_group G']
variables [normed_group E''] [normed_group F''] [normed_group G'']
variables [semi_normed_ring R] [semi_normed_ring R']
variables [normed_field 𝕜] [normed_field 𝕜']
variables {c c' c₁ c₂ : ℝ} {f : α → E} {g : α → F} {k : α → G}
variables {f' : α → E'} {g' : α → F'} {k' : α → G'}
variables {f'' : α → E''} {g'' : α → F''}
variables {l l' : filter α}

/-- We say that `f` is `Θ(g)` along a filter `l` (notation: `f =Θ[l] g`) if `f =O[l] g` and
`g =O[l] f`. -/
def is_Theta (l : filter α) (f : α → E) (g : α → F) : Prop := is_O l f g ∧ is_O l g f

notation f ` =Θ[`:100 l `] ` g:100 := is_Theta l f g

lemma is_O.antisymm (h₁ : f =O[l] g) (h₂ : g =O[l] f) : f =Θ[l] g := ⟨h₁, h₂⟩

@[refl] lemma is_Theta_refl (f : α → E) (l : filter α) : f =Θ[l] f := ⟨is_O_refl _ _, is_O_refl _ _⟩
lemma is_Theta_rfl : f =Θ[l] f := is_Theta_refl _ _
@[symm] lemma is_Theta.symm (h : f =Θ[l] g) : g =Θ[l] f := h.symm

lemma is_Theta_comm : f =Θ[l] g ↔ g =Θ[l] f := ⟨λ h, h.symm, λ h, h.symm⟩

@[trans] lemma is_Theta.trans {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g)
  (h₂ : g =Θ[l] k) : f =Θ[l] k :=
⟨h₁.1.trans h₂.1, h₂.2.trans h₁.2⟩

@[trans] lemma is_O.trans_is_Theta {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =O[l] g)
  (h₂ : g =Θ[l] k) : f =O[l] k :=
h₁.trans h₂.1

@[trans] lemma is_Theta.trans_is_O {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g)
  (h₂ : g =O[l] k) : f =O[l] k :=
h₁.1.trans h₂

@[trans] lemma is_o.trans_is_Theta {f : α → E} {g : α → F} {k : α → G'} (h₁ : f =o[l] g)
  (h₂ : g =Θ[l] k) : f =o[l] k :=
h₁.trans_is_O h₂.1

@[trans] lemma is_Theta.trans_is_o {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g)
  (h₂ : g =o[l] k) : f =o[l] k :=
h₁.1.trans_is_o h₂

@[trans] lemma is_Theta.trans_eventually_eq {f : α → E} {g₁ g₂ : α → F} (h : f =Θ[l] g₁)
  (hg : g₁ =ᶠ[l] g₂) : f =Θ[l] g₂ :=
⟨h.1.trans_eventually_eq hg, hg.symm.trans_is_O h.2⟩

@[trans] lemma _root_.filter.eventually_eq.trans_is_Theta {f₁ f₂ : α → E} {g : α → F}
  (hf : f₁ =ᶠ[l] f₂) (h : f₂ =Θ[l] g) : f₁ =Θ[l] g :=
⟨hf.trans_is_O h.1, h.2.trans_eventually_eq hf.symm⟩

@[simp] lemma is_Theta_norm_left : (λ x, ∥f' x∥) =Θ[l] g ↔ f' =Θ[l] g := by simp [is_Theta]
@[simp]

alias is_Theta_norm_left ↔ asymptotics.is_Theta.of_norm_left asymptotics.is_Theta.norm_left
alias is_Theta_norm_right ↔ asymptotics.is_Theta.of_norm_right asymptotics.is_Theta.norm_right

lemma is_Theta_of_norm_eventually_eq (h : (λ x, ∥f x∥) =ᶠ[l] (λ x, ∥g x∥)) : f =Θ[l] g :=
⟨is_O.of_bound 1 $ by simpa only [one_mul] using h.le,
  is_O.of_bound 1 $ by simpa only [one_mul] using h.symm.le⟩

lemma is_Theta_of_norm_eventually_eq' {g : α → ℝ} (h : (λ x, ∥f' x∥) =ᶠ[l] g) : f' =Θ[l] g :=
is_Theta_of_norm_eventually_eq $ h.mono $ λ x hx, by simp only [← hx, norm_norm]

lemma is_Theta.is_o_congr_left (h : f' =Θ[l] g') : f' =o[l] k ↔ g' =o[l] k :=
⟨h.symm.trans_is_o, h.trans_is_o⟩

lemma is_Theta.is_o_congr_right (h : g' =Θ[l] k') : f =o[l] g' ↔ f =o[l] k' :=
⟨λ H, H.trans_is_Theta h, λ H, H.trans_is_Theta h.symm⟩

lemma is_Theta.is_O_congr_left (h : f' =Θ[l] g') : f' =O[l] k ↔ g' =O[l] k :=
⟨h.symm.trans_is_O, h.trans_is_O⟩

lemma is_Theta.is_O_congr_right (h : g' =Θ[l] k') : f =O[l] g' ↔ f =O[l] k' :=
⟨λ H, H.trans_is_Theta h, λ H, H.trans_is_Theta h.symm⟩

lemma is_Theta.mono (h : f =Θ[l] g) (hl : l' ≤ l) : f =Θ[l'] g := ⟨h.1.mono hl, h.2.mono hl⟩

lemma is_Theta.sup (h : f' =Θ[l] g') (h' : f' =Θ[l'] g') : f' =Θ[l ⊔ l'] g' :=
⟨h.1.sup h'.1, h.2.sup h'.2⟩

@[simp] lemma is_Theta_sup : f' =Θ[l ⊔ l'] g' ↔ f' =Θ[l] g' ∧ f' =Θ[l'] g' :=
⟨λ h, ⟨h.mono le_sup_left, h.mono le_sup_right⟩, λ h, h.1.sup h.2⟩

lemma is_Theta.eq_zero_iff (h : f'' =Θ[l] g'') : ∀ᶠ x in l, f'' x = 0 ↔ g'' x = 0 :=
h.1.eq_zero_imp.mp $ h.2.eq_zero_imp.mono $ λ x, iff.intro

lemma is_Theta.tendsto_zero_iff (h : f'' =Θ[l] g'') : tendsto f'' l (𝓝 0) ↔ tendsto g'' l (𝓝 0) :=
by simp only [← is_o_one_iff ℝ, h.is_o_congr_left]

lemma is_Theta.tendsto_norm_at_top_iff (h : f' =Θ[l] g') :
  tendsto (norm ∘ f') l at_top ↔ tendsto (norm ∘ g') l at_top :=
by simp only [← is_o_const_left_of_ne (@one_ne_zero ℝ _ _), h.is_o_congr_right]

lemma is_Theta.is_bounded_under_le_iff (h : f' =Θ[l] g') :
  is_bounded_under (≤) l (norm ∘ f') ↔ is_bounded_under (≤) l (norm ∘ g') :=
by simp only [← is_O_const_of_ne (@one_ne_zero ℝ _ _), h.is_O_congr_left]

lemma is_Theta.smul [normed_space 𝕜 E'] [normed_space 𝕜' F'] {f₁ : α → 𝕜} {f₂ : α → 𝕜'}
  {g₁ : α → E'} {g₂ : α → F'} (hf : f₁ =Θ[l] f₂) (hg : g₁ =Θ[l] g₂) :
  (λ x, f₁ x • g₁ x) =Θ[l] (λ x, f₂ x • g₂ x) :=
⟨hf.1.smul hg.1, hf.2.smul hg.2⟩

lemma is_Theta.mul {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) :
  (λ x, f₁ x * f₂ x) =Θ[l] (λ x, g₁ x * g₂ x) :=
h₁.smul h₂

lemma is_Theta.inv {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) : (λ x, (f x)⁻¹) =Θ[l] (λ x, (g x)⁻¹) :=
⟨h.2.inv_rev h.1.eq_zero_imp, h.1.inv_rev h.2.eq_zero_imp⟩

@[simp] lemma is_Theta_inv {f : α → 𝕜} {g : α → 𝕜'} :
  (λ x, (f x)⁻¹) =Θ[l] (λ x, (g x)⁻¹) ↔ f =Θ[l] g :=
⟨λ h, by simpa only [inv_inv] using h.inv, is_Theta.inv⟩

lemma is_Theta.div {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) :
  (λ x, f₁ x / f₂ x) =Θ[l] (λ x, g₁ x / g₂ x) :=
by simpa only [div_eq_mul_inv] using h₁.mul h₂.inv

lemma is_Theta.pow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℕ) :
  (λ x, (f x) ^ n) =Θ[l] (λ x, (g x) ^ n) :=
⟨h.1.pow n, h.2.pow n⟩

lemma is_Theta.zpow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℤ) :
  (λ x, (f x) ^ n) =Θ[l] (λ x, (g x) ^ n) :=
begin
  cases n,
  { simpa only [zpow_of_nat] using h.pow _ },
  { simpa only [zpow_neg_succ_of_nat] using (h.pow _).inv }
end

lemma is_Theta_const_const {c₁ : E''} {c₂ : F''} (h₁ : c₁ ≠ 0) (h₂ : c₂ ≠ 0) :
  (λ x : α, c₁) =Θ[l] (λ x, c₂) :=
⟨is_O_const_const _ h₂ _, is_O_const_const _ h₁ _⟩

@[simp] lemma is_Theta_const_const_iff [ne_bot l] {c₁ : E''} {c₂ : F''} :
  (λ x : α, c₁) =Θ[l] (λ x, c₂) ↔ (c₁ = 0 ↔ c₂ = 0) :=
by simpa only [is_Theta, is_O_const_const_iff, ← iff_def] using iff.comm

@[simp] lemma is_Theta_zero_left : (λ x, (0 : E')) =Θ[l] g'' ↔ g'' =ᶠ[l] 0 :=
by simp only [is_Theta, is_O_zero, is_O_zero_right_iff, true_and]

@[simp] lemma is_Theta_zero_right : f'' =Θ[l] (λ x, (0 : F')) ↔ f'' =ᶠ[l] 0 :=
is_Theta_comm.trans is_Theta_zero_left

lemma is_Theta_const_smul_left [normed_space 𝕜 E'] {c : 𝕜} (hc : c ≠ 0) :
  (λ x, c • f' x) =Θ[l] g ↔ f' =Θ[l] g :=
and_congr (is_O_const_smul_left hc) (is_O_const_smul_right hc)

alias is_Theta_const_smul_left ↔ asymptotics.is_Theta.of_const_smul_left
  asymptotics.is_Theta.const_smul_left

lemma is_Theta_const_smul_right [normed_space 𝕜 F'] {c : 𝕜} (hc : c ≠ 0) :
  f =Θ[l] (λ x, c • g' x) ↔ f =Θ[l] g' :=
and_congr (is_O_const_smul_right hc) (is_O_const_smul_left hc)

alias is_Theta_const_smul_right ↔ asymptotics.is_Theta.of_const_smul_right
  asymptotics.is_Theta.const_smul_right

lemma is_Theta_const_mul_left {c : 𝕜} {f : α → 𝕜} (hc : c ≠ 0) :
  (λ x, c * f x) =Θ[l] g ↔ f =Θ[l] g :=
by simpa only [← smul_eq_mul] using is_Theta_const_smul_left hc

alias is_Theta_const_mul_left ↔ asymptotics.is_Theta.of_const_mul_left
  asymptotics.is_Theta.const_mul_left

lemma is_Theta_const_mul_right {c : 𝕜} {g : α → 𝕜} (hc : c ≠ 0) :
  f =Θ[l] (λ x, c * g x) ↔ f =Θ[l] g :=
by simpa only [← smul_eq_mul] using is_Theta_const_smul_right hc

alias is_Theta_const_mul_right ↔ asymptotics.is_Theta.of_const_mul_right
  asymptotics.is_Theta.const_mul_right

end asymptotics


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Bryan Gin-ge Chen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.prime
import Mathlib.data.int.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Lemmas about nat.prime using `int`s
-/

namespace int

theorem not_prime_of_int_mul {a : ℤ} {b : ℤ} {c : ℕ} (ha : 1 < nat_abs a) (hb : 1 < nat_abs b)
    (hc : a * b = ↑c) : ¬nat.prime c :=
  nat.not_prime_mul' (nat_abs_mul_nat_abs_eq hc) ha hb

end Mathlib


-- Prueba del elemento neutro por la derecha de la concatenación
-- =============================================================

import tactic
import data.list.basic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys : list α)

-- ----------------------------------------------------
-- Nota. Se usará la función conc y sus propiedades
-- estudiadas anteriormente.
-- ----------------------------------------------------

def conc : list α → list α → list α
| []        ys := ys
| (x :: xs) ys := x :: (conc xs ys)

@[simp]
lemma conc_nil :
  conc ([] : list α) ys = ys :=
rfl

@[simp]
lemma conc_cons :
  conc (x :: xs) ys = x :: (conc xs ys) :=
rfl

-- ----------------------------------------------------
-- Ejercicio 1. (p. 28) Demostrar que
--    conc xs [] = xs
-- ----------------------------------------------------

-- 1ª demostración
example : conc xs [] = xs :=
begin
  induction xs with a as HI,
  { rw conc_nil, },
  { rw conc_cons,
    rw HI, },
end

-- 2ª demostración
example : conc xs [] = xs :=
begin
  induction xs with x xs HI,
  { rw [conc_nil], },
  { rw [conc_cons, HI], },
end

-- 3ª demostración
example : conc xs [] = xs :=
begin
  induction xs with x xs HI,
  { simp only [conc_nil], },
  { simp only [conc_cons, HI],
    cc, },
end

-- 4ª demostración
example : conc xs [] = xs :=
begin
  induction xs with x xs HI,
  { simp , },
  { simp [HI], },
end

-- 5ª demostración
example : conc xs [] = xs :=
by induction xs ; simp [*]

-- 6ª demostración
example : conc xs [] = xs :=
begin
  induction xs with a as HI,
  { rw conc_nil, },
  { calc
      conc (a :: as) []
          = a :: (conc as []) : by rw conc_cons
      ... = a :: as           : by rw HI, },
end

-- 7ª demostración
example : conc xs [] = xs :=
list.rec_on xs
  ( show conc [] [] = [], from calc
      conc [] [] = [] : by rw conc_nil )
  ( assume a as,
    assume HI : conc as [] = as,
    show conc (a :: as) [] = a :: as, from calc
      conc (a :: as) []
          = a :: (conc as []) : by rw conc_cons
      ... = a :: as           : by rw HI)

-- 8ª demostración
example : conc xs [] = xs :=
list.rec_on xs
  ( show conc [] [] = [], by simp)
  ( assume a as,
    assume HI : conc as [] = as,
    show conc (a :: as) [] = a :: as, by simp [HI])

-- 9ª demostración
example : conc xs [] = xs :=
list.rec_on xs
  (by simp)
  (λ a as HI, by simp [HI])

-- 10ª demostración
lemma conc_nil_1:
  ∀ xs : list α, conc xs [] = xs
| []        := by rw conc_nil
| (a :: as) := by calc
    conc (a :: as) []
        = a :: conc as [] : by rw conc_cons
    ... = a :: as         : by rw conc_nil_1

-- 11ª demostración
lemma conc_nil_2:
  ∀ xs : list α, conc xs [] = xs
| []        := by simp
| (a :: as) := by simp [conc_nil_2 as]

-- Comentarios sobre la función (++)
-- + Es equivalente a la función conc.
-- + Para usarla hay que importar la librería
--   data.list.basic y abrir el espacio de nombre
--   list escribiendo al principio del fichero
--      import data.list.basic
--      open list
-- + Se puede evaluar. Por ejemplo,
--      #eval [1,4] ++ [2,4,1,3]
-- + Se puede demostrar. Por ejemplo,
example : xs ++ [] = xs :=
by induction xs ; simp [*]

example : xs ++ [] = xs :=
-- by library_search
append_nil xs

example : xs ++ [] = xs :=
by simp


/-
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 category_theory.limits.fubini
! leanprover-community/mathlib commit 59382264386afdbaf1727e617f5fdda511992eb9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.HasLimits
import Mathbin.CategoryTheory.Products.Basic
import Mathbin.CategoryTheory.Functor.Currying

/-!
# A Fubini theorem for categorical limits

We prove that $lim_{J × K} G = lim_J (lim_K G(j, -))$ for a functor `G : J × K ⥤ C`,
when all the appropriate limits exist.

We begin working with a functor `F : J ⥤ K ⥤ C`. We'll write `G : J × K ⥤ C` for the associated
"uncurried" functor.

In the first part, given a coherent family `D` of limit cones over the functors `F.obj j`,
and a cone `c` over `G`, we construct a cone over the cone points of `D`.
We then show that if `c` is a limit cone, the constructed cone is also a limit cone.

In the second part, we state the Fubini theorem in the setting where limits are
provided by suitable `has_limit` classes.

We construct
`limit_uncurry_iso_limit_comp_lim F : limit (uncurry.obj F) ≅ limit (F ⋙ lim)`
and give simp lemmas characterising it.
For convenience, we also provide
`limit_iso_limit_curry_comp_lim G : limit G ≅ limit ((curry.obj G) ⋙ lim)`
in terms of the uncurried functor.

## Future work

The dual statement.
-/

universe v u

open CategoryTheory

namespace CategoryTheory.Limits

variable {J K : Type v} [SmallCategory J] [SmallCategory K]

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

variable (F : J ⥤ K ⥤ C)

-- We could try introducing a "dependent functor type" to handle this?
/-- A structure carrying a diagram of cones over the functors `F.obj j`.
-/
structure DiagramOfCones where
  obj : ∀ j : J, Cone (F.obj j)
  map : ∀ {j j' : J} (f : j ⟶ j'), (Cones.postcompose (F.map f)).obj (obj j) ⟶ obj j'
  id : ∀ j : J, (map (𝟙 j)).Hom = 𝟙 _ := by obviously
  comp :
    ∀ {j₁ j₂ j₃ : J} (f : j₁ ⟶ j₂) (g : j₂ ⟶ j₃),
      (map (f ≫ g)).Hom = (map f).Hom ≫ (map g).Hom := by
    obviously
#align category_theory.limits.diagram_of_cones CategoryTheory.Limits.DiagramOfCones

variable {F}

/-- Extract the functor `J ⥤ C` consisting of the cone points and the maps between them,
from a `diagram_of_cones`.
-/
@[simps]
def DiagramOfCones.conePoints (D : DiagramOfCones F) : J ⥤ C
    where
  obj j := (D.obj j).pt
  map j j' f := (D.map f).Hom
  map_id' j := D.id j
  map_comp' j₁ j₂ j₃ f g := D.comp f g
#align category_theory.limits.diagram_of_cones.cone_points CategoryTheory.Limits.DiagramOfCones.conePoints

/-- Given a diagram `D` of limit cones over the `F.obj j`, and a cone over `uncurry.obj F`,
we can construct a cone over the diagram consisting of the cone points from `D`.
-/
@[simps]
def coneOfConeUncurry {D : DiagramOfCones F} (Q : ∀ j, IsLimit (D.obj j))
    (c : Cone (uncurry.obj F)) : Cone D.conePoints
    where
  pt := c.pt
  π :=
    { app := fun j =>
        (Q j).lift
          { pt := c.pt
            π :=
              { app := fun k => c.π.app (j, k)
                naturality' := fun k k' f => by
                  dsimp; simp only [category.id_comp]
                  have := @nat_trans.naturality _ _ _ _ _ _ c.π (j, k) (j, k') (𝟙 j, f)
                  dsimp at this
                  simp only [category.id_comp, CategoryTheory.Functor.map_id, nat_trans.id_app] at
                    this
                  exact this } }
      naturality' := fun j j' f =>
        (Q j').hom_ext
          (by
            dsimp
            intro k
            simp only [limits.cone_morphism.w, limits.cones.postcompose_obj_π,
              limits.is_limit.fac_assoc, limits.is_limit.fac, nat_trans.comp_app, category.id_comp,
              category.assoc]
            have := @nat_trans.naturality _ _ _ _ _ _ c.π (j, k) (j', k) (f, 𝟙 k)
            dsimp at this
            simp only [category.id_comp, category.comp_id, CategoryTheory.Functor.map_id,
              nat_trans.id_app] at this
            exact this) }
#align category_theory.limits.cone_of_cone_uncurry CategoryTheory.Limits.coneOfConeUncurry

/-- `cone_of_cone_uncurry Q c` is a limit cone when `c` is a limit cone.`
-/
def coneOfConeUncurryIsLimit {D : DiagramOfCones F} (Q : ∀ j, IsLimit (D.obj j))
    {c : Cone (uncurry.obj F)} (P : IsLimit c) : IsLimit (coneOfConeUncurry Q c)
    where
  lift s :=
    P.lift
      { pt := s.pt
        π :=
          { app := fun p => s.π.app p.1 ≫ (D.obj p.1).π.app p.2
            naturality' := fun p p' f => by
              dsimp; simp only [category.id_comp, category.assoc]
              rcases p with ⟨j, k⟩
              rcases p' with ⟨j', k'⟩
              rcases f with ⟨fj, fk⟩
              dsimp
              slice_rhs 3 4 => rw [← nat_trans.naturality]
              slice_rhs 2 3 => rw [← (D.obj j).π.naturality]
              simp only [functor.const_obj_map, category.id_comp, category.assoc]
              have w := (D.map fj).w k'
              dsimp at w
              rw [← w]
              have n := s.π.naturality fj
              dsimp at n
              simp only [category.id_comp] at n
              rw [n]
              simp } }
  fac s j := by
    apply (Q j).hom_ext
    intro k
    simp
  uniq s m w :=
    by
    refine'
      P.uniq
        { pt := s.X
          π := _ } m _
    rintro ⟨j, k⟩
    dsimp
    rw [← w j]
    simp
#align category_theory.limits.cone_of_cone_uncurry_is_limit CategoryTheory.Limits.coneOfConeUncurryIsLimit

section

variable (F)

variable [HasLimitsOfShape K C]

/-- Given a functor `F : J ⥤ K ⥤ C`, with all needed limits,
we can construct a diagram consisting of the limit cone over each functor `F.obj j`,
and the universal cone morphisms between these.
-/
@[simps]
noncomputable def DiagramOfCones.mkOfHasLimits : DiagramOfCones F
    where
  obj j := limit.cone (F.obj j)
  map j j' f := { Hom := lim.map (F.map f) }
#align category_theory.limits.diagram_of_cones.mk_of_has_limits CategoryTheory.Limits.DiagramOfCones.mkOfHasLimits

-- Satisfying the inhabited linter.
noncomputable instance diagramOfConesInhabited : Inhabited (DiagramOfCones F) :=
  ⟨DiagramOfCones.mkOfHasLimits F⟩
#align category_theory.limits.diagram_of_cones_inhabited CategoryTheory.Limits.diagramOfConesInhabited

@[simp]
theorem DiagramOfCones.mkOfHasLimits_conePoints :
    (DiagramOfCones.mkOfHasLimits F).conePoints = F ⋙ lim :=
  rfl
#align category_theory.limits.diagram_of_cones.mk_of_has_limits_cone_points CategoryTheory.Limits.DiagramOfCones.mkOfHasLimits_conePoints

variable [HasLimit (uncurry.obj F)]

variable [HasLimit (F ⋙ lim)]

/-- The Fubini theorem for a functor `F : J ⥤ K ⥤ C`,
showing that the limit of `uncurry.obj F` can be computed as
the limit of the limits of the functors `F.obj j`.
-/
noncomputable def limitUncurryIsoLimitCompLim : limit (uncurry.obj F) ≅ limit (F ⋙ lim) :=
  by
  let c := limit.cone (uncurry.obj F)
  let P : is_limit c := limit.is_limit _
  let G := diagram_of_cones.mk_of_has_limits F
  let Q : ∀ j, is_limit (G.obj j) := fun j => limit.is_limit _
  have Q' := cone_of_cone_uncurry_is_limit Q P
  have Q'' := limit.is_limit (F ⋙ limUnder)
  exact is_limit.cone_point_unique_up_to_iso Q' Q''
#align category_theory.limits.limit_uncurry_iso_limit_comp_lim CategoryTheory.Limits.limitUncurryIsoLimitCompLim

@[simp, reassoc.1]
theorem limitUncurryIsoLimitCompLim_hom_π_π {j} {k} :
    (limitUncurryIsoLimitCompLim F).Hom ≫ limit.π _ j ≫ limit.π _ k = limit.π _ (j, k) :=
  by
  dsimp [limit_uncurry_iso_limit_comp_lim, is_limit.cone_point_unique_up_to_iso,
    is_limit.unique_up_to_iso]
  simp
#align category_theory.limits.limit_uncurry_iso_limit_comp_lim_hom_π_π CategoryTheory.Limits.limitUncurryIsoLimitCompLim_hom_π_π

@[simp, reassoc.1]
theorem limitUncurryIsoLimitCompLim_inv_π {j} {k} :
    (limitUncurryIsoLimitCompLim F).inv ≫ limit.π _ (j, k) = limit.π _ j ≫ limit.π _ k :=
  by
  rw [← cancel_epi (limit_uncurry_iso_limit_comp_lim F).Hom]
  simp
#align category_theory.limits.limit_uncurry_iso_limit_comp_lim_inv_π CategoryTheory.Limits.limitUncurryIsoLimitCompLim_inv_π

end

section

variable (F) [HasLimitsOfShape J C] [HasLimitsOfShape K C]

-- With only moderate effort these could be derived if needed:
variable [HasLimitsOfShape (J × K) C] [HasLimitsOfShape (K × J) C]

/-- The limit of `F.flip ⋙ lim` is isomorphic to the limit of `F ⋙ lim`. -/
noncomputable def limitFlipCompLimIsoLimitCompLim : limit (F.flip ⋙ lim) ≅ limit (F ⋙ lim) :=
  (limitUncurryIsoLimitCompLim _).symm ≪≫
    HasLimit.isoOfNatIso (uncurryObjFlip _) ≪≫
      HasLimit.isoOfEquivalence (Prod.braiding _ _)
          (NatIso.ofComponents (fun _ => by rfl) (by tidy)) ≪≫
        limitUncurryIsoLimitCompLim _
#align category_theory.limits.limit_flip_comp_lim_iso_limit_comp_lim CategoryTheory.Limits.limitFlipCompLimIsoLimitCompLim

@[simp, reassoc.1]
theorem limitFlipCompLimIsoLimitCompLim_hom_π_π (j) (k) :
    (limitFlipCompLimIsoLimitCompLim F).Hom ≫ limit.π _ j ≫ limit.π _ k =
      limit.π _ k ≫ limit.π _ j :=
  by
  dsimp [limit_flip_comp_lim_iso_limit_comp_lim]
  simp
  dsimp
  simp
#align category_theory.limits.limit_flip_comp_lim_iso_limit_comp_lim_hom_π_π CategoryTheory.Limits.limitFlipCompLimIsoLimitCompLim_hom_π_π

-- See note [dsimp, simp]
@[simp, reassoc.1]
theorem limitFlipCompLimIsoLimitCompLim_inv_π_π (k) (j) :
    (limitFlipCompLimIsoLimitCompLim F).inv ≫ limit.π _ k ≫ limit.π _ j =
      limit.π _ j ≫ limit.π _ k :=
  by
  dsimp [limit_flip_comp_lim_iso_limit_comp_lim]
  simp
  dsimp
  simp
  dsimp
  simp
#align category_theory.limits.limit_flip_comp_lim_iso_limit_comp_lim_inv_π_π CategoryTheory.Limits.limitFlipCompLimIsoLimitCompLim_inv_π_π

end

section

variable (G : J × K ⥤ C)

section

variable [HasLimitsOfShape K C]

variable [HasLimit G]

variable [HasLimit (curry.obj G ⋙ lim)]

/-- The Fubini theorem for a functor `G : J × K ⥤ C`,
showing that the limit of `G` can be computed as
the limit of the limits of the functors `G.obj (j, _)`.
-/
noncomputable def limitIsoLimitCurryCompLim : limit G ≅ limit (curry.obj G ⋙ lim) :=
  by
  have i : G ≅ uncurry.obj ((@curry J _ K _ C _).obj G) := currying.symm.unit_iso.app G
  haveI : limits.has_limit (uncurry.obj ((@curry J _ K _ C _).obj G)) := has_limit_of_iso i
  trans limit (uncurry.obj ((@curry J _ K _ C _).obj G))
  apply has_limit.iso_of_nat_iso i
  exact limit_uncurry_iso_limit_comp_lim ((@curry J _ K _ C _).obj G)
#align category_theory.limits.limit_iso_limit_curry_comp_lim CategoryTheory.Limits.limitIsoLimitCurryCompLim

@[simp, reassoc.1]
theorem limitIsoLimitCurryCompLim_hom_π_π {j} {k} :
    (limitIsoLimitCurryCompLim G).Hom ≫ limit.π _ j ≫ limit.π _ k = limit.π _ (j, k) := by
  simp [limit_iso_limit_curry_comp_lim, is_limit.cone_point_unique_up_to_iso,
    is_limit.unique_up_to_iso]
#align category_theory.limits.limit_iso_limit_curry_comp_lim_hom_π_π CategoryTheory.Limits.limitIsoLimitCurryCompLim_hom_π_π

@[simp, reassoc.1]
theorem limitIsoLimitCurryCompLim_inv_π {j} {k} :
    (limitIsoLimitCurryCompLim G).inv ≫ limit.π _ (j, k) = limit.π _ j ≫ limit.π _ k :=
  by
  rw [← cancel_epi (limit_iso_limit_curry_comp_lim G).Hom]
  simp
#align category_theory.limits.limit_iso_limit_curry_comp_lim_inv_π CategoryTheory.Limits.limitIsoLimitCurryCompLim_inv_π

end

section

variable [HasLimits C]

-- Certainly one could weaken the hypotheses here.
open CategoryTheory.prod

/-- A variant of the Fubini theorem for a functor `G : J × K ⥤ C`,
showing that $\lim_k \lim_j G(j,k) ≅ \lim_j \lim_k G(j,k)$.
-/
noncomputable def limitCurrySwapCompLimIsoLimitCurryCompLim :
    limit (curry.obj (swap K J ⋙ G) ⋙ lim) ≅ limit (curry.obj G ⋙ lim) :=
  calc
    limit (curry.obj (swap K J ⋙ G) ⋙ lim) ≅ limit (swap K J ⋙ G) :=
      (limitIsoLimitCurryCompLim _).symm
    _ ≅ limit G := (HasLimit.isoOfEquivalence (braiding K J) (Iso.refl _))
    _ ≅ limit (curry.obj G ⋙ lim) := limitIsoLimitCurryCompLim _

#align category_theory.limits.limit_curry_swap_comp_lim_iso_limit_curry_comp_lim CategoryTheory.Limits.limitCurrySwapCompLimIsoLimitCurryCompLim

@[simp]
theorem limitCurrySwapCompLimIsoLimitCurryCompLim_hom_π_π {j} {k} :
    (limitCurrySwapCompLimIsoLimitCurryCompLim G).Hom ≫ limit.π _ j ≫ limit.π _ k =
      limit.π _ k ≫ limit.π _ j :=
  by
  dsimp [limit_curry_swap_comp_lim_iso_limit_curry_comp_lim]
  simp only [iso.refl_hom, braiding_counit_iso_hom_app, limits.has_limit.iso_of_equivalence_hom_π,
    iso.refl_inv, limit_iso_limit_curry_comp_lim_hom_π_π, eq_to_iso_refl, category.assoc]
  erw [nat_trans.id_app]
  -- Why can't `simp` do this`?
  dsimp;
  simp
#align category_theory.limits.limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_hom_π_π CategoryTheory.Limits.limitCurrySwapCompLimIsoLimitCurryCompLim_hom_π_π

@[simp]
theorem limitCurrySwapCompLimIsoLimitCurryCompLim_inv_π_π {j} {k} :
    (limitCurrySwapCompLimIsoLimitCurryCompLim G).inv ≫ limit.π _ k ≫ limit.π _ j =
      limit.π _ j ≫ limit.π _ k :=
  by
  dsimp [limit_curry_swap_comp_lim_iso_limit_curry_comp_lim]
  simp only [iso.refl_hom, braiding_counit_iso_hom_app, limits.has_limit.iso_of_equivalence_inv_π,
    iso.refl_inv, limit_iso_limit_curry_comp_lim_hom_π_π, eq_to_iso_refl, category.assoc]
  erw [nat_trans.id_app]
  -- Why can't `simp` do this`?
  dsimp;
  simp
#align category_theory.limits.limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_inv_π_π CategoryTheory.Limits.limitCurrySwapCompLimIsoLimitCurryCompLim_inv_π_π

end

end

end CategoryTheory.Limits


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.intervals.basic

/-!
# Intervals in `with_top α` and `with_bot α`

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

In this file we prove various lemmas about `set.image`s and `set.preimage`s of intervals under
`coe : α → with_top α` and `coe : α → with_bot α`.
-/

open set

variables {α : Type*}

/-! ### `with_top` -/

namespace with_top

@[simp] lemma preimage_coe_top : (coe : α → with_top α) ⁻¹' {⊤} = (∅ : set α) :=
eq_empty_of_subset_empty $ λ a, coe_ne_top

variables [partial_order α] {a b : α}

lemma range_coe : range (coe : α → with_top α) = Iio ⊤ :=
begin
  ext x,
  rw [mem_Iio, lt_top_iff_ne_top, mem_range, ← none_eq_top, option.ne_none_iff_exists],
  refl,
end

@[simp] lemma preimage_coe_Ioi : (coe : α → with_top α) ⁻¹' (Ioi a) = Ioi a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Ici : (coe : α → with_top α) ⁻¹' (Ici a) = Ici a := ext $ λ x, coe_le_coe
@[simp] lemma preimage_coe_Iio : (coe : α → with_top α) ⁻¹' (Iio a) = Iio a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Iic : (coe : α → with_top α) ⁻¹' (Iic a) = Iic a := ext $ λ x, coe_le_coe

@[simp]

@[simp] lemma preimage_coe_Ico : (coe : α → with_top α) ⁻¹' (Ico a b) = Ico a b :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioc : (coe : α → with_top α) ⁻¹' (Ioc a b) = Ioc a b :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo : (coe : α → with_top α) ⁻¹' (Ioo a b) = Ioo a b :=
by simp [← Ioi_inter_Iio]

@[simp] lemma preimage_coe_Iio_top : (coe : α → with_top α) ⁻¹' (Iio ⊤) = univ :=
by rw [← range_coe, preimage_range]

@[simp] lemma preimage_coe_Ico_top : (coe : α → with_top α) ⁻¹' (Ico a ⊤) = Ici a :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioo_top : (coe : α → with_top α) ⁻¹' (Ioo a ⊤) = Ioi a :=
by simp [← Ioi_inter_Iio]

lemma image_coe_Ioi : (coe : α → with_top α) '' (Ioi a) = Ioo a ⊤ :=
by rw [← preimage_coe_Ioi, image_preimage_eq_inter_range, range_coe, Ioi_inter_Iio]

lemma image_coe_Ici : (coe : α → with_top α) '' (Ici a) = Ico a ⊤ :=
by rw [← preimage_coe_Ici, image_preimage_eq_inter_range, range_coe, Ici_inter_Iio]

lemma image_coe_Iio : (coe : α → with_top α) '' (Iio a) = Iio a :=
by rw [← preimage_coe_Iio, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Iio_subset_Iio le_top)]

lemma image_coe_Iic : (coe : α → with_top α) '' (Iic a) = Iic a :=
by rw [← preimage_coe_Iic, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Iic_subset_Iio.2 $ coe_lt_top a)]

lemma image_coe_Icc : (coe : α → with_top α) '' (Icc a b) = Icc a b :=
by rw [← preimage_coe_Icc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Icc_subset_Iic_self $ Iic_subset_Iio.2 $ coe_lt_top b)]

lemma image_coe_Ico : (coe : α → with_top α) '' (Ico a b) = Ico a b :=
by rw [← preimage_coe_Ico, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ico_subset_Iio_self $ Iio_subset_Iio le_top)]

lemma image_coe_Ioc : (coe : α → with_top α) '' (Ioc a b) = Ioc a b :=
by rw [← preimage_coe_Ioc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioc_subset_Iic_self $ Iic_subset_Iio.2 $ coe_lt_top b)]

lemma image_coe_Ioo : (coe : α → with_top α) '' (Ioo a b) = Ioo a b :=
by rw [← preimage_coe_Ioo, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioo_subset_Iio_self $ Iio_subset_Iio le_top)]

end with_top

/-! ### `with_bot` -/

namespace with_bot

@[simp] lemma preimage_coe_bot : (coe : α → with_bot α) ⁻¹' {⊥} = (∅ : set α) :=
@with_top.preimage_coe_top αᵒᵈ

variables [partial_order α] {a b : α}

lemma range_coe : range (coe : α → with_bot α) = Ioi ⊥ := @with_top.range_coe αᵒᵈ _

@[simp] lemma preimage_coe_Ioi : (coe : α → with_bot α) ⁻¹' (Ioi a) = Ioi a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Ici : (coe : α → with_bot α) ⁻¹' (Ici a) = Ici a := ext $ λ x, coe_le_coe
@[simp] lemma preimage_coe_Iio : (coe : α → with_bot α) ⁻¹' (Iio a) = Iio a := ext $ λ x, coe_lt_coe
@[simp] lemma preimage_coe_Iic : (coe : α → with_bot α) ⁻¹' (Iic a) = Iic a := ext $ λ x, coe_le_coe

@[simp] lemma preimage_coe_Icc : (coe : α → with_bot α) ⁻¹' (Icc a b) = Icc a b :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_coe_Ico : (coe : α → with_bot α) ⁻¹' (Ico a b) = Ico a b :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_coe_Ioc : (coe : α → with_bot α) ⁻¹' (Ioc a b) = Ioc a b :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo : (coe : α → with_bot α) ⁻¹' (Ioo a b) = Ioo a b :=
by simp [← Ioi_inter_Iio]

@[simp] lemma preimage_coe_Ioi_bot : (coe : α → with_bot α) ⁻¹' (Ioi ⊥) = univ :=
by rw [← range_coe, preimage_range]

@[simp] lemma preimage_coe_Ioc_bot : (coe : α → with_bot α) ⁻¹' (Ioc ⊥ a) = Iic a :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_coe_Ioo_bot : (coe : α → with_bot α) ⁻¹' (Ioo ⊥ a) = Iio a :=
by simp [← Ioi_inter_Iio]

lemma image_coe_Iio : (coe : α → with_bot α) '' (Iio a) = Ioo ⊥ a :=
by rw [← preimage_coe_Iio, image_preimage_eq_inter_range, range_coe, inter_comm, Ioi_inter_Iio]

lemma image_coe_Iic : (coe : α → with_bot α) '' (Iic a) = Ioc ⊥ a :=
by rw [← preimage_coe_Iic, image_preimage_eq_inter_range, range_coe, inter_comm, Ioi_inter_Iic]

lemma image_coe_Ioi : (coe : α → with_bot α) '' (Ioi a) = Ioi a :=
by rw [← preimage_coe_Ioi, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Ioi_subset_Ioi bot_le)]

lemma image_coe_Ici : (coe : α → with_bot α) '' (Ici a) = Ici a :=
by rw [← preimage_coe_Ici, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Icc : (coe : α → with_bot α) '' (Icc a b) = Icc a b :=
by rw [← preimage_coe_Icc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Icc_subset_Ici_self $ Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Ioc : (coe : α → with_bot α) '' (Ioc a b) = Ioc a b :=
by rw [← preimage_coe_Ioc, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioc_subset_Ioi_self $ Ioi_subset_Ioi bot_le)]

lemma image_coe_Ico : (coe : α → with_bot α) '' (Ico a b) = Ico a b :=
by rw [← preimage_coe_Ico, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ico_subset_Ici_self $ Ici_subset_Ioi.2 $ bot_lt_coe a)]

lemma image_coe_Ioo : (coe : α → with_bot α) '' (Ioo a b) = Ioo a b :=
by rw [← preimage_coe_Ioo, image_preimage_eq_inter_range, range_coe,
  inter_eq_self_of_subset_left (subset.trans Ioo_subset_Ioi_self $ Ioi_subset_Ioi bot_le)]

end with_bot


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.fin2
import tactic.localized

/-!
# Alternate definition of `vector` in terms of `fin2`

This file provides a locale `vector3` which overrides `[a, b, c]` notation to create `vector3` not
`list`.

The `::` notation is overloaded by this file to mean `vector3.cons`.
-/

universes u

open fin2 nat

/-- Alternate definition of `vector` based on `fin2`. -/
def vector3 (α : Type u) (n : ℕ) : Type u := fin2 n → α

namespace vector3

/-- The empty vector -/
@[pattern] def nil {α} : vector3 α 0.

/-- The vector cons operation -/
@[pattern] def cons {α} {n} (a : α) (v : vector3 α n) : vector3 α (succ n) :=
λi, by {refine i.cases' _ _, exact a, exact v}

/- We do not want to make the following notation global, because then these expressions will be
overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
localized "notation `[` l:(foldr `, ` (h t, vector3.cons h t) nil `]`) := l" in vector3
notation a :: b := cons a b

@[simp] theorem cons_fz {α} {n} (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
@[simp] theorem cons_fs {α} {n} (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl

/-- Get the `i`th element of a vector -/
@[reducible] def nth {α} {n} (i : fin2 n) (v : vector3 α n) : α := v i

/-- Construct a vector from a function on `fin2`. -/
@[reducible] def of_fn {α} {n} (f : fin2 n → α) : vector3 α n := f

/-- Get the head of a nonempty vector. -/
def head {α} {n} (v : vector3 α (succ n)) : α := v fz

/-- Get the tail of a nonempty vector. -/
def tail {α} {n} (v : vector3 α (succ n)) : vector3 α n := λi, v (fs i)

theorem eq_nil {α} (v : vector3 α 0) : v = [] :=
funext $ λi, match i with end

theorem cons_head_tail {α} {n} (v : vector3 α (succ n)) : head v :: tail v = v :=
funext $ λi, fin2.cases' rfl (λ_, rfl) i

def nil_elim {α} {C : vector3 α 0 → Sort u} (H : C []) (v : vector3 α 0) : C v :=
by rw eq_nil v; apply H

def cons_elim {α n} {C : vector3 α (succ n) → Sort u} (H : Π (a : α) (t : vector3 α n), C (a :: t))
  (v : vector3 α (succ n)) : C v :=
by rw ← (cons_head_tail v); apply H

@[simp] theorem cons_elim_cons {α n C H a t} : @cons_elim α n C H (a :: t) = H a t := rfl

@[elab_as_eliminator]
protected def rec_on {α} {C : Π {n}, vector3 α n → Sort u} {n} (v : vector3 α n)
  (H0 : C [])
  (Hs : Π {n} (a) (w : vector3 α n), C w → C (a :: w)) : C v :=
nat.rec_on n
  (λv, v.nil_elim H0)
  (λn IH v, v.cons_elim (λa t, Hs _ _ (IH _))) v

@[simp] theorem rec_on_nil {α C H0 Hs} : @vector3.rec_on α @C 0 [] H0 @Hs = H0 :=
rfl

@[simp] theorem rec_on_cons {α C H0 Hs n a v} :
  @vector3.rec_on α @C (succ n) (a :: v) H0 @Hs = Hs a v (@vector3.rec_on α @C n v H0 @Hs) :=
rfl

/-- Append two vectors -/
def append {α} {m} (v : vector3 α m) {n} (w : vector3 α n) : vector3 α (n+m) :=
nat.rec_on m (λ_, w) (λm IH v, v.cons_elim $ λa t, @fin2.cases' (n+m) (λ_, α) a (IH t)) v

local infix ` +-+ `:65 := vector3.append

@[simp] theorem append_nil {α} {n} (w : vector3 α n) : [] +-+ w = w := rfl

@[simp] theorem append_cons {α} (a : α) {m} (v : vector3 α m) {n} (w : vector3 α n) :
  (a::v) +-+ w = a :: (v +-+ w) := rfl

@[simp] theorem append_left {α} : ∀ {m} (i : fin2 m) (v : vector3 α m) {n} (w : vector3 α n),
  (v +-+ w) (left n i) = v i
| ._ (@fz m)   v n w := v.cons_elim (λa t, by simp [*, left])
| ._ (@fs m i) v n w := v.cons_elim (λa t, by simp [*, left])

@[simp] theorem append_add {α} : ∀ {m} (v : vector3 α m) {n} (w : vector3 α n) (i : fin2 n),
  (v +-+ w) (add i m) = w i
| 0        v n w i := rfl
| (succ m) v n w i := v.cons_elim (λa t, by simp [*, add])

/-- Insert `a` into `v` at index `i`. -/
def insert {α} (a : α) {n} (v : vector3 α n) (i : fin2 (succ n)) : vector3 α (succ n) :=
λj, (a :: v) (insert_perm i j)

@[simp] theorem insert_fz {α} (a : α) {n} (v : vector3 α n) : insert a v fz = a :: v :=
by refine funext (λj, j.cases' _ _); intros; refl

@[simp] theorem insert_fs {α} (a : α) {n} (b : α) (v : vector3 α n) (i : fin2 (succ n)) :
  insert a (b :: v) (fs i) = b :: insert a v i :=
funext $ λj, by
{ refine j.cases' _ (λj, _); simp [insert, insert_perm],
  refine fin2.cases' _ _ (insert_perm i j); simp [insert_perm] }

theorem append_insert {α} (a : α) {k} (t : vector3 α k) {n} (v : vector3 α n) (i : fin2 (succ n))
  (e : succ n + k = succ (n + k)) :
  insert a (t +-+ v) (eq.rec_on e (i.add k)) = eq.rec_on e (t +-+ insert a v i) :=
begin
  refine vector3.rec_on t (λe, _) (λk b t IH e, _) e, refl,
  have e' := succ_add n k,
  change insert a (b :: (t +-+ v)) (eq.rec_on (congr_arg succ e') (fs (add i k)))
    = eq.rec_on (congr_arg succ e') (b :: (t +-+ insert a v i)),
  rw ← (eq.drec_on e' rfl : fs (eq.rec_on e' (i.add k) : fin2 (succ (n + k))) = eq.rec_on
    (congr_arg succ e') (fs (i.add k))),
  simp, rw IH, exact eq.drec_on e' rfl
end

end vector3

section vector3
open vector3
open_locale vector3

/-- "Curried" exists, i.e. ∃ x1 ... xn, f [x1, ..., xn] -/
def vector_ex {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∃x : α, vector_ex k (λv, f (x :: v))

/-- "Curried" forall, i.e. ∀ x1 ... xn, f [x1, ..., xn] -/
def vector_all {α} : Π k, (vector3 α k → Prop) → Prop
| 0        f := f []
| (succ k) f := ∀x : α, vector_all k (λv, f (x :: v))

theorem exists_vector_zero {α} (f : vector3 α 0 → Prop) : Exists f ↔ f [] :=
⟨λ⟨v, fv⟩, by rw ← (eq_nil v); exact fv, λf0, ⟨[], f0⟩⟩

theorem exists_vector_succ {α n} (f : vector3 α (succ n) → Prop) : Exists f ↔ ∃x v, f (x :: v) :=
⟨λ⟨v, fv⟩, ⟨_, _, by rw cons_head_tail v; exact fv⟩, λ⟨x, v, fxv⟩, ⟨_, fxv⟩⟩

theorem vector_ex_iff_exists {α} : ∀ {n} (f : vector3 α n → Prop), vector_ex n f ↔ Exists f
| 0        f := (exists_vector_zero f).symm
| (succ n) f := iff.trans (exists_congr (λx, vector_ex_iff_exists _)) (exists_vector_succ f).symm

theorem vector_all_iff_forall {α} : ∀ {n} (f : vector3 α n → Prop), vector_all n f ↔ ∀ v, f v
| 0        f := ⟨λf0 v, v.nil_elim f0, λal, al []⟩
| (succ n) f := (forall_congr (λx, vector_all_iff_forall (λv, f (x :: v)))).trans
  ⟨λal v, v.cons_elim al, λal x v, al (x::v)⟩

/-- `vector_allp p v` is equivalent to `∀ i, p (v i)`, but unfolds directly to a conjunction,
  i.e. `vector_allp p [0, 1, 2] = p 0 ∧ p 1 ∧ p 2`. -/
def vector_allp {α} (p : α → Prop) {n} (v : vector3 α n) : Prop :=
vector3.rec_on v true (λn a v IH, @vector3.rec_on _ (λn v, Prop) _ v (p a) (λn b v' _, p a ∧ IH))

@[simp] theorem vector_allp_nil {α} (p : α → Prop) : vector_allp p [] = true := rfl
@[simp] theorem vector_allp_singleton {α} (p : α → Prop) (x : α) : vector_allp p [x] = p x := rfl
@[simp] theorem vector_allp_cons {α} (p : α → Prop) {n} (x : α) (v : vector3 α n) :
  vector_allp p (x :: v) ↔ p x ∧ vector_allp p v :=
vector3.rec_on v (and_true _).symm (λn a v IH, iff.rfl)

theorem vector_allp_iff_forall {α} (p : α → Prop) {n} (v : vector3 α n) :
  vector_allp p v ↔ ∀ i, p (v i) :=
begin refine v.rec_on _ _,
  { exact ⟨λ_, fin2.elim0, λ_, trivial⟩ },
  { simp, refine λn a v IH, (and_congr_right (λ_, IH)).trans
      ⟨λ⟨pa, h⟩ i, by {refine i.cases' _ _, exacts [pa, h]}, λh, ⟨_, λi, _⟩⟩,
    { have h0 := h fz, simp at h0, exact h0 },
    { have hs := h (fs i), simp at hs, exact hs } }
end

theorem vector_allp.imp {α} {p q : α → Prop} (h : ∀ x, p x → q x)
  {n} {v : vector3 α n} (al : vector_allp p v) : vector_allp q v :=
(vector_allp_iff_forall _ _).2 (λi, h _ $ (vector_allp_iff_forall _ _).1 al _)

end vector3


import ..list ..logic data.rat

instance rat.inhabited : inhabited rat := ⟨0⟩

inductive term_dlo : Type
| var : nat → term_dlo
| cst : rat → term_dlo

notation `V'` := term_dlo.var
notation `C'` r  := term_dlo.cst r

instance term_dlo.decidable_eq : decidable_eq term_dlo := by tactic.mk_dec_eq_instance

-- def term_dlo.decr_idx : term_dlo rat → term_dlo rat
-- | (term_dlo.var rat m) := term_dlo.var rat (m-1)
-- | (term_dlo.cst b) := term_dlo.cst b
--
def term_dlo.incr_idx : term_dlo → term_dlo
| (term_dlo.var m) := term_dlo.var (m+1)
| (term_dlo.cst b) := term_dlo.cst b

def term_dlo.eval (bs : list rat) : term_dlo → rat
| (term_dlo.var n) := list.inth bs n
| (term_dlo.cst r) := r

-- meta def term_dlo.to_format : term_dlo → format
-- | (term_dlo.var m) := "#" ++ to_fmt m
-- | (term_dlo.cst b) := "@" ++ to_fmt b

-- meta instance term_dlo.has_to_format : has_to_format term_dlo :=
-- ⟨term_dlo.to_format⟩

lemma term_dlo.eval_incr_idx_eq {t : term_dlo} {b : rat} {bs} :
t.incr_idx.eval (b::bs) = t.eval bs :=
begin cases t with n b; simp [term_dlo.incr_idx, term_dlo.eval] end

instance dec_eq_term_dlo : decidable_eq term_dlo :=
by tactic.mk_dec_eq_instance

inductive atom_dlo : Type
| lt : term_dlo → term_dlo → atom_dlo
| eq : term_dlo → term_dlo → atom_dlo

def atom_dlo.eval (bs : list rat) : atom_dlo → Prop
| (atom_dlo.lt t1 t2) := term_dlo.eval bs t1 < term_dlo.eval bs t2
| (atom_dlo.eq t1 t2) := term_dlo.eval bs t1 = term_dlo.eval bs t2
-- | (x <' y) := sorry
-- | (x =' y) := sorry

-- meta def atom_dlo.to_format : atom_dlo → format
-- | (atom_dlo.lt t s) := to_fmt t ++ " < " ++ to_fmt s
-- | (atom_dlo.eq t s) := to_fmt t ++ " = " ++ to_fmt s

inductive formula_dlo : Type
| true  : formula_dlo
| false : formula_dlo
| atom : atom_dlo → formula_dlo
| and : formula_dlo → formula_dlo → formula_dlo
| or  : formula_dlo → formula_dlo → formula_dlo
| not : formula_dlo → formula_dlo
| ex  : formula_dlo → formula_dlo
-- | formula_dlo.true := sorry
-- | formula_dlo.false := sorry
-- | (formula_dlo.atom a) := sorry
-- | (formula_dlo.and p q) := sorry
-- | (p ∨' q) := sorry
-- | (¬' p) := sorry
-- | (formula_dlo.ex p) := sorry

notation `⊤'`     := formula_dlo.true
notation `⊥'`     := formula_dlo.false
notation `A'` a   := formula_dlo.atom a
notation `¬'` p   := formula_dlo.not p
notation p `∧'` q := formula_dlo.and p q
notation p `∨'` q := formula_dlo.or p q
notation `∃'` p   := formula_dlo.ex p
notation x `<'` y := atom_dlo.lt x y
notation x `='` y := atom_dlo.eq x y

def formula_dlo.eval : list rat → formula_dlo → Prop
| as formula_dlo.true := _root_.true
| as formula_dlo.false := _root_.false
| as (formula_dlo.atom a) := a.eval as
| as (formula_dlo.not φ)   := ¬ (formula_dlo.eval as φ)
| as (formula_dlo.or φ ψ)  := (formula_dlo.eval as φ) ∨ (formula_dlo.eval as ψ)
| as (formula_dlo.and φ ψ) := (formula_dlo.eval as φ) ∧ (formula_dlo.eval as ψ)
| as (formula_dlo.ex φ) := ∃ d, formula_dlo.eval (d::as) φ

lemma eval_true  {xs : list rat} : formula_dlo.true.eval xs ↔ _root_.true :=
by simp [formula_dlo.eval]

lemma eval_not {p : formula_dlo} (xs : list rat) :
(p.not).eval xs ↔ ¬ (p.eval xs) := iff.refl _

lemma eval_not_false {p : formula_dlo} (xs : list rat) :
(formula_dlo.false.not).eval xs ↔ _root_.true :=
begin simp [formula_dlo.eval] end

lemma eval_not_or {p q : formula_dlo} {xs : list rat} :
((formula_dlo.or p q).not).eval xs ↔ ((p.not).eval xs ∧ (q.not).eval xs) :=
begin simp [formula_dlo.eval, eval_not, not_or_distrib] end

lemma eval_not_and {p q : formula_dlo} {xs : list rat} :
((formula_dlo.and p q).not).eval xs ↔ ((p.not).eval xs ∨ (q.not).eval xs) :=
begin
  simp only [formula_dlo.eval, eval_not ],
  rw (@not_and_distrib _ _ (classical.dec _))
end

lemma eval_or {p q : formula_dlo} (xs : list rat) :
(formula_dlo.or p q).eval xs = (p.eval xs ∨ q.eval xs) := eq.refl _

lemma eval_and {p q : formula_dlo} {xs : list rat} :
(formula_dlo.and p q).eval xs = (p.eval xs ∧ q.eval xs) := eq.refl _

lemma eval_le {t s : term_dlo} {rs : list rat} :
(atom_dlo.lt t s).eval rs ↔ (t.eval rs < s.eval rs) := iff.refl _

lemma eval_false {xs : list rat} : formula_dlo.false.eval xs ↔ _root_.false :=
by simp [formula_dlo.eval]

lemma eval_ex {p : formula_dlo} (xs) : p.ex.eval xs = ∃ x, (p.eval (x::xs)) :=
begin simp [formula_dlo.eval] end

open rat

def not_o : formula_dlo → formula_dlo
| formula_dlo.true := formula_dlo.false
| formula_dlo.false := formula_dlo.true
| p := p.not

def and_o : formula_dlo → formula_dlo → formula_dlo
| (formula_dlo.true) q' := q'
| p' (formula_dlo.true) := p'
| (formula_dlo.false) q' := formula_dlo.false
| p' (formula_dlo.false) := formula_dlo.false
| p' q' := formula_dlo.and p' q'

def or_o : formula_dlo → formula_dlo → formula_dlo
| (formula_dlo.true ) _ := formula_dlo.true
| _ (formula_dlo.true ) := formula_dlo.true
| (formula_dlo.false ) q := q
| p (formula_dlo.false ) := p
| p q := formula_dlo.or p q

lemma eval_not_o {p : formula_dlo} (xs : list rat) :
  (not_o p).eval xs ↔ ¬(p.eval xs) :=
begin cases p; simp [not_o, formula_dlo.eval] end

lemma eval_or_o {p q : formula_dlo} (xs : list rat) :
(or_o p q).eval xs ↔ (p.eval xs ∨ q.eval xs) :=
begin cases p; cases q; simp [or_o, formula_dlo.eval] end

lemma eval_and_o {p q : formula_dlo} (xs : list rat) :
(and_o p q).eval xs ↔ (p.eval xs ∧ q.eval xs) :=
begin cases p; cases q; simp [and_o, formula_dlo.eval] end

-- Requires : qfree arg-0
def formula_dlo.map (f : atom_dlo → atom_dlo) : formula_dlo → formula_dlo
| formula_dlo.true := formula_dlo.true
| formula_dlo.false := formula_dlo.false
| (formula_dlo.atom a) := formula_dlo.atom (f a)
| (formula_dlo.not p) := p.map.not
| (formula_dlo.or p q) :=  formula_dlo.or p.map q.map
| (formula_dlo.and p q) :=  formula_dlo.and p.map q.map
| (formula_dlo.ex p) := formula_dlo.false

def conj  : list (formula_dlo) → formula_dlo
| [] := formula_dlo.true
| (p::ps) := and_o p $ conj ps

def conj_atom  : list (atom_dlo) → formula_dlo
| [] := formula_dlo.true
| (a::as) := and_o (formula_dlo.atom a) $ conj_atom as

def disj : list (formula_dlo) → formula_dlo
| [] := formula_dlo.false
| (p::ps) := or_o p $ disj ps

lemma eval_disj {xs : list rat} :
  ∀ {ps : list (formula_dlo)}, (disj ps).eval xs ↔ (∃ p : formula_dlo, p ∈ ps ∧ p.eval xs)
| [] := begin simp [disj, formula_dlo.eval] end
| (p::ps) :=
  begin
    rw [list.forsome_mem_cons], simp [disj, eval_or_o],
    apply or_iff_or iff.rfl eval_disj
  end

def disj_map {β : Type} (bs : list β) (p : β → formula_dlo) := disj (list.map p bs)

lemma eval_disj_map {β : Type} (as : list β)
  (p : β → formula_dlo) {ds : list rat} :
  (disj_map as p).eval ds ↔ ∃ a, a ∈ as ∧ (p a).eval ds :=
begin
  simp [disj_map, eval_disj],
  constructor; intro h; cases h with x hx; cases hx with hx1 hx2,
  { cases hx1 with a ha, cases ha with ha1 ha2, subst ha2,
    existsi a, constructor; assumption },
  { existsi (p x), constructor, existsi x,
    constructor, assumption, refl, assumption }
end

lemma cases_not_o (P : formula_dlo → Prop) (p : formula_dlo)
  (HT : P formula_dlo.true) (Hp : P formula_dlo.false) (Hq : P (p.not)) : P (not_o p) :=
begin cases p; try {simp [not_o], assumption} end

lemma cases_or_o (P : formula_dlo → Prop) (p q : formula_dlo)
  (HT : P formula_dlo.true) (Hp : P p) (Hq : P q) (Hpq : P (formula_dlo.or p q)) : P (or_o p q) :=
begin cases p; cases q; try {simp [or_o], assumption} end

lemma cases_and_o (P : formula_dlo → Prop) (p q : formula_dlo)
  (HB : P formula_dlo.false) (Hp : P p) (Hq : P q) (Hpq : P (formula_dlo.and p q)) : P (and_o p q) :=
begin cases p; cases q; try {simp [and_o], assumption} end

-- meta def formula_dlo.to_format  : formula_dlo → format
-- | (formula_dlo.true)  := "⊤"
-- | (formula_dlo.false) := "⊥"
-- | (formula_dlo.atom a) := a.to_format
-- | (formula_dlo.and p q) := "(" ++ (formula_dlo.to_format p) ++ " ∧ " ++ (formula_dlo.to_format q) ++ ")"
-- | (formula_dlo.or p q)  := "(" ++ (formula_dlo.to_format p) ++ " ∨ " ++ (formula_dlo.to_format q) ++ ")"
-- | (formula_dlo.not p)  := "¬(" ++ (formula_dlo.to_format p) ++ ")"
-- | (formula_dlo.ex p)   := "∃(" ++ (formula_dlo.to_format p) ++ ")"

-- meta instance formula_dlo.has_to_format : has_to_format (formula_dlo) := ⟨formula_dlo.to_format⟩
--
-- meta instance formula_dlo.has_to_tactic_format : has_to_tactic_format (formula_dlo) :=
-- has_to_format_to_has_to_tactic_format _

instance atom_dlo.decidable_eq : decidable_eq atom_dlo := by tactic.mk_dec_eq_instance

instance dec_aval {as a} : decidable (atom_dlo.eval as a) :=
begin cases a; {simp [atom_dlo.eval], apply_instance} end

def avals (bs : list rat) (as : list atom_dlo) : Prop :=
∀ a ∈ as, atom_dlo.eval bs a

lemma eval_conj {xs : list rat} :
  ∀ {ps : list formula_dlo}, formula_dlo.eval xs (conj ps) ↔ (∀ p ∈ ps, formula_dlo.eval xs p)
| [] := begin simp [conj, formula_dlo.eval] end
| (p::ps) :=
  begin
    simp [conj, eval_and_o],
    apply and_iff_and iff.rfl eval_conj
  end

lemma eval_conj_atom {xs : list rat} :
  ∀ {as : list atom_dlo}, (conj_atom as).eval xs ↔ (∀ a ∈ as, atom_dlo.eval xs a)
| [] := begin simp [conj_atom] end
| (a::as) :=
  begin simp [conj_atom, eval_and_o, atom_dlo.eval,
   eval_conj_atom, formula_dlo.eval] end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov

! This file was ported from Lean 3 source module order.filter.cofinite
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.AtTopBot
import Mathlib.Order.Filter.Pi

/-!
# The cofinite filter

In this file we define

`Filter.cofinite`: the filter of sets with finite complement

and prove its basic properties. In particular, we prove that for `ℕ` it is equal to `Filter.atTop`.

## TODO

Define filters for other cardinalities of the complement.
-/

open Set Function

variable {ι α β : Type _} {l : Filter α}

namespace Filter

/-- The cofinite filter is the filter of subsets whose complements are finite. -/
def cofinite : Filter α where
  sets := { s | sᶜ.Finite }
  univ_sets := by simp only [compl_univ, finite_empty, mem_setOf_eq]
  sets_of_superset hs st := hs.subset <| compl_subset_compl.2 st
  inter_sets hs ht := by simpa only [compl_inter, mem_setOf_eq] using hs.union ht
#align filter.cofinite Filter.cofinite

@[simp]
theorem mem_cofinite {s : Set α} : s ∈ @cofinite α ↔ sᶜ.Finite :=
  Iff.rfl
#align filter.mem_cofinite Filter.mem_cofinite

@[simp]
theorem eventually_cofinite {p : α → Prop} : (∀ᶠ x in cofinite, p x) ↔ { x | ¬p x }.Finite :=
  Iff.rfl
#align filter.eventually_cofinite Filter.eventually_cofinite

theorem hasBasis_cofinite : HasBasis cofinite (fun s : Set α => s.Finite) compl :=
  ⟨fun s =>
    ⟨fun h => ⟨sᶜ, h, (compl_compl s).subset⟩, fun ⟨_t, htf, hts⟩ =>
      htf.subset <| compl_subset_comm.2 hts⟩⟩
#align filter.has_basis_cofinite Filter.hasBasis_cofinite

instance cofinite_neBot [Infinite α] : NeBot (@cofinite α) :=
  hasBasis_cofinite.neBot_iff.2 fun hs => hs.infinite_compl.nonempty
#align filter.cofinite_ne_bot Filter.cofinite_neBot

@[simp]
theorem cofinite_eq_bot_iff : @cofinite α = ⊥ ↔ Finite α := by
  simp [← empty_mem_iff_bot, finite_univ_iff]

@[simp]
theorem cofinite_eq_bot [Finite α] : @cofinite α = ⊥ := cofinite_eq_bot_iff.2 ‹_›

theorem frequently_cofinite_iff_infinite {p : α → Prop} :
    (∃ᶠ x in cofinite, p x) ↔ Set.Infinite { x | p x } := by
  simp only [Filter.Frequently, Filter.Eventually, mem_cofinite, compl_setOf, not_not,
    Set.Infinite]
#align filter.frequently_cofinite_iff_infinite Filter.frequently_cofinite_iff_infinite

theorem _root_.Set.Finite.compl_mem_cofinite {s : Set α} (hs : s.Finite) : sᶜ ∈ @cofinite α :=
  mem_cofinite.2 <| (compl_compl s).symm ▸ hs
#align set.finite.compl_mem_cofinite Set.Finite.compl_mem_cofinite

theorem _root_.Set.Finite.eventually_cofinite_nmem {s : Set α} (hs : s.Finite) :
    ∀ᶠ x in cofinite, x ∉ s :=
  hs.compl_mem_cofinite
#align set.finite.eventually_cofinite_nmem Set.Finite.eventually_cofinite_nmem

theorem _root_.Finset.eventually_cofinite_nmem (s : Finset α) : ∀ᶠ x in cofinite, x ∉ s :=
  s.finite_toSet.eventually_cofinite_nmem
#align finset.eventually_cofinite_nmem Finset.eventually_cofinite_nmem

theorem _root_.Set.infinite_iff_frequently_cofinite {s : Set α} :
    Set.Infinite s ↔ ∃ᶠ x in cofinite, x ∈ s :=
  frequently_cofinite_iff_infinite.symm
#align set.infinite_iff_frequently_cofinite Set.infinite_iff_frequently_cofinite

theorem eventually_cofinite_ne (x : α) : ∀ᶠ a in cofinite, a ≠ x :=
  (Set.finite_singleton x).eventually_cofinite_nmem
#align filter.eventually_cofinite_ne Filter.eventually_cofinite_ne

theorem le_cofinite_iff_compl_singleton_mem : l ≤ cofinite ↔ ∀ x, {x}ᶜ ∈ l := by
  refine' ⟨fun h x => h (finite_singleton x).compl_mem_cofinite, fun h s (hs : sᶜ.Finite) => _⟩
  rw [← compl_compl s, ← bunionᵢ_of_singleton (sᶜ), compl_unionᵢ₂, Filter.binterᵢ_mem hs]
  exact fun x _ => h x
#align filter.le_cofinite_iff_compl_singleton_mem Filter.le_cofinite_iff_compl_singleton_mem

theorem le_cofinite_iff_eventually_ne : l ≤ cofinite ↔ ∀ x, ∀ᶠ y in l, y ≠ x :=
  le_cofinite_iff_compl_singleton_mem
#align filter.le_cofinite_iff_eventually_ne Filter.le_cofinite_iff_eventually_ne

/-- If `α` is a preorder with no maximal element, then `atTop ≤ cofinite`. -/

theorem comap_cofinite_le (f : α → β) : comap f cofinite ≤ cofinite :=
  le_cofinite_iff_eventually_ne.mpr fun x =>
    mem_comap.2 ⟨{f x}ᶜ, (finite_singleton _).compl_mem_cofinite, fun _ => ne_of_apply_ne f⟩
#align filter.comap_cofinite_le Filter.comap_cofinite_le

/-- The coproduct of the cofinite filters on two types is the cofinite filter on their product. -/
theorem coprod_cofinite : (cofinite : Filter α).coprod (cofinite : Filter β) = cofinite :=
  Filter.coext fun s => by
    simp only [compl_mem_coprod, mem_cofinite, compl_compl, finite_image_fst_and_snd_iff]
#align filter.coprod_cofinite Filter.coprod_cofinite

theorem coprodᵢ_cofinite {α : ι → Type _} [Finite ι] :
    (Filter.coprodᵢ fun i => (cofinite : Filter (α i))) = cofinite :=
  Filter.coext fun s => by
    simp only [compl_mem_coprodᵢ, mem_cofinite, compl_compl, forall_finite_image_eval_iff]
set_option linter.uppercaseLean3 false in
#align filter.Coprod_cofinite Filter.coprodᵢ_cofinite

@[simp]
theorem disjoint_cofinite_left : Disjoint cofinite l ↔ ∃ s ∈ l, Set.Finite s := by
  simp only [hasBasis_cofinite.disjoint_iff l.basis_sets, id, disjoint_compl_left_iff_subset]
  exact ⟨fun ⟨s, hs, t, ht, hts⟩ => ⟨t, ht, hs.subset hts⟩,
    fun ⟨s, hs, hsf⟩ => ⟨s, hsf, s, hs, Subset.rfl⟩⟩
#align filter.disjoint_cofinite_left Filter.disjoint_cofinite_left

@[simp]
theorem disjoint_cofinite_right : Disjoint l cofinite ↔ ∃ s ∈ l, Set.Finite s :=
  disjoint_comm.trans disjoint_cofinite_left
#align filter.disjoint_cofinite_right Filter.disjoint_cofinite_right

end Filter

open Filter

/-- For natural numbers the filters `Filter.cofinite` and `Filter.atTop` coincide. -/
theorem Nat.cofinite_eq_atTop : @cofinite ℕ = atTop := by
  refine' le_antisymm _ atTop_le_cofinite
  refine' atTop_basis.ge_iff.2 fun N _ => _
  simpa only [mem_cofinite, compl_Ici] using finite_lt_nat N
#align nat.cofinite_eq_at_top Nat.cofinite_eq_atTop

theorem Nat.frequently_atTop_iff_infinite {p : ℕ → Prop} :
    (∃ᶠ n in atTop, p n) ↔ Set.Infinite { n | p n } := by
  rw [← Nat.cofinite_eq_atTop, frequently_cofinite_iff_infinite]
#align nat.frequently_at_top_iff_infinite Nat.frequently_atTop_iff_infinite

theorem Filter.Tendsto.exists_within_forall_le {α β : Type _} [LinearOrder β] {s : Set α}
    (hs : s.Nonempty) {f : α → β} (hf : Filter.Tendsto f Filter.cofinite Filter.atTop) :
    ∃ a₀ ∈ s, ∀ a ∈ s, f a₀ ≤ f a := by
  rcases em (∃ y ∈ s, ∃ x, f y < x) with (⟨y, hys, x, hx⟩ | not_all_top)
  · -- the set of points `{y | f y < x}` is nonempty and finite, so we take `min` over this set
    have : { y | ¬x ≤ f y }.Finite := Filter.eventually_cofinite.mp (tendsto_atTop.1 hf x)
    simp only [not_le] at this
    obtain ⟨a₀, ⟨ha₀ : f a₀ < x, ha₀s⟩, others_bigger⟩ :=
      exists_min_image _ f (this.inter_of_left s) ⟨y, hx, hys⟩
    refine' ⟨a₀, ha₀s, fun a has => (lt_or_le (f a) x).elim _ (le_trans ha₀.le)⟩
    exact fun h => others_bigger a ⟨h, has⟩
  · -- in this case, f is constant because all values are at top
    push_neg  at not_all_top
    obtain ⟨a₀, ha₀s⟩ := hs
    exact ⟨a₀, ha₀s, fun a ha => not_all_top a ha (f a₀)⟩
#align filter.tendsto.exists_within_forall_le Filter.Tendsto.exists_within_forall_le

theorem Filter.Tendsto.exists_forall_le [Nonempty α] [LinearOrder β] {f : α → β}
    (hf : Tendsto f cofinite atTop) : ∃ a₀, ∀ a, f a₀ ≤ f a :=
  let ⟨a₀, _, ha₀⟩ := hf.exists_within_forall_le univ_nonempty
  ⟨a₀, fun a => ha₀ a (mem_univ _)⟩
#align filter.tendsto.exists_forall_le Filter.Tendsto.exists_forall_le

theorem Filter.Tendsto.exists_within_forall_ge [LinearOrder β] {s : Set α} (hs : s.Nonempty)
    {f : α → β} (hf : Filter.Tendsto f Filter.cofinite Filter.atBot) :
    ∃ a₀ ∈ s, ∀ a ∈ s, f a ≤ f a₀ :=
  @Filter.Tendsto.exists_within_forall_le _ βᵒᵈ _ _ hs _ hf
#align filter.tendsto.exists_within_forall_ge Filter.Tendsto.exists_within_forall_ge

theorem Filter.Tendsto.exists_forall_ge [Nonempty α] [LinearOrder β] {f : α → β}
    (hf : Tendsto f cofinite atBot) : ∃ a₀, ∀ a, f a ≤ f a₀ :=
  @Filter.Tendsto.exists_forall_le _ βᵒᵈ _ _ _ hf
#align filter.tendsto.exists_forall_ge Filter.Tendsto.exists_forall_ge

theorem Function.Surjective.le_map_cofinite {f : α → β} (hf : Surjective f) :
    cofinite ≤ map f cofinite := fun _ h => .of_preimage h hf

/-- For an injective function `f`, inverse images of finite sets are finite. See also
`Filter.comap_cofinite_le` and `Function.Injective.comap_cofinite_eq`. -/
theorem Function.Injective.tendsto_cofinite {f : α → β} (hf : Injective f) :
    Tendsto f cofinite cofinite := fun _ h => h.preimage (hf.injOn _)
#align function.injective.tendsto_cofinite Function.Injective.tendsto_cofinite

/-- The pullback of the `Filter.cofinite` under an injective function is equal to `Filter.cofinite`.
See also `Filter.comap_cofinite_le` and `Function.Injective.tendsto_cofinite`. -/
theorem Function.Injective.comap_cofinite_eq {f : α → β} (hf : Injective f) :
    comap f cofinite = cofinite :=
  (comap_cofinite_le f).antisymm hf.tendsto_cofinite.le_comap
#align function.injective.comap_cofinite_eq Function.Injective.comap_cofinite_eq

/-- An injective sequence `f : ℕ → ℕ` tends to infinity at infinity. -/
theorem Function.Injective.nat_tendsto_atTop {f : ℕ → ℕ} (hf : Injective f) :
    Tendsto f atTop atTop :=
  Nat.cofinite_eq_atTop ▸ hf.tendsto_cofinite
#align function.injective.nat_tendsto_at_top Function.Injective.nat_tendsto_atTop


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.finset.basic
import data.set.pairwise
import logic.encodable.basic

/-!
# Lattice operations on encodable types

Lemmas about lattice and set operations on encodable types

## Implementation Notes

This is a separate file, to avoid unnecessary imports in basic files.

Previously some of these results were in the `measure_theory` folder.
-/

open set

namespace encodable

variables {α : Type*} {β : Type*} [encodable β]

lemma supr_decode₂ [complete_lattice α] (f : β → α) :
  (⨆ (i : ℕ) (b ∈ decode₂ β i), f b) = (⨆ b, f b) :=
by { rw [supr_comm], simp [mem_decode₂] }

lemma Union_decode₂ (f : β → set α) : (⋃ (i : ℕ) (b ∈ decode₂ β i), f b) = (⋃ b, f b) :=
supr_decode₂ f

@[elab_as_eliminator] lemma Union_decode₂_cases
  {f : β → set α} {C : set α → Prop}
  (H0 : C ∅) (H1 : ∀ b, C (f b)) {n} :
  C (⋃ b ∈ decode₂ β n, f b) :=
match decode₂ β n with
| none := by { simp, apply H0 }
| (some b) := by { convert H1 b, simp [ext_iff] }
end

theorem Union_decode₂_disjoint_on {f : β → set α} (hd : pairwise (disjoint on f)) :
  pairwise (disjoint on λ i, ⋃ b ∈ decode₂ β i, f b) :=
begin
  rintro i j ij x,
  suffices : ∀ a, encode a = i → x ∈ f a → ∀ b, encode b = j → x ∉ f b, by simpa [decode₂_eq_some],
  rintro a rfl ha b rfl hb,
  exact hd a b (mt (congr_arg encode) ij) ⟨ha, hb⟩
end

end encodable

namespace finset

lemma nonempty_encodable {α} (t : finset α) : nonempty $ encodable {i // i ∈ t} :=
begin
  classical, induction t using finset.induction with x t hx ih,
  { refine ⟨⟨λ _, 0, λ _, none, λ ⟨x,y⟩, y.rec _⟩⟩ },
  { cases ih with ih, exactI ⟨encodable.of_equiv _ (finset.subtype_insert_equiv_option hx)⟩ }
end

end finset


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

! This file was ported from Lean 3 source module group_theory.group_action.support
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Pointwise.Smul

/-!
# Support of an element under an action action

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

Given an action of a group `G` on a type `α`, we say that a set `s : set α` supports an element
`a : α` if, for all `g` that fix `s` pointwise, `g` fixes `a`.

This is crucial in Fourier-Motzkin constructions.
-/

open Pointwise

variable {G H α β : Type _}

namespace MulAction

section SMul

variable (G) [SMul G α] [SMul G β]

#print MulAction.Supports /-
/-- A set `s` supports `b` if `g • b = b` whenever `g • a = a` for all `a ∈ s`. -/
@[to_additive "A set `s` supports `b` if `g +ᵥ b = b` whenever `g +ᵥ a = a` for all `a ∈ s`."]
def Supports (s : Set α) (b : β) :=
  ∀ g : G, (∀ ⦃a⦄, a ∈ s → g • a = a) → g • b = b
#align mul_action.supports MulAction.Supports
#align add_action.supports AddAction.Supports
-/

variable {s t : Set α} {a : α} {b : β}

#print MulAction.supports_of_mem /-
@[to_additive]
theorem supports_of_mem (ha : a ∈ s) : Supports G s a := fun g h => h ha
#align mul_action.supports_of_mem MulAction.supports_of_mem
#align add_action.supports_of_mem AddAction.supports_of_mem
-/

variable {G}

/- warning: mul_action.supports.mono -> MulAction.Supports.mono is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u2} G α] [_inst_2 : SMul.{u1, u3} G β] {s : Set.{u2} α} {t : Set.{u2} α} {b : β}, (HasSubset.Subset.{u2} (Set.{u2} α) (Set.hasSubset.{u2} α) s t) -> (MulAction.Supports.{u1, u2, u3} G α β _inst_1 _inst_2 s b) -> (MulAction.Supports.{u1, u2, u3} G α β _inst_1 _inst_2 t b)
but is expected to have type
  forall {G : Type.{u2}} {α : Type.{u3}} {β : Type.{u1}} [_inst_1 : SMul.{u2, u3} G α] [_inst_2 : SMul.{u2, u1} G β] {s : Set.{u3} α} {t : Set.{u3} α} {b : β}, (HasSubset.Subset.{u3} (Set.{u3} α) (Set.instHasSubsetSet.{u3} α) s t) -> (MulAction.Supports.{u2, u3, u1} G α β _inst_1 _inst_2 s b) -> (MulAction.Supports.{u2, u3, u1} G α β _inst_1 _inst_2 t b)
Case conversion may be inaccurate. Consider using '#align mul_action.supports.mono MulAction.Supports.monoₓ'. -/
@[to_additive]
theorem Supports.mono (h : s ⊆ t) (hs : Supports G s b) : Supports G t b := fun g hg =>
  hs _ fun a ha => hg <| h ha
#align mul_action.supports.mono MulAction.Supports.mono
#align add_action.supports.mono AddAction.Supports.mono

end SMul

variable [Group H] [SMul G α] [SMul G β] [MulAction H α] [SMul H β] [SMulCommClass G H β]
  [SMulCommClass G H α] {s t : Set α} {b : β}

/- warning: mul_action.supports.smul -> MulAction.Supports.smul is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} {H : Type.{u2}} {α : Type.{u3}} {β : Type.{u4}} [_inst_1 : Group.{u2} H] [_inst_2 : SMul.{u1, u3} G α] [_inst_3 : SMul.{u1, u4} G β] [_inst_4 : MulAction.{u2, u3} H α (DivInvMonoid.toMonoid.{u2} H (Group.toDivInvMonoid.{u2} H _inst_1))] [_inst_5 : SMul.{u2, u4} H β] [_inst_6 : SMulCommClass.{u1, u2, u4} G H β _inst_3 _inst_5] [_inst_7 : SMulCommClass.{u1, u2, u3} G H α _inst_2 (MulAction.toHasSmul.{u2, u3} H α (DivInvMonoid.toMonoid.{u2} H (Group.toDivInvMonoid.{u2} H _inst_1)) _inst_4)] {s : Set.{u3} α} {b : β} (g : H), (MulAction.Supports.{u1, u3, u4} G α β _inst_2 _inst_3 s b) -> (MulAction.Supports.{u1, u3, u4} G α β _inst_2 _inst_3 (SMul.smul.{u2, u3} H (Set.{u3} α) (Set.smulSet.{u2, u3} H α (MulAction.toHasSmul.{u2, u3} H α (DivInvMonoid.toMonoid.{u2} H (Group.toDivInvMonoid.{u2} H _inst_1)) _inst_4)) g s) (SMul.smul.{u2, u4} H β _inst_5 g b))
but is expected to have type
  forall {G : Type.{u4}} {H : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_1 : Group.{u1} H] [_inst_2 : SMul.{u4, u3} G α] [_inst_3 : SMul.{u4, u2} G β] [_inst_4 : MulAction.{u1, u3} H α (DivInvMonoid.toMonoid.{u1} H (Group.toDivInvMonoid.{u1} H _inst_1))] [_inst_5 : SMul.{u1, u2} H β] [_inst_6 : SMulCommClass.{u4, u1, u2} G H β _inst_3 _inst_5] [_inst_7 : SMulCommClass.{u4, u1, u3} G H α _inst_2 (MulAction.toSMul.{u1, u3} H α (DivInvMonoid.toMonoid.{u1} H (Group.toDivInvMonoid.{u1} H _inst_1)) _inst_4)] {s : Set.{u3} α} {b : β} (g : H), (MulAction.Supports.{u4, u3, u2} G α β _inst_2 _inst_3 s b) -> (MulAction.Supports.{u4, u3, u2} G α β _inst_2 _inst_3 (HSMul.hSMul.{u1, u3, u3} H (Set.{u3} α) (Set.{u3} α) (instHSMul.{u1, u3} H (Set.{u3} α) (Set.smulSet.{u1, u3} H α (MulAction.toSMul.{u1, u3} H α (DivInvMonoid.toMonoid.{u1} H (Group.toDivInvMonoid.{u1} H _inst_1)) _inst_4))) g s) (HSMul.hSMul.{u1, u2, u2} H β β (instHSMul.{u1, u2} H β _inst_5) g b))
Case conversion may be inaccurate. Consider using '#align mul_action.supports.smul MulAction.Supports.smulₓ'. -/
-- TODO: This should work without `smul_comm_class`
@[to_additive]
theorem Supports.smul (g : H) (h : Supports G s b) : Supports G (g • s) (g • b) :=
  by
  rintro g' hg'
  rw [smul_comm, h]
  rintro a ha
  have := Set.ball_image_iff.1 hg' a ha
  rwa [smul_comm, smul_left_cancel_iff] at this
#align mul_action.supports.smul MulAction.Supports.smul
#align add_action.supports.vadd AddAction.Supports.vadd

end MulAction


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

import linear_algebra.dimension
import linear_algebra.finite_dimensional
import linear_algebra.std_basis

/-!
# Linear structures on function with finite support `ι →₀ M`

This file contains results on the `R`-module structure on functions of finite support from a type
`ι` to an `R`-module `M`, in particular in the case that `R` is a field.

Furthermore, it contains some facts about isomorphisms of vector spaces from equality of dimension
as well as the cardinality of finite dimensional vector spaces.

## TODO

Move the second half of this file to more appropriate other files.
-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open set linear_map submodule
open_locale cardinal

universes u v w

namespace finsupp

section ring
variables {R : Type*} {M : Type*} {ι : Type*}
variables [ring R] [add_comm_group M] [module R M]

lemma linear_independent_single {φ : ι → Type*}
  {f : Π ι, φ ι → M} (hf : ∀i, linear_independent R (f i)) :
  linear_independent R (λ ix : Σ i, φ i, single ix.1 (f ix.1 ix.2)) :=
begin
  apply @linear_independent_Union_finite R _ _ _ _ ι φ (λ i x, single i (f i x)),
  { assume i,
    have h_disjoint : disjoint (span R (range (f i))) (ker (lsingle i)),
    { rw ker_lsingle,
      exact disjoint_bot_right },
    apply (hf i).map h_disjoint },
  { intros i t ht hit,
    refine (disjoint_lsingle_lsingle {i} t (disjoint_singleton_left.2 hit)).mono _ _,
    { rw span_le,
      simp only [supr_singleton],
      rw range_coe,
      apply range_comp_subset_range },
    { refine supr_le_supr (λ i, supr_le_supr _),
      intros hi,
      rw span_le,
      rw range_coe,
      apply range_comp_subset_range } }
end

open linear_map submodule

/-- The basis on `ι →₀ M` with basis vectors `λ ⟨i, x⟩, single i (b i x)`. -/
protected def basis {φ : ι → Type*} (b : ∀ i, basis (φ i) R M) :
  basis (Σ i, φ i) R (ι →₀ M) :=
basis.of_repr
  { to_fun := λ g,
      { to_fun := λ ix, (b ix.1).repr (g ix.1) ix.2,
        support := g.support.sigma (λ i, ((b i).repr (g i)).support),
        mem_support_to_fun := λ ix,
          by { simp only [finset.mem_sigma, mem_support_iff, and_iff_right_iff_imp, ne.def],
               intros b hg,
               simpa [hg] using b } },
    inv_fun := λ g,
      { to_fun := λ i, (b i).repr.symm (g.comap_domain _
                          (set.inj_on_of_injective sigma_mk_injective _)),
        support := g.support.image sigma.fst,
        mem_support_to_fun := λ i,
          by { rw [ne.def, ← (b i).repr.injective.eq_iff, (b i).repr.apply_symm_apply, ext_iff],
               simp only [exists_prop, linear_equiv.map_zero, comap_domain_apply, zero_apply,
                  exists_and_distrib_right, mem_support_iff, exists_eq_right, sigma.exists,
                  finset.mem_image, not_forall] } },
    left_inv := λ g,
      by { ext i, rw ← (b i).repr.injective.eq_iff, ext x,
           simp only [coe_mk, linear_equiv.apply_symm_apply, comap_domain_apply] },
    right_inv := λ g,
      by { ext ⟨i, x⟩,
           simp only [coe_mk, linear_equiv.apply_symm_apply, comap_domain_apply] },
    map_add' := λ g h, by { ext ⟨i, x⟩, simp only [coe_mk, add_apply, linear_equiv.map_add] },
    map_smul' := λ c h, by { ext ⟨i, x⟩, simp only [coe_mk, smul_apply, linear_equiv.map_smul,
                                                    ring_hom.id_apply] } }

@[simp] lemma basis_repr {φ : ι → Type*} (b : ∀ i, basis (φ i) R M)
  (g : ι →₀ M) (ix) :
  (finsupp.basis b).repr g ix = (b ix.1).repr (g ix.1) ix.2 :=
rfl

@[simp] lemma coe_basis {φ : ι → Type*} (b : ∀ i, basis (φ i) R M) :
  ⇑(finsupp.basis b) = λ (ix : Σ i, φ i), single ix.1 (b ix.1 ix.2) :=
funext $ λ ⟨i, x⟩, basis.apply_eq_iff.mpr $
begin
  ext ⟨j, y⟩,
  by_cases h : i = j,
  { cases h,
    simp only [basis_repr, single_eq_same, basis.repr_self,
               basis.finsupp.single_apply_left sigma_mk_injective] },
  simp only [basis_repr, single_apply, h, false_and, if_false, linear_equiv.map_zero, zero_apply]
end

/-- The basis on `ι →₀ M` with basis vectors `λ i, single i 1`. -/
@[simps]
protected def basis_single_one :
  basis ι R (ι →₀ R) :=
basis.of_repr (linear_equiv.refl _ _)

@[simp] lemma coe_basis_single_one :
  (finsupp.basis_single_one : ι → (ι →₀ R)) = λ i, finsupp.single i 1 :=
funext $ λ i, basis.apply_eq_iff.mpr rfl

end ring

section dim
variables {K : Type u} {V : Type v} {ι : Type v}
variables [field K] [add_comm_group V] [module K V]

lemma dim_eq : module.rank K (ι →₀ V) = #ι * module.rank K V :=
begin
  let bs := basis.of_vector_space K V,
  rw [← bs.mk_eq_dim'', ← (finsupp.basis (λa:ι, bs)).mk_eq_dim'',
    cardinal.mk_sigma, cardinal.sum_const']
end

end dim

end finsupp

section module
variables {K : Type u} {V V₁ V₂ : Type v} {V' : Type w}
variables [field K]
variables [add_comm_group V] [module K V]
variables [add_comm_group V₁] [module K V₁]
variables [add_comm_group V₂] [module K V₂]
variables [add_comm_group V'] [module K V']

open module

lemma equiv_of_dim_eq_lift_dim
  (h : cardinal.lift.{w} (module.rank K V) = cardinal.lift.{v} (module.rank K V')) :
  nonempty (V ≃ₗ[K] V') :=
begin
  haveI := classical.dec_eq V,
  haveI := classical.dec_eq V',
  let m := basis.of_vector_space K V,
  let m' := basis.of_vector_space K V',
  rw [←cardinal.lift_inj.1 m.mk_eq_dim, ←cardinal.lift_inj.1 m'.mk_eq_dim] at h,
  rcases quotient.exact h with ⟨e⟩,
  let e := (equiv.ulift.symm.trans e).trans equiv.ulift,
  exact ⟨(m.repr ≪≫ₗ (finsupp.dom_lcongr e)) ≪≫ₗ m'.repr.symm⟩
end

/-- Two `K`-vector spaces are equivalent if their dimension is the same. -/
def equiv_of_dim_eq_dim (h : module.rank K V₁ = module.rank K V₂) : V₁ ≃ₗ[K] V₂ :=
begin
  classical,
  exact classical.choice (equiv_of_dim_eq_lift_dim (cardinal.lift_inj.2 h))
end

/-- An `n`-dimensional `K`-vector space is equivalent to `fin n → K`. -/
def fin_dim_vectorspace_equiv (n : ℕ)
  (hn : (module.rank K V) = n) : V ≃ₗ[K] (fin n → K) :=
begin
  have : cardinal.lift.{u} (n : cardinal.{v}) = cardinal.lift.{v} (n : cardinal.{u}),
    by simp,
  have hn := cardinal.lift_inj.{v u}.2 hn,
  rw this at hn,
  rw ←@dim_fin_fun K _ n at hn,
  exact classical.choice (equiv_of_dim_eq_lift_dim hn),
end

end module

section module

open module

variables (K V : Type u) [field K] [add_comm_group V] [module K V]

lemma cardinal_mk_eq_cardinal_mk_field_pow_dim [finite_dimensional K V] :
  #V = #K ^ module.rank K V :=
begin
  let s := basis.of_vector_space_index K V,
  let hs := basis.of_vector_space K V,
  calc #V = #(s →₀ K) : quotient.sound ⟨hs.repr.to_equiv⟩
    ... = #(s → K) : quotient.sound ⟨finsupp.equiv_fun_on_fintype⟩
    ... = _ : by rw [← cardinal.lift_inj.1 hs.mk_eq_dim, cardinal.power_def]
end

lemma cardinal_lt_omega_of_finite_dimensional [fintype K] [finite_dimensional K V] :
  #V < ω :=
begin
  letI : is_noetherian K V := is_noetherian.iff_fg.2 infer_instance,
  rw cardinal_mk_eq_cardinal_mk_field_pow_dim K V,
  exact cardinal.power_lt_omega (cardinal.lt_omega_iff_fintype.2 ⟨infer_instance⟩)
    (is_noetherian.dim_lt_omega K V),
end

end module


import group_theory.submonoid.basic
import algebra.divisibility.basic
import group_theory.submonoid.membership
import algebra.associated

namespace submonoid

variables {M N : Type*} [comm_monoid M] [comm_monoid N]

def absorbing (S : submonoid M) : Prop :=
  ∀ x y, x * y ∈ S → ∃ z ∈ S, associated x z ∧ ∃ z ∈ S, associated y z

section basic

lemma absorbing_def {S : submonoid M} :
  absorbing S ↔ ∀ x y, x * y ∈ S → ∃ z ∈ S, associated x z ∧ ∃ z ∈ S, associated y z :=
iff.rfl

variable (M)
variable (N)

lemma top_absorbing : (⊤ : submonoid M).absorbing :=
  λ x y hxy, ⟨x, submonoid.mem_top _, associated.refl _, y, submonoid.mem_top _, associated.refl _⟩

lemma bot_absorbing : (⊥ : submonoid M).absorbing :=
  λ x y hxy, ⟨1, (⊥ : submonoid M).one_mem,
  associated_one_of_mul_eq_one _ (submonoid.mem_bot.1 hxy), 1, (⊥ : submonoid M).one_mem,
  associated_one_of_mul_eq_one _ (submonoid.mem_bot.1 (by rwa mul_comm at hxy))⟩

lemma is_unit.submonoid_absorbing : (is_unit.submonoid M).absorbing :=
  λ x y hxy, ⟨x, is_unit_of_mul_is_unit_left hxy, associated.refl _,
  y, is_unit_of_mul_is_unit_right hxy, associated.refl _⟩

lemma associated.prod (x z : M × N) : associated x z ↔ associated x.1 z.1 ∧ associated x.2 z.2 :=
begin
  refine ⟨_, λ ⟨⟨u₁, hu₁⟩, ⟨u₂, hu₂⟩⟩, ⟨mul_equiv.prod_units.inv_fun (u₁, u₂),
  prod.eq_iff_fst_eq_snd_eq.2 ⟨hu₁, hu₂⟩⟩⟩,

  rintro ⟨u, hu⟩,
  cases u.is_unit.exists_right_inv with b hb,
  rw [prod.mul_def, prod.mk_eq_one] at hb,
  rw [← hu, prod.fst_mul, prod.snd_mul],
  refine ⟨(associated_mul_is_unit_right_iff (is_unit_of_mul_eq_one _ _ hb.1)).2 (associated.refl _),
  (associated_mul_is_unit_right_iff (is_unit_of_mul_eq_one _ _ hb.2)).2 (associated.refl _)⟩,
end

lemma submonoid.prod_absorbing (s : submonoid M) (t : submonoid N) :
  (s.prod t).absorbing ↔ absorbing s ∧ absorbing t :=
begin
  refine ⟨λ h, ⟨λ x y hxy, _, λ x y hxy, _⟩ , _⟩,
  { specialize h (x,1) (y,1),
    rw prod.mk_one_mul_mk_one at h,
    rcases (h (submonoid.mem_prod.2 ⟨hxy, t.one_mem⟩)) with ⟨a, ha, ha₂, ⟨b, hb, hb₂⟩⟩,
    exact ⟨a.1, (submonoid.mem_prod.1 ha).1, ((associated.prod _ _ _ _).1 ha₂).1,
      b.1, (submonoid.mem_prod.1 hb).1, ((associated.prod _ _ _ _).1 hb₂).1⟩ },
  { specialize h (1,x) (1,y),
    rw prod.one_mk_mul_one_mk at h,
    rcases (h (submonoid.mem_prod.2 ⟨s.one_mem, hxy⟩)) with ⟨a, ha, ha₂, ⟨b, hb, hb₂⟩⟩,
    exact ⟨a.2, (submonoid.mem_prod.1 ha).2, ((associated.prod _ _ _ _).1 ha₂).2,
      b.2, (submonoid.mem_prod.1 hb).2, ((associated.prod _ _ _ _).1 hb₂).2⟩ },
  { rintro ⟨hs, ht⟩ x y hxy,
    rcases (hs x.1 y.1 hxy.1) with ⟨z, hz, hz₂, ⟨z', hz', hz'₂⟩⟩,
    rcases (ht x.2 y.2 hxy.2) with ⟨w, hw, hw₂, ⟨w', hw', hw'₂⟩⟩,
    exact ⟨(z,w), submonoid.mem_prod.2 ⟨hz, hw⟩, (associated.prod _ _ _ _).2 ⟨hz₂, hw₂⟩,
    (z',w'), submonoid.mem_prod.2 ⟨hz', hw'⟩, (associated.prod _ _ _ _).2 ⟨hz'₂, hw'₂⟩⟩ },
end

end basic

section comm_monoid

lemma absorbing_iff_of_comm {S : submonoid M} :
  absorbing S ↔ ∀ x y, x * y ∈ S → ∃ z ∈ S, associated x z :=
begin
  refine ⟨λ hS x y hxy, _, λ h x y hxy, _⟩,

  { rcases (hS x y hxy) with ⟨z, hz, hz₂, hS⟩,
    exact ⟨z, hz, hz₂⟩ },

  { obtain ⟨z, hz, hz₂⟩ := (h x y hxy),
    refine ⟨z, hz, hz₂, _⟩,

    rw mul_comm at hxy,
    exact (h y x hxy) },
end

end comm_monoid

end submonoid


/-
Copyright (c) 2022 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 category_theory.limits.constructions.zero_objects
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Shapes.Pullbacks
import Mathbin.CategoryTheory.Limits.Shapes.ZeroMorphisms
import Mathbin.CategoryTheory.Limits.Constructions.BinaryProducts

/-!
# Limits involving zero objects

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

Binary products and coproducts with a zero object always exist,
and pullbacks/pushouts over a zero object are products/coproducts.
-/

noncomputable section

open CategoryTheory

variable {C : Type _} [Category C]

namespace CategoryTheory.Limits

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

#print CategoryTheory.Limits.binaryFanZeroLeft /-
/-- The limit cone for the product with a zero object. -/
def binaryFanZeroLeft (X : C) : BinaryFan (0 : C) X :=
  BinaryFan.mk 0 (𝟙 X)
#align category_theory.limits.binary_fan_zero_left CategoryTheory.Limits.binaryFanZeroLeft
-/

#print CategoryTheory.Limits.binaryFanZeroLeftIsLimit /-
/-- The limit cone for the product with a zero object is limiting. -/
def binaryFanZeroLeftIsLimit (X : C) : IsLimit (binaryFanZeroLeft X) :=
  BinaryFan.isLimitMk (fun s => BinaryFan.snd s) (by tidy) (by tidy) (by tidy)
#align category_theory.limits.binary_fan_zero_left_is_limit CategoryTheory.Limits.binaryFanZeroLeftIsLimit
-/

#print CategoryTheory.Limits.hasBinaryProduct_zero_left /-
instance hasBinaryProduct_zero_left (X : C) : HasBinaryProduct (0 : C) X :=
  HasLimit.mk ⟨_, binaryFanZeroLeftIsLimit X⟩
#align category_theory.limits.has_binary_product_zero_left CategoryTheory.Limits.hasBinaryProduct_zero_left
-/

#print CategoryTheory.Limits.zeroProdIso /-
/-- A zero object is a left unit for categorical product. -/
def zeroProdIso (X : C) : (0 : C) ⨯ X ≅ X :=
  limit.isoLimitCone ⟨_, binaryFanZeroLeftIsLimit X⟩
#align category_theory.limits.zero_prod_iso CategoryTheory.Limits.zeroProdIso
-/

#print CategoryTheory.Limits.zeroProdIso_hom /-
@[simp]
theorem zeroProdIso_hom (X : C) : (zeroProdIso X).Hom = prod.snd :=
  rfl
#align category_theory.limits.zero_prod_iso_hom CategoryTheory.Limits.zeroProdIso_hom
-/

#print CategoryTheory.Limits.zeroProdIso_inv_snd /-
@[simp]
theorem zeroProdIso_inv_snd (X : C) : (zeroProdIso X).inv ≫ prod.snd = 𝟙 X :=
  by
  dsimp [zero_prod_iso, binary_fan_zero_left]
  simp
#align category_theory.limits.zero_prod_iso_inv_snd CategoryTheory.Limits.zeroProdIso_inv_snd
-/

#print CategoryTheory.Limits.binaryFanZeroRight /-
/-- The limit cone for the product with a zero object. -/
def binaryFanZeroRight (X : C) : BinaryFan X (0 : C) :=
  BinaryFan.mk (𝟙 X) 0
#align category_theory.limits.binary_fan_zero_right CategoryTheory.Limits.binaryFanZeroRight
-/

#print CategoryTheory.Limits.binaryFanZeroRightIsLimit /-
/-- The limit cone for the product with a zero object is limiting. -/
def binaryFanZeroRightIsLimit (X : C) : IsLimit (binaryFanZeroRight X) :=
  BinaryFan.isLimitMk (fun s => BinaryFan.fst s) (by tidy) (by tidy) (by tidy)
#align category_theory.limits.binary_fan_zero_right_is_limit CategoryTheory.Limits.binaryFanZeroRightIsLimit
-/

#print CategoryTheory.Limits.hasBinaryProduct_zero_right /-
instance hasBinaryProduct_zero_right (X : C) : HasBinaryProduct X (0 : C) :=
  HasLimit.mk ⟨_, binaryFanZeroRightIsLimit X⟩
#align category_theory.limits.has_binary_product_zero_right CategoryTheory.Limits.hasBinaryProduct_zero_right
-/

#print CategoryTheory.Limits.prodZeroIso /-
/-- A zero object is a right unit for categorical product. -/
def prodZeroIso (X : C) : X ⨯ (0 : C) ≅ X :=
  limit.isoLimitCone ⟨_, binaryFanZeroRightIsLimit X⟩
#align category_theory.limits.prod_zero_iso CategoryTheory.Limits.prodZeroIso
-/

#print CategoryTheory.Limits.prodZeroIso_hom /-
@[simp]
theorem prodZeroIso_hom (X : C) : (prodZeroIso X).Hom = prod.fst :=
  rfl
#align category_theory.limits.prod_zero_iso_hom CategoryTheory.Limits.prodZeroIso_hom
-/

#print CategoryTheory.Limits.prodZeroIso_iso_inv_snd /-
@[simp]
theorem prodZeroIso_iso_inv_snd (X : C) : (prodZeroIso X).inv ≫ prod.fst = 𝟙 X :=
  by
  dsimp [prod_zero_iso, binary_fan_zero_right]
  simp
#align category_theory.limits.prod_zero_iso_iso_inv_snd CategoryTheory.Limits.prodZeroIso_iso_inv_snd
-/

#print CategoryTheory.Limits.binaryCofanZeroLeft /-
/-- The colimit cocone for the coproduct with a zero object. -/
def binaryCofanZeroLeft (X : C) : BinaryCofan (0 : C) X :=
  BinaryCofan.mk 0 (𝟙 X)
#align category_theory.limits.binary_cofan_zero_left CategoryTheory.Limits.binaryCofanZeroLeft
-/

#print CategoryTheory.Limits.binaryCofanZeroLeftIsColimit /-
/-- The colimit cocone for the coproduct with a zero object is colimiting. -/
def binaryCofanZeroLeftIsColimit (X : C) : IsColimit (binaryCofanZeroLeft X) :=
  BinaryCofan.isColimitMk (fun s => BinaryCofan.inr s) (by tidy) (by tidy) (by tidy)
#align category_theory.limits.binary_cofan_zero_left_is_colimit CategoryTheory.Limits.binaryCofanZeroLeftIsColimit
-/

#print CategoryTheory.Limits.hasBinaryCoproduct_zero_left /-
instance hasBinaryCoproduct_zero_left (X : C) : HasBinaryCoproduct (0 : C) X :=
  HasColimit.mk ⟨_, binaryCofanZeroLeftIsColimit X⟩
#align category_theory.limits.has_binary_coproduct_zero_left CategoryTheory.Limits.hasBinaryCoproduct_zero_left
-/

#print CategoryTheory.Limits.zeroCoprodIso /-
/-- A zero object is a left unit for categorical coproduct. -/
def zeroCoprodIso (X : C) : (0 : C) ⨿ X ≅ X :=
  colimit.isoColimitCocone ⟨_, binaryCofanZeroLeftIsColimit X⟩
#align category_theory.limits.zero_coprod_iso CategoryTheory.Limits.zeroCoprodIso
-/

#print CategoryTheory.Limits.inr_zeroCoprodIso_hom /-
@[simp]
theorem inr_zeroCoprodIso_hom (X : C) : coprod.inr ≫ (zeroCoprodIso X).Hom = 𝟙 X :=
  by
  dsimp [zero_coprod_iso, binary_cofan_zero_left]
  simp
#align category_theory.limits.inr_zero_coprod_iso_hom CategoryTheory.Limits.inr_zeroCoprodIso_hom
-/

#print CategoryTheory.Limits.zeroCoprodIso_inv /-
@[simp]
theorem zeroCoprodIso_inv (X : C) : (zeroCoprodIso X).inv = coprod.inr :=
  rfl
#align category_theory.limits.zero_coprod_iso_inv CategoryTheory.Limits.zeroCoprodIso_inv
-/

#print CategoryTheory.Limits.binaryCofanZeroRight /-
/-- The colimit cocone for the coproduct with a zero object. -/
def binaryCofanZeroRight (X : C) : BinaryCofan X (0 : C) :=
  BinaryCofan.mk (𝟙 X) 0
#align category_theory.limits.binary_cofan_zero_right CategoryTheory.Limits.binaryCofanZeroRight
-/

#print CategoryTheory.Limits.binaryCofanZeroRightIsColimit /-
/-- The colimit cocone for the coproduct with a zero object is colimiting. -/
def binaryCofanZeroRightIsColimit (X : C) : IsColimit (binaryCofanZeroRight X) :=
  BinaryCofan.isColimitMk (fun s => BinaryCofan.inl s) (by tidy) (by tidy) (by tidy)
#align category_theory.limits.binary_cofan_zero_right_is_colimit CategoryTheory.Limits.binaryCofanZeroRightIsColimit
-/

#print CategoryTheory.Limits.hasBinaryCoproduct_zero_right /-
instance hasBinaryCoproduct_zero_right (X : C) : HasBinaryCoproduct X (0 : C) :=
  HasColimit.mk ⟨_, binaryCofanZeroRightIsColimit X⟩
#align category_theory.limits.has_binary_coproduct_zero_right CategoryTheory.Limits.hasBinaryCoproduct_zero_right
-/

#print CategoryTheory.Limits.coprodZeroIso /-
/-- A zero object is a right unit for categorical coproduct. -/
def coprodZeroIso (X : C) : X ⨿ (0 : C) ≅ X :=
  colimit.isoColimitCocone ⟨_, binaryCofanZeroRightIsColimit X⟩
#align category_theory.limits.coprod_zero_iso CategoryTheory.Limits.coprodZeroIso
-/

#print CategoryTheory.Limits.inr_coprodZeroIso_hom /-
@[simp]
theorem inr_coprodZeroIso_hom (X : C) : coprod.inl ≫ (coprodZeroIso X).Hom = 𝟙 X :=
  by
  dsimp [coprod_zero_iso, binary_cofan_zero_right]
  simp
#align category_theory.limits.inr_coprod_zeroiso_hom CategoryTheory.Limits.inr_coprodZeroIso_hom
-/

#print CategoryTheory.Limits.coprodZeroIso_inv /-
@[simp]
theorem coprodZeroIso_inv (X : C) : (coprodZeroIso X).inv = coprod.inl :=
  rfl
#align category_theory.limits.coprod_zero_iso_inv CategoryTheory.Limits.coprodZeroIso_inv
-/

#print CategoryTheory.Limits.hasPullback_over_zero /-
instance hasPullback_over_zero (X Y : C) [HasBinaryProduct X Y] :
    HasPullback (0 : X ⟶ 0) (0 : Y ⟶ 0) :=
  HasLimit.mk
    ⟨_, isPullbackOfIsTerminalIsProduct _ _ _ _ HasZeroObject.zeroIsTerminal (prodIsProd X Y)⟩
#align category_theory.limits.has_pullback_over_zero CategoryTheory.Limits.hasPullback_over_zero
-/

#print CategoryTheory.Limits.pullbackZeroZeroIso /-
/-- The pullback over the zeron object is the product. -/
def pullbackZeroZeroIso (X Y : C) [HasBinaryProduct X Y] :
    pullback (0 : X ⟶ 0) (0 : Y ⟶ 0) ≅ X ⨯ Y :=
  limit.isoLimitCone
    ⟨_, isPullbackOfIsTerminalIsProduct _ _ _ _ HasZeroObject.zeroIsTerminal (prodIsProd X Y)⟩
#align category_theory.limits.pullback_zero_zero_iso CategoryTheory.Limits.pullbackZeroZeroIso
-/

#print CategoryTheory.Limits.pullbackZeroZeroIso_inv_fst /-
@[simp]
theorem pullbackZeroZeroIso_inv_fst (X Y : C) [HasBinaryProduct X Y] :
    (pullbackZeroZeroIso X Y).inv ≫ pullback.fst = prod.fst :=
  by
  dsimp [pullback_zero_zero_iso]
  simp
#align category_theory.limits.pullback_zero_zero_iso_inv_fst CategoryTheory.Limits.pullbackZeroZeroIso_inv_fst
-/

#print CategoryTheory.Limits.pullbackZeroZeroIso_inv_snd /-
@[simp]
theorem pullbackZeroZeroIso_inv_snd (X Y : C) [HasBinaryProduct X Y] :
    (pullbackZeroZeroIso X Y).inv ≫ pullback.snd = prod.snd :=
  by
  dsimp [pullback_zero_zero_iso]
  simp
#align category_theory.limits.pullback_zero_zero_iso_inv_snd CategoryTheory.Limits.pullbackZeroZeroIso_inv_snd
-/

#print CategoryTheory.Limits.pullbackZeroZeroIso_hom_fst /-
@[simp]
theorem pullbackZeroZeroIso_hom_fst (X Y : C) [HasBinaryProduct X Y] :
    (pullbackZeroZeroIso X Y).Hom ≫ prod.fst = pullback.fst := by simp [← iso.eq_inv_comp]
#align category_theory.limits.pullback_zero_zero_iso_hom_fst CategoryTheory.Limits.pullbackZeroZeroIso_hom_fst
-/

#print CategoryTheory.Limits.pullbackZeroZeroIso_hom_snd /-
@[simp]
theorem pullbackZeroZeroIso_hom_snd (X Y : C) [HasBinaryProduct X Y] :
    (pullbackZeroZeroIso X Y).Hom ≫ prod.snd = pullback.snd := by simp [← iso.eq_inv_comp]
#align category_theory.limits.pullback_zero_zero_iso_hom_snd CategoryTheory.Limits.pullbackZeroZeroIso_hom_snd
-/

#print CategoryTheory.Limits.hasPushout_over_zero /-
instance hasPushout_over_zero (X Y : C) [HasBinaryCoproduct X Y] :
    HasPushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) :=
  HasColimit.mk
    ⟨_, isPushoutOfIsInitialIsCoproduct _ _ _ _ HasZeroObject.zeroIsInitial (coprodIsCoprod X Y)⟩
#align category_theory.limits.has_pushout_over_zero CategoryTheory.Limits.hasPushout_over_zero
-/

#print CategoryTheory.Limits.pushoutZeroZeroIso /-
/-- The pushout over the zero object is the coproduct. -/
def pushoutZeroZeroIso (X Y : C) [HasBinaryCoproduct X Y] :
    pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) ≅ X ⨿ Y :=
  colimit.isoColimitCocone
    ⟨_, isPushoutOfIsInitialIsCoproduct _ _ _ _ HasZeroObject.zeroIsInitial (coprodIsCoprod X Y)⟩
#align category_theory.limits.pushout_zero_zero_iso CategoryTheory.Limits.pushoutZeroZeroIso
-/

#print CategoryTheory.Limits.inl_pushoutZeroZeroIso_hom /-
@[simp]
theorem inl_pushoutZeroZeroIso_hom (X Y : C) [HasBinaryCoproduct X Y] :
    pushout.inl ≫ (pushoutZeroZeroIso X Y).Hom = coprod.inl :=
  by
  dsimp [pushout_zero_zero_iso]
  simp
#align category_theory.limits.inl_pushout_zero_zero_iso_hom CategoryTheory.Limits.inl_pushoutZeroZeroIso_hom
-/

#print CategoryTheory.Limits.inr_pushoutZeroZeroIso_hom /-
@[simp]
theorem inr_pushoutZeroZeroIso_hom (X Y : C) [HasBinaryCoproduct X Y] :
    pushout.inr ≫ (pushoutZeroZeroIso X Y).Hom = coprod.inr :=
  by
  dsimp [pushout_zero_zero_iso]
  simp
#align category_theory.limits.inr_pushout_zero_zero_iso_hom CategoryTheory.Limits.inr_pushoutZeroZeroIso_hom
-/

#print CategoryTheory.Limits.inl_pushoutZeroZeroIso_inv /-
@[simp]
theorem inl_pushoutZeroZeroIso_inv (X Y : C) [HasBinaryCoproduct X Y] :
    coprod.inl ≫ (pushoutZeroZeroIso X Y).inv = pushout.inl := by simp [iso.comp_inv_eq]
#align category_theory.limits.inl_pushout_zero_zero_iso_inv CategoryTheory.Limits.inl_pushoutZeroZeroIso_inv
-/

#print CategoryTheory.Limits.inr_pushoutZeroZeroIso_inv /-
@[simp]
theorem inr_pushoutZeroZeroIso_inv (X Y : C) [HasBinaryCoproduct X Y] :
    coprod.inr ≫ (pushoutZeroZeroIso X Y).inv = pushout.inr := by simp [iso.comp_inv_eq]
#align category_theory.limits.inr_pushout_zero_zero_iso_inv CategoryTheory.Limits.inr_pushoutZeroZeroIso_inv
-/

end CategoryTheory.Limits


/-
Copyright (c) 2020 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import deprecated.group

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

This file defines typeclasses for unbundled semiring and ring homomorphisms. Though these classes
are deprecated, they are still widely used in mathlib, and probably will not go away before Lean 4
because Lean 3 often fails to coerce a bundled homomorphism to a function.

## main definitions

is_semiring_hom (deprecated), is_ring_hom (deprecated)

## Tags

is_semiring_hom, is_ring_hom

-/

universes u v w

variable {α : Type u}

/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
class is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero [] : f 0 = 0)
(map_one [] : f 1 = 1)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables (f : α → β) [is_semiring_hom f] {x y : α}

/-- The identity map is a semiring homomorphism. -/
instance id : is_semiring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
-- see Note [no instance on morphisms]
lemma comp {γ} [semiring γ] (g : β → γ) [is_semiring_hom g] :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simp [map_zero f]; exact map_zero g,
  map_one := by simp [map_one f]; exact map_one g,
  map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl }

/-- A semiring homomorphism is an additive monoid homomorphism. -/
@[priority 100] -- see Note [lower instance priority]
instance : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

/-- A semiring homomorphism is a monoid homomorphism. -/
@[priority 100] -- see Note [lower instance priority]
instance : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

/-- Predicate for ring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
class is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one [] : f 1 = 1)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
lemma of_semiring (f : α → β) [H : is_semiring_hom f] : is_ring_hom f := {..H}

variables (f : α → β) [is_ring_hom f] {x y : α}

/-- Ring homomorphisms map zero to zero. -/
lemma map_zero : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [map_add f]; simp
     ... = 0 : by simp

/-- Ring homomorphisms preserve additive inverses. -/
lemma map_neg : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [map_add f]; simp
        ... = -f x : by simp [map_zero f]

/-- Ring homomorphisms preserve subtraction. -/
lemma map_sub : f (x - y) = f x - f y :=
by simp [sub_eq_add_neg, map_add f, map_neg f]

/-- The identity map is a ring homomorphism. -/
instance id : is_ring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two ring homomorphisms is a ring homomorphism. -/
-- see Note [no instance on morphisms]
lemma comp {γ} [ring γ] (g : β → γ) [is_ring_hom g] :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl,
  map_one := by simp [map_one f]; exact map_one g }

/-- A ring homomorphism is also a semiring homomorphism. -/
@[priority 100] -- see Note [lower instance priority]
instance : is_semiring_hom f :=
{ map_zero := map_zero f, ..‹is_ring_hom f› }

@[priority 100] -- see Note [lower instance priority]
instance : is_add_group_hom f := { }

end is_ring_hom

variables {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β]

namespace ring_hom

section
include rα rβ

/-- Interpret `f : α → β` with `is_semiring_hom f` as a ring homomorphism. -/
def of (f : α → β) [is_semiring_hom f] : α →+* β :=
{ to_fun := f,
  .. monoid_hom.of f,
  .. add_monoid_hom.of f }

@[simp] lemma coe_of (f : α → β) [is_semiring_hom f] : ⇑(of f) = f := rfl

instance (f : α →+* β) : is_semiring_hom f :=
{ map_zero := f.map_zero,
  map_one := f.map_one,
  map_add := f.map_add,
  map_mul := f.map_mul }

end

instance {α γ} [ring α] [ring γ] (g : α →+* γ) : is_ring_hom g :=
is_ring_hom.of_semiring g

end ring_hom