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

! This file was ported from Lean 3 source module control.traversable.instances
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Applicative
import Mathbin.Data.List.Forall2
import Mathbin.Data.Set.Functor

/-!
# Traversable instances

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

This file provides instances of `traversable` for types from the core library: `option`, `list` and
`sum`.
-/

universe u v

section Option

open Functor

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

variable [LawfulApplicative F] [LawfulApplicative G]

/- warning: option.id_traverse -> Option.id_traverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (x : Option.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Option.{u1} α)) (Option.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {α : Type.{u1}} (x : Option.{u1} α), Eq.{succ u1} (Id.{u1} (Option.{u1} α)) (Option.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align option.id_traverse Option.id_traverseₓ'. -/
theorem Option.id_traverse {α} (x : Option α) : Option.traverse id.mk x = x := by cases x <;> rfl
#align option.id_traverse Option.id_traverse

/- warning: option.comp_traverse -> Option.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : Option.{u2} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (Option.{u1} γ)) (Option.traverse.{u1, u1, u2} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u2, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (Option.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) (Option.{u1} β) (F (Option.{u1} γ)) (Option.traverse.{u1, u1, u1} F _inst_1 β γ f) (Option.traverse.{u1, u1, u2} G _inst_2 α β g x)))
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} G _inst_2] {_inst_4 : Type.{u1}} {α : Type.{u2}} {β : Type.{u2}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : Option.{u1} _inst_4), Eq.{succ u2} (Functor.Comp.{u2, u2, u2} G F (Option.{u2} β)) (Option.traverse.{u2, u2, u1} (Functor.Comp.{u2, u2, u2} G F) (Functor.Comp.instApplicativeComp.{u2, u2, u2} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G (F β)) (Functor.Comp.{u2, u2, u2} G F β) (Functor.Comp.mk.{u2, u2, u2} G F β) (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.175 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.177 : G α) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.175 x._@.Mathlib.Control.Traversable.Instances._hyg.177) γ) f)) g) (Functor.Comp.mk.{u2, u2, u2} G F (Option.{u2} β) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (Option.{u2} α) (F (Option.{u2} β)) (Option.traverse.{u2, u2, u2} F _inst_1 α β γ) (Option.traverse.{u2, u2, u1} G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align option.comp_traverse Option.comp_traverseₓ'. -/
@[nolint unused_arguments]
theorem Option.comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : Option α) :
    Option.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x =
      Comp.mk (Option.traverse f <$> Option.traverse g x) :=
  by cases x <;> simp! [functor_norm] <;> rfl
#align option.comp_traverse Option.comp_traverse

/- warning: option.traverse_eq_map_id -> Option.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Option.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Option.{u1} β)) (Traversable.traverse.{u1} (fun {α : Type.{u1}} => Option.{u1} α) Option.traversable.{u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (Option.{u1} β) (Functor.map.{u1, u1} Option.{u1} (Traversable.toFunctor.{u1} Option.{u1} Option.traversable.{u1}) α β f x))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Option.{u1} α), Eq.{succ u1} (Id.{u1} (Option.{u1} β)) (Option.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (Option.{u1} β) (Functor.map.{u1, u1} Option.{u1} instFunctorOption.{u1} α β f x))
Case conversion may be inaccurate. Consider using '#align option.traverse_eq_map_id Option.traverse_eq_map_idₓ'. -/
theorem Option.traverse_eq_map_id {α β} (f : α → β) (x : Option α) :
    traverse (id.mk ∘ f) x = id.mk (f <$> x) := by cases x <;> rfl
#align option.traverse_eq_map_id Option.traverse_eq_map_id

variable (η : ApplicativeTransformation F G)

/- warning: option.naturality -> Option.naturality is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : Option.{u2} α), Eq.{succ u1} (G (Option.{u1} β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (Option.{u1} β) (Option.traverse.{u1, u1, u2} F _inst_1 α β f x)) (Option.traverse.{u1, u1, u2} G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : Option.{u1} α), Eq.{succ u2} (G (Option.{u2} β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (Option.{u2} β) (Option.traverse.{u2, u2, u1} F _inst_1 α β f x)) (Option.traverse.{u2, u2, u1} G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align option.naturality Option.naturalityₓ'. -/
theorem Option.naturality {α β} (f : α → F β) (x : Option α) :
    η (Option.traverse f x) = Option.traverse (@η _ ∘ f) x := by
  cases' x with x <;> simp! [*, functor_norm]
#align option.naturality Option.naturality

end Option

instance : IsLawfulTraversable Option :=
  { Option.lawfulMonad with
    id_traverse := @Option.id_traverse
    comp_traverse := @Option.comp_traverse
    traverse_eq_map_id := @Option.traverse_eq_map_id
    naturality := @Option.naturality }

namespace List

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

section

variable [LawfulApplicative F] [LawfulApplicative G]

open Applicative Functor List

/- warning: list.id_traverse -> List.id_traverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (xs : List.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (List.{u1} α)) (List.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) xs) xs
but is expected to have type
  forall {α : Type.{u1}} (xs : List.{u1} α), Eq.{succ u1} (Id.{u1} (List.{u1} α)) (List.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) xs) xs
Case conversion may be inaccurate. Consider using '#align list.id_traverse List.id_traverseₓ'. -/
protected theorem id_traverse {α} (xs : List α) : List.traverse id.mk xs = xs := by
  induction xs <;> simp! [*, functor_norm] <;> rfl
#align list.id_traverse List.id_traverse

/- warning: list.comp_traverse -> List.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : List.{u2} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (List.{u1} γ)) (List.traverse.{u1, u1, u2} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u2, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (List.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) (List.{u1} β) (F (List.{u1} γ)) (List.traverse.{u1, u1, u1} F _inst_1 β γ f) (List.traverse.{u1, u1, u2} G _inst_2 α β g x)))
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} G _inst_2] {_inst_4 : Type.{u1}} {α : Type.{u2}} {β : Type.{u2}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : List.{u1} _inst_4), Eq.{succ u2} (Functor.Comp.{u2, u2, u2} G F (List.{u2} β)) (List.traverse.{u2, u2, u1} (Functor.Comp.{u2, u2, u2} G F) (Functor.Comp.instApplicativeComp.{u2, u2, u2} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G (F β)) (Functor.Comp.{u2, u2, u2} G F β) (Functor.Comp.mk.{u2, u2, u2} G F β) (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.982 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.984 : G α) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.982 x._@.Mathlib.Control.Traversable.Instances._hyg.984) γ) f)) g) (Functor.Comp.mk.{u2, u2, u2} G F (List.{u2} β) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (List.{u2} α) (F (List.{u2} β)) (List.traverse.{u2, u2, u2} F _inst_1 α β γ) (List.traverse.{u2, u2, u1} G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align list.comp_traverse List.comp_traverseₓ'. -/
@[nolint unused_arguments]
protected theorem comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : List α) :
    List.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x = Comp.mk (List.traverse f <$> List.traverse g x) :=
  by induction x <;> simp! [*, functor_norm] <;> rfl
#align list.comp_traverse List.comp_traverse

/- warning: list.traverse_eq_map_id -> List.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : List.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (List.{u1} β)) (List.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (List.{u1} β) (Functor.map.{u1, u1} List.{u1} (Traversable.toFunctor.{u1} List.{u1} List.traversable.{u1}) α β f x))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : List.{u1} α), Eq.{succ u1} (Id.{u1} (List.{u1} β)) (List.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (List.{u1} β) (Functor.map.{u1, u1} List.{u1} List.instFunctorList.{u1} α β f x))
Case conversion may be inaccurate. Consider using '#align list.traverse_eq_map_id List.traverse_eq_map_idₓ'. -/
protected theorem traverse_eq_map_id {α β} (f : α → β) (x : List α) :
    List.traverse (id.mk ∘ f) x = id.mk (f <$> x) := by
  induction x <;> simp! [*, functor_norm] <;> rfl
#align list.traverse_eq_map_id List.traverse_eq_map_id

variable (η : ApplicativeTransformation F G)

/- warning: list.naturality -> List.naturality is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : List.{u2} α), Eq.{succ u1} (G (List.{u1} β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (List.{u1} β) (List.traverse.{u1, u1, u2} F _inst_1 α β f x)) (List.traverse.{u1, u1, u2} G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : List.{u1} α), Eq.{succ u2} (G (List.{u2} β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (List.{u2} β) (List.traverse.{u2, u2, u1} F _inst_1 α β f x)) (List.traverse.{u2, u2, u1} G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align list.naturality List.naturalityₓ'. -/
protected theorem naturality {α β} (f : α → F β) (x : List α) :
    η (List.traverse f x) = List.traverse (@η _ ∘ f) x := by induction x <;> simp! [*, functor_norm]
#align list.naturality List.naturality

open Nat

instance : IsLawfulTraversable.{u} List :=
  { List.lawfulMonad with
    id_traverse := @List.id_traverse
    comp_traverse := @List.comp_traverse
    traverse_eq_map_id := @List.traverse_eq_map_id
    naturality := @List.naturality }

end

section Traverse

variable {α' β' : Type u} (f : α' → F β')

#print List.traverse_nil /-
@[simp]
theorem traverse_nil : traverse f ([] : List α') = (pure [] : F (List β')) :=
  rfl
#align list.traverse_nil List.traverse_nil
-/

/- warning: list.traverse_cons -> List.traverse_cons is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) (a : α') (l : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f (List.cons.{u1} α' a l)) (Seq.seq.{u1, u1} F (Applicative.toHasSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) β' ((List.{u1} β') -> (List.{u1} β')) (fun (_x : β') (_y : List.{u1} β') => List.cons.{u1} β' _x _y) (f a)) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f l))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) (a : α') (l : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f (List.cons.{u1} α' a l)) (Seq.seq.{u1, u1} F (Applicative.toSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) β' ((List.{u1} β') -> (List.{u1} β')) (fun (_x : β') (_y : List.{u1} β') => List.cons.{u1} β' _x _y) (f a)) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1745 : Unit) => Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f l))
Case conversion may be inaccurate. Consider using '#align list.traverse_cons List.traverse_consₓ'. -/
@[simp]
theorem traverse_cons (a : α') (l : List α') :
    traverse f (a :: l) = (· :: ·) <$> f a <*> traverse f l :=
  rfl
#align list.traverse_cons List.traverse_cons

variable [LawfulApplicative F]

/- warning: list.traverse_append -> List.traverse_append is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] (as : List.{u1} α') (bs : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} (fun {α' : Type.{u1}} => List.{u1} α') List.traversable.{u1} F _inst_1 α' β' f (Append.append.{u1} (List.{u1} α') (List.hasAppend.{u1} α') as bs)) (Seq.seq.{u1, u1} F (Applicative.toHasSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) (List.{u1} β') ((List.{u1} β') -> (List.{u1} β')) (Append.append.{u1} (List.{u1} β') (List.hasAppend.{u1} β')) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f as)) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f bs))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] (as : List.{u1} α') (bs : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f (HAppend.hAppend.{u1, u1, u1} (List.{u1} α') (List.{u1} α') (List.{u1} α') (instHAppend.{u1} (List.{u1} α') (List.instAppendList.{u1} α')) as bs)) (Seq.seq.{u1, u1} F (Applicative.toSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) (List.{u1} β') ((List.{u1} β') -> (List.{u1} β')) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1825 : List.{u1} β') (x._@.Mathlib.Control.Traversable.Instances._hyg.1827 : List.{u1} β') => HAppend.hAppend.{u1, u1, u1} (List.{u1} β') (List.{u1} β') (List.{u1} β') (instHAppend.{u1} (List.{u1} β') (List.instAppendList.{u1} β')) x._@.Mathlib.Control.Traversable.Instances._hyg.1825 x._@.Mathlib.Control.Traversable.Instances._hyg.1827) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f as)) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1844 : Unit) => Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f bs))
Case conversion may be inaccurate. Consider using '#align list.traverse_append List.traverse_appendₓ'. -/
@[simp]
theorem traverse_append :
    ∀ as bs : List α', traverse f (as ++ bs) = (· ++ ·) <$> traverse f as <*> traverse f bs
  | [], bs => by
    have : Append.append ([] : List β') = id := by funext <;> rfl
    simp [this, functor_norm]
  | a :: as, bs => by simp [traverse_append as bs, functor_norm] <;> congr
#align list.traverse_append List.traverse_append

#print List.mem_traverse /-
theorem mem_traverse {f : α' → Set β'} :
    ∀ (l : List α') (n : List β'), n ∈ traverse f l ↔ Forall₂ (fun b a => b ∈ f a) n l
  | [], [] => by simp
  | a :: as, [] => by simp
  | [], b :: bs => by simp
  | a :: as, b :: bs => by simp [mem_traverse as bs]
#align list.mem_traverse List.mem_traverse
-/

end Traverse

end List

namespace Sum

section Traverse

variable {σ : Type u}

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

open Applicative Functor

open List (cons)

/- warning: sum.traverse_map -> Sum.traverse_map is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> β) (f : β -> (G γ)) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Sum.traverse.{u1, u1} σ G _inst_2 β γ f (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) α β g x)) (Sum.traverse.{u1, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u1, succ u1} α β (G γ) f g) x)
but is expected to have type
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> β) (f : β -> (G γ)) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Sum.traverse.{u1, u1} σ G _inst_2 β γ f (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (instTraversableSum.{u1} σ)) α β g x)) (Sum.traverse.{u1, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u1, succ u1} α β (G γ) f g) x)
Case conversion may be inaccurate. Consider using '#align sum.traverse_map Sum.traverse_mapₓ'. -/
protected theorem traverse_map {α β γ : Type u} (g : α → β) (f : β → G γ) (x : Sum σ α) :
    Sum.traverse f (g <$> x) = Sum.traverse (f ∘ g) x := by
  cases x <;> simp [Sum.traverse, id_map, functor_norm] <;> rfl
#align sum.traverse_map Sum.traverse_map

variable [LawfulApplicative F] [LawfulApplicative G]

/- warning: sum.id_traverse -> Sum.id_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {α : Type.{u1}} (x : Sum.{u1, u1} σ α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Sum.{u1, u1} σ α)) (Sum.traverse.{u1, u1} σ (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {σ : Type.{u1}} {α : Type.{u1}} (x : Sum.{u1, u1} σ α), Eq.{succ u1} (Id.{u1} (Sum.{u1, u1} σ α)) (Sum.traverse.{u1, u1} σ Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align sum.id_traverse Sum.id_traverseₓ'. -/
protected theorem id_traverse {σ α} (x : Sum σ α) : Sum.traverse id.mk x = x := by cases x <;> rfl
#align sum.id_traverse Sum.id_traverse

/- warning: sum.comp_traverse -> Sum.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u}} {F : Type.{u} -> Type.{u}} {G : Type.{u} -> Type.{u}} [_inst_1 : Applicative.{u, u} F] [_inst_2 : Applicative.{u, u} G] [_inst_3 : LawfulApplicative.{u, u} F _inst_1] [_inst_4 : LawfulApplicative.{u, u} G _inst_2] {α : Type.{u_1}} {β : Type.{u}} {γ : Type.{u}} (f : β -> (F γ)) (g : α -> (G β)) (x : Sum.{u, u_1} σ α), Eq.{succ u} (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F (Sum.{u, u} σ γ)) (Sum.traverse.{u, u_1} σ (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F) (Functor.Comp.applicative.{u, u, u} (fun {β : Type.{u}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u_1, succ u, succ u} α (G (F γ)) (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F γ) (Functor.Comp.mk.{u, u, u} (fun {β : Type.{u}} => G β) F γ) (Function.comp.{succ u_1, succ u, succ u} α (G β) (G (F γ)) (Functor.map.{u, u} (fun {β : Type.{u}} => G β) (Applicative.toFunctor.{u, u} (fun {β : Type.{u}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u, u, u} (fun {β : Type.{u}} => G β) F (Sum.{u, u} σ γ) (Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) (Sum.{u, u} σ β) (F (Sum.{u, u} σ γ)) (Sum.traverse.{u, u} σ F _inst_1 β γ f) (Sum.traverse.{u, u_1} σ G _inst_2 α β g x)))
but is expected to have type
  forall {σ : Type.{u}} {F : Type.{u} -> Type.{u}} {G : Type.{u} -> Type.{u}} [_inst_1 : Applicative.{u, u} F] [_inst_2 : Applicative.{u, u} G] [_inst_3 : LawfulApplicative.{u, u} G _inst_2] {_inst_4 : Type.{u}} {α : Type.{u}} {β : Type.{u}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : Sum.{u, u} σ _inst_4), Eq.{succ u} (Functor.Comp.{u, u, u} G F (Sum.{u, u} σ β)) (Sum.traverse.{u, u} σ (Functor.Comp.{u, u, u} G F) (Functor.Comp.instApplicativeComp.{u, u, u} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u, succ u, succ u} _inst_4 (G (F β)) (Functor.Comp.{u, u, u} G F β) (Functor.Comp.mk.{u, u, u} G F β) (Function.comp.{succ u, succ u, succ u} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2374 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.2376 : G α) => Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.2374 x._@.Mathlib.Control.Traversable.Instances._hyg.2376) γ) f)) g) (Functor.Comp.mk.{u, u, u} G F (Sum.{u, u} σ β) (Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) (Sum.{u, u} σ α) (F (Sum.{u, u} σ β)) (Sum.traverse.{u, u} σ F _inst_1 α β γ) (Sum.traverse.{u, u} σ G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align sum.comp_traverse Sum.comp_traverseₓ'. -/
@[nolint unused_arguments]
protected theorem comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : Sum σ α) :
    Sum.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x = Comp.mk (Sum.traverse f <$> Sum.traverse g x) := by
  cases x <;> simp! [Sum.traverse, map_id, functor_norm] <;> rfl
#align sum.comp_traverse Sum.comp_traverse

/- warning: sum.traverse_eq_map_id -> Sum.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Sum.{u1, u1} σ β)) (Sum.traverse.{u1, u1} σ (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (Sum.{u1, u1} σ β) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) α β f x))
but is expected to have type
  forall {σ : Type.{u1}} {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (Id.{u1} (Sum.{u1, u1} σ β)) (Sum.traverse.{u1, u1} σ Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (Sum.{u1, u1} σ β) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (instTraversableSum.{u1} σ)) α β f x))
Case conversion may be inaccurate. Consider using '#align sum.traverse_eq_map_id Sum.traverse_eq_map_idₓ'. -/
protected theorem traverse_eq_map_id {α β} (f : α → β) (x : Sum σ α) :
    Sum.traverse (id.mk ∘ f) x = id.mk (f <$> x) := by
  induction x <;> simp! [*, functor_norm] <;> rfl
#align sum.traverse_eq_map_id Sum.traverse_eq_map_id

/- warning: sum.map_traverse -> Sum.map_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> (G β)) (f : β -> γ) (x : Sum.{u1, u2} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) (Sum.{u1, u1} σ β) (Sum.{u1, u1} σ γ) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) β γ f) (Sum.traverse.{u1, u2} σ (fun {β : Type.{u1}} => G β) _inst_2 α β g x)) (Sum.traverse.{u1, u2} σ G _inst_2 α γ (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) β γ f) g) x)
but is expected to have type
  forall {σ : Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_2 : Applicative.{u2, u2} G] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u2}} (g : α -> (G β)) (f : β -> γ) (x : Sum.{u2, u1} σ α), Eq.{succ u2} (G (Sum.{u2, u2} σ γ)) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (Sum.{u2, u2} σ β) (Sum.{u2, u2} σ γ) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2806 : β -> γ) (x._@.Mathlib.Control.Traversable.Instances._hyg.2808 : Sum.{u2, u2} σ β) => Functor.map.{u2, u2} (Sum.{u2, u2} σ) (Traversable.toFunctor.{u2} (Sum.{u2, u2} σ) (instTraversableSum.{u2} σ)) β γ x._@.Mathlib.Control.Traversable.Instances._hyg.2806 x._@.Mathlib.Control.Traversable.Instances._hyg.2808) f) (Sum.traverse.{u2, u1} σ G _inst_2 α β g x)) (Sum.traverse.{u2, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u2, succ u2} α (G β) (G γ) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2832 : β -> γ) (x._@.Mathlib.Control.Traversable.Instances._hyg.2834 : G β) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) β γ x._@.Mathlib.Control.Traversable.Instances._hyg.2832 x._@.Mathlib.Control.Traversable.Instances._hyg.2834) f) g) x)
Case conversion may be inaccurate. Consider using '#align sum.map_traverse Sum.map_traverseₓ'. -/
protected theorem map_traverse {α β γ} (g : α → G β) (f : β → γ) (x : Sum σ α) :
    (· <$> ·) f <$> Sum.traverse g x = Sum.traverse ((· <$> ·) f ∘ g) x := by
  cases x <;> simp [Sum.traverse, id_map, functor_norm] <;> congr <;> rfl
#align sum.map_traverse Sum.map_traverse

variable (η : ApplicativeTransformation F G)

/- warning: sum.naturality -> Sum.naturality is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : Sum.{u1, u2} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (Sum.{u1, u1} σ β) (Sum.traverse.{u1, u2} σ F _inst_1 α β f x)) (Sum.traverse.{u1, u2} σ G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {σ : Type.{u2}} {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : Sum.{u2, u1} σ α), Eq.{succ u2} (G (Sum.{u2, u2} σ β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (Sum.{u2, u2} σ β) (Sum.traverse.{u2, u1} σ F _inst_1 α β f x)) (Sum.traverse.{u2, u1} σ G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align sum.naturality Sum.naturalityₓ'. -/
protected theorem naturality {α β} (f : α → F β) (x : Sum σ α) :
    η (Sum.traverse f x) = Sum.traverse (@η _ ∘ f) x := by
  cases x <;> simp! [Sum.traverse, functor_norm]
#align sum.naturality Sum.naturality

end Traverse

instance {σ : Type u} : IsLawfulTraversable.{u} (Sum σ) :=
  { Sum.lawfulMonad with
    id_traverse := @Sum.id_traverse σ
    comp_traverse := @Sum.comp_traverse σ
    traverse_eq_map_id := @Sum.traverse_eq_map_id σ
    naturality := @Sum.naturality σ }

end Sum


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.products
import category_theory.limits.shapes.images
import category_theory.isomorphism_classes

/-!
# Zero morphisms and zero objects

A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. (Notice this is extra
structure, not merely a property.)

A category "has a zero object" if it has an object which is both initial and terminal. Having a
zero object provides zero morphisms, as the unique morphisms factoring through the zero object.

## References

* https://en.wikipedia.org/wiki/Zero_morphism
* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v u

open category_theory
open category_theory.category

namespace category_theory.limits

variables (C : Type u) [category.{v} C]

/-- A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. -/
class has_zero_morphisms :=
[has_zero : Π X Y : C, has_zero (X ⟶ Y)]
(comp_zero' : ∀ {X Y : C} (f : X ⟶ Y) (Z : C), f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) . obviously)
(zero_comp' : ∀ (X : C) {Y Z : C} (f : Y ⟶ Z), (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) . obviously)

attribute [instance] has_zero_morphisms.has_zero
restate_axiom has_zero_morphisms.comp_zero'
restate_axiom has_zero_morphisms.zero_comp'

variables {C}

@[simp] lemma comp_zero [has_zero_morphisms C] {X Y : C} {f : X ⟶ Y} {Z : C} :
  f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) := has_zero_morphisms.comp_zero f Z
@[simp] lemma zero_comp [has_zero_morphisms C] {X : C} {Y Z : C} {f : Y ⟶ Z} :
  (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) := has_zero_morphisms.zero_comp X f

instance has_zero_morphisms_pempty : has_zero_morphisms (discrete pempty) :=
{ has_zero := by tidy }

instance has_zero_morphisms_punit : has_zero_morphisms (discrete punit) :=
{ has_zero := by tidy }

namespace has_zero_morphisms
variables {C}

/-- This lemma will be immediately superseded by `ext`, below. -/
private lemma ext_aux (I J : has_zero_morphisms C)
  (w : ∀ X Y : C, (@has_zero_morphisms.has_zero _ _ I X Y).zero =
    (@has_zero_morphisms.has_zero _ _ J X Y).zero) : I = J :=
begin
  casesI I, casesI J,
  congr,
  { ext X Y,
    exact w X Y },
  { apply proof_irrel_heq, },
  { apply proof_irrel_heq, }
end

/--
If you're tempted to use this lemma "in the wild", you should probably
carefully consider whether you've made a mistake in allowing two
instances of `has_zero_morphisms` to exist at all.

See, particularly, the note on `zero_morphisms_of_zero_object` below.
-/
lemma ext (I J : has_zero_morphisms C) : I = J :=
begin
  apply ext_aux,
  intros X Y,
  rw ←@has_zero_morphisms.comp_zero _ _ I X X (@has_zero_morphisms.has_zero _ _ J X X).zero,
  rw @has_zero_morphisms.zero_comp _ _ J,
end

instance : subsingleton (has_zero_morphisms C) :=
⟨ext⟩

end has_zero_morphisms

open opposite has_zero_morphisms

instance has_zero_morphisms_opposite [has_zero_morphisms C] :
  has_zero_morphisms Cᵒᵖ :=
{ has_zero := λ X Y, ⟨(0 : unop Y ⟶ unop X).op⟩,
  comp_zero' := λ X Y f Z, congr_arg quiver.hom.op (has_zero_morphisms.zero_comp (unop Z) f.unop),
  zero_comp' := λ X Y Z f, congr_arg quiver.hom.op (has_zero_morphisms.comp_zero f.unop (unop X)), }

section
variables {C} [has_zero_morphisms C]

lemma zero_of_comp_mono {X Y Z : C} {f : X ⟶ Y} (g : Y ⟶ Z) [mono g] (h : f ≫ g = 0) : f = 0 :=
by { rw [←zero_comp, cancel_mono] at h, exact h }

lemma zero_of_epi_comp {X Y Z : C} (f : X ⟶ Y) {g : Y ⟶ Z} [epi f] (h : f ≫ g = 0) : g = 0 :=
by { rw [←comp_zero, cancel_epi] at h, exact h }

lemma eq_zero_of_image_eq_zero {X Y : C} {f : X ⟶ Y} [has_image f] (w : image.ι f = 0) : f = 0 :=
by rw [←image.fac f, w, has_zero_morphisms.comp_zero]

lemma nonzero_image_of_nonzero {X Y : C} {f : X ⟶ Y} [has_image f] (w : f ≠ 0) : image.ι f ≠ 0 :=
λ h, w (eq_zero_of_image_eq_zero h)
end

section
universes v' u'
variables (D : Type u') [category.{v'} D]

variables [has_zero_morphisms D]

instance : has_zero_morphisms (C ⥤ D) :=
{ has_zero := λ F G, ⟨{ app := λ X, 0, }⟩ }

@[simp] lemma zero_app (F G : C ⥤ D) (j : C) : (0 : F ⟶ G).app j = 0 := rfl

variables [has_zero_morphisms C]

lemma equivalence_preserves_zero_morphisms (F : C ≌ D) (X Y : C) :
  F.functor.map (0 : X ⟶ Y) = (0 : F.functor.obj X ⟶ F.functor.obj Y) :=
begin
  have t : F.functor.map (0 : X ⟶ Y) =
    F.functor.map (0 : X ⟶ Y) ≫ (0 : F.functor.obj Y ⟶ F.functor.obj Y),
  { apply faithful.map_injective (F.inverse),
    rw [functor.map_comp, equivalence.inv_fun_map],
    dsimp,
    rw [zero_comp, comp_zero, zero_comp], },
  exact t.trans (by simp)
end

@[simp] lemma is_equivalence_preserves_zero_morphisms (F : C ⥤ D) [is_equivalence F] (X Y : C) :
  F.map (0 : X ⟶ Y) = 0 :=
by rw [←functor.as_equivalence_functor F, equivalence_preserves_zero_morphisms]

end

variables (C)

/-- A category "has a zero object" if it has an object which is both initial and terminal. -/
class has_zero_object :=
(zero : C)
(unique_to : Π X : C, unique (zero ⟶ X))
(unique_from : Π X : C, unique (X ⟶ zero))

instance has_zero_object_punit : has_zero_object (discrete punit) :=
{ zero := punit.star,
  unique_to := by tidy,
  unique_from := by tidy, }

variables {C}

namespace has_zero_object

variables [has_zero_object C]

/--
Construct a `has_zero C` for a category with a zero object.
This can not be a global instance as it will trigger for every `has_zero C` typeclass search.
-/
protected def has_zero : has_zero C :=
{ zero := has_zero_object.zero }

localized "attribute [instance] category_theory.limits.has_zero_object.has_zero" in zero_object
localized "attribute [instance] category_theory.limits.has_zero_object.unique_to" in zero_object
localized "attribute [instance] category_theory.limits.has_zero_object.unique_from" in zero_object

@[ext]
lemma to_zero_ext {X : C} (f g : X ⟶ 0) : f = g :=
by rw [(has_zero_object.unique_from X).uniq f, (has_zero_object.unique_from X).uniq g]

@[ext]
lemma from_zero_ext {X : C} (f g : 0 ⟶ X) : f = g :=
by rw [(has_zero_object.unique_to X).uniq f, (has_zero_object.unique_to X).uniq g]

instance (X : C) : subsingleton (X ≅ 0) := by tidy

instance {X : C} (f : 0 ⟶ X) : mono f :=
{ right_cancellation := λ Z g h w, by ext, }

instance {X : C} (f : X ⟶ 0) : epi f :=
{ left_cancellation := λ Z g h w, by ext, }

/-- A category with a zero object has zero morphisms.

    It is rarely a good idea to use this. Many categories that have a zero object have zero
    morphisms for some other reason, for example from additivity. Library code that uses
    `zero_morphisms_of_zero_object` will then be incompatible with these categories because
    the `has_zero_morphisms` instances will not be definitionally equal. For this reason library
    code should generally ask for an instance of `has_zero_morphisms` separately, even if it already
    asks for an instance of `has_zero_objects`. -/
def zero_morphisms_of_zero_object : has_zero_morphisms C :=
{ has_zero := λ X Y,
  { zero := inhabited.default (X ⟶ 0) ≫ inhabited.default (0 ⟶ Y) },
  zero_comp' := λ X Y Z f, by { dunfold has_zero.zero, rw category.assoc, congr, },
  comp_zero' := λ X Y Z f, by { dunfold has_zero.zero, rw ←category.assoc, congr, }}

/-- A zero object is in particular initial. -/
def zero_is_initial : is_initial (0 : C) :=
is_initial.of_unique 0
/-- A zero object is in particular terminal. -/
def zero_is_terminal : is_terminal (0 : C) :=
is_terminal.of_unique 0

/-- A zero object is in particular initial. -/
@[priority 10]
instance has_initial : has_initial C :=
has_initial_of_unique 0
/-- A zero object is in particular terminal. -/
@[priority 10]
instance has_terminal : has_terminal C :=
has_terminal_of_unique 0

@[priority 100]
instance has_strict_initial : initial_mono_class C :=
initial_mono_class.of_is_initial zero_is_initial (λ X, category_theory.mono _)

open_locale zero_object

instance {B : Type*} [category B] [has_zero_morphisms C] : has_zero_object (B ⥤ C) :=
{ zero := { obj := λ X, 0, map := λ X Y f, 0, },
  unique_to := λ F, ⟨⟨{ app := λ X, 0, }⟩, by tidy⟩,
  unique_from := λ F, ⟨⟨{ app := λ X, 0, }⟩, by tidy⟩ }

@[simp] lemma functor.zero_obj {B : Type*} [category B] [has_zero_morphisms C] (X : B) :
  (0 : B ⥤ C).obj X = 0 := rfl
@[simp] lemma functor.zero_map {B : Type*} [category B] [has_zero_morphisms C]
  {X Y : B} (f : X ⟶ Y) : (0 : B ⥤ C).map f = 0 := rfl

end has_zero_object

section
variables [has_zero_object C] [has_zero_morphisms C]
open_locale zero_object

@[simp]
lemma id_zero : 𝟙 (0 : C) = (0 : 0 ⟶ 0) :=
by ext

/--  An arrow ending in the zero object is zero -/
-- This can't be a `simp` lemma because the left hand side would be a metavariable.
lemma zero_of_to_zero {X : C} (f : X ⟶ 0) : f = 0 :=
by ext

lemma zero_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : f = 0 :=
begin
  have h : f = f ≫ i.hom ≫ 𝟙 0 ≫ i.inv := by simp only [iso.hom_inv_id, id_comp, comp_id],
  simpa using h,
end

/-- An arrow starting at the zero object is zero -/
lemma zero_of_from_zero {X : C} (f : 0 ⟶ X) : f = 0 :=
by ext

lemma zero_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : f = 0 :=
begin
  have h : f = i.hom ≫ 𝟙 0 ≫ i.inv ≫ f := by simp only [iso.hom_inv_id_assoc, id_comp, comp_id],
  simpa using h,
end

lemma zero_of_source_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic X 0) : f = 0 :=
zero_of_source_iso_zero f (nonempty.some i)
lemma zero_of_target_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic Y 0) : f = 0 :=
zero_of_target_iso_zero f (nonempty.some i)

lemma mono_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : mono f :=
⟨λ Z g h w, by rw [zero_of_target_iso_zero g i, zero_of_target_iso_zero h i]⟩

lemma epi_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : epi f :=
⟨λ Z g h w, by rw [zero_of_source_iso_zero g i, zero_of_source_iso_zero h i]⟩

/--
An object `X` has `𝟙 X = 0` if and only if it is isomorphic to the zero object.

Because `X ≅ 0` contains data (even if a subsingleton), we express this `↔` as an `≃`.
-/
def id_zero_equiv_iso_zero (X : C) : (𝟙 X = 0) ≃ (X ≅ 0) :=
{ to_fun    := λ h, { hom := 0, inv := 0, },
  inv_fun   := λ i, zero_of_target_iso_zero (𝟙 X) i,
  left_inv  := by tidy,
  right_inv := by tidy, }

@[simp]
lemma id_zero_equiv_iso_zero_apply_hom (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).hom = 0 := rfl

@[simp]
lemma id_zero_equiv_iso_zero_apply_inv (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).inv = 0 := rfl

/-- If `0 : X ⟶ Y` is an monomorphism, then `X ≅ 0`. -/
@[simps]
def iso_zero_of_mono_zero {X Y : C} (h : mono (0 : X ⟶ Y)) : X ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' := (cancel_mono (0 : X ⟶ Y)).mp (by simp) }

/-- If `0 : X ⟶ Y` is an epimorphism, then `Y ≅ 0`. -/
@[simps]
def iso_zero_of_epi_zero {X Y : C} (h : epi (0 : X ⟶ Y)) : Y ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' := (cancel_epi (0 : X ⟶ Y)).mp (by simp) }

/-- If an object `X` is isomorphic to 0, there's no need to use choice to construct
an explicit isomorphism: the zero morphism suffices. -/
def iso_of_is_isomorphic_zero {X : C} (P : is_isomorphic X 0) : X ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' :=
  begin
    casesI P,
    rw ←P.hom_inv_id,
    rw ←category.id_comp P.inv,
    simp,
  end,
  inv_hom_id' := by simp, }

end

section is_iso
variables [has_zero_morphisms C]

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
the identities on both `X` and `Y` are zero.
-/
@[simps]
def is_iso_zero_equiv (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (𝟙 X = 0 ∧ 𝟙 Y = 0) :=
{ to_fun := by { introsI i, rw ←is_iso.hom_inv_id (0 : X ⟶ Y),
    rw ←is_iso.inv_hom_id (0 : X ⟶ Y), simp },
  inv_fun := λ h, ⟨⟨(0 : Y ⟶ X), by tidy⟩⟩,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
the identity on `X` is zero.
-/
def is_iso_zero_self_equiv (X : C) : is_iso (0 : X ⟶ X) ≃ (𝟙 X = 0) :=
by simpa using is_iso_zero_equiv X X

variables [has_zero_object C]
open_locale zero_object

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
`X` and `Y` are isomorphic to the zero object.
-/
def is_iso_zero_equiv_iso_zero (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (X ≅ 0) × (Y ≅ 0) :=
begin
  -- This is lame, because `prod` can't cope with `Prop`, so we can't use `equiv.prod_congr`.
  refine (is_iso_zero_equiv X Y).trans _,
  symmetry,
  fsplit,
  { rintros ⟨eX, eY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X).symm eX,
    exact (id_zero_equiv_iso_zero Y).symm eY, },
  { rintros ⟨hX, hY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X) hX,
    exact (id_zero_equiv_iso_zero Y) hY, },
  { tidy, },
  { tidy, },
end

lemma is_iso_of_source_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) (j : Y ≅ 0) : is_iso f :=
begin
  rw zero_of_source_iso_zero f i,
  exact (is_iso_zero_equiv_iso_zero _ _).inv_fun ⟨i, j⟩,
end

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
`X` is isomorphic to the zero object.
-/
def is_iso_zero_self_equiv_iso_zero (X : C) : is_iso (0 : X ⟶ X) ≃ (X ≅ 0) :=
(is_iso_zero_equiv_iso_zero X X).trans subsingleton_prod_self_equiv

end is_iso

/-- If there are zero morphisms, any initial object is a zero object. -/
def has_zero_object_of_has_initial_object
  [has_zero_morphisms C] [has_initial C] : has_zero_object C :=
{ zero := ⊥_ C,
  unique_to := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_from := λ X, ⟨⟨0⟩, λ f,
  calc
    f = f ≫ 𝟙 _ : (category.comp_id _).symm
    ... = f ≫ 0 : by congr
    ... = 0     : has_zero_morphisms.comp_zero _ _
  ⟩ }

/-- If there are zero morphisms, any terminal object is a zero object. -/
def has_zero_object_of_has_terminal_object
  [has_zero_morphisms C] [has_terminal C] : has_zero_object C :=
{ zero := ⊤_ C,
  unique_from := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_to := λ X, ⟨⟨0⟩, λ f,
  calc
    f = 𝟙 _ ≫ f : (category.id_comp _).symm
    ... = 0 ≫ f : by congr
    ... = 0     : zero_comp
  ⟩ }

section image
variable [has_zero_morphisms C]

lemma image_ι_comp_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image f]
  [epi (factor_thru_image f)] (h : f ≫ g = 0) : image.ι f ≫ g = 0 :=
zero_of_epi_comp (factor_thru_image f) $ by simp [h]

lemma comp_factor_thru_image_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image g]
  (h : f ≫ g = 0) : f ≫ factor_thru_image g = 0 :=
zero_of_comp_mono (image.ι g) $ by simp [h]

variables [has_zero_object C]
open_locale zero_object

/--
The zero morphism has a `mono_factorisation` through the zero object.
-/
@[simps]
def mono_factorisation_zero (X Y : C) : mono_factorisation (0 : X ⟶ Y) :=
{ I := 0, m := 0, e := 0, }

/--
The factorisation through the zero object is an image factorisation.
-/
def image_factorisation_zero (X Y : C) : image_factorisation (0 : X ⟶ Y) :=
{ F := mono_factorisation_zero X Y,
  is_image := { lift := λ F', 0 } }

instance has_image_zero {X Y : C} : has_image (0 : X ⟶ Y) :=
has_image.mk $ image_factorisation_zero _ _

/-- The image of a zero morphism is the zero object. -/
def image_zero {X Y : C} : image (0 : X ⟶ Y) ≅ 0 :=
is_image.iso_ext (image.is_image (0 : X ⟶ Y)) (image_factorisation_zero X Y).is_image

/-- The image of a morphism which is equal to zero is the zero object. -/
def image_zero' {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] : image f ≅ 0 :=
image.eq_to_iso h ≪≫ image_zero

@[simp]
lemma image.ι_zero {X Y : C} [has_image (0 : X ⟶ Y)] : image.ι (0 : X ⟶ Y) = 0 :=
begin
  rw ←image.lift_fac (mono_factorisation_zero X Y),
  simp,
end

/--
If we know `f = 0`,
it requires a little work to conclude `image.ι f = 0`,
because `f = g` only implies `image f ≅ image g`.
-/
@[simp]
lemma image.ι_zero' [has_equalizers C] {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] :
  image.ι f = 0 :=
by { rw image.eq_fac h, simp }

end image

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_sigma_ι
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_colimit (discrete.functor f)] (b : β) : split_mono (sigma.ι f b) :=
{ retraction := sigma.desc (λ b', if h : b' = b then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_pi_π
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_limit (discrete.functor f)] (b : β) : split_epi (pi.π f b) :=
{ section_ := pi.lift (λ b', if h : b = b' then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inl
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inl : X ⟶ X ⨿ Y) :=
{ retraction := coprod.desc (𝟙 X) 0, }
/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inr
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inr : Y ⟶ X ⨿ Y) :=
{ retraction := coprod.desc 0 (𝟙 Y), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_fst
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.fst : X ⨯ Y ⟶ X) :=
{ section_ := prod.lift (𝟙 X) 0, }
/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_snd
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.snd : X ⨯ Y ⟶ Y) :=
{ section_ := prod.lift 0 (𝟙 Y), }

end category_theory.limits


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.bitraversable.basic

/-!
# Bitraversable Lemmas

## Main definitions
  * tfst - traverse on first functor argument
  * tsnd - traverse on second functor argument

## Lemmas

Combination of
  * bitraverse
  * tfst
  * tsnd

with the applicatives `id` and `comp`

## References

 * Hackage: <https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Bitraversable.html>

## Tags

traversable bitraversable functor bifunctor applicative

-/

universes u

variables {t : Type u → Type u → Type u} [bitraversable t]
variables {β : Type u}

namespace bitraversable
open functor is_lawful_applicative
variables {F G : Type u → Type u}
          [applicative F] [applicative G]

/-- traverse on the first functor argument -/
@[reducible] def tfst {α α'} (f : α → F α') : t α β → F (t α' β) :=
bitraverse f pure

/-- traverse on the second functor argument -/
@[reducible] def tsnd {α α'} (f : α → F α') : t β α → F (t β α') :=
bitraverse pure f

variables [is_lawful_bitraversable t]
          [is_lawful_applicative F]
          [is_lawful_applicative G]

@[higher_order tfst_id]
lemma id_tfst : Π {α β} (x : t α β), tfst id.mk x = id.mk x :=
@id_bitraverse _ _ _

@[higher_order tsnd_id]
lemma id_tsnd : Π {α β} (x : t α β), tsnd id.mk x = id.mk x :=
@id_bitraverse _ _ _

@[higher_order tfst_comp_tfst]
lemma comp_tfst {α₀ α₁ α₂ β}
  (f : α₀ → F α₁) (f' : α₁ → G α₂) (x : t α₀ β) :
  comp.mk (tfst f' <$> tfst f x) = tfst (comp.mk ∘ map f' ∘ f) x :=
by rw ← comp_bitraverse; simp [tfst,map_comp_pure,has_pure.pure]

@[higher_order tfst_comp_tsnd]
lemma tfst_tsnd {α₀ α₁ β₀ β₁}
  (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
  comp.mk (tfst f <$> tsnd f' x) =
  bitraverse (comp.mk ∘ pure ∘ f) (comp.mk ∘ map pure ∘ f') x :=
by rw ← comp_bitraverse; simp [tfst,tsnd]

@[higher_order tsnd_comp_tfst]
lemma tsnd_tfst {α₀ α₁ β₀ β₁}
  (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
  comp.mk (tsnd f' <$> tfst f x) =
  bitraverse (comp.mk ∘ map pure ∘ f) (comp.mk ∘ pure ∘ f') x :=
by rw ← comp_bitraverse; simp [tfst,tsnd]

@[higher_order tsnd_comp_tsnd]
lemma comp_tsnd {α β₀ β₁ β₂}
  (g : β₀ → F β₁) (g' : β₁ → G β₂) (x : t α β₀) :
  comp.mk (tsnd g' <$> tsnd g x) = tsnd (comp.mk ∘ map g' ∘ g) x :=
by rw ← comp_bitraverse; simp [tsnd]; refl

open bifunctor

private

open function

@[higher_order]
lemma tfst_eq_fst_id {α α' β} (f : α → α') (x : t α β) :
  tfst (id.mk ∘ f) x = id.mk (fst f x) :=
by simp [tfst,fst,pure_eq_id_mk_comp_id,-comp.right_id,bitraverse_eq_bimap_id]

@[higher_order]
lemma tsnd_eq_snd_id {α β β'} (f : β → β') (x : t α β) :
  tsnd (id.mk ∘ f) x = id.mk (snd f x) :=
by simp [tsnd,snd,pure_eq_id_mk_comp_id,-comp.right_id,bitraverse_eq_bimap_id]

attribute [functor_norm] comp_bitraverse comp_tsnd comp_tfst
  tsnd_comp_tsnd tsnd_comp_tfst tfst_comp_tsnd tfst_comp_tfst
  bitraverse_comp bitraverse_id_id tfst_id tsnd_id

end bitraversable


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.cau_seq
import Mathlib.topology.uniform_space.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Uniform structure induced by an absolute value

We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
`𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
follows exactly the same path.

## Implementation details

Note that we import `data.real.cau_seq` because this is where absolute values are defined, but
the current file does not depend on real numbers. TODO: extract absolute values from that
`data.real` folder.

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

absolute value, uniform spaces
-/

namespace is_absolute_value

/-- The uniformity coming from an absolute value. -/
def uniform_space_core {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R]
    (abv : R → 𝕜) [is_absolute_value abv] : uniform_space.core R :=
  uniform_space.core.mk
    (infi
      fun (ε : 𝕜) =>
        infi
          fun (H : ε > 0) =>
            filter.principal (set_of fun (p : R × R) => abv (prod.snd p - prod.fst p) < ε))
    sorry sorry sorry

/-- The uniform structure coming from an absolute value. -/
def uniform_space {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R] (abv : R → 𝕜)
    [is_absolute_value abv] : uniform_space R :=
  uniform_space.of_core (uniform_space_core abv)

theorem mem_uniformity {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R]
    (abv : R → 𝕜) [is_absolute_value abv] {s : set (R × R)} :
    s ∈ uniform_space.core.uniformity (uniform_space_core abv) ↔
        ∃ (ε : 𝕜), ∃ (H : ε > 0), ∀ {a b : R}, abv (b - a) < ε → (a, b) ∈ s :=
  sorry

end Mathlib


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from sorry,
  have h2 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from sorry,
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from sorry,
end

--OUTPUT 2
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  { assume h1 : G.colorable 2,
    let f : (G.adj_matrix.to_list).finset → ℕ := sorry,
    have h2 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h3 : f (list.range (G.adj_matrix.to_list).length) = (finset.univ : finset ℕ), from sorry,
    have h4 : (finset.univ : finset ℕ) = finset.range 2, from sorry,
    have h5 : f (list.range (G.adj_matrix.to_list).length) = finset.range 2, from sorry,
    have h6 : ∀ (n : ℕ), n ∈ finset.range 2 → n = 0 ∨ n = 1, from sorry,
    have h7 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h8 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h9 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h10 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h11 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h12 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h13 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h14 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h15 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h16 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h17 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h18 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h19 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h20 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h21 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h22 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h23 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h24 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h25 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h26 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h27 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h28 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h29 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h30 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h31 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h32 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h33 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h34 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h35 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h36 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h37 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h38 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h39 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h40 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h41 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h42 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h43 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h44 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h45 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h46 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h47 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h48 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h49 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h50 : ∀ (i : fin (G.adj_matrix.to_list).length), f i = 0 ∨ f i = 1, from sorry,
    have h51 : ∀ (i
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) := sorry

/--`theorem`
Intersection of Preorders is Preorder
Let $P$ and $Q$ be preorders. Then $P \cap Q$ is a preorder.
`proof`
The intersection of preorders is a subset of both preorders, so it is a subset of any preorder containing both. Therefore, it is a preorder.

QED
-/
theorem intersection_of_preorders_is_preorder {α : Type*} {P Q : α → α → Prop} [preorder P] [preorder Q] : preorder (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Equivalence Relations is Equivalence Relation
Let $R$ and $S$ be equivalence relations. Then $R \cap S$ is an equivalence relation.
`proof`
The intersection of equivalence relations is a subset of both equivalence relations, so it is a subset of any equivalence relation containing both. Therefore, it is an equivalence relation.

QED
-/
theorem intersection_of_equiv_rels_is_equiv_rel {α : Type*} {R S : α → α → Prop} [equiv_rel R] [equiv_rel S] : equiv_rel (λ x y : α, R x y ∧ S x y) := sorry

/--`theorem`
Intersection of Partial Orders is Partial Order
Let $P$ and $Q$ be partial orders. Then $P \cap Q$ is a partial order.
`proof`
The intersection of partial orders is a subset of both partial orders, so it is a subset of any partial order containing both. Therefore, it is a partial order.

QED
-/
theorem intersection_of_part_orders_is_part_order {α : Type*} {P Q : α → α → Prop} [part_order P] [part_order Q] : part_order (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Total Orders is Total Order
Let $P$ and $Q$ be total orders. Then $P \cap Q$ is a total order.
`proof`
The intersection of total orders is a subset of both total orders, so it is a subset of any total order containing both. Therefore, it is a total order.

QED
-/
theorem intersection_of_total_orders_is_total_order {α : Type*} {P Q : α → α → Prop} [total_order P] [total_order Q] : total_order (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Well Orders is Well Order
Let $P$ and $Q$ be well orders. Then $P \cap Q$ is a well order.
`proof`
The intersection of well orders is a subset of both well orders, so it is a subset of any well order containing both. Therefore, it is a well order.

QED
-/
theorem intersection_of_well_orders_is_well_order {α : Type*} {P Q : α → α → Prop} [well_order P] [well_order Q] : well_order (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Lattices is Lattice
Let $P$ and $Q$ be lattices. Then $P \cap Q$ is a lattice.
`proof`
The intersection of lattices is a subset of both lattices, so it is a subset of any lattice containing both. Therefore, it is a lattice.

QED
-/
theorem intersection_of_lattices_is_lattice {α : Type*} {P Q : α → α → Prop} [lattice P] [lattice Q] : lattice (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Boolean Algebras is Boolean Algebra
Let $P$ and $Q$ be boolean algebras. Then $P \cap Q$ is a boolean algebra.
`proof`
The intersection of boolean algebras is a subset of both boolean algebras, so it is a subset of any boolean algebra containing both. Therefore, it is a boolean algebra.

QED
-/
theorem intersection_of_bool_algs_is_bool_alg {α : Type*} {P Q : α → α → Prop} [bool_alg P] [bool_alg Q] : bool_alg (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Groups is Group
Let $P$ and $Q$ be groups. Then $P \cap Q$ is a group.
`proof`
The intersection of groups is a subset of both groups, so it is a subset of any group containing both. Therefore, it is a group.

QED
-/
theorem intersection_of_groups_is_group {α : Type*} {P Q : α → α → Prop} [group P] [group Q] : group (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Rings is Ring
Let $P$ and $Q$ be rings. Then $P \cap Q$ is a ring.
`proof`
The intersection of rings is a subset of both rings, so it is a subset of any ring containing both. Therefore, it is a ring.

QED
-/
theorem intersection_of_rings_is_ring {α : Type*} {P Q : α → α → Prop} [ring P] [ring Q] : ring (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Fields is Field
Let $P$ and $Q$ be fields. Then $P \cap Q$ is a field.
`proof`
The intersection of fields is a subset of both fields, so it is a subset of any field containing both. Therefore, it is a field.

QED
-/
theorem intersection_of_fields_is_field {α : Type*} {P Q : α → α → Prop} [field P] [field Q] : field (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Topological Spaces is Topological Space
Let $P$ and $Q$ be topological spaces. Then $P \cap Q$ is a topological space.
`proof`
The intersection of topological spaces is a subset of both topological spaces, so it is a subset of any topological space containing both. Therefore, it is a topological space.

QED
-/
theorem intersection_of_top_spaces_is_top_space {α : Type*} {P Q : α → α → Prop} [top_space P] [top_space Q] : top_space (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Metric Spaces is Metric Space
Let $P$ and $Q$ be metric spaces. Then $P \cap Q$ is a metric space.
`proof`
The intersection of metric spaces is a subset of both metric spaces, so it is a subset of any metric space containing both. Therefore, it is a metric space.

QED
-/
theorem intersection_of_metric_spaces_is_metric_space {α : Type*} {P Q : α → α → Prop} [metric_space P] [metric_space Q] : metric_space (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem`
Intersection of Normed Spaces is Normed Space
Let $P$ and $Q$ be normed spaces. Then $P \cap Q$ is a normed space.
`proof`
The intersection of normed spaces is a subset of both normed spaces, so it is a subset of any normed space containing both. Therefore, it is a normed space.

QED
-/
theorem intersection_of_normed_spaces_is_normed_space {α : Type*} {P Q : α → α → Prop} [normed_space P] [normed_space Q] : normed_space (λ x y : α, P x y ∧ Q x y) := sorry

/--`theorem
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  {
    assume h1,
    obtain ⟨P, h2⟩ := h1,
    let f : V → fin 2 := λ v, (P v).1,
    let A : Type* := { v : V | f v = 0 },
    let B : Type* := { v : V | f v = 1 },
    let h3 : (A ⊕ B) = V := sorry,
    let G' : simple_graph (A ⊕ B) := cast (congr_arg _ h3) G,
    have h4 : ∀ (v : V), (v ∈ A) ∨ (v ∈ B), from sorry,
    have h5 : ∀ (a : A), ∀ (b : B), (a.1 ≠ b.1), from sorry,
    let G'' : simple_graph (A ⊕ B) := sorry,
    have h6 : G' = G'', from sorry,
    show ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from sorry,
  },
  {
    assume h1,
    obtain ⟨A, ⟨B, ⟨h2, h3⟩⟩⟩ := h1,
    let f : V → fin 2 := λ v, sorry,
    let P : V → fin 2 × fin 2 := λ v, sorry,
    show G.colorable 2, from sorry,
  }
end

--OUTPUT 5
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  assume h1 : G.colorable 2,
  have h2 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from sorry,
  show (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from h2,
  assume h3 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B),
  have h4 : G.colorable 2, from sorry,
  show G.colorable 2, from h4,
end

--OUTPUT 6
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1 : (∀ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from sorry,
  have h2 : ((G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B))) := sorry,
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from iff.intro h1 h2,
end

--OUTPUT 7
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  have h1 : ∀ G : simple_graph V, (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from sorry,
  have h2 : ∀ G : simple_graph V, (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (G.colorable 2), from sorry,
  show (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from sorry,
end

--OUTPUT 8
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  split,
  {
    assume h1 : G.colorable 2,
    have h2 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from sorry,
    show (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from h2,
  },
  {
    assume h1 : (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)),
    have h2 : G.colorable 2, from sorry,
    show G.colorable 2, from h2,
  },
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem  bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import Lean.Elab.ElabRules
syntax "kdef " ident (".{" ident,+ "}")? " : " term " := " term : command

open Lean Elab Command Term in
elab_rules : command | `(kdef $name $[.{ $levelParams?,* }]? : $type := $value) => do
  let levelParams :=
    if let some levelParams := levelParams?
    then levelParams.getElems.toList.map (·.getId)
    else []
  let (type, value) ← runTermElabM fun _ => do
    setLevelNames levelParams
    let type ← elabTermAndSynthesize type none
    let value ← elabTermAndSynthesize value none
    return (type, value)
  liftCoreM <| addDecl <| .defnDecl {
    name := name.getId
    levelParams
    type
    value
    hints := .abbrev
    safety := .safe
  }

kdef Univ'.{u} : Sort (imax 1 u + 1) := Sort (imax 1 u + 1)
def Univ := Univ'.{0}
#check (Univ : Univ) -- !!!

example : Sort (imax u v + 1) := Unit → Sort (imax u v)
-- (kernel) declaration type mismatch, '_example' has type
--   Type (max 0 (imax u v))
-- but it is expected to have type
--   Type (imax u v)


import data.real.basic
import data.set
import tactic
-- import exercices_espaces_metriques
open push_neg

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- sinon ne comprends pas ident*

/- décompose en premier caractère, reste  INUTILISE-/
def un_car : string → string × string
| ⟨(x :: xs)⟩  := ( ⟨ [x] ⟩ , ⟨ xs ⟩ )
| _ := ("","")

def deux_car : string → string
| ⟨(x ::  y :: xs)⟩  := ⟨ [x,y] ⟩
| _ := ""

def trois_car : string → string
| ⟨(x ::  y :: z ::xs)⟩  := ⟨ [x,y,z] ⟩
| _ := ""

/- décompose une chaine de caractères selon la première parenthèse ouvrante
Le premier terme ne sert qu'à la récursivité  INUTILISE-/
meta def debut_chaine : string × string → string × string
| (s , t ) := do
    let d := un_car t,
    match d  with
        | ("(",reste) :=  (s,t)
        | ( ⟨(x)⟩, reste) :=  (debut_chaine (s ++ d.1, reste ))
        -- | _ := ("ERREUR", "")
        end

-- set_option trace.eqn_compiler.elim_match true
-- ne fonctionne pas : le "Prop" est ignoré, ou bien tout est Prop ??
-- meta def is_prop : expr →  bool
--     | `(%%e : Prop) := tt
   --  | _             := ff

-- détermine si l'expression est une propriété
-- basé sur le fait (peut-être optimiste) que si on échoue à trouver le type,
-- c'est qu'il y a des variables libres,
-- et donc que c'est une propriété

-- test if expr is semantically an implication or a function
-- (as opposed to a "∀" expression )
meta def is_arrow' : expr → tactic bool
| `(%%P → %%Q) := if has_var_idx Q 0 then return ff else return tt
| _ := return ff

meta def instanciate (e : expr) : tactic expr :=
match e with
| (pi pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    return $ instantiate_var body a
| (lam pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    return $ instantiate_var body a
| _ := return e
end

meta def instanciate' (e : expr) : tactic (expr × expr) :=
match e with
| (pi pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    let inst_body := instantiate_var body a,
    return (a , inst_body)
| (lam pp_name binder type body) := do
    a ← mk_local' pp_name binder type,
    let inst_body := instantiate_var body a,
    return (a , inst_body)
| _ := return (e, e)
end

open tactic
example : true :=
by do e ← to_expr ```(∀ y : ℕ, ∀ x : ℕ, y = x), (es, tgt) ← mk_local_pis e, trace e, trace es, trace tgt

/- Décompose la racine d'une expression (un seul pas)
 LOGICS : ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON, EXISTE,
SETS: INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1,s IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION
NUMBERS: -/
private meta def analyse_expr_step  (e : expr) : tactic (string × (list expr)) :=
do  S ←  (tactic.pp e), let e_joli := to_string S,
match e with
| (lam name binder type body)          := return ("lambda[" ++ to_string name ++ "]", [type,body]) -- name → binder_info → expr → expr → expr
------------------------- LOGIQUE -------------------------
| `(%%p ∧ %%q) := return ("PROP_AND", [p,q])
| `(%%p ∨ %%q) := return ("PROP_OR", [p,q])
| `(%%p ↔ %%q) := return ("PROP_IFF", [p,q])
| `(¬ %%p) := return ("PROP_NOT", [p])
| `(%%p → false)  := return ("PROP_NOT", [p])
| (pi name binder type body) := do is_arr ←  (is_arrow' e),
    if is_arr then do is_p ← tactic.is_prop e,
                    if is_p then return ("PROP_IMPLIES", [type,body])
                        else return ("FUNCTION", [type,body])
     else do (var_, inst_body) ← instanciate' e,
               return ("QUANT_∀", [var_, type, inst_body])
| `(Exists %%p) := do match p with          --  améliorer : cas d'une prop, mais attention aux variables !!
    | (lam name binder type body) :=
    -- la suite teste s'il s'agit de l'existence d'un objet ou d'une propriété
        -- d'abord, si `body` contient des variables libres, c'est une propriété
        -- if type.has_var then return ("EXISTE[PROP:" ++ to_string name ++ "]", [type,body])
        -- si ce n'est pas le cas, on peut chercher son type, et voir si c'est Prop
        -- else do type_type ← infer_type type,
            -- if type_type = `(Prop)
            do (var_, inst_body) ← instanciate' p,
                is_p ← is_prop type, if is_p
                then return ("PROP_∃", [var_, type, inst_body])
                else return ("QUANT_∃", [var_, type, inst_body])
    |  _ := return ("ERROR", [])
    end
------------------------- THEORIE DES ENSEMBLES -------------------------
| `(%%A ∩ %%B) := return ("SET_INTER", [A,B])
| `(%%A ∪ %%B) := return ("SET_UNION", [A,B])
| `(set.compl %%A) := return ("SET_COMPLEMENT", [A])
| `(%%A \ %%B) := return ("SET_SYM_DIFF", [A,B])
| `(%%A ⊆ %%B) := return ("PROP_INCLUDED", [A,B])
| `(%%a ∈ %%A) := return ("PROP_BELONGS", [a,A])
| `(@set.univ %%X) := return ("SET_UNIVERSE", [X])
| `(-%%A) := return ("MINUS", [A])
| `(set.Union %%A) := return ("SET_UNION+", [A])
| `(set.Inter %%A) := return ("SET_INTER+", [A])
| `(%%f '' %%A) := return ("SET_IMAGE", [f,A])
| `(%%f  ⁻¹' %%A) := return ("SET_INVERSE", [f,A])
| `(∅) := return ("SET_EMPTY", [])
| `(_root_.set %%X) := return ("SET", [X])
-- polymorphe
| `(%%a = %%b) := return ("PROP_EQUAL", [a,b]) -- faudrait connaitre le type ?
| `(%%a ≠ %%b) := return ("PROP_EQUAL_NOT", [a,b]) -- faudrait connaitre le type ?
----------- TOPOLOGY --------------
-- | `(B(%%x, %%r))

---------------------------- NOMBRES particuliers (cf aussi plus bas)
| `(0:ℝ) := return ("NUMBER[0]",[])               -- OK, mais peut-être faut-il garder l'info 0 : réel
| `(0:ℕ) := return ("NUMBER[0]",[])               -- non testé
| `(0:ℤ) := return ("NUMBER[0]",[])               -- non testé
| `(1:ℝ) := return ("NUMBER[1]",[])
| `(1:ℕ) := return ("NUMBER[1]",[])               -- non testé
| `(1:ℤ) := return ("NUMBER[1]",[])               -- non testé
-- | `(0 < %%b) := return ("POSITIF", [b])
| `(%%a < %%b) := return ("PROP_<", [a,b])
| `(%%a ≤ %%b) := return ("PROP_≤", [a,b])
-- | `(%%a > 0) := return ("POSITIF", [a])
| `(%%a > %%b) := return ("PROP_>", [a,b])
| `(%%a ≥ %%b) := return ("PROP_≥", [a,b])
------------------------------ Meta_applications

| (app fonction argument)   := -- do let Sfonction := to_string(fonction),
    -- pour les nombres, utiliser la pretty printer de Lean
    -- récupérer le type ?
    if is_numeral e
        then return ("NUMBER["++e_joli ++"]",[])
    -- détecter les sous-ensembles
--    else if to_string(fonction) = "set.{0}"
--        then return("SET", [argument])
--        else return("META_APPLICATION[[pp:" ++ e_joli ++"]]",[fonction,argument])
        else return("APPLICATION",[fonction,argument])
| `(ℝ) := return ("TYPE_NUMBER[ℝ]",[])
| `(ℕ) := return ("TYPE_NUMBER[ℕ]",[])
| (const name list_level)   := return ("CONSTANT[name:"++ e_joli ++ "/" ++ to_string name ++"]", []) -- name → list level → expr
| (var nat)       := return ("VAR["++ to_string nat ++ "]", []) --  nat → expr
| (sort level)      := return ("TYPE", [])  -- level → expr
| (mvar name pretty_name type)        := return ("METAVAR[" ++ to_string pretty_name ++ "]", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("LOCAL_CONSTANT[name:"++ to_string pretty_name++"/identifier:"++ to_string name ++ "]", []) -- name → name → binder_info → expr → expr
| (elet name_var type_var expr body)        := return ("LET["++ to_string name_var ++"]", [type_var,expr,body]) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("MACRO", []) -- macro_def → list expr → expr
end

-- A node will be a leaf of the analysis tree iff it belongs to the following list:
-- leaves = ["NOMBRE", "CONSTANT", "VAR", "TYPE", "METAVAR", "LOCAL_CONSTANT",
--          "LET", "MACRO", "ERREUR"]
-- A leaf is followed by a separateur_virgule or a ")"
-- A node which is not a leaf is followed by a "("

def separateur_virgule := "¿, "
def separateur_egale := " ¿= "
def open_paren := "¿("
def closed_paren := "¿)"
/- Analyse récursivement une expression à l'aide de analyse_expr_step,
renvoie le résultat sous forme de chaine bien parenthésée-/
private meta def analyse_rec : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step(e),
--    bool ← is_prop e,
--    let string := to_string bool ++ "." ++ string,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec e1,
       return(string ++ open_paren ++ string1 ++ closed_paren)
    |[e1,e2] :=  do
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
--        if  string = "APPLICATION"
--            then return (string1 ++ open_paren ++ string2 ++ closed_paren) else
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ closed_paren)
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec e1,
        string2 ← analyse_rec e2,
        string3 ← analyse_rec e3,
        return (string ++ open_paren ++ string1 ++ separateur_virgule ++ string2 ++ separateur_virgule ++ string3 ++ closed_paren)
    | _ :=    return(string)
    end
private meta def analyse_expr : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    bool ← is_prop expr_t,
    -- expr_tt ← infer_type expr_t,
    if bool then do
            -- S ←  (tactic.pp expr_t),
            -- let S1 := to_string S,
            S ←  (tactic.pp expr_t), let et_joli := to_string S,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPERTY[" ++ S1b ++ "/pp_type: " ++ et_joli ++ "]" ++ separateur_egale ++ S2,
            return(S3)
        else  do
            -- let S1 :=  to_string e,
            S1b ← analyse_rec e,
            S2 ← analyse_rec expr_t,
            let S3 := "OBJECT[" ++ S1b ++ separateur_egale ++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte : tactic unit :=
do liste_expr ← local_context,
    trace "context:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

/- Affiche la liste des buts, même format que analyse_contexte
(excepté qu'il n'y a que des PROPRIETES) -/
meta def analyse_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "goals:",
    liste_expr.mmap (λ h, analyse_expr h >>= trace),
    return ()

---------------------------------------------------------
--------- NON UTILISES (debuggage) ----------------------------------
---------------------------------------------------------

/- Appelle l'analyse récursive sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec expr_t)
                else  do S1 ← (analyse_rec expr),
                        S2 ← (analyse_rec expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

/- Appelle l'analyse en 1 coup sur le but ou sur une hypothèse. Non utilisé par la suite. -/
meta def analyse1 (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_expr_step goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace (analyse_expr_step expr_t)
    | _ := skip
    end

-- non utilisé
private meta def analyse_expr2 : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

---------------------------------------------------------
----------------- Essai de rendu LateX, non abouti ------
---------------------------------------------------------

/- transforme une expression lean en expression latex
AMELIORER :
tenir compte de la profondeur de l'arbre pour décider si on met des prenthèses-/
/- ET, OU, SSI, QUELQUESOIT, IMPLIQUE, FONCTION, NON1, EXISTE,
INTER, UNION, INCLUS, APPARTIENT, COMPLEMENTAIRE1, IMAGE_ENSEMBLE, IMAGE_RECIPROQUE,
EGALITE, ENSEMBLE1, APPLICATION-/
meta def latex_expr : expr →  tactic string
| e := do
    ⟨string, liste_expr⟩ ←  analyse_expr_step e,
    if list.length liste_expr =2 then do
        let e1 := list.head liste_expr,
        let e2 := list.head (list.tail liste_expr),
        S1 ← latex_expr e1,
        S2 ← latex_expr e2,
        match string with
            | "ET" := return (S1 ++ " et " ++ S2)
            | "OU" := return (S1 ++ " ou " ++ S2)
            | "SSI" := return ("(" ++ S1 ++ "" ++") \\Leftrightarrow (" ++ S2 ++ ")")

            | "INCLUS" := return (S1 ++ "" ++" \\subset " ++ S2)
            | _ := return "ERREUR"
            end

    else if list.length liste_expr =1 then do
        let e1 := list.head liste_expr,
        S1 ← latex_expr e1,
        match string with
            | "NON" := return ("NON (" ++ S1 ++ ")")
            | "COMPLEMENTAIRE" := return (S1  ++ "^c")
            | _ := return "ERREUR"
            end
    else return (string)

meta def latex_buts : tactic unit :=
do liste_expr ← get_goals,
    trace "Buts :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    liste_expr.mmap (λ h, latex_expr h >>= trace),
    return ()

meta def latex_but : tactic unit :=
do expr ← target,
    trace "But :",
    -- liste_buts ← tactic.get_goals,
    -- types ← list.mmap tactic.infer_type liste_buts,
    -- trace types,
    trace (latex_expr expr),
    return ()

----------------------------------------------
------------- DEBUGGAGE -------------------
-------------------------------------------

/- debug -/
private meta def analyse_expr_step_brut  (e : expr) : tactic (string × (list expr)) :=
match e with
-- autres
| (pi name binder type body ) := return ("pi (nom : " ++ to_string name ++ ")",[type,body])
| (app fonction argument)   := return ("application", [fonction,argument])
| (const name list_level)   := return ("constante :" ++ to_string name, []) -- name → list level → expr
| (var nat)       := return ("var_"++ to_string nat, []) --  nat → expr
| (sort level)      := return ("sort", [])  -- level → expr
| (mvar name pretty_name type)        := return ("metavar", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("constante_locale :" ++ to_string pretty_name, []) -- name → name → binder_info → expr → expr
| (lam name binder type body)          := return ("lambda (nom : " ++ to_string name ++ ")", [type,body]) -- name → binder_info → expr → expr → expr
| (elet name_var type_var expr body)        := return ("let", []) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("macro", []) -- macro_def → list expr → expr
end

/-  Debug -/
private meta def analyse_rec_brut : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step_brut e,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec_brut e1,
       return(string ++ "(" ++ string1 ++ ")")
    |[e1,e2] :=  do
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        if  string = "APPLICATION" then do
            { type2 ← infer_type e2,
            let string_type2 := to_string type2, -- trace string_type2,
            if (string_type2 = "Type" ) ∨ (trois_car (to_string(e2)) = "_in" ) -- Type  ou instance
                then return (string1)
                else return (string1 ++ "(" ++ string2 ++")")
            }   <|> return (string1 ++ "(" ++ string2 ++")")
            else return (string ++ "(" ++ string1 ++ "," ++ string2 ++ ")")
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        string3 ← analyse_rec_brut e3,
        return (string ++ "(" ++ string1 ++ "," ++ string2 ++ "," ++ string3 ++ ")")
    | _ :=    return(string)
    end

/- Debug -/
meta def analyse_brut (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace (analyse_rec_brut goal)
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                expr_tt ← infer_type expr_t,
                -- la suite différencie selon la sémantique,
                -- ie les objets (éléments, ensembles, fonctions)
                -- vs les propriétés
                if expr_tt = `(Prop) then
                    trace (analyse_rec_brut expr_t)
                else  do S1 ← (analyse_rec_brut expr),
                        S2 ← (analyse_rec_brut expr_t),
                        --let S2 := to_string expr_t,
                        let S3 := S1 ++ " : "++ S2,
                        trace(S3)
    | _ := skip
    end

-- débug
private meta def analyse_expr_brut : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec_brut expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec_brut expr_t,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte_brut : tactic unit :=
do liste_expr ← local_context,
    trace "Contexte :",
    liste_expr.mmap (λ h, analyse_expr_brut h >>= trace),
    return ()

/- Analyse brute de Lean (dans expr) -/
meta def analyse_raw (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace $ to_raw_fmt goal
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace $ to_raw_fmt expr_t
    | _ := skip
    end

end tactic.interactive


import LMT

variable {I} [Nonempty I] {E} [Nonempty E] [Nonempty (A I E)]

example {a a' b b' : A I E} : a.write i (b.read i) = b.write i (a.read i) → a ≠ b → False := by
  arr