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

! This file was ported from Lean 3 source module tactic.omega.main
! leanprover-community/mathlib commit 58581d0fe523063f5651df0619be2bf65012a94a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Omega.Int.Main
import Mathbin.Tactic.Omega.Nat.Main

/-
A tactic for discharging linear integer & natural
number arithmetic goals using the Omega test.
-/
namespace Omega

open Tactic

unsafe def select_domain (t s : tactic (Option Bool)) : tactic (Option Bool) := do
  let a ← t
  let b ← s
  match a, b with
    | a, none => return a
    | none, b => return b
    | some tt, some tt => return (some tt)
    | some ff, some ff => return (some ff)
    | _, _ => failed
#align omega.select_domain omega.select_domain

unsafe def type_domain (x : expr) : tactic (Option Bool) :=
  if x = q(Int) then return (some true) else if x = q(Nat) then return (some false) else failed
#align omega.type_domain omega.type_domain

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Detects domain of a formula from its expr.
      * Returns none, if domain can be either ℤ or ℕ
      * Returns some tt, if domain is exclusively ℤ
      * Returns some ff, if domain is exclusively ℕ
      * Fails, if domain is neither ℤ nor ℕ -/
    unsafe
  def
    form_domain
    : expr → tactic ( Option Bool )
    | q( ¬ $ ( px ) ) => form_domain px
      | q( $ ( px ) ∨ $ ( qx ) ) => select_domain ( form_domain px ) ( form_domain qx )
      | q( $ ( px ) ∧ $ ( qx ) ) => select_domain ( form_domain px ) ( form_domain qx )
      | q( $ ( px ) ↔ $ ( qx ) ) => select_domain ( form_domain px ) ( form_domain qx )
      |
        q( $ ( expr.pi _ _ px qx ) )
        =>
        Monad.cond
          ( if expr.has_var px then return true else is_prop px )
            ( select_domain ( form_domain px ) ( form_domain qx ) )
            ( select_domain ( type_domain px ) ( form_domain qx ) )
      | q( @ LT.lt $ ( dx ) $ ( h ) _ _ ) => type_domain dx
      | q( @ LE.le $ ( dx ) $ ( h ) _ _ ) => type_domain dx
      | q( @ Eq $ ( dx ) _ _ ) => type_domain dx
      | q( @ GE.ge $ ( dx ) $ ( h ) _ _ ) => type_domain dx
      | q( @ GT.gt $ ( dx ) $ ( h ) _ _ ) => type_domain dx
      | q( @ Ne $ ( dx ) _ _ ) => type_domain dx
      | q( True ) => return none
      | q( False ) => return none
      | x => failed
#align omega.form_domain omega.form_domain

unsafe def goal_domain_aux (x : expr) : tactic Bool :=
  omega.int.wff x >> return true <|> omega.nat.wff x >> return false
#align omega.goal_domain_aux omega.goal_domain_aux

/-- Use the current goal to determine.
    Return tt if the domain is ℤ, and return ff if it is ℕ -/
unsafe def goal_domain : tactic Bool := do
  let gx ← target
  let hxs ← local_context >>= Monad.mapM infer_type
  app_first goal_domain_aux (gx :: hxs)
#align omega.goal_domain omega.goal_domain

/-- Return tt if the domain is ℤ, and return ff if it is ℕ -/
unsafe def determine_domain (opt : List Name) : tactic Bool :=
  if `int ∈ opt then return true else if `nat ∈ opt then return false else goal_domain
#align omega.determine_domain omega.determine_domain

end Omega

open Lean.Parser Interactive Omega

/-- Attempts to discharge goals in the quantifier-free fragment of
linear integer and natural number arithmetic using the Omega test.
Guesses the correct domain by looking at the goal and hypotheses,
and then reverts all relevant hypotheses and variables.
Use `omega manual` to disable automatic reverts, and `omega int` or
`omega nat` to specify the domain.
-/
unsafe def tactic.interactive.omega (opt : parse (many ident)) : tactic Unit := do
  let is_int ← determine_domain opt
  let is_manual : Bool := if `manual ∈ opt then true else false
  if is_int then omega_int is_manual else omega_nat is_manual
#align tactic.interactive.omega tactic.interactive.omega

add_hint_tactic omega

initialize
  registerTraceClass.1 `omega

/--
`omega` attempts to discharge goals in the quantifier-free fragment of linear integer and natural
number arithmetic using the Omega test. In other words, the core procedure of `omega` works with
goals of the form
```lean
∀ x₁, ... ∀ xₖ, P
```
where `x₁, ... xₖ` are integer (resp. natural number) variables, and `P` is a quantifier-free
formula of linear integer (resp. natural number) arithmetic. For instance:
```lean
example : ∀ (x y : int), (x ≤ 5 ∧ y ≤ 3) → x + y ≤ 8 := by omega
```
By default, `omega` tries to guess the correct domain by looking at the goal and hypotheses, and
then reverts all relevant hypotheses and variables (e.g., all variables of type `nat` and `Prop`s
in linear natural number arithmetic, if the domain was determined to be `nat`) to universally close
the goal before calling the main procedure. Therefore, `omega` will often work even if the goal
is not in the above form:
```lean
example (x y : nat) (h : 2 * x + 1 = 2 * y) : false := by omega
```
But this behaviour is not always optimal, since it may revert irrelevant hypotheses or incorrectly
guess the domain. Use `omega manual` to disable automatic reverts, and `omega int` or `omega nat`
to specify the domain.
```lean
example (x y z w : int) (h1 : 3 * y ≥ x) (h2 : z > 19 * w) : 3 * x ≤ 9 * y :=
by {revert h1 x y, omega manual}

example (i : int) (n : nat) (h1 : i = 0) (h2 : n < n) : false := by omega nat

example (n : nat) (h1 : n < 34) (i : int) (h2 : i * 9 = -72) : i = -8 :=
by {revert h2 i, omega manual int}
```
`omega` handles `nat` subtraction by repeatedly rewriting goals of the form `P[t-s]` into
`P[x] ∧ (t = s + x ∨ (t ≤ s ∧ x = 0))`, where `x` is fresh. This means that each (distinct)
occurrence of subtraction will cause the goal size to double during DNF transformation.

`omega` implements the real shadow step of the Omega test, but not the dark and gray shadows.
Therefore, it should (in principle) succeed whenever the negation of the goal has no real solution,
but it may fail if a real solution exists, even if there is no integer/natural number solution.

You can enable `set_option trace.omega true` to see how `omega` interprets your goal.
-/
add_tactic_doc
  { Name := "omega"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.omega]
    tags := ["finishing", "arithmetic", "decision procedure"] }


/- This file contains various definitions and lemmas which don't fit anywhere else, or when there
  is not enough material to make its own file -/

import data.pfun data.set.finite data.nat.enat topology.basic
import tactic.fattribute
universes u v

axiom omitted {P : Prop} : P

notation `ℕ∞` := enat

def is_finite (α : Type*) : Prop := nonempty (fintype α) -- set.finite (set.univ : set α)

namespace subtype
attribute [extensionality] subtype.eq'

variables {α : Sort*} {p : α → Prop}

protected lemma subsingleton (h : ∃ x, ∀ y, p y → y = x) : subsingleton {x // p x} :=
begin
  rcases h with ⟨x, px⟩, constructor, rintro ⟨y, py⟩ ⟨z, pz⟩, ext,
  cases px y py, cases px z pz, refl
end

protected lemma subsingleton' (h : ∃! x, p x) : subsingleton {x // p x} :=
let ⟨x, px, qx⟩ := h in subtype.subsingleton ⟨x, qx⟩

protected lemma nonempty (h : ∃ x, p x) : nonempty {x // p x} :=
let ⟨x, hx⟩ := h in ⟨⟨x, hx⟩⟩

end subtype

namespace trunc
instance nonempty {α : Sort u} [h : nonempty α] : nonempty (trunc α) :=
let ⟨x⟩ := h in ⟨trunc.mk x⟩

end trunc

namespace classical
variables {α : Sort u} {β : Sort v} {p : α → Prop}
noncomputable def unique_choice : nonempty α ∧ subsingleton α → α :=
classical.choice ∘ and.left

noncomputable def unique_indefinite_description (p : α → Prop)
  (h : ∃! x, p x) : {x // p x} :=
unique_choice $ let ⟨x, px, qx⟩ := h in ⟨⟨⟨x, px⟩⟩, subtype.subsingleton' h⟩

noncomputable def the (p : α → Prop) (h : ∃! x, p x) : α :=
(unique_indefinite_description p h).1
lemma the_spec (h : ∃! x, p x) : p (the p h) :=
(unique_indefinite_description p h).2
lemma the_unique (h : ∃! x, p x) (y : α) (py : p y) : y = the p h :=
let ⟨x, px, qx⟩ := h in (qx y py).trans (qx _ (the_spec h)).symm

noncomputable def choose_trunc (h : nonempty α) : trunc α :=
unique_choice $ by split; apply_instance

open set
noncomputable def take_arbitrary {α β : Type*} (f : α → β) (h : nonempty α)
  (hf : ∀x y : α, f x = f y) : β :=
the (range f) $ let ⟨x⟩ := h in
  ⟨f x, mem_range_self x, λ y hy, let ⟨x', hx'⟩ := hy in hx'.symm.trans $ hf x' x⟩

noncomputable def take_arbitrary_in {α β : Type*} (s : set α) (f : α → β) (h : nonempty s)
  (hf : ∀x y ∈ s, f x = f y) : β :=
take_arbitrary (λ x : s, f x.1) (let ⟨⟨x, hx⟩⟩ := h in ⟨⟨x, hx⟩⟩) (λ⟨x, hx⟩ ⟨y, hy⟩, hf x y hx hy)

noncomputable def take_arbitrary_such_that {α β : Type*} {p : α → Prop} (f : α → β)
  (h : ∃ x, p x) (hf : ∀x y, p x → p y → f x = f y) : β :=
take_arbitrary_in {x | p x } f (let ⟨x, px⟩ := h in ⟨⟨x, px⟩⟩) hf

end classical

variables {α : Type*} {β : Type*}

noncomputable def roption.classical_to_option {α} (x : roption α) : option α :=
by haveI := classical.dec; exact x.to_option

namespace vector

def vector_one_equiv : vector α 1 ≃ α :=
{ to_fun := λ x, x.head,
  inv_fun := λ x, ⟨[x], dec_trivial⟩,
  left_inv := omitted,
  right_inv := omitted}

end vector

namespace set
lemma finite_of_subset_finset {s : set α} (t : finset α) (h : s ⊆ ↑t) : s.finite :=
finite_subset (finset.finite_to_set t) h

/-- The cardinality of any subset of a finite type. -/
noncomputable def cardinality [fintype α] (s : set α) : ℕ :=
by haveI := classical.dec; haveI := (set_fintype s); exact fintype.card s

end set

namespace finset

variables (r : α → α → Prop) [decidable_rel r] [is_trans α r] [is_antisymm α r] [is_total α r]

lemma sort_length [decidable_eq α] (s : finset α) : (sort r s).length = s.card :=
by rw [←list.to_finset_card_of_nodup (sort_nodup r s), sort_to_finset r s]

end finset

/-- the pullback of a relation along a function -/
-- cf. preorder_lift
def pullback_rel (f : α → β) (r : β → β → Prop) : α → α → Prop := λ x y, r (f x) (f y)
namespace pullback_rel
instance (f : α → β) (r : β → β → Prop) [is_trans β r] : is_trans α (pullback_rel f r) :=
⟨λ x y z h₁ h₂, (trans h₁ h₂ : r (f x) (f z))⟩

protected def is_antisymm (f : α → β) (r : β → β → Prop) (h : function.injective f)
  [is_antisymm β r] : is_antisymm α (pullback_rel f r) :=
⟨λ x y h₁ h₂, h $ antisymm h₁ h₂⟩

instance (f : α → β) (r : β → β → Prop) [is_total β r] : is_total α (pullback_rel f r) :=
⟨λ x y, total_of r (f x) (f y)⟩

instance (f : α → β) (r : β → β → Prop) [decidable_rel r] : decidable_rel (pullback_rel f r) :=
by dsimp [pullback_rel]; apply_instance
end pullback_rel

def is_maximal {α : Type*} [preorder α] (s : set α) (x : α) : Prop := x ∈ s ∧ ∀(y ∈ s), ¬y > x
def is_minimal {α : Type*} [preorder α] (s : set α) (x : α) : Prop := x ∈ s ∧ ∀(y ∈ s), ¬y < x


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

! This file was ported from Lean 3 source module category_theory.limits.preserves.shapes.biproducts
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Biproducts
import Mathlib.CategoryTheory.Limits.Preserves.Shapes.Zero

/-!
# Preservation of biproducts

We define the image of a (binary) bicone under a functor that preserves zero morphisms and define
classes `PreservesBiproduct` and `PreservesBinaryBiproduct`. We then

* show that a functor that preserves biproducts of a two-element type preserves binary biproducts,
* construct the comparison morphisms between the image of a biproduct and the biproduct of the
  images and show that the biproduct is preserved if one of them is an isomorphism,
* give the canonical isomorphism between the image of a biproduct and the biproduct of the images
  in case that the biproduct is preserved.

-/

universe w₁ w₂ v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory

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

section HasZeroMorphisms

variable [HasZeroMorphisms C] [HasZeroMorphisms D]

namespace Functor

section Map

variable (F : C ⥤ D) [PreservesZeroMorphisms F]

section Bicone

variable {J : Type w₁}

/-- The image of a bicone under a functor. -/
@[simps]
def mapBicone {f : J → C} (b : Bicone f) : Bicone (F.obj ∘ f) where
  pt := F.obj b.pt
  π j := F.map (b.π j)
  ι j := F.map (b.ι j)
  ι_π j j' := by
    rw [← F.map_comp]
    split_ifs with h
    · subst h
      simp only [bicone_ι_π_self, CategoryTheory.Functor.map_id, eqToHom_refl]; dsimp
    · rw [bicone_ι_π_ne _ h, F.map_zero]
#align category_theory.functor.map_bicone CategoryTheory.Functor.mapBicone

theorem mapBicone_whisker {K : Type w₂} {g : K ≃ J} {f : J → C} (c : Bicone f) :
    F.mapBicone (c.whisker g) = (F.mapBicone c).whisker g :=
  rfl
#align category_theory.functor.map_bicone_whisker CategoryTheory.Functor.mapBicone_whisker

end Bicone

/-- The image of a binary bicone under a functor. -/
@[simps]
def mapBinaryBicone {X Y : C} (b : BinaryBicone X Y) : BinaryBicone (F.obj X) (F.obj Y) where
  pt := F.obj b.pt
  fst := F.map b.fst
  snd := F.map b.snd
  inl := F.map b.inl
  inr := F.map b.inr
  inl_fst := by rw [← F.map_comp, b.inl_fst, F.map_id]
  inl_snd := by rw [← F.map_comp, b.inl_snd, F.map_zero]
  inr_fst := by rw [← F.map_comp, b.inr_fst, F.map_zero]
  inr_snd := by rw [← F.map_comp, b.inr_snd, F.map_id]
#align category_theory.functor.map_binary_bicone CategoryTheory.Functor.mapBinaryBicone

end Map

end Functor

open CategoryTheory.Functor

namespace Limits

section Bicone

variable {J : Type w₁} {K : Type w₂}

/-- A functor `F` preserves biproducts of `f` if `F` maps every bilimit bicone over `f` to a
    bilimit bicone over `F.obj ∘ f`. -/
class PreservesBiproduct (f : J → C) (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {b : Bicone f}, b.IsBilimit → (F.mapBicone b).IsBilimit
#align category_theory.limits.preserves_biproduct CategoryTheory.Limits.PreservesBiproduct

attribute [inherit_doc PreservesBiproduct] PreservesBiproduct.preserves

/-- A functor `F` preserves biproducts of `f` if `F` maps every bilimit bicone over `f` to a
    bilimit bicone over `F.obj ∘ f`. -/
def isBilimitOfPreserves {f : J → C} (F : C ⥤ D) [PreservesZeroMorphisms F] [PreservesBiproduct f F]
    {b : Bicone f} (hb : b.IsBilimit) : (F.mapBicone b).IsBilimit :=
  PreservesBiproduct.preserves hb
#align category_theory.limits.is_bilimit_of_preserves CategoryTheory.Limits.isBilimitOfPreserves

variable (J)

/-- A functor `F` preserves biproducts of shape `J` if it preserves biproducts of `f` for every
    `f : J → C`. -/
class PreservesBiproductsOfShape (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {f : J → C}, PreservesBiproduct f F
#align category_theory.limits.preserves_biproducts_of_shape CategoryTheory.Limits.PreservesBiproductsOfShape

attribute [inherit_doc PreservesBiproductsOfShape] PreservesBiproductsOfShape.preserves

attribute [instance] PreservesBiproductsOfShape.preserves

end Bicone

/-- A functor `F` preserves finite biproducts if it preserves biproducts of shape `J` whenever
    `J` is a fintype. -/
class PreservesFiniteBiproducts (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {J : Type} [Fintype J], PreservesBiproductsOfShape J F
#align category_theory.limits.preserves_finite_biproducts CategoryTheory.Limits.PreservesFiniteBiproducts

attribute [inherit_doc PreservesFiniteBiproducts] PreservesFiniteBiproducts.preserves

attribute [instance] PreservesFiniteBiproducts.preserves

/-- A functor `F` preserves biproducts if it preserves biproducts of any shape `J` of size `w`.
    The usual notion of preservation of biproducts is recovered by choosing `w` to be the universe
    of the morphisms of `C`. -/
class PreservesBiproducts (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {J : Type w₁}, PreservesBiproductsOfShape J F
#align category_theory.limits.preserves_biproducts CategoryTheory.Limits.PreservesBiproducts

attribute [inherit_doc PreservesBiproducts] PreservesBiproducts.preserves

attribute [instance] PreservesBiproducts.preserves

/-- Preserving biproducts at a bigger universe level implies preserving biproducts at a
smaller universe level. -/
def preservesBiproductsShrink (F : C ⥤ D) [PreservesZeroMorphisms F]
    [PreservesBiproducts.{max w₁ w₂} F] : PreservesBiproducts.{w₁} F :=
  ⟨fun {_} =>
    ⟨fun {_} =>
      ⟨fun {b} ib =>
        ((F.mapBicone b).whiskerIsBilimitIff _).toFun
          (isBilimitOfPreserves F ((b.whiskerIsBilimitIff Equiv.ulift.{w₂}).invFun ib))⟩⟩⟩
#align category_theory.limits.preserves_biproducts_shrink CategoryTheory.Limits.preservesBiproductsShrink

instance (priority := 100) preservesFiniteBiproductsOfPreservesBiproducts (F : C ⥤ D)
    [PreservesZeroMorphisms F] [PreservesBiproducts.{w₁} F] : PreservesFiniteBiproducts F where
  preserves {J} _ := by letI := preservesBiproductsShrink.{0} F; infer_instance
#align category_theory.limits.preserves_finite_biproducts_of_preserves_biproducts CategoryTheory.Limits.preservesFiniteBiproductsOfPreservesBiproducts

/-- A functor `F` preserves binary biproducts of `X` and `Y` if `F` maps every bilimit bicone over
    `X` and `Y` to a bilimit bicone over `F.obj X` and `F.obj Y`. -/
class PreservesBinaryBiproduct (X Y : C) (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {b : BinaryBicone X Y}, b.IsBilimit → (F.mapBinaryBicone b).IsBilimit
#align category_theory.limits.preserves_binary_biproduct CategoryTheory.Limits.PreservesBinaryBiproduct

attribute [inherit_doc PreservesBinaryBiproduct] PreservesBinaryBiproduct.preserves

/-- A functor `F` preserves binary biproducts of `X` and `Y` if `F` maps every bilimit bicone over
    `X` and `Y` to a bilimit bicone over `F.obj X` and `F.obj Y`. -/
def isBinaryBilimitOfPreserves {X Y : C} (F : C ⥤ D) [PreservesZeroMorphisms F]
    [PreservesBinaryBiproduct X Y F] {b : BinaryBicone X Y} (hb : b.IsBilimit) :
    (F.mapBinaryBicone b).IsBilimit :=
  PreservesBinaryBiproduct.preserves hb
#align category_theory.limits.is_binary_bilimit_of_preserves CategoryTheory.Limits.isBinaryBilimitOfPreserves

/-- A functor `F` preserves binary biproducts if it preserves the binary biproduct of `X` and `Y`
    for all `X` and `Y`. -/
class PreservesBinaryBiproducts (F : C ⥤ D) [PreservesZeroMorphisms F] where
  preserves : ∀ {X Y : C}, PreservesBinaryBiproduct X Y F := by infer_instance
#align category_theory.limits.preserves_binary_biproducts CategoryTheory.Limits.PreservesBinaryBiproducts

attribute [inherit_doc PreservesBinaryBiproducts] PreservesBinaryBiproducts.preserves

/-- A functor that preserves biproducts of a pair preserves binary biproducts. -/
def preservesBinaryBiproductOfPreservesBiproduct (F : C ⥤ D) [PreservesZeroMorphisms F] (X Y : C)
    [PreservesBiproduct (pairFunction X Y) F] : PreservesBinaryBiproduct X Y F
    where preserves {b} hb :=
    { isLimit :=
        IsLimit.ofIsoLimit
            ((IsLimit.postcomposeHomEquiv (diagramIsoPair _) _).symm
              (isBilimitOfPreserves F (b.toBiconeIsBilimit.symm hb)).isLimit) <|
          Cones.ext (Iso.refl _) fun j => by
            rcases j with ⟨⟨⟩⟩ <;> simp
      isColimit :=
        IsColimit.ofIsoColimit
            ((IsColimit.precomposeInvEquiv (diagramIsoPair _) _).symm
              (isBilimitOfPreserves F (b.toBiconeIsBilimit.symm hb)).isColimit) <|
          Cocones.ext (Iso.refl _) fun j => by
            rcases j with ⟨⟨⟩⟩ <;> simp }
#align category_theory.limits.preserves_binary_biproduct_of_preserves_biproduct CategoryTheory.Limits.preservesBinaryBiproductOfPreservesBiproduct

/-- A functor that preserves biproducts of a pair preserves binary biproducts. -/
def preservesBinaryBiproductsOfPreservesBiproducts (F : C ⥤ D) [PreservesZeroMorphisms F]
    [PreservesBiproductsOfShape WalkingPair F] : PreservesBinaryBiproducts F where
  preserves {X} Y := preservesBinaryBiproductOfPreservesBiproduct F X Y
#align category_theory.limits.preserves_binary_biproducts_of_preserves_biproducts CategoryTheory.Limits.preservesBinaryBiproductsOfPreservesBiproducts

attribute [instance] PreservesBinaryBiproducts.preserves

end Limits

open CategoryTheory.Limits

namespace Functor

section Bicone

variable {J : Type w₁} (F : C ⥤ D) (f : J → C) [HasBiproduct f]

section

variable [HasBiproduct (F.obj ∘ f)]

/-- As for products, any functor between categories with biproducts gives rise to a morphism
    `F.obj (⨁ f) ⟶ ⨁ (F.obj ∘ f)`. -/
def biproductComparison : F.obj (⨁ f) ⟶ ⨁ F.obj ∘ f :=
  biproduct.lift fun j => F.map (biproduct.π f j)
#align category_theory.functor.biproduct_comparison CategoryTheory.Functor.biproductComparison

@[reassoc (attr := simp)]
theorem biproductComparison_π (j : J) :
    biproductComparison F f ≫ biproduct.π _ j = F.map (biproduct.π f j) :=
  biproduct.lift_π _ _
#align category_theory.functor.biproduct_comparison_π CategoryTheory.Functor.biproductComparison_π

/-- As for coproducts, any functor between categories with biproducts gives rise to a morphism
    `⨁ (F.obj ∘ f) ⟶ F.obj (⨁ f)` -/
def biproductComparison' : ⨁ F.obj ∘ f ⟶ F.obj (⨁ f) :=
  biproduct.desc fun j => F.map (biproduct.ι f j)
#align category_theory.functor.biproduct_comparison' CategoryTheory.Functor.biproductComparison'

@[reassoc (attr := simp)]
theorem ι_biproductComparison' (j : J) :
    biproduct.ι _ j ≫ biproductComparison' F f = F.map (biproduct.ι f j) :=
  biproduct.ι_desc _ _
#align category_theory.functor.ι_biproduct_comparison' CategoryTheory.Functor.ι_biproductComparison'

variable [PreservesZeroMorphisms F]

/-- The composition in the opposite direction is equal to the identity if and only if `F` preserves
    the biproduct, see `preservesBiproduct_of_monoBiproductComparison`.  -/
@[reassoc (attr := simp)]
theorem biproductComparison'_comp_biproductComparison :
    biproductComparison' F f ≫ biproductComparison F f = 𝟙 (⨁ F.obj ∘ f) := by
  classical
    ext
    simp [biproduct.ι_π, ← Functor.map_comp, eqToHom_map]
#align category_theory.functor.biproduct_comparison'_comp_biproduct_comparison CategoryTheory.Functor.biproductComparison'_comp_biproductComparison

/-- `biproduct_comparison F f` is a split epimorphism. -/
@[simps]
def splitEpiBiproductComparison : SplitEpi (biproductComparison F f) where
  section_ := biproductComparison' F f
  id := by aesop
#align category_theory.functor.split_epi_biproduct_comparison CategoryTheory.Functor.splitEpiBiproductComparison

instance : IsSplitEpi (biproductComparison F f) :=
  IsSplitEpi.mk' (splitEpiBiproductComparison F f)

/-- `biproduct_comparison' F f` is a split monomorphism. -/
@[simps]
def splitMonoBiproductComparison' : SplitMono (biproductComparison' F f) where
  retraction := biproductComparison F f
  id := by aesop
#align category_theory.functor.split_mono_biproduct_comparison' CategoryTheory.Functor.splitMonoBiproductComparison'

instance : IsSplitMono (biproductComparison' F f) :=
  IsSplitMono.mk' (splitMonoBiproductComparison' F f)

end

variable [PreservesZeroMorphisms F] [PreservesBiproduct f F]

instance hasBiproduct_of_preserves : HasBiproduct (F.obj ∘ f) :=
  HasBiproduct.mk
    { bicone := F.mapBicone (biproduct.bicone f)
      isBilimit := PreservesBiproduct.preserves (biproduct.isBilimit _) }
#align category_theory.functor.has_biproduct_of_preserves CategoryTheory.Functor.hasBiproduct_of_preserves

/-- If `F` preserves a biproduct, we get a definitionally nice isomorphism
    `F.obj (⨁ f) ≅ ⨁ (F.obj ∘ f)`. -/
@[simp]
def mapBiproduct : F.obj (⨁ f) ≅ ⨁ F.obj ∘ f :=
  biproduct.uniqueUpToIso _ (PreservesBiproduct.preserves (biproduct.isBilimit _))
#align category_theory.functor.map_biproduct CategoryTheory.Functor.mapBiproduct

theorem mapBiproduct_hom :
    haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
    (mapBiproduct F f).hom = biproduct.lift fun j => F.map (biproduct.π f j) := rfl
#align category_theory.functor.map_biproduct_hom CategoryTheory.Functor.mapBiproduct_hom

theorem mapBiproduct_inv :
    haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
    (mapBiproduct F f).inv = biproduct.desc fun j => F.map (biproduct.ι f j) := rfl
#align category_theory.functor.map_biproduct_inv CategoryTheory.Functor.mapBiproduct_inv

end Bicone

variable (F : C ⥤ D) (X Y : C) [HasBinaryBiproduct X Y]

section

variable [HasBinaryBiproduct (F.obj X) (F.obj Y)]

/-- As for products, any functor between categories with binary biproducts gives rise to a
    morphism `F.obj (X ⊞ Y) ⟶ F.obj X ⊞ F.obj Y`. -/
def biprodComparison : F.obj (X ⊞ Y) ⟶ F.obj X ⊞ F.obj Y :=
  biprod.lift (F.map biprod.fst) (F.map biprod.snd)
#align category_theory.functor.biprod_comparison CategoryTheory.Functor.biprodComparison

@[reassoc (attr := simp)]
theorem biprodComparison_fst : biprodComparison F X Y ≫ biprod.fst = F.map biprod.fst :=
  biprod.lift_fst _ _
#align category_theory.functor.biprod_comparison_fst CategoryTheory.Functor.biprodComparison_fst

@[reassoc (attr := simp)]
theorem biprodComparison_snd : biprodComparison F X Y ≫ biprod.snd = F.map biprod.snd :=
  biprod.lift_snd _ _
#align category_theory.functor.biprod_comparison_snd CategoryTheory.Functor.biprodComparison_snd

/-- As for coproducts, any functor between categories with binary biproducts gives rise to a
    morphism `F.obj X ⊞ F.obj Y ⟶ F.obj (X ⊞ Y)`. -/
def biprodComparison' : F.obj X ⊞ F.obj Y ⟶ F.obj (X ⊞ Y) :=
  biprod.desc (F.map biprod.inl) (F.map biprod.inr)
#align category_theory.functor.biprod_comparison' CategoryTheory.Functor.biprodComparison'

@[reassoc (attr := simp)]
theorem inl_biprodComparison' : biprod.inl ≫ biprodComparison' F X Y = F.map biprod.inl :=
  biprod.inl_desc _ _
#align category_theory.functor.inl_biprod_comparison' CategoryTheory.Functor.inl_biprodComparison'

@[reassoc (attr := simp)]
theorem inr_biprodComparison' : biprod.inr ≫ biprodComparison' F X Y = F.map biprod.inr :=
  biprod.inr_desc _ _
#align category_theory.functor.inr_biprod_comparison' CategoryTheory.Functor.inr_biprodComparison'

variable [PreservesZeroMorphisms F]

/-- The composition in the opposite direction is equal to the identity if and only if `F` preserves
    the biproduct, see `preservesBinaryBiproduct_of_monoBiprodComparison`. -/
@[reassoc (attr := simp)]
theorem biprodComparison'_comp_biprodComparison :
    biprodComparison' F X Y ≫ biprodComparison F X Y = 𝟙 (F.obj X ⊞ F.obj Y) := by
  ext <;> simp [← Functor.map_comp]
#align category_theory.functor.biprod_comparison'_comp_biprod_comparison CategoryTheory.Functor.biprodComparison'_comp_biprodComparison

/-- `biprodComparison F X Y` is a split epi. -/
@[simps]
def splitEpiBiprodComparison : SplitEpi (biprodComparison F X Y) where
  section_ := biprodComparison' F X Y
  id := by aesop
#align category_theory.functor.split_epi_biprod_comparison CategoryTheory.Functor.splitEpiBiprodComparison

instance : IsSplitEpi (biprodComparison F X Y) :=
  IsSplitEpi.mk' (splitEpiBiprodComparison F X Y)

/-- `biprodComparison' F X Y` is a split mono. -/
@[simps]
def splitMonoBiprodComparison' : SplitMono (biprodComparison' F X Y) where
  retraction := biprodComparison F X Y
  id := by aesop
#align category_theory.functor.split_mono_biprod_comparison' CategoryTheory.Functor.splitMonoBiprodComparison'

instance : IsSplitMono (biprodComparison' F X Y) :=
  IsSplitMono.mk' (splitMonoBiprodComparison' F X Y)

end

variable [PreservesZeroMorphisms F] [PreservesBinaryBiproduct X Y F]

instance hasBinaryBiproduct_of_preserves : HasBinaryBiproduct (F.obj X) (F.obj Y) :=
  HasBinaryBiproduct.mk
    { bicone := F.mapBinaryBicone (BinaryBiproduct.bicone X Y)
      isBilimit := PreservesBinaryBiproduct.preserves (BinaryBiproduct.isBilimit _ _) }
#align category_theory.functor.has_binary_biproduct_of_preserves CategoryTheory.Functor.hasBinaryBiproduct_of_preserves

/-- If `F` preserves a binary biproduct, we get a definitionally nice isomorphism
    `F.obj (X ⊞ Y) ≅ F.obj X ⊞ F.obj Y`. -/
@[simp]
def mapBiprod : F.obj (X ⊞ Y) ≅ F.obj X ⊞ F.obj Y :=
  biprod.uniqueUpToIso _ _ (PreservesBinaryBiproduct.preserves (BinaryBiproduct.isBilimit _ _))
#align category_theory.functor.map_biprod CategoryTheory.Functor.mapBiprod

theorem mapBiprod_hom : (mapBiprod F X Y).hom = biprod.lift (F.map biprod.fst) (F.map biprod.snd) :=
  rfl
#align category_theory.functor.map_biprod_hom CategoryTheory.Functor.mapBiprod_hom

theorem mapBiprod_inv : (mapBiprod F X Y).inv = biprod.desc (F.map biprod.inl) (F.map biprod.inr) :=
  rfl
#align category_theory.functor.map_biprod_inv CategoryTheory.Functor.mapBiprod_inv

end Functor

namespace Limits

variable (F : C ⥤ D) [PreservesZeroMorphisms F]

section Bicone

variable {J : Type w₁} (f : J → C) [HasBiproduct f] [PreservesBiproduct f F] {W : C}

theorem biproduct.map_lift_mapBiprod (g : ∀ j, W ⟶ f j) :
    -- Porting note: twice we need haveI to tell Lean about hasBiproduct_of_preserves F f
    haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
    F.map (biproduct.lift g) ≫ (F.mapBiproduct f).hom = biproduct.lift fun j => F.map (g j) := by
  apply biproduct.hom_ext; intro j'
  dsimp [Function.comp]
  haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
  simp only [mapBiproduct_hom, Category.assoc, biproduct.lift_π, ← F.map_comp]
#align category_theory.limits.biproduct.map_lift_map_biprod CategoryTheory.Limits.biproduct.map_lift_mapBiprod

theorem biproduct.mapBiproduct_inv_map_desc (g : ∀ j, f j ⟶ W) :
    -- Porting note: twice we need haveI to tell Lean about hasBiproduct_of_preserves F f
    haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
    (F.mapBiproduct f).inv ≫ F.map (biproduct.desc g) = biproduct.desc fun j => F.map (g j) := by
  apply biproduct.hom_ext'; intro j
  dsimp [Function.comp]
  haveI : HasBiproduct fun j => F.obj (f j) := hasBiproduct_of_preserves F f
  simp only [mapBiproduct_inv, ← Category.assoc, biproduct.ι_desc ,← F.map_comp]
#align category_theory.limits.biproduct.map_biproduct_inv_map_desc CategoryTheory.Limits.biproduct.mapBiproduct_inv_map_desc

theorem biproduct.mapBiproduct_hom_desc (g : ∀ j, f j ⟶ W) :
    ((F.mapBiproduct f).hom ≫ biproduct.desc fun j => F.map (g j)) = F.map (biproduct.desc g) := by
  rw [← biproduct.mapBiproduct_inv_map_desc, Iso.hom_inv_id_assoc]
#align category_theory.limits.biproduct.map_biproduct_hom_desc CategoryTheory.Limits.biproduct.mapBiproduct_hom_desc

end Bicone

section BinaryBicone

variable (X Y : C) [HasBinaryBiproduct X Y] [PreservesBinaryBiproduct X Y F] {W : C}

theorem biprod.map_lift_mapBiprod (f : W ⟶ X) (g : W ⟶ Y) :
    F.map (biprod.lift f g) ≫ (F.mapBiprod X Y).hom = biprod.lift (F.map f) (F.map g) := by
  apply biprod.hom_ext <;> simp [mapBiprod, ← F.map_comp]
#align category_theory.limits.biprod.map_lift_map_biprod CategoryTheory.Limits.biprod.map_lift_mapBiprod

theorem biprod.lift_mapBiprod (f : W ⟶ X) (g : W ⟶ Y) :
    biprod.lift (F.map f) (F.map g) ≫ (F.mapBiprod X Y).inv = F.map (biprod.lift f g) := by
  rw [← biprod.map_lift_mapBiprod, Category.assoc, Iso.hom_inv_id, Category.comp_id]
#align category_theory.limits.biprod.lift_map_biprod CategoryTheory.Limits.biprod.lift_mapBiprod

theorem biprod.mapBiprod_inv_map_desc (f : X ⟶ W) (g : Y ⟶ W) :
    (F.mapBiprod X Y).inv ≫ F.map (biprod.desc f g) = biprod.desc (F.map f) (F.map g) := by
  apply biprod.hom_ext' <;> simp [mapBiprod, ← F.map_comp]
#align category_theory.limits.biprod.map_biprod_inv_map_desc CategoryTheory.Limits.biprod.mapBiprod_inv_map_desc

theorem biprod.mapBiprod_hom_desc (f : X ⟶ W) (g : Y ⟶ W) :
    (F.mapBiprod X Y).hom ≫ biprod.desc (F.map f) (F.map g) = F.map (biprod.desc f g) := by
  rw [← biprod.mapBiprod_inv_map_desc, Iso.hom_inv_id_assoc]
#align category_theory.limits.biprod.map_biprod_hom_desc CategoryTheory.Limits.biprod.mapBiprod_hom_desc

end BinaryBicone

end Limits

end HasZeroMorphisms

end CategoryTheory


import Smt

theorem conjunction (p q : Bool) : p → q → p && q := by
  smt
  simp_all


import logic.relation

open function

variables {α β γ δ ε ν : Type*} {f : α → γ} {g : β → δ}

namespace relation

@[simp] lemma map_id_id (r : α → β → Prop) : relation.map r id id = r := by simp [relation.map]

@[simp] lemma map_map (r : α → β → Prop) (f₁ : α → γ) (g₁ : β → δ) (f₂ : γ → ε) (g₂ : δ → ν) :
  relation.map (relation.map r f₁ g₁) f₂ g₂ = relation.map r (f₂ ∘ f₁) (g₂ ∘ g₁) :=
begin
  ext a b,
  simp_rw [relation.map, function.comp_app, ←exists_and_distrib_right, @exists_comm γ,
    @exists_comm δ],
  refine exists₂_congr (λ a b, ⟨_, λ h, ⟨_, _, ⟨⟨h.1, rfl, rfl⟩, h.2⟩⟩⟩),
  rintro ⟨_, _, ⟨hab, rfl, rfl⟩, h⟩,
  exact ⟨hab, h⟩,
end

@[simp]
lemma map_apply_apply (hf : injective f) (hg : injective g) (r : α → β → Prop) (a : α) (b : β) :
  relation.map r f g (f a) (g b) ↔ r a b :=
by simp [relation.map, hf.eq_iff, hg.eq_iff]

end relation


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

Direct sum of modules over commutative rings, indexed by a discrete type.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.direct_sum
import Mathlib.linear_algebra.dfinsupp
import Mathlib.PostPort

universes u v w u₁ u_1

namespace Mathlib

/-!
# Direct sum of modules over commutative rings, indexed by a discrete type.

This file provides constructors for finite direct sums of modules.
It provides a construction of the direct sum using the universal property and proves
its uniqueness.

## Implementation notes

All of this file assumes that
* `R` is a commutative ring,
* `ι` is a discrete type,
* `S` is a finite set in `ι`,
* `M` is a family of `R` semimodules indexed over `ι`.
-/

namespace direct_sum

protected instance semimodule {R : Type u} [semiring R] {ι : Type v} {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] :
    semimodule R (direct_sum ι fun (i : ι) => M i) :=
  dfinsupp.semimodule

theorem smul_apply {R : Type u} [semiring R] {ι : Type v} {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (b : R)
    (v : direct_sum ι fun (i : ι) => M i) (i : ι) : coe_fn (b • v) i = b • coe_fn v i :=
  dfinsupp.smul_apply b v i

/-- Create the direct sum given a family `M` of `R` semimodules indexed over `ι`. -/
def lmk (R : Type u) [semiring R] (ι : Type v) [dec_ι : DecidableEq ι] (M : ι → Type w)
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (s : finset ι) :
    linear_map R ((i : ↥↑s) → M (subtype.val i)) (direct_sum ι fun (i : ι) => M i) :=
  dfinsupp.lmk

/-- Inclusion of each component into the direct sum. -/
def lof (R : Type u) [semiring R] (ι : Type v) [dec_ι : DecidableEq ι] (M : ι → Type w)
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι) :
    linear_map R (M i) (direct_sum ι fun (i : ι) => M i) :=
  dfinsupp.lsingle

theorem single_eq_lof (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι)
    (b : M i) : dfinsupp.single i b = coe_fn (lof R ι M i) b :=
  rfl

/-- Scalar multiplication commutes with direct sums. -/
theorem mk_smul (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (s : finset ι) (c : R)
    (x : (i : ↥↑s) → M (subtype.val i)) : coe_fn (mk M s) (c • x) = c • coe_fn (mk M s) x :=
  linear_map.map_smul (lmk R ι M s) c x

/-- Scalar multiplication commutes with the inclusion of each component into the direct sum. -/
theorem of_smul (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι) (c : R) (x : M i) :
    coe_fn (of M i) (c • x) = c • coe_fn (of M i) x :=
  linear_map.map_smul (lof R ι M i) c x

theorem support_smul {R : Type u} [semiring R] {ι : Type v} [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)]
    [(i : ι) → (x : M i) → Decidable (x ≠ 0)] (c : R) (v : direct_sum ι fun (i : ι) => M i) :
    dfinsupp.support (c • v) ⊆ dfinsupp.support v :=
  dfinsupp.support_smul c v

/-- The linear map constructed using the universal property of the coproduct. -/
def to_module (R : Type u) [semiring R] (ι : Type v) [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (N : Type u₁)
    [add_comm_monoid N] [semimodule R N] (φ : (i : ι) → linear_map R (M i) N) :
    linear_map R (direct_sum ι fun (i : ι) => M i) N :=
  coe_fn dfinsupp.lsum φ

/-- The map constructed using the universal property gives back the original maps when
restricted to each component. -/
@[simp] theorem to_module_lof (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] {N : Type u₁}
    [add_comm_monoid N] [semimodule R N] {φ : (i : ι) → linear_map R (M i) N} (i : ι) (x : M i) :
    coe_fn (to_module R ι N φ) (coe_fn (lof R ι M i) x) = coe_fn (φ i) x :=
  to_add_monoid_of (fun (i : ι) => linear_map.to_add_monoid_hom (φ i)) i x

/-- Every linear map from a direct sum agrees with the one obtained by applying
the universal property to each of its components. -/
theorem to_module.unique (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] {N : Type u₁}
    [add_comm_monoid N] [semimodule R N] (ψ : linear_map R (direct_sum ι fun (i : ι) => M i) N)
    (f : direct_sum ι fun (i : ι) => M i) :
    coe_fn ψ f = coe_fn (to_module R ι N fun (i : ι) => linear_map.comp ψ (lof R ι M i)) f :=
  to_add_monoid.unique (linear_map.to_add_monoid_hom ψ) f

theorem to_module.ext (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] {N : Type u₁}
    [add_comm_monoid N] [semimodule R N] {ψ : linear_map R (direct_sum ι fun (i : ι) => M i) N}
    {ψ' : linear_map R (direct_sum ι fun (i : ι) => M i) N}
    (H : ∀ (i : ι), linear_map.comp ψ (lof R ι M i) = linear_map.comp ψ' (lof R ι M i))
    (f : direct_sum ι fun (i : ι) => M i) : coe_fn ψ f = coe_fn ψ' f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn ψ f = coe_fn ψ' f)) (dfinsupp.lhom_ext' H)))
    (Eq.refl (coe_fn ψ' f))

/--
The inclusion of a subset of the direct summands
into a larger subset of the direct summands, as a linear map.
-/
def lset_to_set (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (S : set ι) (T : set ι)
    (H : S ⊆ T) :
    linear_map R (direct_sum ↥S fun (i : ↥S) => M ↑i) (direct_sum ↥T fun (i : ↥T) => M ↑i) :=
  to_module R (↥S) (direct_sum ↥T fun (i : ↥T) => M ↑i)
    fun (i : ↥S) => lof R (↥T) (fun (i : Subtype T) => M ↑i) { val := ↑i, property := sorry }

/-- The natural linear equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/
protected def lid (R : Type u) [semiring R] (M : Type v) (ι : optParam (Type u_1) PUnit)
    [add_comm_monoid M] [semimodule R M] [unique ι] :
    linear_equiv R (direct_sum ι fun (_x : ι) => M) M :=
  linear_equiv.mk (add_equiv.to_fun (direct_sum.id M ι)) sorry sorry
    (add_equiv.inv_fun (direct_sum.id M ι)) sorry sorry

/-- The projection map onto one component, as a linear map. -/
def component (R : Type u) [semiring R] (ι : Type v) (M : ι → Type w)
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι) :
    linear_map R (direct_sum ι fun (i : ι) => M i) (M i) :=
  dfinsupp.lapply i

theorem apply_eq_component (R : Type u) [semiring R] {ι : Type v} {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)]
    (f : direct_sum ι fun (i : ι) => M i) (i : ι) : coe_fn f i = coe_fn (component R ι M i) f :=
  rfl

theorem ext (R : Type u) [semiring R] {ι : Type v} {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)]
    {f : direct_sum ι fun (i : ι) => M i} {g : direct_sum ι fun (i : ι) => M i}
    (h : ∀ (i : ι), coe_fn (component R ι M i) f = coe_fn (component R ι M i) g) : f = g :=
  dfinsupp.ext h

theorem ext_iff (R : Type u) [semiring R] {ι : Type v} {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)]
    {f : direct_sum ι fun (i : ι) => M i} {g : direct_sum ι fun (i : ι) => M i} :
    f = g ↔ ∀ (i : ι), coe_fn (component R ι M i) f = coe_fn (component R ι M i) g :=
  sorry

@[simp] theorem lof_apply (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι)
    (b : M i) : coe_fn (coe_fn (lof R ι M i) b) i = b :=
  dfinsupp.single_eq_same

@[simp] theorem component.lof_self (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι]
    {M : ι → Type w} [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι)
    (b : M i) : coe_fn (component R ι M i) (coe_fn (lof R ι M i) b) = b :=
  lof_apply R i b

theorem component.of (R : Type u) [semiring R] {ι : Type v} [dec_ι : DecidableEq ι] {M : ι → Type w}
    [(i : ι) → add_comm_monoid (M i)] [(i : ι) → semimodule R (M i)] (i : ι) (j : ι) (b : M j) :
    coe_fn (component R ι M i) (coe_fn (lof R ι M j) b) =
        dite (j = i) (fun (h : j = i) => eq.rec_on h b) fun (h : ¬j = i) => 0 :=
  dfinsupp.single_apply

end Mathlib


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

! This file was ported from Lean 3 source module algebra.monoid_algebra.to_direct_sum
! leanprover-community/mathlib commit c0a51cf2de54089d69301befc4c73bbc2f5c7342
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.DirectSum.Algebra
import Mathbin.Algebra.MonoidAlgebra.Basic
import Mathbin.Data.Finsupp.ToDfinsupp

/-!
# Conversion between `add_monoid_algebra` and homogenous `direct_sum`

This module provides conversions between `add_monoid_algebra` and `direct_sum`.
The latter is essentially a dependent version of the former.

Note that since `direct_sum.has_mul` combines indices additively, there is no equivalent to
`monoid_algebra`.

## Main definitions

* `add_monoid_algebra.to_direct_sum : add_monoid_algebra M ι → (⨁ i : ι, M)`
* `direct_sum.to_add_monoid_algebra : (⨁ i : ι, M) → add_monoid_algebra M ι`
* Bundled equiv versions of the above:
  * `add_monoid_algebra_equiv_direct_sum : add_monoid_algebra M ι ≃ (⨁ i : ι, M)`
  * `add_monoid_algebra_add_equiv_direct_sum : add_monoid_algebra M ι ≃+ (⨁ i : ι, M)`
  * `add_monoid_algebra_ring_equiv_direct_sum R : add_monoid_algebra M ι ≃+* (⨁ i : ι, M)`
  * `add_monoid_algebra_alg_equiv_direct_sum R : add_monoid_algebra A ι ≃ₐ[R] (⨁ i : ι, A)`

## Theorems

The defining feature of these operations is that they map `finsupp.single` to
`direct_sum.of` and vice versa:

* `add_monoid_algebra.to_direct_sum_single`
* `direct_sum.to_add_monoid_algebra_of`

as well as preserving arithmetic operations.

For the bundled equivalences, we provide lemmas that they reduce to
`add_monoid_algebra.to_direct_sum`:

* `add_monoid_algebra_add_equiv_direct_sum_apply`
* `add_monoid_algebra_lequiv_direct_sum_apply`
* `add_monoid_algebra_add_equiv_direct_sum_symm_apply`
* `add_monoid_algebra_lequiv_direct_sum_symm_apply`

## Implementation notes

This file largely just copies the API of `data/finsupp/to_dfinsupp`, and reuses the proofs.
Recall that `add_monoid_algebra M ι` is defeq to `ι →₀ M` and `⨁ i : ι, M` is defeq to
`Π₀ i : ι, M`.

Note that there is no `add_monoid_algebra` equivalent to `finsupp.single`, so many statements
still involve this definition.
-/

variable {ι : Type _} {R : Type _} {M : Type _} {A : Type _}

open DirectSum

/-! ### Basic definitions and lemmas -/

section Defs

/-- Interpret a `add_monoid_algebra` as a homogenous `direct_sum`. -/
def AddMonoidAlgebra.toDirectSum [Semiring M] (f : AddMonoidAlgebra M ι) : ⨁ i : ι, M :=
  Finsupp.toDfinsupp f
#align add_monoid_algebra.to_direct_sum AddMonoidAlgebra.toDirectSum

section

variable [DecidableEq ι] [Semiring M]

@[simp]
theorem AddMonoidAlgebra.toDirectSum_single (i : ι) (m : M) :
    AddMonoidAlgebra.toDirectSum (Finsupp.single i m) = DirectSum.of _ i m :=
  Finsupp.toDfinsupp_single i m
#align add_monoid_algebra.to_direct_sum_single AddMonoidAlgebra.toDirectSum_single

variable [∀ m : M, Decidable (m ≠ 0)]

/-- Interpret a homogenous `direct_sum` as a `add_monoid_algebra`. -/
def DirectSum.toAddMonoidAlgebra (f : ⨁ i : ι, M) : AddMonoidAlgebra M ι :=
  Dfinsupp.toFinsupp f
#align direct_sum.to_add_monoid_algebra DirectSum.toAddMonoidAlgebra

@[simp]
theorem DirectSum.toAddMonoidAlgebra_of (i : ι) (m : M) :
    (DirectSum.of _ i m : ⨁ i : ι, M).toAddMonoidAlgebra = Finsupp.single i m :=
  Dfinsupp.toFinsupp_single i m
#align direct_sum.to_add_monoid_algebra_of DirectSum.toAddMonoidAlgebra_of

@[simp]
theorem AddMonoidAlgebra.toDirectSum_toAddMonoidAlgebra (f : AddMonoidAlgebra M ι) :
    f.toDirectSum.toAddMonoidAlgebra = f :=
  Finsupp.toDfinsupp_toFinsupp f
#align add_monoid_algebra.to_direct_sum_to_add_monoid_algebra AddMonoidAlgebra.toDirectSum_toAddMonoidAlgebra

@[simp]
theorem DirectSum.toAddMonoidAlgebra_toDirectSum (f : ⨁ i : ι, M) :
    f.toAddMonoidAlgebra.toDirectSum = f :=
  Dfinsupp.toFinsupp_toDfinsupp f
#align direct_sum.to_add_monoid_algebra_to_direct_sum DirectSum.toAddMonoidAlgebra_toDirectSum

end

end Defs

/-! ### Lemmas about arithmetic operations -/

section Lemmas

namespace AddMonoidAlgebra

@[simp]
theorem toDirectSum_zero [Semiring M] : (0 : AddMonoidAlgebra M ι).toDirectSum = 0 :=
  Finsupp.toDfinsupp_zero
#align add_monoid_algebra.to_direct_sum_zero AddMonoidAlgebra.toDirectSum_zero

@[simp]
theorem toDirectSum_add [Semiring M] (f g : AddMonoidAlgebra M ι) :
    (f + g).toDirectSum = f.toDirectSum + g.toDirectSum :=
  Finsupp.toDfinsupp_add _ _
#align add_monoid_algebra.to_direct_sum_add AddMonoidAlgebra.toDirectSum_add

@[simp]
theorem toDirectSum_mul [DecidableEq ι] [AddMonoid ι] [Semiring M] (f g : AddMonoidAlgebra M ι) :
    (f * g).toDirectSum = f.toDirectSum * g.toDirectSum :=
  by
  let to_hom : AddMonoidAlgebra M ι →+ ⨁ i : ι, M :=
    ⟨to_direct_sum, to_direct_sum_zero, to_direct_sum_add⟩
  show to_hom (f * g) = to_hom f * to_hom g
  revert f g
  rw [AddMonoidHom.map_mul_iff]
  ext (xi xv yi yv) : 4
  dsimp only [AddMonoidHom.comp_apply, AddMonoidHom.compl₂_apply, AddMonoidHom.compr₂_apply,
    AddMonoidHom.mul_apply, AddEquiv.coe_toAddMonoidHom, Finsupp.singleAddHom_apply]
  simp only [AddMonoidAlgebra.single_mul_single, to_hom, AddMonoidHom.coe_mk,
    AddMonoidAlgebra.toDirectSum_single, DirectSum.of_mul_of, Mul.gMul_mul]
#align add_monoid_algebra.to_direct_sum_mul AddMonoidAlgebra.toDirectSum_mul

end AddMonoidAlgebra

namespace DirectSum

variable [DecidableEq ι]

@[simp]
theorem toAddMonoidAlgebra_zero [Semiring M] [∀ m : M, Decidable (m ≠ 0)] :
    toAddMonoidAlgebra 0 = (0 : AddMonoidAlgebra M ι) :=
  Dfinsupp.toFinsupp_zero
#align direct_sum.to_add_monoid_algebra_zero DirectSum.toAddMonoidAlgebra_zero

@[simp]
theorem toAddMonoidAlgebra_add [Semiring M] [∀ m : M, Decidable (m ≠ 0)] (f g : ⨁ i : ι, M) :
    (f + g).toAddMonoidAlgebra = toAddMonoidAlgebra f + toAddMonoidAlgebra g :=
  Dfinsupp.toFinsupp_add _ _
#align direct_sum.to_add_monoid_algebra_add DirectSum.toAddMonoidAlgebra_add

@[simp]
theorem toAddMonoidAlgebra_mul [AddMonoid ι] [Semiring M] [∀ m : M, Decidable (m ≠ 0)]
    (f g : ⨁ i : ι, M) : (f * g).toAddMonoidAlgebra = toAddMonoidAlgebra f * toAddMonoidAlgebra g :=
  by
  apply_fun AddMonoidAlgebra.toDirectSum
  · simp
  · apply Function.LeftInverse.injective
    apply AddMonoidAlgebra.toDirectSum_toAddMonoidAlgebra
#align direct_sum.to_add_monoid_algebra_mul DirectSum.toAddMonoidAlgebra_mul

end DirectSum

end Lemmas

/-! ### Bundled `equiv`s -/

section Equivs

/-- `add_monoid_algebra.to_direct_sum` and `direct_sum.to_add_monoid_algebra` together form an
equiv. -/
@[simps (config := { fullyApplied := false })]
def addMonoidAlgebraEquivDirectSum [DecidableEq ι] [Semiring M] [∀ m : M, Decidable (m ≠ 0)] :
    AddMonoidAlgebra M ι ≃ ⨁ i : ι, M :=
  { finsuppEquivDfinsupp with
    toFun := AddMonoidAlgebra.toDirectSum
    invFun := DirectSum.toAddMonoidAlgebra }
#align add_monoid_algebra_equiv_direct_sum addMonoidAlgebraEquivDirectSum

/-- The additive version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps (config := { fullyApplied := false })]
def addMonoidAlgebraAddEquivDirectSum [DecidableEq ι] [Semiring M] [∀ m : M, Decidable (m ≠ 0)] :
    AddMonoidAlgebra M ι ≃+ ⨁ i : ι, M :=
  {
    addMonoidAlgebraEquivDirectSum with
    toFun := AddMonoidAlgebra.toDirectSum
    invFun := DirectSum.toAddMonoidAlgebra
    map_add' := AddMonoidAlgebra.toDirectSum_add }
#align add_monoid_algebra_add_equiv_direct_sum addMonoidAlgebraAddEquivDirectSum

/-- The ring version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps (config := { fullyApplied := false })]
def addMonoidAlgebraRingEquivDirectSum [DecidableEq ι] [AddMonoid ι] [Semiring M]
    [∀ m : M, Decidable (m ≠ 0)] : AddMonoidAlgebra M ι ≃+* ⨁ i : ι, M :=
  {
    (addMonoidAlgebraAddEquivDirectSum :
      AddMonoidAlgebra M ι ≃+
        ⨁ i : ι, M) with
    toFun := AddMonoidAlgebra.toDirectSum
    invFun := DirectSum.toAddMonoidAlgebra
    map_mul' := AddMonoidAlgebra.toDirectSum_mul }
#align add_monoid_algebra_ring_equiv_direct_sum addMonoidAlgebraRingEquivDirectSum

/-- The algebra version of `add_monoid_algebra.to_add_monoid_algebra`. Note that this is
`noncomputable` because `add_monoid_algebra.has_add` is noncomputable. -/
@[simps (config := { fullyApplied := false })]
def addMonoidAlgebraAlgEquivDirectSum [DecidableEq ι] [AddMonoid ι] [CommSemiring R] [Semiring A]
    [Algebra R A] [∀ m : A, Decidable (m ≠ 0)] : AddMonoidAlgebra A ι ≃ₐ[R] ⨁ i : ι, A :=
  {
    (addMonoidAlgebraRingEquivDirectSum :
      AddMonoidAlgebra A ι ≃+*
        ⨁ i : ι, A) with
    toFun := AddMonoidAlgebra.toDirectSum
    invFun := DirectSum.toAddMonoidAlgebra
    commutes' := fun r => AddMonoidAlgebra.toDirectSum_single _ _ }
#align add_monoid_algebra_alg_equiv_direct_sum addMonoidAlgebraAlgEquivDirectSum

end Equivs


/-
Copyright (c) 2021 Ashwin Iyengar. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Johan Commelin, Ashwin Iyengar, Patrick Massot

! This file was ported from Lean 3 source module topology.algebra.nonarchimedean.basic
! leanprover-community/mathlib commit 83f81aea33931a1edb94ce0f32b9a5d484de6978
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.Topology.Algebra.OpenSubgroup
import Mathlib.Topology.Algebra.Ring.Basic

/-!
# Nonarchimedean Topology

In this file we set up the theory of nonarchimedean topological groups and rings.

A nonarchimedean group is a topological group whose topology admits a basis of
open neighborhoods of the identity element in the group consisting of open subgroups.
A nonarchimedean ring is a topological ring whose underlying topological (additive)
group is nonarchimedean.

## Definitions

- `NonarchimedeanAddGroup`: nonarchimedean additive group.
- `NonarchimedeanGroup`: nonarchimedean multiplicative group.
- `NonarchimedeanRing`: nonarchimedean ring.

-/

open Pointwise

/-- An topological additive group is nonarchimedean if every neighborhood of 0
  contains an open subgroup. -/
class NonarchimedeanAddGroup (G : Type _) [AddGroup G] [TopologicalSpace G] extends
  TopologicalAddGroup G : Prop where
  is_nonarchimedean : ∀ U ∈ nhds (0 : G), ∃ V : OpenAddSubgroup G, (V : Set G) ⊆ U
#align nonarchimedean_add_group NonarchimedeanAddGroup

/-- A topological group is nonarchimedean if every neighborhood of 1 contains an open subgroup. -/
@[to_additive]
class NonarchimedeanGroup (G : Type _) [Group G] [TopologicalSpace G] extends TopologicalGroup G :
  Prop where
  is_nonarchimedean : ∀ U ∈ nhds (1 : G), ∃ V : OpenSubgroup G, (V : Set G) ⊆ U
#align nonarchimedean_group NonarchimedeanGroup

/-- An topological ring is nonarchimedean if its underlying topological additive
  group is nonarchimedean. -/
class NonarchimedeanRing (R : Type _) [Ring R] [TopologicalSpace R] extends TopologicalRing R :
  Prop where
  is_nonarchimedean : ∀ U ∈ nhds (0 : R), ∃ V : OpenAddSubgroup R, (V : Set R) ⊆ U
#align nonarchimedean_ring NonarchimedeanRing

-- see Note [lower instance priority]
/-- Every nonarchimedean ring is naturally a nonarchimedean additive group. -/
instance (priority := 100) NonarchimedeanRing.to_nonarchimedeanAddGroup (R : Type _) [Ring R]
    [TopologicalSpace R] [t : NonarchimedeanRing R] : NonarchimedeanAddGroup R :=
  { t with }
#align nonarchimedean_ring.to_nonarchimedean_add_group NonarchimedeanRing.to_nonarchimedeanAddGroup

namespace NonarchimedeanGroup

variable {G : Type _} [Group G] [TopologicalSpace G] [NonarchimedeanGroup G]

variable {H : Type _} [Group H] [TopologicalSpace H] [TopologicalGroup H]

variable {K : Type _} [Group K] [TopologicalSpace K] [NonarchimedeanGroup K]

/-- If a topological group embeds into a nonarchimedean group, then it is nonarchimedean. -/
@[to_additive]
theorem nonarchimedean_of_emb (f : G →* H) (emb : OpenEmbedding f) : NonarchimedeanGroup H :=
  {
    is_nonarchimedean := fun U hU =>
      have h₁ : f ⁻¹' U ∈ nhds (1 : G) :=
        by
        apply emb.continuous.tendsto
        rwa [f.map_one]
      let ⟨V, hV⟩ := is_nonarchimedean (f ⁻¹' U) h₁
      ⟨{ Subgroup.map f V with isOpen' := emb.isOpenMap _ V.isOpen }, Set.image_subset_iff.2 hV⟩ }
#align nonarchimedean_group.nonarchimedean_of_emb NonarchimedeanGroup.nonarchimedean_of_emb
#align nonarchimedean_add_group.nonarchimedean_of_emb NonarchimedeanAddGroup.nonarchimedean_of_emb

/-- An open neighborhood of the identity in the cartesian product of two nonarchimedean groups
contains the cartesian product of an open neighborhood in each group. -/
@[to_additive NonarchimedeanAddGroup.prod_subset "An open neighborhood of the identity in
the cartesian product of two nonarchimedean groups contains the cartesian product of
an open neighborhood in each group."]

/-- An open neighborhood of the identity in the cartesian square of a nonarchimedean group
contains the cartesian square of an open neighborhood in the group. -/
@[to_additive NonarchimedeanAddGroup.prod_self_subset "An open neighborhood of the identity in
the cartesian square of a nonarchimedean group contains the cartesian square of
an open neighborhood in the group."]
theorem prod_self_subset {U} (hU : U ∈ nhds (1 : G × G)) :
    ∃ V : OpenSubgroup G, (V : Set G) ×ˢ (V : Set G) ⊆ U :=
  let ⟨V, W, h⟩ := prod_subset hU
  ⟨V ⊓ W, by refine' Set.Subset.trans (Set.prod_mono _ _) ‹_› <;> simp⟩
#align nonarchimedean_group.prod_self_subset NonarchimedeanGroup.prod_self_subset
#align nonarchimedean_add_group.prod_self_subset NonarchimedeanAddGroup.prod_self_subset

/-- The cartesian product of two nonarchimedean groups is nonarchimedean. -/
@[to_additive "The cartesian product of two nonarchimedean groups is nonarchimedean."]
instance : NonarchimedeanGroup (G × K)
    where is_nonarchimedean U hU :=
    let ⟨V, W, h⟩ := prod_subset hU
    ⟨V.prod W, ‹_›⟩

end NonarchimedeanGroup

namespace NonarchimedeanRing

open NonarchimedeanRing

open NonarchimedeanAddGroup

variable {R S : Type _}

variable [Ring R] [TopologicalSpace R] [NonarchimedeanRing R]

variable [Ring S] [TopologicalSpace S] [NonarchimedeanRing S]

/-- The cartesian product of two nonarchimedean rings is nonarchimedean. -/
instance : NonarchimedeanRing (R × S)
    where is_nonarchimedean := NonarchimedeanAddGroup.is_nonarchimedean

/-- Given an open subgroup `U` and an element `r` of a nonarchimedean ring, there is an open
  subgroup `V` such that `r • V` is contained in `U`. -/
theorem left_mul_subset (U : OpenAddSubgroup R) (r : R) :
    ∃ V : OpenAddSubgroup R, r • (V : Set R) ⊆ U :=
  ⟨U.comap (AddMonoidHom.mulLeft r) (continuous_mul_left r), (U : Set R).image_preimage_subset _⟩
#align nonarchimedean_ring.left_mul_subset NonarchimedeanRing.left_mul_subset

/-- An open subgroup of a nonarchimedean ring contains the square of another one. -/
theorem mul_subset (U : OpenAddSubgroup R) : ∃ V : OpenAddSubgroup R, (V : Set R) * V ⊆ U := by
  let ⟨V, H⟩ :=
    prod_self_subset
      (IsOpen.mem_nhds (IsOpen.preimage continuous_mul U.isOpen)
        (by simpa only [Set.mem_preimage, SetLike.mem_coe, Prod.snd_zero,
            MulZeroClass.mul_zero] using U.zero_mem))
  use V
  rintro v ⟨a, b, ha, hb, hv⟩
  have hy := H (Set.mk_mem_prod ha hb)
  simp only [Set.mem_preimage, SetLike.mem_coe, hv] at hy
  rw [SetLike.mem_coe]
  exact hy
#align nonarchimedean_ring.mul_subset NonarchimedeanRing.mul_subset

end NonarchimedeanRing