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

! This file was ported from Lean 3 source module category_theory.is_connected
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Chain
import Mathbin.CategoryTheory.Punit
import Mathbin.CategoryTheory.Groupoid
import Mathbin.CategoryTheory.Category.Ulift

/-!
# Connected category

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

Define a connected category as a _nonempty_ category for which every functor
to a discrete category is isomorphic to the constant functor.

NB. Some authors include the empty category as connected, we do not.
We instead are interested in categories with exactly one 'connected
component'.

We give some equivalent definitions:
- A nonempty category for which every functor to a discrete category is
  constant on objects.
  See `any_functor_const_on_obj` and `connected.of_any_functor_const_on_obj`.
- A nonempty category for which every function `F` for which the presence of a
  morphism `f : j₁ ⟶ j₂` implies `F j₁ = F j₂` must be constant everywhere.
  See `constant_of_preserves_morphisms` and `connected.of_constant_of_preserves_morphisms`.
- A nonempty category for which any subset of its elements containing the
  default and closed under morphisms is everything.
  See `induct_on_objects` and `connected.of_induct`.
- A nonempty category for which every object is related under the reflexive
  transitive closure of the relation "there is a morphism in some direction
  from `j₁` to `j₂`".
  See `connected_zigzag` and `zigzag_connected`.
- A nonempty category for which for any two objects there is a sequence of
  morphisms (some reversed) from one to the other.
  See `exists_zigzag'` and `connected_of_zigzag`.

We also prove the result that the functor given by `(X × -)` preserves any
connected limit. That is, any limit of shape `J` where `J` is a connected
category is preserved by the functor `(X × -)`. This appears in `category_theory.limits.connected`.
-/

universe v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory.Category

open Opposite

namespace CategoryTheory

#print CategoryTheory.IsPreconnected /-
/-- A possibly empty category for which every functor to a discrete category is constant.
-/
class IsPreconnected (J : Type u₁) [Category.{v₁} J] : Prop where
  iso_constant :
    ∀ {α : Type u₁} (F : J ⥤ Discrete α) (j : J), Nonempty (F ≅ (Functor.const J).obj (F.obj j))
#align category_theory.is_preconnected CategoryTheory.IsPreconnected
-/

#print CategoryTheory.IsConnected /-
/-- We define a connected category as a _nonempty_ category for which every
functor to a discrete category is constant.

NB. Some authors include the empty category as connected, we do not.
We instead are interested in categories with exactly one 'connected
component'.

This allows us to show that the functor X ⨯ - preserves connected limits.

See <https://stacks.math.columbia.edu/tag/002S>
-/
class IsConnected (J : Type u₁) [Category.{v₁} J] extends IsPreconnected J : Prop where
  [is_nonempty : Nonempty J]
#align category_theory.is_connected CategoryTheory.IsConnected
-/

attribute [instance] is_connected.is_nonempty

variable {J : Type u₁} [Category.{v₁} J]

variable {K : Type u₂} [Category.{v₂} K]

/- warning: category_theory.iso_constant -> CategoryTheory.isoConstant is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J), CategoryTheory.Iso.{u2, max u1 u2} (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.category.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) F (CategoryTheory.Functor.obj.{u2, u2, u2, max u1 u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.category.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.const.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.obj.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F j))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J), CategoryTheory.Iso.{u2, max u2 u1} (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.category.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) F (Prefunctor.obj.{succ u2, succ u2, u2, max u2 u1} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u2 u1} (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Category.toCategoryStruct.{u2, max u2 u1} (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.category.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u2, max u2 u1} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) (CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.category.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (CategoryTheory.Functor.const.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (Prefunctor.obj.{succ u1, succ u2, u2, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F) j))
Case conversion may be inaccurate. Consider using '#align category_theory.iso_constant CategoryTheory.isoConstantₓ'. -/
/-- If `J` is connected, any functor `F : J ⥤ discrete α` is isomorphic to
the constant functor with value `F.obj j` (for any choice of `j`).
-/
def isoConstant [IsPreconnected J] {α : Type u₁} (F : J ⥤ Discrete α) (j : J) :
    F ≅ (Functor.const J).obj (F.obj j) :=
  (IsPreconnected.iso_constant F j).some
#align category_theory.iso_constant CategoryTheory.isoConstant

/- warning: category_theory.any_functor_const_on_obj -> CategoryTheory.any_functor_const_on_obj is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J) (j' : J), Eq.{succ u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Functor.obj.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F j) (CategoryTheory.Functor.obj.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F j')
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J) (j' : J), Eq.{succ u2} (CategoryTheory.Discrete.{u2} α) (Prefunctor.obj.{succ u1, succ u2, u2, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F) j) (Prefunctor.obj.{succ u1, succ u2, u2, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F) j')
Case conversion may be inaccurate. Consider using '#align category_theory.any_functor_const_on_obj CategoryTheory.any_functor_const_on_objₓ'. -/
/-- If J is connected, any functor to a discrete category is constant on objects.
The converse is given in `is_connected.of_any_functor_const_on_obj`.
-/
theorem any_functor_const_on_obj [IsPreconnected J] {α : Type u₁} (F : J ⥤ Discrete α) (j j' : J) :
    F.obj j = F.obj j' := by
  ext
  exact ((iso_constant F j').Hom.app j).down.1
#align category_theory.any_functor_const_on_obj CategoryTheory.any_functor_const_on_obj

/- warning: category_theory.is_connected.of_any_functor_const_on_obj -> CategoryTheory.IsConnected.of_any_functor_const_on_obj is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : Nonempty.{succ u2} J], (forall {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J) (j' : J), Eq.{succ u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Functor.obj.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F j) (CategoryTheory.Functor.obj.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F j')) -> (CategoryTheory.IsConnected.{u1, u2} J _inst_1)
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : Nonempty.{succ u2} J], (forall {α : Type.{u2}} (F : CategoryTheory.Functor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α)) (j : J) (j' : J), Eq.{succ u2} (CategoryTheory.Discrete.{u2} α) (Prefunctor.obj.{succ u1, succ u2, u2, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F) j) (Prefunctor.obj.{succ u1, succ u2, u2, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) (CategoryTheory.Discrete.{u2} α) (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.Category.toCategoryStruct.{u2, u2} (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u2} J _inst_1 (CategoryTheory.Discrete.{u2} α) (CategoryTheory.discreteCategory.{u2} α) F) j')) -> (CategoryTheory.IsConnected.{u1, u2} J _inst_1)
Case conversion may be inaccurate. Consider using '#align category_theory.is_connected.of_any_functor_const_on_obj CategoryTheory.IsConnected.of_any_functor_const_on_objₓ'. -/
/-- If any functor to a discrete category is constant on objects, J is connected.
The converse of `any_functor_const_on_obj`.
-/
theorem IsConnected.of_any_functor_const_on_obj [Nonempty J]
    (h : ∀ {α : Type u₁} (F : J ⥤ Discrete α), ∀ j j' : J, F.obj j = F.obj j') : IsConnected J :=
  {
    iso_constant := fun α F j' =>
      ⟨NatIso.ofComponents (fun j => eqToIso (h F j j')) fun _ _ _ => Subsingleton.elim _ _⟩ }
#align category_theory.is_connected.of_any_functor_const_on_obj CategoryTheory.IsConnected.of_any_functor_const_on_obj

#print CategoryTheory.constant_of_preserves_morphisms /-
/-- If `J` is connected, then given any function `F` such that the presence of a
morphism `j₁ ⟶ j₂` implies `F j₁ = F j₂`, we have that `F` is constant.
This can be thought of as a local-to-global property.

The converse is shown in `is_connected.of_constant_of_preserves_morphisms`
-/
theorem constant_of_preserves_morphisms [IsPreconnected J] {α : Type u₁} (F : J → α)
    (h : ∀ (j₁ j₂ : J) (f : j₁ ⟶ j₂), F j₁ = F j₂) (j j' : J) : F j = F j' := by
  simpa using
    any_functor_const_on_obj
      { obj := discrete.mk ∘ F
        map := fun _ _ f =>
          eq_to_hom
            (by
              ext
              exact h _ _ f) }
      j j'
#align category_theory.constant_of_preserves_morphisms CategoryTheory.constant_of_preserves_morphisms
-/

#print CategoryTheory.IsConnected.of_constant_of_preserves_morphisms /-
/-- `J` is connected if: given any function `F : J → α` which is constant for any
`j₁, j₂` for which there is a morphism `j₁ ⟶ j₂`, then `F` is constant.
This can be thought of as a local-to-global property.

The converse of `constant_of_preserves_morphisms`.
-/
theorem IsConnected.of_constant_of_preserves_morphisms [Nonempty J]
    (h :
      ∀ {α : Type u₁} (F : J → α),
        (∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), F j₁ = F j₂) → ∀ j j' : J, F j = F j') :
    IsConnected J :=
  IsConnected.of_any_functor_const_on_obj fun _ F =>
    h F.obj fun _ _ f => by
      ext
      exact discrete.eq_of_hom (F.map f)
#align category_theory.is_connected.of_constant_of_preserves_morphisms CategoryTheory.IsConnected.of_constant_of_preserves_morphisms
-/

#print CategoryTheory.induct_on_objects /-
/-- An inductive-like property for the objects of a connected category.
If the set `p` is nonempty, and `p` is closed under morphisms of `J`,
then `p` contains all of `J`.

The converse is given in `is_connected.of_induct`.
-/
theorem induct_on_objects [IsPreconnected J] (p : Set J) {j₀ : J} (h0 : j₀ ∈ p)
    (h1 : ∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), j₁ ∈ p ↔ j₂ ∈ p) (j : J) : j ∈ p :=
  by
  injection constant_of_preserves_morphisms (fun k => ULift.up (k ∈ p)) (fun j₁ j₂ f => _) j j₀ with
    i
  rwa [i]
  dsimp
  exact congr_arg ULift.up (propext (h1 f))
#align category_theory.induct_on_objects CategoryTheory.induct_on_objects
-/

#print CategoryTheory.IsConnected.of_induct /-
/--
If any maximal connected component containing some element j₀ of J is all of J, then J is connected.

The converse of `induct_on_objects`.
-/
theorem IsConnected.of_induct [Nonempty J] {j₀ : J}
    (h : ∀ p : Set J, j₀ ∈ p → (∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), j₁ ∈ p ↔ j₂ ∈ p) → ∀ j : J, j ∈ p) :
    IsConnected J :=
  IsConnected.of_constant_of_preserves_morphisms fun α F a =>
    by
    have w := h { j | F j = F j₀ } rfl fun _ _ f => by simp [a f]
    dsimp at w
    intro j j'
    rw [w j, w j']
#align category_theory.is_connected.of_induct CategoryTheory.IsConnected.of_induct
-/

/-- Lifting the universe level of morphisms and objects preserves connectedness. -/
instance [hc : IsConnected J] : IsConnected (ULiftHom.{v₂} (ULift.{u₂} J)) :=
  by
  have : Nonempty (ULiftHom.{v₂} (ULift.{u₂} J)) := by simp [ulift_hom, hc.is_nonempty]
  apply is_connected.of_induct
  rintro p hj₀ h ⟨j⟩
  let p' : Set J := (fun j : J => p { down := j } : Set J)
  have hj₀' : Classical.choice hc.is_nonempty ∈ p' :=
    by
    simp only [p']
    exact hj₀
  apply
    induct_on_objects (fun j : J => p { down := j }) hj₀' fun _ _ f =>
      h ((ulift_hom_ulift_category.equiv J).Functor.map f)

/- warning: category_theory.is_preconnected_induction -> CategoryTheory.isPreconnected_induction is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] [_inst_3 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] (Z : J -> Sort.{u3}), (forall {j₁ : J} {j₂ : J}, (Quiver.Hom.{succ u1, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) j₁ j₂) -> (Z j₁) -> (Z j₂)) -> (forall {j₁ : J} {j₂ : J}, (Quiver.Hom.{succ u1, u2} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) j₁ j₂) -> (Z j₂) -> (Z j₁)) -> (forall {j₀ : J}, (Z j₀) -> (forall (j : J), Nonempty.{u3} (Z j)))
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u2, u3} J] [_inst_3 : CategoryTheory.IsPreconnected.{u2, u3} J _inst_1] (Z : J -> Sort.{u1}), (forall {j₁ : J} {j₂ : J}, (Quiver.Hom.{succ u2, u3} J (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} J (CategoryTheory.Category.toCategoryStruct.{u2, u3} J _inst_1)) j₁ j₂) -> (Z j₁) -> (Z j₂)) -> (forall {j₁ : J} {j₂ : J}, (Quiver.Hom.{succ u2, u3} J (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} J (CategoryTheory.Category.toCategoryStruct.{u2, u3} J _inst_1)) j₁ j₂) -> (Z j₂) -> (Z j₁)) -> (forall {j₀ : J}, (Z j₀) -> (forall (j : J), Nonempty.{u1} (Z j)))
Case conversion may be inaccurate. Consider using '#align category_theory.is_preconnected_induction CategoryTheory.isPreconnected_inductionₓ'. -/
/-- Another induction principle for `is_preconnected J`:
given a type family `Z : J → Sort*` and
a rule for transporting in *both* directions along a morphism in `J`,
we can transport an `x : Z j₀` to a point in `Z j` for any `j`.
-/
theorem isPreconnected_induction [IsPreconnected J] (Z : J → Sort _)
    (h₁ : ∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), Z j₁ → Z j₂) (h₂ : ∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), Z j₂ → Z j₁)
    {j₀ : J} (x : Z j₀) (j : J) : Nonempty (Z j) :=
  (induct_on_objects { j | Nonempty (Z j) } ⟨x⟩
      (fun j₁ j₂ f =>
        ⟨by
          rintro ⟨y⟩
          exact ⟨h₁ f y⟩, by
          rintro ⟨y⟩
          exact ⟨h₂ f y⟩⟩)
      j :
    _)
#align category_theory.is_preconnected_induction CategoryTheory.isPreconnected_induction

/- warning: category_theory.is_preconnected_of_equivalent -> CategoryTheory.isPreconnected_of_equivalent is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} K] [_inst_4 : CategoryTheory.IsPreconnected.{u1, u3} J _inst_1], (CategoryTheory.Equivalence.{u1, u2, u3, u3} J _inst_1 K _inst_3) -> (CategoryTheory.IsPreconnected.{u2, u3} K _inst_3)
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} K] [_inst_4 : CategoryTheory.IsPreconnected.{u1, u3} J _inst_1], (CategoryTheory.Equivalence.{u1, u2, u3, u3} J K _inst_1 _inst_3) -> (CategoryTheory.IsPreconnected.{u2, u3} K _inst_3)
Case conversion may be inaccurate. Consider using '#align category_theory.is_preconnected_of_equivalent CategoryTheory.isPreconnected_of_equivalentₓ'. -/
/-- If `J` and `K` are equivalent, then if `J` is preconnected then `K` is as well. -/
theorem isPreconnected_of_equivalent {K : Type u₁} [Category.{v₂} K] [IsPreconnected J]
    (e : J ≌ K) : IsPreconnected K :=
  {
    iso_constant := fun α F k =>
      ⟨calc
          F ≅ e.inverse ⋙ e.Functor ⋙ F := (e.invFunIdAssoc F).symm
          _ ≅ e.inverse ⋙ (Functor.const J).obj ((e.Functor ⋙ F).obj (e.inverse.obj k)) :=
            (isoWhiskerLeft e.inverse (isoConstant (e.Functor ⋙ F) (e.inverse.obj k)))
          _ ≅ e.inverse ⋙ (Functor.const J).obj (F.obj k) :=
            (isoWhiskerLeft _ ((F ⋙ Functor.const J).mapIso (e.counitIso.app k)))
          _ ≅ (Functor.const K).obj (F.obj k) := NatIso.ofComponents (fun X => Iso.refl _) (by simp)
          ⟩ }
#align category_theory.is_preconnected_of_equivalent CategoryTheory.isPreconnected_of_equivalent

/- warning: category_theory.is_connected_of_equivalent -> CategoryTheory.isConnected_of_equivalent is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} K], (CategoryTheory.Equivalence.{u1, u2, u3, u3} J _inst_1 K _inst_3) -> (forall [_inst_4 : CategoryTheory.IsConnected.{u1, u3} J _inst_1], CategoryTheory.IsConnected.{u2, u3} K _inst_3)
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} K], (CategoryTheory.Equivalence.{u1, u2, u3, u3} J K _inst_1 _inst_3) -> (forall [_inst_4 : CategoryTheory.IsConnected.{u1, u3} J _inst_1], CategoryTheory.IsConnected.{u2, u3} K _inst_3)
Case conversion may be inaccurate. Consider using '#align category_theory.is_connected_of_equivalent CategoryTheory.isConnected_of_equivalentₓ'. -/
/-- If `J` and `K` are equivalent, then if `J` is connected then `K` is as well. -/
theorem isConnected_of_equivalent {K : Type u₁} [Category.{v₂} K] (e : J ≌ K) [IsConnected J] :
    IsConnected K :=
  { is_nonempty := Nonempty.map e.Functor.obj (by infer_instance)
    to_isPreconnected := isPreconnected_of_equivalent e }
#align category_theory.is_connected_of_equivalent CategoryTheory.isConnected_of_equivalent

#print CategoryTheory.isPreconnected_op /-
/-- If `J` is preconnected, then `Jᵒᵖ` is preconnected as well. -/
instance isPreconnected_op [IsPreconnected J] : IsPreconnected Jᵒᵖ
    where iso_constant α F X :=
    ⟨NatIso.ofComponents
        (fun Y =>
          eqToIso
            (Discrete.ext _ _
              (Discrete.eq_of_hom
                ((Nonempty.some
                        (IsPreconnected.iso_constant (F.rightOp ⋙ (Discrete.opposite α).Functor)
                          (unop X))).app
                    (unop Y)).Hom)))
        fun Y Z f => Subsingleton.elim _ _⟩
#align category_theory.is_preconnected_op CategoryTheory.isPreconnected_op
-/

#print CategoryTheory.isConnected_op /-
/-- If `J` is connected, then `Jᵒᵖ` is connected as well. -/
instance isConnected_op [IsConnected J] : IsConnected Jᵒᵖ
    where is_nonempty := Nonempty.intro (op (Classical.arbitrary J))
#align category_theory.is_connected_op CategoryTheory.isConnected_op
-/

#print CategoryTheory.isPreconnected_of_isPreconnected_op /-
theorem isPreconnected_of_isPreconnected_op [IsPreconnected Jᵒᵖ] : IsPreconnected J :=
  isPreconnected_of_equivalent (opOpEquivalence J)
#align category_theory.is_preconnected_of_is_preconnected_op CategoryTheory.isPreconnected_of_isPreconnected_op
-/

#print CategoryTheory.isConnected_of_isConnected_op /-
theorem isConnected_of_isConnected_op [IsConnected Jᵒᵖ] : IsConnected J :=
  isConnected_of_equivalent (opOpEquivalence J)
#align category_theory.is_connected_of_is_connected_op CategoryTheory.isConnected_of_isConnected_op
-/

#print CategoryTheory.Zag /-
/-- j₁ and j₂ are related by `zag` if there is a morphism between them. -/
@[reducible]
def Zag (j₁ j₂ : J) : Prop :=
  Nonempty (j₁ ⟶ j₂) ∨ Nonempty (j₂ ⟶ j₁)
#align category_theory.zag CategoryTheory.Zag
-/

#print CategoryTheory.zag_symmetric /-
theorem zag_symmetric : Symmetric (@Zag J _) := fun j₂ j₁ h => h.symm
#align category_theory.zag_symmetric CategoryTheory.zag_symmetric
-/

#print CategoryTheory.Zigzag /-
/-- `j₁` and `j₂` are related by `zigzag` if there is a chain of
morphisms from `j₁` to `j₂`, with backward morphisms allowed.
-/
@[reducible]
def Zigzag : J → J → Prop :=
  Relation.ReflTransGen Zag
#align category_theory.zigzag CategoryTheory.Zigzag
-/

#print CategoryTheory.zigzag_symmetric /-
theorem zigzag_symmetric : Symmetric (@Zigzag J _) :=
  Relation.ReflTransGen.symmetric zag_symmetric
#align category_theory.zigzag_symmetric CategoryTheory.zigzag_symmetric
-/

#print CategoryTheory.zigzag_equivalence /-
theorem zigzag_equivalence : Equivalence (@Zigzag J _) :=
  Equivalence.mk _ Relation.reflexive_reflTransGen zigzag_symmetric Relation.transitive_reflTransGen
#align category_theory.zigzag_equivalence CategoryTheory.zigzag_equivalence
-/

#print CategoryTheory.Zigzag.setoid /-
/-- The setoid given by the equivalence relation `zigzag`. A quotient for this
setoid is a connected component of the category.
-/
def Zigzag.setoid (J : Type u₂) [Category.{v₁} J] : Setoid J
    where
  R := Zigzag
  iseqv := zigzag_equivalence
#align category_theory.zigzag.setoid CategoryTheory.Zigzag.setoid
-/

/- warning: category_theory.zigzag_obj_of_zigzag -> CategoryTheory.zigzag_obj_of_zigzag is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} K] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 K _inst_2) {j₁ : J} {j₂ : J}, (CategoryTheory.Zigzag.{u1, u3} J _inst_1 j₁ j₂) -> (CategoryTheory.Zigzag.{u2, u4} K _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} J _inst_1 K _inst_2 F j₁) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} J _inst_1 K _inst_2 F j₂))
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} K] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 K _inst_2) {j₁ : J} {j₂ : J}, (CategoryTheory.Zigzag.{u1, u3} J _inst_1 j₁ j₂) -> (CategoryTheory.Zigzag.{u2, u4} K _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} J (CategoryTheory.Category.toCategoryStruct.{u1, u3} J _inst_1)) K (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} K (CategoryTheory.Category.toCategoryStruct.{u2, u4} K _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} J _inst_1 K _inst_2 F) j₁) (Prefunctor.obj.{succ u1, succ u2, u3, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} J (CategoryTheory.Category.toCategoryStruct.{u1, u3} J _inst_1)) K (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} K (CategoryTheory.Category.toCategoryStruct.{u2, u4} K _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} J _inst_1 K _inst_2 F) j₂))
Case conversion may be inaccurate. Consider using '#align category_theory.zigzag_obj_of_zigzag CategoryTheory.zigzag_obj_of_zigzagₓ'. -/
/-- If there is a zigzag from `j₁` to `j₂`, then there is a zigzag from `F j₁` to
`F j₂` as long as `F` is a functor.
-/
theorem zigzag_obj_of_zigzag (F : J ⥤ K) {j₁ j₂ : J} (h : Zigzag j₁ j₂) :
    Zigzag (F.obj j₁) (F.obj j₂) :=
  h.lift _ fun j k => Or.imp (Nonempty.map fun f => F.map f) (Nonempty.map fun f => F.map f)
#align category_theory.zigzag_obj_of_zigzag CategoryTheory.zigzag_obj_of_zigzag

/- warning: category_theory.zag_of_zag_obj -> CategoryTheory.zag_of_zag_obj is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} K] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 K _inst_2) [_inst_3 : CategoryTheory.Full.{u1, u2, u3, u4} J _inst_1 K _inst_2 F] {j₁ : J} {j₂ : J}, (CategoryTheory.Zag.{u2, u4} K _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} J _inst_1 K _inst_2 F j₁) (CategoryTheory.Functor.obj.{u1, u2, u3, u4} J _inst_1 K _inst_2 F j₂)) -> (CategoryTheory.Zag.{u1, u3} J _inst_1 j₁ j₂)
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {K : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u2, u4} K] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 K _inst_2) [_inst_3 : CategoryTheory.Full.{u1, u2, u3, u4} J _inst_1 K _inst_2 F] {j₁ : J} {j₂ : J}, (CategoryTheory.Zag.{u2, u4} K _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} J (CategoryTheory.Category.toCategoryStruct.{u1, u3} J _inst_1)) K (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} K (CategoryTheory.Category.toCategoryStruct.{u2, u4} K _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} J _inst_1 K _inst_2 F) j₁) (Prefunctor.obj.{succ u1, succ u2, u3, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} J (CategoryTheory.Category.toCategoryStruct.{u1, u3} J _inst_1)) K (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} K (CategoryTheory.Category.toCategoryStruct.{u2, u4} K _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} J _inst_1 K _inst_2 F) j₂)) -> (CategoryTheory.Zag.{u1, u3} J _inst_1 j₁ j₂)
Case conversion may be inaccurate. Consider using '#align category_theory.zag_of_zag_obj CategoryTheory.zag_of_zag_objₓ'. -/
-- TODO: figure out the right way to generalise this to `zigzag`.
theorem zag_of_zag_obj (F : J ⥤ K) [Full F] {j₁ j₂ : J} (h : Zag (F.obj j₁) (F.obj j₂)) :
    Zag j₁ j₂ :=
  Or.imp (Nonempty.map F.Preimage) (Nonempty.map F.Preimage) h
#align category_theory.zag_of_zag_obj CategoryTheory.zag_of_zag_obj

#print CategoryTheory.equiv_relation /-
/-- Any equivalence relation containing (⟶) holds for all pairs of a connected category. -/
theorem equiv_relation [IsConnected J] (r : J → J → Prop) (hr : Equivalence r)
    (h : ∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), r j₁ j₂) : ∀ j₁ j₂ : J, r j₁ j₂ :=
  by
  have z : ∀ j : J, r (Classical.arbitrary J) j :=
    induct_on_objects (fun k => r (Classical.arbitrary J) k) (hr.1 (Classical.arbitrary J))
      fun _ _ f => ⟨fun t => hr.2.2 t (h f), fun t => hr.2.2 t (hr.2.1 (h f))⟩
  intros ; apply hr.2.2 (hr.2.1 (z _)) (z _)
#align category_theory.equiv_relation CategoryTheory.equiv_relation
-/

#print CategoryTheory.isConnected_zigzag /-
/-- In a connected category, any two objects are related by `zigzag`. -/
theorem isConnected_zigzag [IsConnected J] (j₁ j₂ : J) : Zigzag j₁ j₂ :=
  equiv_relation _ zigzag_equivalence
    (fun _ _ f => Relation.ReflTransGen.single (Or.inl (Nonempty.intro f))) _ _
#align category_theory.is_connected_zigzag CategoryTheory.isConnected_zigzag
-/

#print CategoryTheory.zigzag_isConnected /-
/-- If any two objects in an nonempty category are related by `zigzag`, the category is connected.
-/
theorem zigzag_isConnected [Nonempty J] (h : ∀ j₁ j₂ : J, Zigzag j₁ j₂) : IsConnected J :=
  by
  apply is_connected.of_induct
  intro p hp hjp j
  have : ∀ j₁ j₂ : J, zigzag j₁ j₂ → (j₁ ∈ p ↔ j₂ ∈ p) :=
    by
    introv k
    induction' k with _ _ rt_zag zag
    · rfl
    · rw [k_ih]
      rcases zag with (⟨⟨_⟩⟩ | ⟨⟨_⟩⟩)
      apply hjp zag
      apply (hjp zag).symm
  rwa [this j (Classical.arbitrary J) (h _ _)]
#align category_theory.zigzag_is_connected CategoryTheory.zigzag_isConnected
-/

#print CategoryTheory.exists_zigzag' /-
theorem exists_zigzag' [IsConnected J] (j₁ j₂ : J) :
    ∃ l, List.Chain Zag j₁ l ∧ List.getLast (j₁ :: l) (List.cons_ne_nil _ _) = j₂ :=
  List.exists_chain_of_relationReflTransGen (isConnected_zigzag _ _)
#align category_theory.exists_zigzag' CategoryTheory.exists_zigzag'
-/

#print CategoryTheory.isConnected_of_zigzag /-
/-- If any two objects in an nonempty category are linked by a sequence of (potentially reversed)
morphisms, then J is connected.

The converse of `exists_zigzag'`.
-/
theorem isConnected_of_zigzag [Nonempty J]
    (h :
      ∀ j₁ j₂ : J, ∃ l, List.Chain Zag j₁ l ∧ List.getLast (j₁ :: l) (List.cons_ne_nil _ _) = j₂) :
    IsConnected J := by
  apply zigzag_is_connected
  intro j₁ j₂
  rcases h j₁ j₂ with ⟨l, hl₁, hl₂⟩
  apply List.relationReflTransGen_of_exists_chain l hl₁ hl₂
#align category_theory.is_connected_of_zigzag CategoryTheory.isConnected_of_zigzag
-/

#print CategoryTheory.discreteIsConnectedEquivPunit /-
/-- If `discrete α` is connected, then `α` is (type-)equivalent to `punit`. -/
def discreteIsConnectedEquivPunit {α : Type u₁} [IsConnected (Discrete α)] : α ≃ PUnit :=
  Discrete.equivOfEquivalence.{u₁, u₁}
    { Functor := Functor.star (Discrete α)
      inverse := Discrete.functor fun _ => Classical.arbitrary _
      unitIso := iso_constant _ (Classical.arbitrary _)
      counitIso := Functor.pUnitExt _ _ }
#align category_theory.discrete_is_connected_equiv_punit CategoryTheory.discreteIsConnectedEquivPunit
-/

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

/- warning: category_theory.nat_trans_from_is_connected -> CategoryTheory.nat_trans_from_is_connected is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} C] [_inst_4 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {X : C} {Y : C} (α : Quiver.Hom.{succ u2, max u1 u2 u3} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2 u3} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2 u3} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) X) (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) Y)) (j : J) (j' : J), Eq.{succ u2} (Quiver.Hom.{succ u2, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.obj.{u1, u2, u2, u3} J _inst_1 C _inst_3 (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) X) j) (CategoryTheory.Functor.obj.{u1, u2, u2, u3} J _inst_1 C _inst_3 (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) Y) j)) (CategoryTheory.NatTrans.app.{u1, u2, u2, u3} J _inst_1 C _inst_3 (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) X) (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) Y) α j) (CategoryTheory.NatTrans.app.{u1, u2, u2, u3} J _inst_1 C _inst_3 (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) X) (CategoryTheory.Functor.obj.{u2, u2, u3, max u1 u2 u3} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3) Y) α j')
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u3}} [_inst_3 : CategoryTheory.Category.{u2, u3} C] [_inst_4 : CategoryTheory.IsPreconnected.{u1, u2} J _inst_1] {X : C} {Y : C} (α : Quiver.Hom.{succ u2, max (max u2 u1) u3} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max u2 u3) u1} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max u2 u3) u1} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) X) (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) Y)) (j : J) (j' : J), Eq.{succ u2} (Quiver.Hom.{succ u2, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (Prefunctor.obj.{succ u1, succ u2, u2, u3} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u3} J _inst_1 C _inst_3 (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) X)) j) (Prefunctor.obj.{succ u1, succ u2, u2, u3} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_1)) C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u2, u3} J _inst_1 C _inst_3 (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) Y)) j)) (CategoryTheory.NatTrans.app.{u1, u2, u2, u3} J _inst_1 C _inst_3 (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) X) (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) Y) α j) (CategoryTheory.NatTrans.app.{u1, u2, u2, u3} J _inst_1 C _inst_3 (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) X) (Prefunctor.obj.{succ u2, succ u2, u3, max (max u2 u1) u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_3)) (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.CategoryStruct.toQuiver.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Category.toCategoryStruct.{u2, max (max (max u2 u1) u3) u2} (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3))) (CategoryTheory.Functor.toPrefunctor.{u2, u2, u3, max (max (max u2 u1) u3) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u2, u3} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u2, u3} J _inst_1 C _inst_3)) Y) α j')
Case conversion may be inaccurate. Consider using '#align category_theory.nat_trans_from_is_connected CategoryTheory.nat_trans_from_is_connectedₓ'. -/
/-- For objects `X Y : C`, any natural transformation `α : const X ⟶ const Y` from a connected
category must be constant.
This is the key property of connected categories which we use to establish properties about limits.
-/
theorem nat_trans_from_is_connected [IsPreconnected J] {X Y : C}
    (α : (Functor.const J).obj X ⟶ (Functor.const J).obj Y) :
    ∀ j j' : J, α.app j = (α.app j' : X ⟶ Y) :=
  @constant_of_preserves_morphisms _ _ _ (X ⟶ Y) (fun j => α.app j) fun _ _ f =>
    by
    have := α.naturality f
    erw [id_comp, comp_id] at this
    exact this.symm
#align category_theory.nat_trans_from_is_connected CategoryTheory.nat_trans_from_is_connected

instance [IsConnected J] : Full (Functor.const J : C ⥤ J ⥤ C)
    where
  Preimage X Y f := f.app (Classical.arbitrary J)
  witness' X Y f := by
    ext j
    apply nat_trans_from_is_connected f (Classical.arbitrary J) j

#print CategoryTheory.nonempty_hom_of_connected_groupoid /-
instance nonempty_hom_of_connected_groupoid {G} [Groupoid G] [IsConnected G] :
    ∀ x y : G, Nonempty (x ⟶ y) :=
  by
  refine' equiv_relation _ _ fun j₁ j₂ => Nonempty.intro
  exact
    ⟨fun j => ⟨𝟙 _⟩, fun j₁ j₂ => Nonempty.map fun f => inv f, fun _ _ _ => Nonempty.map2 (· ≫ ·)⟩
#align category_theory.nonempty_hom_of_connected_groupoid CategoryTheory.nonempty_hom_of_connected_groupoid
-/

end CategoryTheory


/-
Copyright (c) 2020. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import tactic.ring
import tactic.doc_commands
import algebra.group.commutator

/-!
# `group`

Normalizes expressions in the language of groups. The basic idea is to use the simplifier
to put everything into a product of group powers (`zpow` which takes a group element and an
integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
since `ring` can normalize an exponent to zero, leading to a factor that can be removed
before collecting exponents again. The simplifier step also uses some extra lemmas to avoid
some `ring` invocations.

## Tags

group_theory
-/

-- The next four lemmas are not general purpose lemmas, they are intended for use only by
-- the `group` tactic.

@[to_additive]
lemma tactic.group.zpow_trick {G : Type*} [group G] (a b : G) (n m : ℤ) : a*b^n*b^m = a*b^(n+m) :=
by rw [mul_assoc, ← zpow_add]

@[to_additive]
lemma tactic.group.zpow_trick_one {G : Type*} [group G] (a b : G) (m : ℤ) : a*b*b^m = a*b^(m+1) :=
by rw [mul_assoc, mul_self_zpow]

@[to_additive]
lemma tactic.group.zpow_trick_one' {G : Type*} [group G] (a b : G) (n : ℤ) : a*b^n*b = a*b^(n+1) :=
by rw [mul_assoc, mul_zpow_self]

@[to_additive]
lemma tactic.group.zpow_trick_sub {G : Type*} [group G] (a b : G) (n m : ℤ) :
  a*b^n*b^(-m) = a*b^(n-m) :=
by rw [mul_assoc, ← zpow_add] ; refl

namespace tactic

setup_tactic_parser

open tactic.simp_arg_type interactive tactic.group

/-- Auxiliary tactic for the `group` tactic. Calls the simplifier only. -/
meta def aux_group₁ (locat : loc) : tactic unit :=
simp_core { fail_if_unchanged := ff } skip tt [
  expr ``(commutator_element_def),
  expr ``(mul_one),
  expr ``(one_mul),
  expr ``(one_pow),
  expr ``(one_zpow),
  expr ``(sub_self),
  expr ``(add_neg_self),
  expr ``(neg_add_self),
  expr ``(neg_neg),
  expr ``(tsub_self),
  expr ``(int.coe_nat_add),
  expr ``(int.coe_nat_mul),
  expr ``(int.coe_nat_zero),
  expr ``(int.coe_nat_one),
  expr ``(int.coe_nat_bit0),
  expr ``(int.coe_nat_bit1),
  expr ``(int.mul_neg_eq_neg_mul_symm),
  expr ``(int.neg_mul_eq_neg_mul_symm),
  symm_expr ``(zpow_coe_nat),
  symm_expr ``(zpow_neg_one),
  symm_expr ``(zpow_mul),
  symm_expr ``(zpow_add_one),
  symm_expr ``(zpow_one_add),
  symm_expr ``(zpow_add),
  expr ``(mul_zpow_neg_one),
  expr ``(zpow_zero),
  expr ``(mul_zpow),
  symm_expr ``(mul_assoc),
  expr ``(zpow_trick),
  expr ``(zpow_trick_one),
  expr ``(zpow_trick_one'),
  expr ``(zpow_trick_sub),
  expr ``(tactic.ring.horner)]
  [] locat >> skip

/-- Auxiliary tactic for the `group` tactic. Calls `ring_nf` to normalize exponents. -/
meta def aux_group₂ (locat : loc) : tactic unit :=
ring_nf none tactic.ring.normalize_mode.raw locat
end tactic

namespace tactic.interactive
setup_tactic_parser
open tactic

/--
Tactic for normalizing expressions in multiplicative groups, without assuming
commutativity, using only the group axioms without any information about which group
is manipulated.

(For additive commutative groups, use the `abel` tactic instead.)

Example:
```lean
example {G : Type} [group G] (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h, -- normalizes `h` which becomes `h : c = d`
  rw h,       -- the goal is now `a*d*d⁻¹ = a`
  group,      -- which then normalized and closed
end
```
-/
meta def group (locat : parse location) : tactic unit :=
do when locat.include_goal `[rw ← mul_inv_eq_one],
   aux_group₁ locat,
   repeat (aux_group₂ locat ; aux_group₁ locat)

end tactic.interactive

add_tactic_doc
{ name := "group",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.group],
  tags := ["decision procedure", "simplification"] }


import tactic
import tactic.induction
import order.zorn
import tukey

namespace prop_logic

inductive prop_formula
| bot : prop_formula
| var : ℕ → prop_formula
| imp : prop_formula → prop_formula → prop_formula

notation ⊥ := prop_formula.bot
notation ¬ := λp : prop_formula, p.imp ⊥
infixr ` ->> `:5 := prop_formula.imp

inductive prop_thm  : set prop_formula → prop_formula → Prop
| ax : ∀{Γ p}, p ∈ Γ → prop_thm Γ p
| imp_i : ∀{Γ p q}, prop_thm (Γ ∪ {p}) q → prop_thm Γ (p ->> q)
| imp_e : ∀{Γ p q}, prop_thm Γ (p ->> q) → prop_thm Γ p → prop_thm Γ q
| bot_e : ∀{Γ p}, prop_thm Γ ⊥ → prop_thm Γ p
| lem : ∀{Γ p q}, prop_thm Γ ((¬q) ->> (¬p)) → prop_thm Γ (p ->> q)

infix ` ⊢ `:50 := prop_thm

def assignment := ℕ → Prop

def value (s : assignment) : prop_formula → Prop
| ⊥ := false
| (prop_formula.var n) := s n
| (p ->> q) := value p → value q

def satisfies (s : assignment) (Γ : set prop_formula) : Prop
 := ∀{p}, p ∈ Γ → value s p
def satisfiable (Γ : set prop_formula) : Prop := ∃s, satisfies s Γ
def tautology (p : prop_formula) : Prop := ∀ s : assignment, value s p
def contradiction (p : prop_formula) : Prop := ∀ s : assignment, ¬(value s p)
def logically_implies (Γ : set prop_formula) (p : prop_formula) : Prop :=
∀{s}, satisfies s Γ → value s p
def inconsistent (Γ : set prop_formula) := Γ ⊢ ⊥
def consistent (Γ : set prop_formula) := ¬(Γ ⊢ ⊥)

infix ` ⊨ `: 5 := logically_implies

lemma proves_of_proves_bot {Γ φ} : (Γ ⊢ ⊥) → (Γ ⊢ φ) :=
λh, prop_thm.bot_e h

lemma inconsistent_iff_proves_all (Γ : set prop_formula) :
inconsistent Γ ↔ ∀p, Γ ⊢ p :=
⟨
	λh p, prop_thm.bot_e h,
	λh, h ⊥
⟩

lemma inconsistent_iff_proves_contra (Γ : set prop_formula) :
inconsistent Γ ↔ (Γ ⊢ ((prop_formula.var 0 ->> prop_formula.var 0) ->> ⊥)) :=
begin
	split,
	{
		intro h,
		exact (inconsistent_iff_proves_all Γ).mp h
		((prop_formula.var 0 ->> prop_formula.var 0) ->> ⊥),
	},
	{
		intro h,
		apply prop_thm.imp_e h,
		apply prop_thm.imp_i,
		apply prop_thm.ax,
		simp,
	},
end

lemma proves_of_subset_proves {Γ Δ : set prop_formula} {p : prop_formula} :
 Δ ⊆ Γ → (Δ ⊢ p) → (Γ ⊢ p) :=
begin
	intros hss hDp,
	induction hDp with a b c d e f g h i j k l m n o p q r s t u v w x generalizing Γ,
	{
		apply prop_thm.ax,
		exact hss c,
	},
	{
		apply prop_thm.imp_i,
		have : d ∪ {e} ⊆ Γ ∪ {e},
		{
			intros x hx,
			simp at *,
			cases hx,
			{exact or.inl hx},
			{exact or.inr (hss hx)},
		},
		exact h this,
	},
	{
		specialize n hss,
		specialize o hss,
		exact prop_thm.imp_e n o,
	},
	{
		specialize s hss,
		exact prop_thm.bot_e s,
	},
	{
		specialize x hss,
		exact prop_thm.lem x,
	}
end

lemma proves_of_empty_proves (Γ : set prop_formula) {p : prop_formula} :
∅ ⊢ p → Γ ⊢ p := λh, proves_of_subset_proves (set.empty_subset Γ) h

lemma valid_imp_of_neg_premise (p q : prop_formula) : ∅ ⊢ ((¬p) ->> (p ->> q)) :=
begin
	apply prop_thm.imp_i,
	apply prop_thm.imp_i,
	apply prop_thm.bot_e,
	simp,
	have t1 := prop_thm.ax (set.mem_insert p {p ->> ⊥}),
	have t2 : {p, p ->> ⊥} ⊢ (p ->> ⊥) := prop_thm.ax (by simp at *),
	exact prop_thm.imp_e t2 t1,
end

theorem deduction_thm (Γ : set prop_formula) (p q : prop_formula) :
(Γ ∪ {p} ⊢ q) ↔ (Γ ⊢ (p ->> q)) :=
begin
	split,
	{
		intro h,
		apply prop_thm.imp_i,
		exact h,
	},
	{
		intro h,
		have := proves_of_subset_proves (set.subset_union_left Γ {p}) h,
		exact prop_thm.imp_e this
		(begin
		apply prop_thm.ax,
		simp,
		end),
	},
end

theorem soundness {Γ φ} : (Γ ⊢ φ) → (Γ ⊨ φ) :=
begin
	intros hΓφ s hΓs,
	induction hΓφ with a b c d e f g h i j k l m n o p q r s t u v w x,
	{
		exact hΓs c,
	},
	{
		intro h1,
		apply h,
		intros x hx,
		simp at hx,
		cases hx,
		{rwa hx},
		{exact hΓs hx},
	},
	{
		specialize n @hΓs,
		specialize o @hΓs,
		exact n o,
	},
	{
		exfalso,
		exact (s @hΓs),
	},
	{
		intro h,
		specialize x @hΓs,
		unfold value at *,
		tauto!,
	}
end

lemma consistent_of_satisfiable {Γ} : satisfiable Γ → consistent Γ :=
begin
	intro h,
	cases h with s hs,
	apply mt (@soundness Γ ⊥),
	intro contra,
	exact contra (by assumption),
end

lemma empty_consistent : consistent ∅ :=
begin
	apply consistent_of_satisfiable,
	use (λn, true),
	intros x hx, exfalso,
	exact set.not_mem_empty _ hx,
end

lemma consistent_of_not_proves {Γ : set prop_formula} {φ : prop_formula} :
¬(Γ ⊢ φ) → (consistent (Γ ∪ {¬φ})) :=
begin
	unfold consistent, contrapose, push_neg,
	intro h,
	change inconsistent (Γ ∪ {φ ->> ⊥}) at h,
	rw inconsistent_iff_proves_contra at h,
	rw deduction_thm at h,

	apply prop_thm.imp_e (prop_thm.lem h),
	apply prop_thm.imp_i,
	apply prop_thm.ax,
	simp,
end

lemma consistent_of_proves {Γ : set prop_formula} {φ : prop_formula} :
 (Γ ⊢ φ) → consistent Γ → (consistent (Γ ∪ {φ})) :=
begin
	intro h,
	contrapose,
	intro h1,
	unfold consistent at *, push_neg at h1 ⊢,
	have := prop_thm.imp_i h1,
	exact prop_thm.imp_e this h,
end

lemma completeness_iff :
(∀{Γ φ}, (Γ ⊨ φ) → (Γ ⊢ φ)) ↔ (∀{Γ}, consistent Γ → satisfiable Γ) :=
begin
	split,
	{
		intros h Γ hΓ,
		specialize @h Γ ⊥,
		have h1 : ¬(Γ ⊢ ⊥) → ¬(Γ ⊨ ⊥) := mt h, clear h,
		specialize h1 hΓ,
		unfold logically_implies at h1,
		push_neg at h1,
		cases h1 with s hs,
		exact ⟨s, hs.1⟩,
	},
	{
		intros h Γ φ,
		contrapose,
		intros hΓφ contra,
		have := consistent_of_not_proves hΓφ,
		specialize h this,
		cases h with s hs, dsimp only at hs,
		have hsΓ : satisfies s Γ := λx hx, hs (set.mem_union_left {φ ->> ⊥} hx),
		have hsΓnφ : value s (φ ->> ⊥) := hs (by simp),
		apply hsΓnφ,
		exact contra (by assumption),
	}
end

def maximal_consistent (Γ : set prop_formula) := consistent Γ ∧ ∀p, p ∉ Γ → (¬p) ∈ Γ

lemma mem_maximal_consistent_iff_proves {Γ : set prop_formula} :
maximal_consistent Γ → ∀p, (p ∈ Γ ↔ Γ ⊢ p) :=
begin
	intros hΓ p,
	split,
	{exact λh, prop_thm.ax h},
	{
		contrapose,
		intros h contra,
		have t1 := hΓ.2 p h, dsimp only at t1,
		have := prop_thm.imp_e (prop_thm.ax t1) contra,
		exact hΓ.1 this,
	}
end

lemma maximal_consistent_iff (Γ : set prop_formula) : maximal_consistent Γ ↔ (consistent Γ ∧
∀Δ, consistent Δ → ¬(Γ ⊂ Δ)) :=
begin
	split,
	{
		intros h,
		split,
		{exact h.1},
		intros Δ hΔ contra,
		rw ssubset_iff_subset_not_subset at contra,
		have : ∃φ, φ ∈ Δ ∧ φ ∉ Γ,
		{
			by_contra h1,
			push_neg at h1,
			exact contra.2 h1,
		},
		cases this with φ hφ,
		have := contra.1 (h.2 _ hφ.2), dsimp only at this,
		exact hΔ (prop_thm.imp_e (prop_thm.ax this) (prop_thm.ax hφ.1)),
	},
	{
		intros h, use h.1,
		intros p hp, dsimp only,
		cases h with Γ_con h,
		have mem_Γ : ∀{p}, Γ ⊢ p ↔ (p ∈ Γ),
		{
			intros q,
			split,
			{
				intro h1, by_contra hq,
				have := h _ (consistent_of_proves h1 Γ_con),
				apply this,
				rw ssubset_iff_subset_not_subset,
				use set.subset_union_left Γ {q},
				intro contra,
				have : q ∈ Γ,
				{
					apply contra,
					simp at *,
				},
				exact hq this,
			},
			{
				intro h,
				exact prop_thm.ax h,
			},
		},
		rw← mem_Γ at hp,
		have temp := h _ (consistent_of_not_proves hp), dsimp only at temp,
		by_contra contra,
		apply temp,
		split, {exact set.subset_union_left Γ {p ->> ⊥}},
		intros h1,
		exact contra (h1 (by simp at *)),
	},
end

lemma satisfiable_of_maximal_consistent {Γ : set prop_formula} :
 maximal_consistent Γ → satisfiable Γ :=
begin
	intro h,
	set s := λn : ℕ, @ite Prop ((prop_formula.var n) ∈ Γ)
	(classical.dec (prop_formula.var n ∈ Γ)) true false with s_def,

	have s_pos : ∀n, (prop_formula.var n ∈ Γ) → s n = true,
	{
		intros n hn,
		finish,
	},
	have s_neg : ∀n, (prop_formula.var n ∉ Γ) → s n = false,
	{
		intros n hn,
		finish,
	},
	have s_iff : ∀n, s n ↔ (prop_formula.var n) ∈ Γ,
	{
		intro n,
		split,
		{
			intro h1,
			by_contra,
			specialize s_neg n h,
			rw← s_neg,
			exact h1,
		},
		{
			intro h1,
			specialize s_pos n h1,
			rw s_pos,
			trivial,
		},
	},

	have : ∀p, value s p ↔ p ∈ Γ,
	{
		intro p,
		induction p with a b c d e f g h i j k l m n o p q r s t u v w x,
		{exact ⟨by tauto, λh1, h.left (prop_thm.ax h1)⟩},
		{
			rw← s_iff,
			refl,
		},
		{
			split,
			{
				intro h1,
				unfold value at h1,
				by_contra h2,
				have hbc := h.2 (b ->> c) h2,
				rw [d, e] at h1,
				by_cases h3 : b ∈ Γ,
				{
					have h4 := h1 h3,
					have temp1 : Γ ⊢ (b ->> c),
					{
						apply prop_thm.imp_i,
						have obv : Γ ⊆ Γ ∪ {b} := set.subset_union_left Γ {b},
						exact proves_of_subset_proves obv (prop_thm.ax h4),
					},
					apply h.1,
					apply prop_thm.imp_e (prop_thm.ax hbc),
					exact temp1,
				},
				have hnb := h.2 b h3, dsimp only at hnb,
				have t1 := proves_of_empty_proves Γ (valid_imp_of_neg_premise b c),
				simp at t1,
				have t2 := prop_thm.imp_e t1 (prop_thm.ax hnb),
				simp at hbc,
				exact h.1 (prop_thm.imp_e (prop_thm.ax hbc) t2),
			},
			{
				intros h1 hb,
				rw d at *,
				rw e,
				rw mem_maximal_consistent_iff_proves h at *,
				exact prop_thm.imp_e h1 hb,
			},
		},
	},

	use s,
	intros p hp,
	rwa← this p at hp,
end

lemma fin_subset_proves_of_proves {Γ : set prop_formula} {φ : prop_formula}
  (h : Γ ⊢ φ) : ∃ (Δ : set prop_formula), Δ ⊆ Γ ∧ Δ.finite ∧ Δ ⊢ φ :=
begin
	induction' h,
	{
		use [{φ}, by rwa set.singleton_subset_iff, set.finite_singleton _],
		apply prop_thm.ax, apply set.mem_singleton,
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ \ {φ}, by rwa [set.diff_subset_iff, set.union_comm], set.finite.diff h2 _],
		apply prop_thm.imp_i,
		rw set.diff_union_self,
		exact proves_of_subset_proves (set.subset_union_left Δ {φ}) h3,
	},
	{
		rcases ih_h with ⟨Δ, h1, h2, h3⟩,
		rcases ih_h_1 with ⟨Δ', h1', h2', h3'⟩,
		use [Δ ∪ Δ', set.union_subset h1 h1', set.finite.union h2 h2'],

		have t1 := proves_of_subset_proves (set.subset_union_left Δ Δ') h3,
		have t2 := proves_of_subset_proves (set.subset_union_right Δ Δ') h3',

		exact prop_thm.imp_e t1 t2,
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, proves_of_proves_bot h3],
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, prop_thm.lem h3],
	},
end

lemma finite_character_of_consistent : finite_character {Γ : (set prop_formula) | consistent Γ} :=
begin
	intros Δ,
	split,
	{
		intros Δ_con Y Y_ss Y_fin,
		by_contra h,
		simp at *,unfold consistent at *, push_neg at h,
		exact Δ_con (proves_of_subset_proves Y_ss h),
	},
	{
		intro h,
		simp at *,
		intro Δ_bot,
		rcases fin_subset_proves_of_proves Δ_bot with ⟨Y, Y_ss, Y_fin, Y_bot⟩,
		exact (h Y_ss Y_fin) Y_bot,
	}
end

lemma maximal_consistent_of_consistent {Γ} :
consistent Γ → ∃Γ', Γ ⊆ Γ' ∧ maximal_consistent Γ' :=
begin
	intro Γ_con,
	have : Γ ∈ {Γ : (set prop_formula) | consistent Γ} := Γ_con,
	rcases exists_maximal_of_finite_character this finite_character_of_consistent with
	 ⟨Γ', Γ'_con, Γ_ss, Γ'_maximal⟩,
	simp at Γ'_con,
	use [Γ', Γ_ss],
	rw maximal_consistent_iff, use Γ'_con,
	intros Δ Δ_con,
	rw ssubset_iff_subset_ne,
	push_neg,
	finish [Γ'_maximal Δ_con],
end

theorem completeness (Γ φ) : (Γ ⊢ φ) ↔ (Γ ⊨ φ) :=
begin
	split, {exact soundness},
	suffices h : ∀Γ, consistent Γ → satisfiable Γ,
	{exact completeness_iff.mpr h}, clear Γ φ,
	intros Γ Γ_con,
	rcases maximal_consistent_of_consistent Γ_con with ⟨Γ', Γ_ss, Γ'_maxcon⟩,
	cases (satisfiable_of_maximal_consistent Γ'_maxcon) with s hs,
	use s,
	intros p hp,
	exact hs (Γ_ss hp),
end

theorem pierces_law (p q) : ∅ ⊢ (((p ->> q) ->> p) ->> p) :=
begin
	rw completeness,
	intros s hs,
	unfold value,
	tauto!,
end

namespace prop_formula

def or (φ ψ) := (¬φ ->> ψ)
def and (φ ψ) := (or (¬φ) (¬ψ)) ->> ⊥
def iff (φ ψ) := and (φ ->> ψ) (ψ ->> φ)

infix ` ∨ ` := or
infix ` ∧ ` := and
infix ` ↔ ` := iff

end prop_formula

/- Proof of ∨-introduction without completeness for comparison with
   lemma or_inl, which uses completeness.
-/
example {Γ φ} (ψ : prop_formula) : Γ ⊢ φ → Γ ⊢ (φ ∨ ψ) :=
begin
	intro h,
	apply prop_thm.imp_i,
	apply prop_thm.bot_e,
	exact prop_thm.imp_e (prop_thm.ax (by simp at *))
	(proves_of_subset_proves (set.subset_union_left Γ {φ ->> ⊥}) h),
end

namespace prop_thm

lemma or_inl {Γ φ} (ψ) : Γ ⊢ φ → Γ ⊢ (φ ∨ ψ) :=
begin
	rw [completeness, completeness],
	tauto,
end

lemma or_inr {Γ ψ} (φ) : Γ ⊢ ψ → Γ ⊢ (φ ∨ ψ) :=
begin
	rw [completeness, completeness],
	tauto,
end

lemma or_e {Γ φ ψ χ}  : Γ ∪ {φ} ⊢ χ → Γ ∪ {ψ} ⊢ χ → Γ ∪ {φ ∨ ψ} ⊢ χ :=
begin
	rw [deduction_thm, deduction_thm, deduction_thm],
	rw [completeness, completeness, completeness],
	intros h1 h2 s hs,
	unfold prop_formula.or value,
	tauto!,
end

lemma and_i {Γ} (φ ψ) : Γ ⊢ φ → Γ ⊢ ψ → Γ ⊢ (φ ∧ ψ) :=
begin
	rw [completeness, completeness, completeness],
	intros h1 h2 s hs h3,
	unfold prop_formula.or value at h3,
	tauto!,
end

lemma and_l {Γ} {φ ψ} : Γ ⊢ (φ ∧ ψ) → Γ ⊢ φ :=
begin
	rw [completeness, completeness],
	intros h1 s hs,
	have := h1 (by assumption),
	unfold prop_formula.and prop_formula.or value at this,
	tauto!,
end

lemma and_r {Γ} {φ ψ} : Γ ⊢ (φ ∧ ψ) → Γ ⊢ ψ :=
begin
	rw [completeness, completeness],
	intros h1 s hs,
	have := h1 (by assumption),
	unfold prop_formula.and prop_formula.or value at this,
	tauto!,
end

end prop_thm

theorem de_morgan_1 {φ ψ : prop_formula} : ∅ ⊢ ((¬)(φ ∧ ψ) ↔ (¬φ ∨ ¬ψ)) :=
begin
	rw completeness,
	intros s hs,
	unfold prop_formula.and prop_formula.iff prop_formula.or value,
	tauto!,
end

theorem de_morgan_2 {φ ψ : prop_formula} : ∅ ⊢ ((¬)(φ ∨ ψ) ↔ (¬φ ∧ ¬ψ)) :=
begin
	rw completeness,
	intros s hs,
	unfold prop_formula.and prop_formula.iff prop_formula.or value,
	tauto!,
end

end prop_logic


namespace TBA

-- Let's work with some inductive types other than `Nat`!

-- Here is our very own definition of `List`:
inductive List (α : Type) where
  | nil : List α
  | cons (head : α) (tail : List α) : List α

notation  (priority := high) "[" "]" => List.nil   -- `[]`
infixr:67 (priority := high) " :: "  => List.cons  -- `a :: as`

-- as a warm-up exercise, let's define concatenation of two lists
def append (as bs : List α) : List α :=
  match as with
  | [] => bs
  | x :: xs => x :: (append xs bs)

infixl:65 (priority := high) " ++ " => append

example : 1::2::[] ++ 3::4::[] = 1::2::3::4::[] := rfl

-- as with associativity on `Nat`, think twice about what induction variable to use!
theorem append_assoc : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by
  induction as
  case nil => rfl
  case cons x xs h => simp [h, append]

open Decidable

/-
One important special case of `Decidable` is decidability of equalities:
```
abbrev DecidableEq (α : Type) :=
  (a b : α) → Decidable (a = b)

def decEq [s : DecidableEq α] (a b : α) : Decidable (a = b) :=
  s a b
```
Note: `DecidableEq` is defined using `abbrev` instead of `def` because typeclass resolution only
unfolds the former for performance reasons.

Let's try to prove that `List` equality is decidable!
-/
-- hint: Something is still missing. Do we need to assume anything about `α`?
-- hint: Apply `match` case distinctions until the the appropriate `Decidable` constructor is clear,
--   then fill in its proof argument with `by`.
--   We could also do everything in a `by` block, but it's nicer to reserve tactics for proofs so we have
--   more control about the code of programs, i.e. the part that is actually executed
def ldecEq [DecidableEq α] (as bs : List α) : Decidable (as = bs) :=
  match as,bs with
  | [], [] => isTrue rfl
  | [], x :: xs => isFalse (fun h => by injection h)
  | x :: xs, [] => isFalse (fun h => by injection h)
  | x :: xs, y :: ys =>
    match decEq x y, ldecEq xs ys with
    | isTrue h, isTrue h' => isTrue (by simp [h, h'])
    | isTrue h, isFalse h' => isFalse (by simp_all)
    | isFalse h', _ => isFalse (by simp_all)

-- Let's declare the instance:
instance [DecidableEq α] : DecidableEq (List α) := ldecEq

-- This should now work:
#eval decEq (1::2::[]) (1::3::[])

/-
`DecidablePred` is another convenient abbreviation of `Decidable`
```
abbrev DecidablePred (r : α → Prop) :=
  (a : α) → Decidable (r a)
```
If we have `[DecidablePred p]`, we can e.g. use `if p a then ...` for some `a : α`.

`filter p as` is a simple list function that should remove all elements `a` for which `p a` does not hold.
-/
def filter (p : α → Prop) [DecidablePred p] (as : List α) : List α :=
  match as with
  | [] => []
  | x :: xs => if p x then x :: (filter p xs) else (filter p xs)

example : filter (fun x => x % 2 = 0) (1::2::3::4::[]) = 2::4::[] := rfl

variable {p : α → Prop} [DecidablePred p] {as bs : List α}

-- These helper theorems can be useful, also for manual rewriting
@[simp] theorem filter_cons_true (h : p a) : filter p (a :: as) = a :: filter p as :=
  by simp [filter, h]
@[simp] theorem filter_cons_false (h : ¬ p a) : filter p (a :: as) = filter p as :=
  by simp [filter, h]
-- It's worthwhile thinking about what's actually happening here:
-- * first, `filter p (a :: as)` is unfolded to `if p a then a :: filter p as else filter p as`
--   (note that the second `filter` cannot be unfolded)
-- * then `if p a then ...` is rewritten to `if True then ...` using `h`
-- * finally, `if True then a :: filter p as else ...` is rewritten to `a :: filter p as` using
--   the built-in simp theorem `Lean.Simp.ite_true`

-- useful tactic: `by_cases h : q` for a decidable proposition `q`
theorem filter_idem : filter p (filter p as) = filter p as := by
  induction as with
  | nil => rfl
  | cons x xs h =>
    by_cases hpx : p x
    case inl => simp [h, hpx]
    case inr => simp [hpx, h]

theorem filter_append : filter p (as ++ bs) = filter p as ++ filter p bs := by
  induction as with
  | nil => rfl
  | cons x xs h => by_cases hpx : p x <;> simp [h, hpx, append]
    -- by_cases hpx : p x
    -- case inl =>
    --   simp [h, hpx, append]
    -- case inr =>
    --   simp [h, hpx, append]

-- list membership as an inductive predicate:
inductive Mem (a : α) : List α → Prop where
  -- either it's the first element...
  | head {as} : Mem a (a::as)
  -- or it's in the remainder list
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

-- recall that `a ≠ b` is the same as `a = b → False`
theorem mem_of_nonempty_filter (h : ∀ a, p a → a = x) : filter p as ≠ [] → x ∈ as := by
  intro h1
  induction as with
  | nil => contradiction
  | cons a as h2 =>
    by_cases hpa : p a
    case inl =>
      rw [h _ hpa]
      exact Mem.head
    case inr =>
      rw [filter_cons_false hpa] at h1
      exact Mem.tail (h2 h1)

-- This proof is pretty long! Some hints:
-- * If you have an assumption `h : a ∈ []`, you can solve the current goal by `cases h`:
--   since there is no `Mem` constructor that could possibly match `[]`, there is nothing left to prove!
--   This exclusion of cases, and case analysis on inductive predicates in general,
--   is also called *rule inversion* since we (try to) apply the introduction rules (constructors)
--   "in reverse".
-- * On the other hand, if you try to do case analysis on a proof of e.g. `a ∈ filter p as`,
--   Lean will complain with "dependent elimination failed" since it *doesn't* know yet if
--   the argument `filter p as` is of the form `_ :: _` as demanded by the `Mem` constructors.
--   You need to get the assumption into the shape `_ ∈ []` or `_ ∈ _ :: _` before applying
--   `(no)match/cases` to it.
theorem mem_filter : a ∈ filter p as ↔ a ∈ as ∧ p a := by
  apply Iff.intro
  intro h
  induction as with
  | nil => cases h
  | cons x xs h1 =>
    by_cases hpx : p x
    case mp.cons.inl =>
      rw [filter_cons_true hpx] at h
      cases h with
      | head => exact ⟨Mem.head, hpx⟩
      | tail h => exact ⟨Mem.tail (h1 h).1, (h1 h).2⟩
    case mp.cons.inr =>
      rw [filter_cons_false hpx] at h
      exact ⟨Mem.tail (h1 h).1, (h1 h).2⟩
  intro ⟨h,h1⟩
  sorry

-- Here is an alternative definition of list membership via `append`
inductive Mem' (a : α) : List α → Prop where
  | intro (as bs) : Mem' a (as ++ (a :: bs))

infix:50 " ∈' " => Mem'

-- Let's prove that they are equivalent!
theorem mem_mem' : a ∈ as ↔ a ∈' as := by
  apply Iff.intro
  case mp =>
    intro h
    induction h with
    | head => exact ⟨[], _⟩
    | tail h ih =>
      have ⟨as', bs'⟩ := ih
      exact ⟨_::as', _⟩
  case mpr =>
    intro ⟨as', bs'⟩
    induction as' with
    | nil => exact Mem.head
    | cons a' as' ih => exact Mem.tail ih

end TBA


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

! This file was ported from Lean 3 source module measure_theory.function.strongly_measurable.inner
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Function.StronglyMeasurable.Basic
import Mathbin.Analysis.InnerProductSpace.Basic

/-!
# Inner products of strongly measurable functions are strongly measurable.

-/

variable {α : Type _}

namespace MeasureTheory

/-! ## Strongly measurable functions -/

namespace StronglyMeasurable

protected theorem inner {𝕜 : Type _} {E : Type _} [IsROrC 𝕜] [NormedAddCommGroup E]
    [InnerProductSpace 𝕜 E] {m : MeasurableSpace α} {f g : α → E} (hf : StronglyMeasurable f)
    (hg : StronglyMeasurable g) : StronglyMeasurable fun t => @inner 𝕜 _ _ (f t) (g t) :=
  Continuous.comp_stronglyMeasurable continuous_inner (hf.prod_mk hg)
#align measure_theory.strongly_measurable.inner MeasureTheory.StronglyMeasurable.inner

end StronglyMeasurable

namespace AeStronglyMeasurable

variable {m : MeasurableSpace α} {μ : Measure α} {𝕜 : Type _} {E : Type _} [IsROrC 𝕜]
  [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

protected theorem re {f : α → 𝕜} (hf : AeStronglyMeasurable f μ) :
    AeStronglyMeasurable (fun x => IsROrC.re (f x)) μ :=
  IsROrC.continuous_re.compAeStronglyMeasurable hf
#align measure_theory.ae_strongly_measurable.re MeasureTheory.AeStronglyMeasurable.re

protected theorem im {f : α → 𝕜} (hf : AeStronglyMeasurable f μ) :
    AeStronglyMeasurable (fun x => IsROrC.im (f x)) μ :=
  IsROrC.continuous_im.compAeStronglyMeasurable hf
#align measure_theory.ae_strongly_measurable.im MeasureTheory.AeStronglyMeasurable.im

protected theorem inner {m : MeasurableSpace α} {μ : Measure α} {f g : α → E}
    (hf : AeStronglyMeasurable f μ) (hg : AeStronglyMeasurable g μ) :
    AeStronglyMeasurable (fun x => ⟪f x, g x⟫) μ :=
  continuous_inner.compAeStronglyMeasurable (hf.prod_mk hg)
#align measure_theory.ae_strongly_measurable.inner MeasureTheory.AeStronglyMeasurable.inner

end AeStronglyMeasurable

end MeasureTheory


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

/-!
# Lemmas about rings of characteristic two

This file contains results about `char_p R 2`, in the `char_two` namespace.

The lemmas in this file with a `_sq` suffix are just special cases of the `_pow_char` lemmas
elsewhere, with a shorter name for ease of discovery, and no need for a `[fact (prime 2)]` argument.
-/

variables {R ι : Type*}

local attribute [instance] nat.fact_prime_two

namespace char_two

section semiring
variables [semiring R] [char_p R 2]

lemma two_eq_zero : (2 : R) = 0 :=
by rw [← nat.cast_two, char_p.cast_eq_zero]

lemma add_self_eq_zero (x : R) : x + x = 0 :=
by rw [←two_smul R x, two_eq_zero, zero_smul]

lemma bit0_eq_zero (x : R) : (bit0 x : R) = 0 :=
add_self_eq_zero x

lemma bit1_eq_one (x : R) : (bit1 x : R) = 1 :=
by rw [bit1, bit0_eq_zero, zero_add]

end semiring

section ring
variables [ring R] [char_p R 2]

lemma neg_eq (x : R) : -x = x :=
by rw [neg_eq_iff_add_eq_zero, ←two_smul R x, two_eq_zero, zero_smul]

lemma neg_eq' : has_neg.neg = (id : R → R) :=
funext neg_eq

lemma sub_eq_add (x y : R) : x - y = x + y :=
by rw [sub_eq_add_neg, neg_eq]

lemma sub_eq_add' : has_sub.sub = ((+) : R → R → R) :=
funext $ λ x, funext $ λ y, sub_eq_add x y

end ring

section comm_semiring
variables [comm_semiring R] [char_p R 2]

lemma add_sq (x y : R) : (x + y) ^ 2 = x ^ 2 + y ^ 2 :=
add_pow_char _ _ _

lemma add_mul_self (x y : R) : (x + y) * (x + y) = x * x + y * y :=
by rw [←pow_two, ←pow_two, ←pow_two, add_sq]

open_locale big_operators

lemma list_sum_sq (l : list R) : l.sum ^ 2 = (l.map (^ 2)).sum :=
list_sum_pow_char _ _

lemma list_sum_mul_self (l : list R) : l.sum * l.sum = (list.map (λ x, x * x) l).sum :=
by simp_rw [←pow_two, list_sum_sq]

lemma multiset_sum_sq (l : multiset R) : l.sum ^ 2 = (l.map (^ 2)).sum :=
multiset_sum_pow_char _ _

lemma multiset_sum_mul_self (l : multiset R) : l.sum * l.sum = (multiset.map (λ x, x * x) l).sum :=
by simp_rw [←pow_two, multiset_sum_sq]

lemma sum_sq (s : finset ι) (f : ι → R) :
  (∑ i in s, f i) ^ 2 = ∑ i in s, f i ^ 2 :=
sum_pow_char _ _ _

lemma sum_mul_self (s : finset ι) (f : ι → R) :
  (∑ i in s, f i) * (∑ i in s, f i) = ∑ i in s, f i * f i :=
by simp_rw [←pow_two, sum_sq]

end comm_semiring

end char_two

section ring_char
variables [ring R]

lemma neg_one_eq_one_iff [nontrivial R]: (-1 : R) = 1 ↔ ring_char R = 2 :=
begin
  refine ⟨λ h, _, λ h, @@char_two.neg_eq _ (ring_char.of_eq h) 1⟩,
  rw [eq_comm, ←sub_eq_zero, sub_neg_eq_add, ← nat.cast_one, ← nat.cast_add] at h,
  exact ((nat.dvd_prime nat.prime_two).mp (ring_char.dvd h)).resolve_left char_p.ring_char_ne_one
end

@[simp] lemma order_of_neg_one [nontrivial R] :
  order_of (-1 : R) = if ring_char R = 2 then 1 else 2 :=
begin
  split_ifs,
  { rw [neg_one_eq_one_iff.2 h, order_of_one] },
  apply order_of_eq_prime,
  { simp },
  simpa [neg_one_eq_one_iff] using h
end

end ring_char


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

! This file was ported from Lean 3 source module algebra.lie.normalizer
! leanprover-community/mathlib commit 938fead7abdc0cbbca8eba7a1052865a169dc102
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Abelian
import Mathbin.Algebra.Lie.IdealOperations
import Mathbin.Algebra.Lie.Quotient

/-!
# The normalizer of a Lie submodules and subalgebras.

Given a Lie module `M` over a Lie subalgebra `L`, the normalizer of a Lie submodule `N ⊆ M` is
the Lie submodule with underlying set `{ m | ∀ (x : L), ⁅x, m⁆ ∈ N }`.

The lattice of Lie submodules thus has two natural operations, the normalizer: `N ↦ N.normalizer`
and the ideal operation: `N ↦ ⁅⊤, N⁆`; these are adjoint, i.e., they form a Galois connection. This
adjointness is the reason that we may define nilpotency in terms of either the upper or lower
central series.

Given a Lie subalgebra `H ⊆ L`, we may regard `H` as a Lie submodule of `L` over `H`, and thus
consider the normalizer. This turns out to be a Lie subalgebra.

## Main definitions

  * `lie_submodule.normalizer`
  * `lie_subalgebra.normalizer`
  * `lie_submodule.gc_top_lie_normalizer`

## Tags

lie algebra, normalizer
-/

variable {R L M M' : Type _}

variable [CommRing R] [LieRing L] [LieAlgebra R L]

variable [AddCommGroup M] [Module R M] [LieRingModule L M] [LieModule R L M]

variable [AddCommGroup M'] [Module R M'] [LieRingModule L M'] [LieModule R L M']

namespace LieSubmodule

variable (N : LieSubmodule R L M) {N₁ N₂ : LieSubmodule R L M}

/-- The normalizer of a Lie submodule. -/
def normalizer : LieSubmodule R L M
    where
  carrier := { m | ∀ x : L, ⁅x, m⁆ ∈ N }
  add_mem' m₁ m₂ hm₁ hm₂ x := by
    rw [lie_add]
    exact N.add_mem' (hm₁ x) (hm₂ x)
  zero_mem' x := by simp
  smul_mem' t m hm x := by
    rw [lie_smul]
    exact N.smul_mem' t (hm x)
  lie_mem x m hm y := by
    rw [leibniz_lie]
    exact N.add_mem' (hm ⁅y, x⁆) (N.lie_mem (hm y))
#align lie_submodule.normalizer LieSubmodule.normalizer

@[simp]
theorem mem_normalizer (m : M) : m ∈ N.normalizer ↔ ∀ x : L, ⁅x, m⁆ ∈ N :=
  Iff.rfl
#align lie_submodule.mem_normalizer LieSubmodule.mem_normalizer

theorem le_normalizer : N ≤ N.normalizer := by
  intro m hm
  rw [mem_normalizer]
  exact fun x => N.lie_mem hm
#align lie_submodule.le_normalizer LieSubmodule.le_normalizer

theorem normalizer_inf : (N₁ ⊓ N₂).normalizer = N₁.normalizer ⊓ N₂.normalizer :=
  by
  ext
  simp [← forall_and]
#align lie_submodule.normalizer_inf LieSubmodule.normalizer_inf

@[mono]
theorem monotone_normalizer : Monotone (normalizer : LieSubmodule R L M → LieSubmodule R L M) :=
  by
  intro N₁ N₂ h m hm
  rw [mem_normalizer] at hm⊢
  exact fun x => h (hm x)
#align lie_submodule.monotone_normalizer LieSubmodule.monotone_normalizer

@[simp]
theorem comap_normalizer (f : M' →ₗ⁅R,L⁆ M) : N.normalizer.comap f = (N.comap f).normalizer :=
  by
  ext
  simp
#align lie_submodule.comap_normalizer LieSubmodule.comap_normalizer

theorem top_lie_le_iff_le_normalizer (N' : LieSubmodule R L M) :
    ⁅(⊤ : LieIdeal R L), N⁆ ≤ N' ↔ N ≤ N'.normalizer :=
  by
  rw [lie_le_iff]
  tauto
#align lie_submodule.top_lie_le_iff_le_normalizer LieSubmodule.top_lie_le_iff_le_normalizer

theorem gc_top_lie_normalizer :
    GaloisConnection (fun N : LieSubmodule R L M => ⁅(⊤ : LieIdeal R L), N⁆) normalizer :=
  top_lie_le_iff_le_normalizer
#align lie_submodule.gc_top_lie_normalizer LieSubmodule.gc_top_lie_normalizer

variable (R L M)

theorem normalizer_bot_eq_maxTrivSubmodule :
    (⊥ : LieSubmodule R L M).normalizer = LieModule.maxTrivSubmodule R L M :=
  rfl
#align lie_submodule.normalizer_bot_eq_max_triv_submodule LieSubmodule.normalizer_bot_eq_maxTrivSubmodule

end LieSubmodule

namespace LieSubalgebra

variable (H : LieSubalgebra R L)

/-- Regarding a Lie subalgebra `H ⊆ L` as a module over itself, its normalizer is in fact a Lie
subalgebra. -/
def normalizer : LieSubalgebra R L :=
  { H.toLieSubmodule.normalizer with
    lie_mem' := fun y z hy hz x =>
      by
      rw [coe_bracket_of_module, mem_to_lie_submodule, leibniz_lie, ← lie_skew y, ← sub_eq_add_neg]
      exact H.sub_mem (hz ⟨_, hy x⟩) (hy ⟨_, hz x⟩) }
#align lie_subalgebra.normalizer LieSubalgebra.normalizer

theorem mem_normalizer_iff' (x : L) : x ∈ H.normalizer ↔ ∀ y : L, y ∈ H → ⁅y, x⁆ ∈ H :=
  by
  rw [Subtype.forall']
  rfl
#align lie_subalgebra.mem_normalizer_iff' LieSubalgebra.mem_normalizer_iff'

theorem mem_normalizer_iff (x : L) : x ∈ H.normalizer ↔ ∀ y : L, y ∈ H → ⁅x, y⁆ ∈ H :=
  by
  rw [mem_normalizer_iff']
  refine' forall₂_congr fun y hy => _
  rw [← lie_skew, neg_mem_iff]
#align lie_subalgebra.mem_normalizer_iff LieSubalgebra.mem_normalizer_iff

theorem le_normalizer : H ≤ H.normalizer :=
  H.toLieSubmodule.le_normalizer
#align lie_subalgebra.le_normalizer LieSubalgebra.le_normalizer

theorem coe_normalizer_eq_normalizer :
    (H.toLieSubmodule.normalizer : Submodule R L) = H.normalizer :=
  rfl
#align lie_subalgebra.coe_normalizer_eq_normalizer LieSubalgebra.coe_normalizer_eq_normalizer

variable {H}

theorem lie_mem_sup_of_mem_normalizer {x y z : L} (hx : x ∈ H.normalizer) (hy : y ∈ (R ∙ x) ⊔ ↑H)
    (hz : z ∈ (R ∙ x) ⊔ ↑H) : ⁅y, z⁆ ∈ (R ∙ x) ⊔ ↑H :=
  by
  rw [Submodule.mem_sup] at hy hz
  obtain ⟨u₁, hu₁, v, hv : v ∈ H, rfl⟩ := hy
  obtain ⟨u₂, hu₂, w, hw : w ∈ H, rfl⟩ := hz
  obtain ⟨t, rfl⟩ := submodule.mem_span_singleton.mp hu₁
  obtain ⟨s, rfl⟩ := submodule.mem_span_singleton.mp hu₂
  apply Submodule.mem_sup_right
  simp only [LieSubalgebra.mem_coe_submodule, smul_lie, add_lie, zero_add, lie_add, smul_zero,
    lie_smul, lie_self]
  refine' H.add_mem (H.smul_mem s _) (H.add_mem (H.smul_mem t _) (H.lie_mem hv hw))
  exacts[(H.mem_normalizer_iff' x).mp hx v hv, (H.mem_normalizer_iff x).mp hx w hw]
#align lie_subalgebra.lie_mem_sup_of_mem_normalizer LieSubalgebra.lie_mem_sup_of_mem_normalizer

/-- A Lie subalgebra is an ideal of its normalizer. -/
theorem ideal_in_normalizer {x y : L} (hx : x ∈ H.normalizer) (hy : y ∈ H) : ⁅x, y⁆ ∈ H :=
  by
  rw [← lie_skew, neg_mem_iff]
  exact hx ⟨y, hy⟩
#align lie_subalgebra.ideal_in_normalizer LieSubalgebra.ideal_in_normalizer

/-- A Lie subalgebra `H` is an ideal of any Lie subalgebra `K` containing `H` and contained in the
normalizer of `H`. -/
theorem exists_nested_lieIdeal_ofLe_normalizer {K : LieSubalgebra R L} (h₁ : H ≤ K)
    (h₂ : K ≤ H.normalizer) : ∃ I : LieIdeal R K, (I : LieSubalgebra R K) = ofLe h₁ :=
  by
  rw [exists_nested_lie_ideal_coe_eq_iff]
  exact fun x y hx hy => ideal_in_normalizer (h₂ hx) hy
#align lie_subalgebra.exists_nested_lie_ideal_of_le_normalizer LieSubalgebra.exists_nested_lieIdeal_ofLe_normalizer

variable (H)

theorem normalizer_eq_self_iff :
    H.normalizer = H ↔ (LieModule.maxTrivSubmodule R H <| L ⧸ H.toLieSubmodule) = ⊥ :=
  by
  rw [LieSubmodule.eq_bot_iff]
  refine' ⟨fun h => _, fun h => le_antisymm (fun x hx => _) H.le_normalizer⟩
  · rintro ⟨x⟩ hx
    suffices x ∈ H by simpa
    rw [← h, H.mem_normalizer_iff']
    intro y hy
    replace hx : ⁅_, LieSubmodule.Quotient.mk' _ x⁆ = 0 := hx ⟨y, hy⟩
    rwa [← LieModuleHom.map_lie, LieSubmodule.Quotient.mk_eq_zero] at hx
  · let y := LieSubmodule.Quotient.mk' H.to_lie_submodule x
    have hy : y ∈ LieModule.maxTrivSubmodule R H (L ⧸ H.to_lie_submodule) :=
      by
      rintro ⟨z, hz⟩
      rw [← LieModuleHom.map_lie, LieSubmodule.Quotient.mk_eq_zero, coe_bracket_of_module,
        Submodule.coe_mk, mem_to_lie_submodule]
      exact (H.mem_normalizer_iff' x).mp hx z hz
    simpa using h y hy
#align lie_subalgebra.normalizer_eq_self_iff LieSubalgebra.normalizer_eq_self_iff

end LieSubalgebra