/-
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.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Functor
import Mathbin.Tactic.Ext

/-!
# Traversable type class

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

Type classes for traversing collections. The concepts and laws are taken from
<http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html>

Traversable collections are a generalization of functors. Whereas
functors (such as `list`) allow us to apply a function to every
element, it does not allow functions which external effects encoded in
a monad. Consider for instance a functor `invite : email → io response`
that takes an email address, sends an email and waits for a
response. If we have a list `guests : list email`, using calling
`invite` using `map` gives us the following: `map invite guests : list
(io response)`.  It is not what we need. We need something of type `io
(list response)`. Instead of using `map`, we can use `traverse` to
send all the invites: `traverse invite guests : io (list response)`.
`traverse` applies `invite` to every element of `guests` and combines
all the resulting effects. In the example, the effect is encoded in the
monad `io` but any applicative functor is accepted by `traverse`.

For more on how to use traversable, consider the Haskell tutorial:
<https://en.wikibooks.org/wiki/Haskell/Traversable>

## Main definitions
  * `traversable` type class - exposes the `traverse` function
  * `sequence` - based on `traverse`,
    turns a collection of effects into an effect returning a collection
  * `is_lawful_traversable` - laws for a traversable functor
  * `applicative_transformation` - the notion of a natural transformation for applicative functors

## Tags

traversable iterator functor applicative

## References

 * "Applicative Programming with Effects", by Conor McBride and Ross Paterson,
   Journal of Functional Programming 18:1 (2008) 1-13, online at
   <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>
 * "The Essence of the Iterator Pattern", by Jeremy Gibbons and Bruno Oliveira,
   in Mathematically-Structured Functional Programming, 2006, online at
   <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>
 * "An Investigation of the Laws of Traversals", by Mauro Jaskelioff and Ondrej Rypacek,
   in Mathematically-Structured Functional Programming, 2012,
   online at <http://arxiv.org/pdf/1202.2919>
-/

open Function hiding comp

universe u v w

section ApplicativeTransformation

variable (F : Type u → Type v) [Applicative F] [LawfulApplicative F]

variable (G : Type u → Type w) [Applicative G] [LawfulApplicative G]

/- warning: applicative_transformation -> ApplicativeTransformation is a dubious translation:
lean 3 declaration is
  forall (F : Type.{u1} -> Type.{u2}) [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (G : Type.{u1} -> Type.{u3}) [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3], Type.{max (succ u1) u2 u3}
but is expected to have type
  forall (F : Type.{u1} -> Type.{u2}) [_inst_1 : Applicative.{u1, u2} F] (_inst_2 : Type.{u1} -> Type.{u3}) [G : Applicative.{u1, u3} _inst_2], Type.{max (succ u1) u2 u3}
Case conversion may be inaccurate. Consider using '#align applicative_transformation ApplicativeTransformationₓ'. -/
/-- A transformation between applicative functors.  It is a natural
transformation such that `app` preserves the `has_pure.pure` and
`functor.map` (`<*>`) operations. See
`applicative_transformation.preserves_map` for naturality. -/
structure ApplicativeTransformation : Type max (u + 1) v w where
  app : ∀ α : Type u, F α → G α
  preserves_pure' : ∀ {α : Type u} (x : α), app _ (pure x) = pure x
  preserves_seq' : ∀ {α β : Type u} (x : F (α → β)) (y : F α), app _ (x <*> y) = app _ x <*> app _ y
#align applicative_transformation ApplicativeTransformation

end ApplicativeTransformation

namespace ApplicativeTransformation

variable (F : Type u → Type v) [Applicative F] [LawfulApplicative F]

variable (G : Type u → Type w) [Applicative G] [LawfulApplicative G]

instance : CoeFun (ApplicativeTransformation F G) fun _ => ∀ {α}, F α → G α :=
  ⟨ApplicativeTransformation.app⟩

variable {F G}

/- warning: applicative_transformation.app_eq_coe -> ApplicativeTransformation.app_eq_coe is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4), Eq.{max (succ (succ u1)) (succ u2) (succ u3)} (forall (α : Type.{u1}), (F α) -> (G α)) (ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4 η) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η)
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G), Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (forall (α : Type.{u1}), (F α) -> (_inst_2 α)) (ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3) (fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243)
Case conversion may be inaccurate. Consider using '#align applicative_transformation.app_eq_coe ApplicativeTransformation.app_eq_coeₓ'. -/
@[simp]
theorem app_eq_coe (η : ApplicativeTransformation F G) : η.app = η :=
  rfl
#align applicative_transformation.app_eq_coe ApplicativeTransformation.app_eq_coe

/- warning: applicative_transformation.coe_mk -> ApplicativeTransformation.coe_mk is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (f : forall (α : Type.{u1}), (F α) -> (G α)) (pp : forall {α : Type.{u1}} (x : α), Eq.{succ u3} (G α) (f α (Pure.pure.{u1, u2} (fun (α : Type.{u1}) => F α) (Applicative.toHasPure.{u1, u2} (fun (α : Type.{u1}) => F α) _inst_1) α x)) (Pure.pure.{u1, u3} (fun (α : Type.{u1}) => G α) (Applicative.toHasPure.{u1, u3} (fun (α : Type.{u1}) => G α) _inst_3) α x)) (ps : forall {α : Type.{u1}} {β : Type.{u1}} (x : F (α -> β)) (y : F α), Eq.{succ u3} (G β) (f β (Seq.seq.{u1, u2} (fun (α : Type.{u1}) => F α) (Applicative.toHasSeq.{u1, u2} (fun (α : Type.{u1}) => F α) _inst_1) α β x y)) (Seq.seq.{u1, u3} (fun (α : Type.{u1}) => G α) (Applicative.toHasSeq.{u1, u3} (fun (α : Type.{u1}) => G α) _inst_3) α β (f (α -> β) x) (f α y))), Eq.{max (succ (succ u1)) (succ u2) (succ u3)} (forall {α : Type.{u1}}, (F α) -> (G α)) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 _inst_2 (fun (α : Type.{u1}) => G α) _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 _inst_2 (fun (α : Type.{u1}) => G α) _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 _inst_2 (fun (α : Type.{u1}) => G α) _inst_3 _inst_4) (ApplicativeTransformation.mk.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 _inst_2 (fun (α : Type.{u1}) => G α) _inst_3 _inst_4 f pp ps)) f
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : forall (α : Type.{u1}), (F α) -> (_inst_2 α)) (_inst_4 : forall {α : Type.{u1}} (x : α), Eq.{succ u3} (_inst_2 α) (_inst_3 α (Pure.pure.{u1, u2} (fun (α : Type.{u1}) => F α) (Applicative.toPure.{u1, u2} (fun (α : Type.{u1}) => F α) _inst_1) α x)) (Pure.pure.{u1, u3} (fun (α : Type.{u1}) => _inst_2 α) (Applicative.toPure.{u1, u3} (fun (α : Type.{u1}) => _inst_2 α) G) α x)) (f : forall {α : Type.{u1}} {ᾰ : Type.{u1}} (x : F (α -> ᾰ)) (y : F α), Eq.{succ u3} (_inst_2 ᾰ) (_inst_3 ᾰ (Seq.seq.{u1, u2} (fun (α : Type.{u1}) => F α) (Applicative.toSeq.{u1, u2} (fun (α : Type.{u1}) => F α) _inst_1) α ᾰ x (fun (x._@.Mathlib.Control.Traversable.Basic._hyg.113 : Unit) => y))) (Seq.seq.{u1, u3} (fun (α : Type.{u1}) => _inst_2 α) (Applicative.toSeq.{u1, u3} (fun (α : Type.{u1}) => _inst_2 α) G) α ᾰ (_inst_3 (α -> ᾰ) x) (fun (x._@.Mathlib.Control.Traversable.Basic._hyg.125 : Unit) => _inst_3 α y))), Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (forall {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}}, (F α._@.Mathlib.Control.Traversable.Basic._hyg.243) -> (_inst_2 α._@.Mathlib.Control.Traversable.Basic._hyg.243)) (fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 (fun (α : Type.{u1}) => _inst_2 α) G (ApplicativeTransformation.mk.{u1, u2, u3} (fun (α : Type.{u1}) => F α) _inst_1 (fun (α : Type.{u1}) => _inst_2 α) G _inst_3 _inst_4 f) α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_3
Case conversion may be inaccurate. Consider using '#align applicative_transformation.coe_mk ApplicativeTransformation.coe_mkₓ'. -/
@[simp]
theorem coe_mk (f : ∀ α : Type u, F α → G α) (pp ps) :
    ⇑(ApplicativeTransformation.mk f pp ps) = f :=
  rfl
#align applicative_transformation.coe_mk ApplicativeTransformation.coe_mk

/- warning: applicative_transformation.congr_fun -> ApplicativeTransformation.congr_fun is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (η' : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4), (Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η η') -> (forall {α : Type.{u1}} (x : F α), Eq.{succ u3} (G α) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α x) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η' α x))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) (_inst_4 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G), (Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) _inst_3 _inst_4) -> (forall {η' : Type.{u1}} (h : F η'), Eq.{succ u3} (_inst_2 η') ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) η' h) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_4 α._@.Mathlib.Control.Traversable.Basic._hyg.243) η' h))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.congr_fun ApplicativeTransformation.congr_funₓ'. -/
protected theorem congr_fun (η η' : ApplicativeTransformation F G) (h : η = η') {α : Type u}
    (x : F α) : η x = η' x :=
  congr_arg (fun η'' : ApplicativeTransformation F G => η'' x) h
#align applicative_transformation.congr_fun ApplicativeTransformation.congr_fun

/- warning: applicative_transformation.congr_arg -> ApplicativeTransformation.congr_arg is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) {α : Type.{u1}} {x : F α} {y : F α}, (Eq.{succ u2} (F α) x y) -> (Eq.{succ u3} (G α) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α x) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α y))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) {_inst_4 : Type.{u1}} {η : F _inst_4} {α : F _inst_4}, (Eq.{succ u2} (F _inst_4) η α) -> (Eq.{succ u3} (_inst_2 _inst_4) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_4 η) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_4 α))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.congr_arg ApplicativeTransformation.congr_argₓ'. -/
protected theorem congr_arg (η : ApplicativeTransformation F G) {α : Type u} {x y : F α}
    (h : x = y) : η x = η y :=
  congr_arg (fun z : F α => η z) h
#align applicative_transformation.congr_arg ApplicativeTransformation.congr_arg

/- warning: applicative_transformation.coe_inj -> ApplicativeTransformation.coe_inj is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {{η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4}} {{η' : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4}}, (Eq.{max (succ (succ u1)) (succ u2) (succ u3)} ((fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) η) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η')) -> (Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η η')
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {{_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G}} {{_inst_4 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G}}, (Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (forall {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}}, (F α._@.Mathlib.Control.Traversable.Basic._hyg.243) -> (_inst_2 α._@.Mathlib.Control.Traversable.Basic._hyg.243)) (fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) (fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_4 α._@.Mathlib.Control.Traversable.Basic._hyg.243)) -> (Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) _inst_3 _inst_4)
Case conversion may be inaccurate. Consider using '#align applicative_transformation.coe_inj ApplicativeTransformation.coe_injₓ'. -/
theorem coe_inj ⦃η η' : ApplicativeTransformation F G⦄ (h : (η : ∀ α, F α → G α) = η') : η = η' :=
  by
  cases η
  cases η'
  congr
  exact h
#align applicative_transformation.coe_inj ApplicativeTransformation.coe_inj

/- warning: applicative_transformation.ext -> ApplicativeTransformation.ext is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {{η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4}} {{η' : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4}}, (forall (α : Type.{u1}) (x : F α), Eq.{succ u3} (G α) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α x) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η' α x)) -> (Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η η')
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {{_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G}} {{_inst_4 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G}}, (forall (α : Type.{u1}) (x : F α), Eq.{succ u3} (_inst_2 α) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) α x) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_4 α._@.Mathlib.Control.Traversable.Basic._hyg.243) α x)) -> (Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) _inst_3 _inst_4)
Case conversion may be inaccurate. Consider using '#align applicative_transformation.ext ApplicativeTransformation.extₓ'. -/
@[ext]
theorem ext ⦃η η' : ApplicativeTransformation F G⦄ (h : ∀ (α : Type u) (x : F α), η x = η' x) :
    η = η' := by
  apply coe_inj
  ext1 α
  exact funext (h α)
#align applicative_transformation.ext ApplicativeTransformation.ext

/- warning: applicative_transformation.ext_iff -> ApplicativeTransformation.ext_iff is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4} {η' : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4}, Iff (Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η η') (forall (α : Type.{u1}) (x : F α), Eq.{succ u3} (G α) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α x) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η' α x))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G} {_inst_4 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G}, Iff (Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) _inst_3 _inst_4) (forall (α : Type.{u1}) (x : F α), Eq.{succ u3} (_inst_2 α) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) α x) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_4 α._@.Mathlib.Control.Traversable.Basic._hyg.243) α x))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.ext_iff ApplicativeTransformation.ext_iffₓ'. -/
theorem ext_iff {η η' : ApplicativeTransformation F G} :
    η = η' ↔ ∀ (α : Type u) (x : F α), η x = η' x :=
  ⟨fun h α x => h ▸ rfl, fun h => ext h⟩
#align applicative_transformation.ext_iff ApplicativeTransformation.ext_iff

section Preserves

variable (η : ApplicativeTransformation F G)

/- warning: applicative_transformation.preserves_pure -> ApplicativeTransformation.preserves_pure is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) {α : Type.{u1}} (x : α), Eq.{succ u3} (G α) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α (Pure.pure.{u1, u2} F (Applicative.toHasPure.{u1, u2} F _inst_1) α x)) (Pure.pure.{u1, u3} G (Applicative.toHasPure.{u1, u3} G _inst_3) α x)
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) {_inst_4 : Type.{u1}} (η : _inst_4), Eq.{succ u3} (_inst_2 _inst_4) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_4 (Pure.pure.{u1, u2} F (Applicative.toPure.{u1, u2} F _inst_1) _inst_4 η)) (Pure.pure.{u1, u3} _inst_2 (Applicative.toPure.{u1, u3} _inst_2 G) _inst_4 η)
Case conversion may be inaccurate. Consider using '#align applicative_transformation.preserves_pure ApplicativeTransformation.preserves_pureₓ'. -/
@[functor_norm]
theorem preserves_pure {α} : ∀ x : α, η (pure x) = pure x :=
  η.preserves_pure'
#align applicative_transformation.preserves_pure ApplicativeTransformation.preserves_pure

/- warning: applicative_transformation.preserves_seq -> ApplicativeTransformation.preserves_seq is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) {α : Type.{u1}} {β : Type.{u1}} (x : F (α -> β)) (y : F α), Eq.{succ u3} (G β) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η β (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) α β x y)) (Seq.seq.{u1, u3} G (Applicative.toHasSeq.{u1, u3} G _inst_3) α β (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η (α -> β) x) (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α y))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) {_inst_4 : Type.{u1}} {η : Type.{u1}} (α : F (_inst_4 -> η)) (β : F _inst_4), Eq.{succ u3} (_inst_2 η) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) η (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) _inst_4 η α (fun (x._@.Mathlib.Control.Traversable.Basic._hyg.768 : Unit) => β))) (Seq.seq.{u1, u3} _inst_2 (Applicative.toSeq.{u1, u3} _inst_2 G) _inst_4 η ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) (_inst_4 -> η) α) (fun (x._@.Mathlib.Control.Traversable.Basic._hyg.780 : Unit) => (fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_4 β))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.preserves_seq ApplicativeTransformation.preserves_seqₓ'. -/
@[functor_norm]
theorem preserves_seq {α β : Type u} : ∀ (x : F (α → β)) (y : F α), η (x <*> y) = η x <*> η y :=
  η.preserves_seq'
#align applicative_transformation.preserves_seq ApplicativeTransformation.preserves_seq

#print ApplicativeTransformation.preserves_map /-
@[functor_norm]
theorem preserves_map {α β} (x : α → β) (y : F α) : η (x <$> y) = x <$> η y := by
  rw [← pure_seq_eq_map, η.preserves_seq] <;> simp [functor_norm]
#align applicative_transformation.preserves_map ApplicativeTransformation.preserves_map
-/

#print ApplicativeTransformation.preserves_map' /-
theorem preserves_map' {α β} (x : α → β) : @η _ ∘ Functor.map x = Functor.map x ∘ @η _ :=
  by
  ext y
  exact preserves_map η x y
#align applicative_transformation.preserves_map' ApplicativeTransformation.preserves_map'
-/

end Preserves

#print ApplicativeTransformation.idTransformation /-
/-- The identity applicative transformation from an applicative functor to itself. -/
def idTransformation : ApplicativeTransformation F F
    where
  app α := id
  preserves_pure' := by simp
  preserves_seq' α β x y := by simp
#align applicative_transformation.id_transformation ApplicativeTransformation.idTransformation
-/

instance : Inhabited (ApplicativeTransformation F F) :=
  ⟨idTransformation⟩

universe s t

variable {H : Type u → Type s} [Applicative H] [LawfulApplicative H]

/- warning: applicative_transformation.comp -> ApplicativeTransformation.comp is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {H : Type.{u1} -> Type.{u4}} [_inst_5 : Applicative.{u1, u4} H] [_inst_6 : LawfulApplicative.{u1, u4} H _inst_5], (ApplicativeTransformation.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) -> (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) -> (ApplicativeTransformation.{u1, u2, u4} F _inst_1 _inst_2 H _inst_5 _inst_6)
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {_inst_3 : Type.{u1} -> Type.{u4}} [_inst_4 : Applicative.{u1, u4} _inst_3], (ApplicativeTransformation.{u1, u3, u4} _inst_2 G _inst_3 _inst_4) -> (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) -> (ApplicativeTransformation.{u1, u2, u4} F _inst_1 _inst_3 _inst_4)
Case conversion may be inaccurate. Consider using '#align applicative_transformation.comp ApplicativeTransformation.compₓ'. -/
/-- The composition of applicative transformations. -/
def comp (η' : ApplicativeTransformation G H) (η : ApplicativeTransformation F G) :
    ApplicativeTransformation F H where
  app α x := η' (η x)
  preserves_pure' α x := by simp [functor_norm]
  preserves_seq' α β x y := by simp [functor_norm]
#align applicative_transformation.comp ApplicativeTransformation.comp

/- warning: applicative_transformation.comp_apply -> ApplicativeTransformation.comp_apply is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {H : Type.{u1} -> Type.{u4}} [_inst_5 : Applicative.{u1, u4} H] [_inst_6 : LawfulApplicative.{u1, u4} H _inst_5] (η' : ApplicativeTransformation.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) {α : Type.{u1}} (x : F α), Eq.{succ u4} (H α) (coeFn.{succ (max (succ u1) u2 u4), max (succ (succ u1)) (succ u2) (succ u4)} (ApplicativeTransformation.{u1, u2, u4} F _inst_1 _inst_2 H _inst_5 _inst_6) (fun (_x : ApplicativeTransformation.{u1, u2, u4} F _inst_1 _inst_2 H _inst_5 _inst_6) => forall {α : Type.{u1}}, (F α) -> (H α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u4} F _inst_1 _inst_2 H _inst_5 _inst_6) (ApplicativeTransformation.comp.{u1, u2, u3, u4} F _inst_1 _inst_2 G _inst_3 _inst_4 H _inst_5 _inst_6 η' η) α x) (coeFn.{succ (max (succ u1) u3 u4), max (succ (succ u1)) (succ u3) (succ u4)} (ApplicativeTransformation.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) (fun (_x : ApplicativeTransformation.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) => forall {α : Type.{u1}}, (G α) -> (H α)) (ApplicativeTransformation.hasCoeToFun.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) η' α (coeFn.{succ (max (succ u1) u2 u3), max (succ (succ u1)) (succ u2) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) η α x))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {_inst_3 : Type.{u1} -> Type.{u4}} [_inst_4 : Applicative.{u1, u4} _inst_3] (H : ApplicativeTransformation.{u1, u3, u4} _inst_2 G _inst_3 _inst_4) (_inst_5 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) {_inst_6 : Type.{u1}} (η' : F _inst_6), Eq.{succ u4} (_inst_3 _inst_6) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u4} F _inst_1 _inst_3 _inst_4 (ApplicativeTransformation.comp.{u1, u2, u3, u4} F _inst_1 _inst_2 G _inst_3 _inst_4 H _inst_5) α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_6 η') ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u3, u4} _inst_2 G _inst_3 _inst_4 H α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_6 ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u1}} => ApplicativeTransformation.app.{u1, u2, u3} F _inst_1 _inst_2 G _inst_5 α._@.Mathlib.Control.Traversable.Basic._hyg.243) _inst_6 η'))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.comp_apply ApplicativeTransformation.comp_applyₓ'. -/
@[simp]
theorem comp_apply (η' : ApplicativeTransformation G H) (η : ApplicativeTransformation F G)
    {α : Type u} (x : F α) : η'.comp η x = η' (η x) :=
  rfl
#align applicative_transformation.comp_apply ApplicativeTransformation.comp_apply

/- warning: applicative_transformation.comp_assoc -> ApplicativeTransformation.comp_assoc is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] {H : Type.{u1} -> Type.{u4}} [_inst_5 : Applicative.{u1, u4} H] [_inst_6 : LawfulApplicative.{u1, u4} H _inst_5] {I : Type.{u1} -> Type.{u5}} [_inst_7 : Applicative.{u1, u5} I] [_inst_8 : LawfulApplicative.{u1, u5} I _inst_7] (η'' : ApplicativeTransformation.{u1, u4, u5} H _inst_5 _inst_6 I _inst_7 _inst_8) (η' : ApplicativeTransformation.{u1, u3, u4} G _inst_3 _inst_4 H _inst_5 _inst_6) (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4), Eq.{succ (max (succ u1) u2 u5)} (ApplicativeTransformation.{u1, u2, u5} F _inst_1 _inst_2 I _inst_7 _inst_8) (ApplicativeTransformation.comp.{u1, u2, u3, u5} F _inst_1 _inst_2 G _inst_3 _inst_4 I _inst_7 _inst_8 (ApplicativeTransformation.comp.{u1, u3, u4, u5} G _inst_3 _inst_4 H _inst_5 _inst_6 I _inst_7 _inst_8 η'' η') η) (ApplicativeTransformation.comp.{u1, u2, u4, u5} F _inst_1 _inst_2 H _inst_5 _inst_6 I _inst_7 _inst_8 η'' (ApplicativeTransformation.comp.{u1, u2, u3, u4} F _inst_1 _inst_2 G _inst_3 _inst_4 H _inst_5 _inst_6 η' η))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] {_inst_3 : Type.{u1} -> Type.{u4}} [_inst_4 : Applicative.{u1, u4} _inst_3] {H : Type.{u1} -> Type.{u5}} [_inst_5 : Applicative.{u1, u5} H] (_inst_6 : ApplicativeTransformation.{u1, u4, u5} _inst_3 _inst_4 H _inst_5) (I : ApplicativeTransformation.{u1, u3, u4} _inst_2 G _inst_3 _inst_4) (_inst_7 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G), Eq.{max (max (succ u5) (succ (succ u1))) (succ u2)} (ApplicativeTransformation.{u1, u2, u5} F _inst_1 H _inst_5) (ApplicativeTransformation.comp.{u1, u2, u3, u5} F _inst_1 _inst_2 G H _inst_5 (ApplicativeTransformation.comp.{u1, u3, u4, u5} _inst_2 G _inst_3 _inst_4 H _inst_5 _inst_6 I) _inst_7) (ApplicativeTransformation.comp.{u1, u2, u4, u5} F _inst_1 _inst_3 _inst_4 H _inst_5 _inst_6 (ApplicativeTransformation.comp.{u1, u2, u3, u4} F _inst_1 _inst_2 G _inst_3 _inst_4 I _inst_7))
Case conversion may be inaccurate. Consider using '#align applicative_transformation.comp_assoc ApplicativeTransformation.comp_assocₓ'. -/
theorem comp_assoc {I : Type u → Type t} [Applicative I] [LawfulApplicative I]
    (η'' : ApplicativeTransformation H I) (η' : ApplicativeTransformation G H)
    (η : ApplicativeTransformation F G) : (η''.comp η').comp η = η''.comp (η'.comp η) :=
  rfl
#align applicative_transformation.comp_assoc ApplicativeTransformation.comp_assoc

/- warning: applicative_transformation.comp_id -> ApplicativeTransformation.comp_id is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4), Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (ApplicativeTransformation.comp.{u1, u2, u2, u3} F _inst_1 _inst_2 F _inst_1 _inst_2 G _inst_3 _inst_4 η (ApplicativeTransformation.idTransformation.{u1, u2} F _inst_1 _inst_2)) η
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G), Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) (ApplicativeTransformation.comp.{u1, u2, u2, u3} F _inst_1 F _inst_1 _inst_2 G _inst_3 (ApplicativeTransformation.idTransformation.{u1, u2} F _inst_1)) _inst_3
Case conversion may be inaccurate. Consider using '#align applicative_transformation.comp_id ApplicativeTransformation.comp_idₓ'. -/
@[simp]
theorem comp_id (η : ApplicativeTransformation F G) : η.comp idTransformation = η :=
  ext fun α x => rfl
#align applicative_transformation.comp_id ApplicativeTransformation.comp_id

/- warning: applicative_transformation.id_comp -> ApplicativeTransformation.id_comp is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] {G : Type.{u1} -> Type.{u3}} [_inst_3 : Applicative.{u1, u3} G] [_inst_4 : LawfulApplicative.{u1, u3} G _inst_3] (η : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4), Eq.{succ (max (succ u1) u2 u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G _inst_3 _inst_4) (ApplicativeTransformation.comp.{u1, u2, u3, u3} F _inst_1 _inst_2 G _inst_3 _inst_4 G _inst_3 _inst_4 (ApplicativeTransformation.idTransformation.{u1, u3} G _inst_3 _inst_4) η) η
but is expected to have type
  forall {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] {_inst_2 : Type.{u1} -> Type.{u3}} [G : Applicative.{u1, u3} _inst_2] (_inst_3 : ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G), Eq.{max (max (succ (succ u1)) (succ u2)) (succ u3)} (ApplicativeTransformation.{u1, u2, u3} F _inst_1 _inst_2 G) (ApplicativeTransformation.comp.{u1, u2, u3, u3} F _inst_1 _inst_2 G _inst_2 G (ApplicativeTransformation.idTransformation.{u1, u3} _inst_2 G) _inst_3) _inst_3
Case conversion may be inaccurate. Consider using '#align applicative_transformation.id_comp ApplicativeTransformation.id_compₓ'. -/
@[simp]
theorem id_comp (η : ApplicativeTransformation F G) : idTransformation.comp η = η :=
  ext fun α x => rfl
#align applicative_transformation.id_comp ApplicativeTransformation.id_comp

end ApplicativeTransformation

open ApplicativeTransformation

#print Traversable /-
/-- A traversable functor is a functor along with a way to commute
with all applicative functors (see `sequence`).  For example, if `t`
is the traversable functor `list` and `m` is the applicative functor
`io`, then given a function `f : α → io β`, the function `functor.map f` is
`list α → list (io β)`, but `traverse f` is `list α → io (list β)`. -/
class Traversable (t : Type u → Type u) extends Functor t where
  traverse : ∀ {m : Type u → Type u} [Applicative m] {α β}, (α → m β) → t α → m (t β)
#align traversable Traversable
-/

open Functor

export Traversable (traverse)

section Functions

variable {t : Type u → Type u}

variable {m : Type u → Type v} [Applicative m]

variable {α β : Type u}

variable {f : Type u → Type u} [Applicative f]

#print sequence /-
/-- A traversable functor commutes with all applicative functors. -/
def sequence [Traversable t] : t (f α) → f (t α) :=
  traverse id
#align sequence sequence
-/

end Functions

#print IsLawfulTraversable /-
/-- A traversable functor is lawful if its `traverse` satisfies a
number of additional properties.  It must send `id.mk` to `id.mk`,
send the composition of applicative functors to the composition of the
`traverse` of each, send each function `f` to `λ x, f <$> x`, and
satisfy a naturality condition with respect to applicative
transformations. -/
class IsLawfulTraversable (t : Type u → Type u) [Traversable t] extends LawfulFunctor t :
  Type (u + 1) where
  id_traverse : ∀ {α} (x : t α), traverse id.mk x = x
  comp_traverse :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G] {α β γ}
      (f : β → F γ) (g : α → G β) (x : t α),
      traverse (Comp.mk ∘ map f ∘ g) x = Comp.mk (map (traverse f) (traverse g x))
  traverse_eq_map_id : ∀ {α β} (f : α → β) (x : t α), traverse (id.mk ∘ f) x = id.mk (f <$> x)
  naturality :
    ∀ {F G} [Applicative F] [Applicative G] [LawfulApplicative F] [LawfulApplicative G]
      (η : ApplicativeTransformation F G) {α β} (f : α → F β) (x : t α),
      η (traverse f x) = traverse (@η _ ∘ f) x
#align is_lawful_traversable IsLawfulTraversable
-/

instance : Traversable id :=
  ⟨fun _ _ _ _ => id⟩

instance : IsLawfulTraversable id := by refine' { .. } <;> intros <;> rfl

section

variable {F : Type u → Type v} [Applicative F]

instance : Traversable Option :=
  ⟨@Option.traverse⟩

instance : Traversable List :=
  ⟨@List.traverse⟩

end

namespace Sum

variable {σ : Type u}

variable {F : Type u → Type u}

variable [Applicative F]

#print Sum.traverse /-
/-- Defines a `traverse` function on the second component of a sum type.
This is used to give a `traversable` instance for the functor `σ ⊕ -`. -/
protected def traverse {α β} (f : α → F β) : Sum σ α → F (Sum σ β)
  | Sum.inl x => pure (Sum.inl x)
  | Sum.inr x => Sum.inr <$> f x
#align sum.traverse Sum.traverse
-/

end Sum

instance {σ : Type u} : Traversable.{u} (Sum σ) :=
  ⟨@Sum.traverse _⟩


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

/-!
# Sigma instances for additive and multiplicative actions

This file defines instances for arbitrary sum of additive and multiplicative actions.

## See also

* `group_theory.group_action.pi`
* `group_theory.group_action.prod`
* `group_theory.group_action.sum`
-/

variables {ι : Type*} {M N : Type*} {α : ι → Type*}

namespace sigma

section has_smul
variables [Π i, has_smul M (α i)] [Π i, has_smul N (α i)] (a : M) (i : ι) (b : α i)
  (x : Σ i, α i)

@[to_additive sigma.has_vadd] instance : has_smul M (Σ i, α i) := ⟨λ a, sigma.map id $ λ i, (•) a⟩

@[to_additive] lemma smul_def : a • x = x.map id (λ i, (•) a) := rfl
@[simp, to_additive] lemma smul_mk : a • mk i b = ⟨i, a • b⟩ := rfl

instance [has_smul M N] [Π i, is_scalar_tower M N (α i)] : is_scalar_tower M N (Σ i, α i) :=
⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_assoc] }⟩

@[to_additive] instance [Π i, smul_comm_class M N (α i)] : smul_comm_class M N (Σ i, α i) :=
⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_mk, smul_comm] }⟩

instance [Π i, has_smul Mᵐᵒᵖ (α i)] [Π i, is_central_scalar M (α i)] :
  is_central_scalar M (Σ i, α i) :=
⟨λ a x, by { cases x, rw [smul_mk, smul_mk, op_smul_eq_smul] }⟩

/-- This is not an instance because `i` becomes a metavariable. -/
@[to_additive "This is not an instance because `i` becomes a metavariable."]
protected lemma has_faithful_smul' [has_faithful_smul M (α i)] : has_faithful_smul M (Σ i, α i) :=
⟨λ x y h, eq_of_smul_eq_smul $ λ a : α i, heq_iff_eq.1 (ext_iff.1 $ h $ mk i a).2⟩

@[to_additive] instance [nonempty ι] [Π i, has_faithful_smul M (α i)] :
  has_faithful_smul M (Σ i, α i) :=
nonempty.elim ‹_› $ λ i, sigma.has_faithful_smul' i

end has_smul

@[to_additive] instance {m : monoid M} [Π i, mul_action M (α i)] : mul_action M (Σ i, α i) :=
{ mul_smul := λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, mul_smul] },
  one_smul := λ x, by { cases x, rw [smul_mk, one_smul] } }

end sigma


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.concrete_category.unbundled_hom
import Mathlib.topology.continuous_map
import Mathlib.topology.opens
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-- The category of topological spaces and continuous maps. -/
def Top := category_theory.bundled topological_space

namespace Top

protected instance bundled_hom : category_theory.bundled_hom continuous_map :=
  category_theory.bundled_hom.mk continuous_map.to_fun continuous_map.id continuous_map.comp

protected instance has_coe_to_sort : has_coe_to_sort Top := category_theory.bundled.has_coe_to_sort

protected instance topological_space_unbundled (x : Top) : topological_space ↥x :=
  category_theory.bundled.str x

@[simp] theorem id_app (X : Top) (x : ↥X) : coe_fn 𝟙 x = x := rfl

@[simp] theorem comp_app {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (x : ↥X) :
    coe_fn (f ≫ g) x = coe_fn g (coe_fn f x) :=
  rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top := category_theory.bundled.mk X

protected instance topological_space (X : Top) : topological_space ↥X :=
  category_theory.bundled.str X

@[simp] theorem coe_of (X : Type u) [topological_space X] : ↥(of X) = X := rfl

protected instance inhabited : Inhabited Top := { default := of empty }

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top :=
  category_theory.functor.mk (fun (X : Type u) => category_theory.bundled.mk X)
    fun (X Y : Type u) (f : X ⟶ Y) => continuous_map.mk f

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top :=
  category_theory.functor.mk (fun (X : Type u) => category_theory.bundled.mk X)
    fun (X Y : Type u) (f : X ⟶ Y) => continuous_map.mk f

end Mathlib


import Std.Data.AssocList

namespace MWE6

inductive Syntax where
  | leaf
  | withDeclaration (d: String) (s: Syntax)
  | withSpecialization (sub: String) (sup: String) (s: Syntax)
  deriving Repr

def s1 := Syntax.leaf |>.withDeclaration "a" |>.withSpecialization "a" "b"
#eval s1

abbrev Strings := List String

abbrev Sups := Std.AssocList String Strings
instance : Repr Sups where reprPrec s n := s.toList.repr n

structure State where
  decls: Strings := .nil
  specializations: Sups := .nil
  deriving Repr

def State.wff(s: State) : Prop :=
  s.specializations.all
    fun (sub sups) =>
      s.decls.contains sub &&
      sups.all (fun sup => s.decls.contains sup)

def State.empty: State := {}

theorem State.empty.wff : State.empty.wff := by rfl

def State.withDecl (s: State) (d: String) : State :=
  match s.decls.contains d with
  | true    => s
  | false   => { s with decls := d :: s.decls }

theorem State.withDecl.noChange (s: State) (d: String) (h: s.decls.contains d) : s = s.withDecl d := by {
  sorry
}

theorem State.withDecl.added (s: State) (d: String) (h: ! s.decls.contains d) : (s.withDecl d).decls.contains d := by {
  sorry
}

theorem State.withDecl.wff (s: State) (d: String) (h: s.wff) : s.withDecl d |>.wff := by {
  sorry
}

-- To ensure WFF, make sure sub and sup are declared.
def State.withSpecialization (s: State) (sub: String) (sup: String) : State :=
  let s' := s.withDecl sub |>.withDecl sup
  let sups : Strings := match s'.specializations.find? sub with
    | none => [sup]
    | some xs => if xs.contains sup then xs else xs.cons sup
  match s'.specializations.contains sub with
  | false => { s' with specializations := s'.specializations.cons sub .nil }
  | true => { s' with specializations := s'.specializations.replace sub sups }

def Syntax.toState (s: Syntax): State :=
  match s with
  | .leaf =>
    .empty
  | .withDeclaration d s =>
    s.toState.withDecl d
  | .withSpecialization sub sup s =>
    s.toState.withSpecialization sub sup

def st1 := s1.toState
#eval st1

end MWE6


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.int.basic
import category_theory.shift
import category_theory.concrete_category.basic

/-!
# Differential objects in a category.

A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.

We build the category of differential objects, and some basic constructions
such as the forgetful functor, zero morphisms and zero objects, and the shift functor
on differential objects.
-/

open category_theory.limits

universes v u

namespace category_theory

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

-- TODO: generaize to `has_shift C A` for an arbitrary `[add_monoid A]` `[has_one A]`.
variables [has_zero_morphisms C] [has_shift C ℤ]

/--
A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.
-/
@[nolint has_inhabited_instance]
structure differential_object :=
(X : C)
(d : X ⟶ X⟦1⟧)
(d_squared' : d ≫ d⟦(1:ℤ)⟧' = 0 . obviously)

restate_axiom differential_object.d_squared'
attribute [simp] differential_object.d_squared

variables {C}

namespace differential_object

/--
A morphism of differential objects is a morphism commuting with the differentials.
-/
@[ext, nolint has_inhabited_instance]
structure hom (X Y : differential_object C) :=
(f : X.X ⟶ Y.X)
(comm' : X.d ≫ f⟦1⟧' = f ≫ Y.d . obviously)

restate_axiom hom.comm'
attribute [simp, reassoc] hom.comm

namespace hom

/-- The identity morphism of a differential object. -/
@[simps]
def id (X : differential_object C) : hom X X :=
{ f := 𝟙 X.X }

/-- The composition of morphisms of differential objects. -/
@[simps]
def comp {X Y Z : differential_object C} (f : hom X Y) (g : hom Y Z) : hom X Z :=
{ f := f.f ≫ g.f, }

end hom

instance category_of_differential_objects : category (differential_object C) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z f g, hom.comp f g, }

@[simp]

@[simp]
lemma comp_f {X Y Z : differential_object C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).f = f.f ≫ g.f :=
rfl

@[simp]
lemma eq_to_hom_f {X Y : differential_object C} (h : X = Y) :
  hom.f (eq_to_hom h) = eq_to_hom (congr_arg _ h) :=
by { subst h, rw [eq_to_hom_refl, eq_to_hom_refl], refl }

variables (C)

/-- The forgetful functor taking a differential object to its underlying object. -/
def forget : (differential_object C) ⥤ C :=
{ obj := λ X, X.X,
  map := λ X Y f, f.f, }

instance forget_faithful : faithful (forget C) :=
{ }

instance has_zero_morphisms : has_zero_morphisms (differential_object C) :=
{ has_zero := λ X Y,
  ⟨{ f := 0 }⟩}

variables {C}

@[simp]
lemma zero_f (P Q : differential_object C) : (0 : P ⟶ Q).f = 0 := rfl

/--
An isomorphism of differential objects gives an isomorphism of the underlying objects.
-/
@[simps] def iso_app {X Y : differential_object C} (f : X ≅ Y) : X.X ≅ Y.X :=
⟨f.hom.f, f.inv.f, by { dsimp, rw [← comp_f, iso.hom_inv_id, id_f] },
  by { dsimp, rw [← comp_f, iso.inv_hom_id, id_f] }⟩

@[simp] lemma iso_app_refl (X : differential_object C) : iso_app (iso.refl X) = iso.refl X.X := rfl
@[simp] lemma iso_app_symm {X Y : differential_object C} (f : X ≅ Y) :
  iso_app f.symm = (iso_app f).symm := rfl
@[simp] lemma iso_app_trans {X Y Z : differential_object C} (f : X ≅ Y) (g : Y ≅ Z) :
  iso_app (f ≪≫ g) = iso_app f ≪≫ iso_app g := rfl

/-- An isomorphism of differential objects can be constructed
from an isomorphism of the underlying objects that commutes with the differentials. -/
@[simps] def mk_iso {X Y : differential_object C}
  (f : X.X ≅ Y.X) (hf : X.d ≫ f.hom⟦1⟧' = f.hom ≫ Y.d) : X ≅ Y :=
{ hom := ⟨f.hom, hf⟩,
  inv := ⟨f.inv, by { dsimp, rw [← functor.map_iso_inv, iso.comp_inv_eq, category.assoc,
    iso.eq_inv_comp, functor.map_iso_hom, hf] }⟩,
  hom_inv_id' := by { ext1, dsimp, exact f.hom_inv_id },
  inv_hom_id' := by { ext1, dsimp, exact f.inv_hom_id } }

end differential_object

namespace functor

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

/--
A functor `F : C ⥤ D` which commutes with shift functors on `C` and `D` and preserves zero morphisms
can be lifted to a functor `differential_object C ⥤ differential_object D`.
-/
@[simps]
def map_differential_object (F : C ⥤ D)
  (η : (shift_functor C (1:ℤ)).comp F ⟶ F.comp (shift_functor D (1:ℤ)))
  (hF : ∀ c c', F.map (0 : c ⟶ c') = 0) :
  differential_object C ⥤ differential_object D :=
{ obj := λ X, { X := F.obj X.X,
    d := F.map X.d ≫ η.app X.X,
    d_squared' := begin
      rw [functor.map_comp, ← functor.comp_map F (shift_functor D (1:ℤ))],
      slice_lhs 2 3 { rw [← η.naturality X.d] },
      rw [functor.comp_map],
      slice_lhs 1 2 { rw [← F.map_comp, X.d_squared, hF] },
      rw [zero_comp, zero_comp],
    end },
  map := λ X Y f, { f := F.map f.f,
    comm' := begin
      dsimp,
      slice_lhs 2 3 { rw [← functor.comp_map F (shift_functor D (1:ℤ)), ← η.naturality f.f] },
      slice_lhs 1 2 { rw [functor.comp_map, ← F.map_comp, f.comm, F.map_comp] },
      rw [category.assoc]
    end },
  map_id' := by { intros, ext, simp },
  map_comp' := by { intros, ext, simp }, }

end functor

end category_theory

namespace category_theory

namespace differential_object

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

variables [has_zero_object C] [has_zero_morphisms C] [has_shift C ℤ]

open_locale zero_object

instance has_zero_object : has_zero_object (differential_object C) :=
by { refine ⟨⟨⟨0, 0⟩, λ X, ⟨⟨⟨⟨0⟩⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨⟨0⟩⟩, λ f, _⟩⟩⟩⟩; ext, }

end differential_object

namespace differential_object

variables (C : Type (u+1)) [large_category C] [concrete_category C]
  [has_zero_morphisms C] [has_shift C ℤ]

instance concrete_category_of_differential_objects :
  concrete_category (differential_object C) :=
{ forget := forget C ⋙ category_theory.forget C }

instance : has_forget₂ (differential_object C) C :=
{ forget₂ := forget C }

end differential_object

/-! The category of differential objects itself has a shift functor. -/
namespace differential_object

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

noncomputable theory

/-- The shift functor on `differential_object C`. -/
@[simps]
def shift_functor (n : ℤ) : differential_object C ⥤ differential_object C :=
{ obj := λ X,
  { X := X.X⟦n⟧,
    d := X.d⟦n⟧' ≫ (shift_comm _ _ _).hom,
    d_squared' := by rw [functor.map_comp, category.assoc, shift_comm_hom_comp_assoc,
        ←functor.map_comp_assoc, X.d_squared, functor.map_zero, zero_comp] },
  map := λ X Y f,
  { f := f.f⟦n⟧',
    comm' := by { dsimp, rw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc,
      f.comm, functor.map_comp_assoc], }, },
  map_id' := by { intros X, ext1, dsimp, rw functor.map_id },
  map_comp' := by { intros X Y Z f g, ext1, dsimp, rw functor.map_comp } }

local attribute [simp] eq_to_hom_map
local attribute [reducible] discrete.add_monoidal shift_comm

/-- The shift functor on `differential_object C` is additive. -/
@[simps] def shift_functor_add (m n : ℤ) :
  shift_functor C (m + n) ≅ shift_functor C m ⋙ shift_functor C n :=
begin
  refine nat_iso.of_components (λ X, mk_iso (shift_add X.X _ _) _) _,
  { dsimp,
    -- This is just `simp, simp [eq_to_hom_map]`.
    simp_rw [category.assoc, obj_μ_inv_app, μ_inv_hom_app_assoc, functor.map_comp, obj_μ_app,
      category.assoc, μ_naturality_assoc, μ_inv_hom_app_assoc, obj_μ_inv_app, category.assoc,
      μ_naturalityₗ_assoc, μ_inv_hom_app_assoc, μ_inv_naturalityᵣ_assoc],
    simp only [eq_to_hom_map, eq_to_hom_app, eq_to_iso.hom, eq_to_hom_trans_assoc,
      eq_to_iso.inv], },
  { intros X Y f, ext, dsimp, exact nat_trans.naturality _ _ }
end

local attribute [reducible] endofunctor_monoidal_category

section
local attribute [instance] endofunctor_monoidal_category

/-- The shift by zero is naturally isomorphic to the identity. -/
@[simps]
def shift_ε : 𝟭 (differential_object C) ≅ shift_functor C 0 :=
begin
  refine nat_iso.of_components (λ X, mk_iso ((shift_monoidal_functor C ℤ).ε_iso.app X.X) _) _,
  { dsimp, simp, dsimp, simp },
  { introv, ext, dsimp, simp }
end

end

local attribute [simp] eq_to_hom_map

instance : has_shift (differential_object C) ℤ :=
has_shift_mk _ _
{ F := shift_functor C,
  ε := shift_ε C,
  μ := λ m n, (shift_functor_add C m n).symm }

end differential_object

end category_theory


/-
Copyright (c) 2023 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.is_tracking

/-!
# Tracking Simulation Oracles

This file defines a typeclass `sim_oracle.is_stateless` for oracles in which there is no
meaningful internal state, represented by the state type being `subsingleton`.
This is a special case of `sim_oracle.is_tracking`, see `is_stateless.is_tracking`.
This allows for a number of very general lemmas that simplify the process of working
with simulated computations, by automatically removing states.
-/

variables {α β γ : Type} {spec spec' spec'' : oracle_spec} {S S' : Type}

open_locale big_operators ennreal
open oracle_comp oracle_spec

namespace sim_oracle

/-- Class to represent oracles that make no use of their internal state.
This class is introduced rather than using a `subsingleton` hypothesis directly
in order to create a unified `is_tracking` instance based on this fact.
This also allows typeclass resolution to work "backwords", in that subsingleton instances don't
have to be defined on the type parameter `S` explicitly, but on the actual oracle instead. -/
class is_stateless (so : sim_oracle spec spec' S) :=
(state_subsingleton : subsingleton S)

variables (so : sim_oracle spec spec' S) (i : spec.ι)
  (t t' : spec.domain i) (s s' : S) (u u' : spec.range i)

/-- Specialize `subsingleton.elim` to simplify the state to the default oracle state.
Usefull for giving a unified convergence point for state values. -/
lemma state_elim [hso : so.is_stateless] (s : S) : s = so.default_state :=
@subsingleton.elim S hso.state_subsingleton s so.default_state

instance is_stateless.is_tracking [hso : so.is_stateless] : so.is_tracking :=
{
  query_f := λ i t, prod.fst <$> so i (t, so.default_state),
  state_f := λ s i t u, so.default_state,
  apply_equiv_state_f_map_query_f :=
    begin
      sorry,
      -- refine λ i t s, trans ((eval_dist_map_id $ (so i (t, s))).symm.trans
      --   (map_equiv_congr (λ x, _) (by rw so.state_elim s))) (eval_dist_map_comp' _ _ _).symm,
      -- simp only [prod.eq_iff_fst_eq_snd_eq, so.state_elim x.2, id.def, eq_self_iff_true, and_self]
    end
}

namespace is_stateless

variable [is_stateless so]

@[simp] lemma answer_query.def : so.answer_query =
  λ i t, prod.fst <$> so i (t, so.default_state) := rfl

@[simp] lemma update_state.def : so.update_state =
  λ s i t u, so.default_state := rfl

section support

lemma support_apply' : (so i (t, s)).support =
  ((λ u, (u, so.default_state)) <$> so.answer_query i t).support :=
by simp only [is_tracking.support_apply', update_state.def]

lemma support_apply : (so i (t, s)).support =
  (λ u, (u, so.default_state)) '' (so.answer_query i t).support :=
by rw [support_apply', support_map]

end support

end is_stateless

end sim_oracle


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich
-/
prelude
import init.data.bool.lemmas
import init.data.string.basic
import init.meta.well_founded_tactics

namespace string

namespace iterator

@[simp] lemma next_to_string_mk_iterator (s : string) : s.mk_iterator.next_to_string = s :=
by induction s; refl

@[simp] lemma length_next_to_string_next (it : iterator) :
  it.next.next_to_string.length = it.next_to_string.length - 1 :=
by cases it; cases it_snd;
  simp [iterator.next, iterator.next_to_string, string.length, nat.add_sub_cancel_left]

lemma zero_lt_length_next_to_string_of_has_next {it : iterator} :
  it.has_next → 0 < it.next_to_string.length :=
by cases it; cases it_snd; simp [iterator.has_next, iterator.next_to_string, string.length,
  nat.zero_lt_one_add, nat.add_comm, false_implies_iff]

end iterator

-- TODO(Sebastian): generalize to something like
-- https://doc.rust-lang.org/std/primitive.str.html#method.split
private def split_core (p : char → bool) : iterator → iterator → list string
| start stop :=
if h : stop.has_next then
  -- wf hint
  have stop.next_to_string.length - 1 < stop.next_to_string.length,
    from nat.sub_lt (iterator.zero_lt_length_next_to_string_of_has_next h) dec_trivial,
  if p stop.curr then
    let rest := stop.next.next_to_string in
    (start.extract stop).get_or_else "" :: split_core stop.next stop.next
  else
    split_core start stop.next
else
  [start.next_to_string]
using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ e, e.2.next_to_string.length)⟩] }

def split (p : char → bool) (s : string) : list string :=
split_core p s.mk_iterator s.mk_iterator

end string


import tactic
import row_bump

/-

Recording tableau

The recording tableau "records" the outer corner resulting from [ssyt.row_bump]
on an associated ssyt of the same shape (called the "insertion tableau").
A specified value is placed in the outer corner of the recording tableau.

This is defined using [ssyt.legal.add].

This file contains:
  - basic definitions and weight of the tableau
    [ssyt.rec_cert]
    [ssyt.rec_cert.to_legal]
    [ssyt.rec_cert.rec_step]
    [ssyt.rec_cert.rec_wt]
    [ssyt.rec_cert.rec_wt]

  - The key fact:
    after bumping/recording a legal pair (recval, bumpval), any other
    pair (recval', bumpval') will then be legal as long as
        (recval, bumpval) ≤ₗ (recval', bumpval')
    where ≤ₗ refers to lexicographic order on ℕ × ℕ. That is,
      recval < recval' ∨ (recval = recval' ∧ bumpval ≤ bumpval').

    [ssyt.rec_cert.next_cert]
    This fact uses the key lemma [ssyt.rbs_cert.rbwf_pieri].

-/

section recording_tableau

section rec_cert

structure ssyt.rec_cert {μ : young_diagram} (R B : ssyt μ) :=
  (recval bumpval : ℕ)
  (rec_le : ∀ i j, R i j ≤ recval)
  (rec_eq_left : ∀ i j (cell : (i, j) ∈ μ),
      R i j = recval → j < (B.row_bump bumpval).1.j)

def ssyt.rec_cert.to_legal
  {μ : young_diagram} {R B : ssyt μ} (rcert : ssyt.rec_cert R B) : R.legal :=
{ i := (B.row_bump rcert.bumpval).1.i,
  j := (B.row_bump rcert.bumpval).1.j,
  val := rcert.recval,
  cell_left := (B.row_bump rcert.bumpval).1.cell_left,
  cell_up := (B.row_bump rcert.bumpval).1.cell_up,
  left := λ _ _, rcert.rec_le _ _,
  right := λ j hj cell, absurd (μ.nw_of (le_refl _) (le_of_lt hj) cell)
                               (B.row_bump rcert.bumpval).1.not_cell,
  up := λ i hi,
    lt_of_le_of_ne (rcert.rec_le _ _)
      (λ h, (lt_self_iff_false _).mp $
        rcert.rec_eq_left _ _ ((B.row_bump rcert.bumpval).1.cell_up hi) h),
  down := λ i hi cell, absurd (μ.nw_of (le_of_lt hi) (le_refl _) cell)
                               (B.row_bump rcert.bumpval).1.not_cell
}

end rec_cert

section rec_step

def ssyt.rec_cert.rec_step
  {μ : young_diagram} {R B : ssyt μ} (rcert : ssyt.rec_cert R B) :
  ssyt (B.row_bump rcert.bumpval).1.add :=
rcert.to_legal.add (B.row_bump rcert.bumpval).1.not_cell

lemma ssyt.rec_cert.rec_entry
  {μ : young_diagram} {R B : ssyt μ} (rcert : ssyt.rec_cert R B) (i j : ℕ) :
  rcert.rec_step i j =
  ite ((i, j) = (rcert.to_legal.i, rcert.to_legal.j)) rcert.to_legal.val (R i j) := rfl

lemma ssyt.rec_cert.rec_wt
  {μ : young_diagram} {R B : ssyt μ} (rcert : ssyt.rec_cert R B) (val : ℕ) :
  rcert.rec_step.wt val = R.wt val + ite (val = rcert.recval) 1 0 :=
by apply ssyt.wt_add

def ssyt.rec_cert_of_gt {μ : young_diagram} (R B : ssyt μ) (recval bumpval : ℕ)
  (h_lt : ∀ i j (cell : (i, j) ∈ μ), R i j < recval) : ssyt.rec_cert R B :=
{ bumpval := bumpval, recval := recval,
  rec_le := λ i j, dite ((i, j) ∈ μ)
    (λ cell, le_of_lt $ h_lt _ _ cell)
    (λ not_cell, (R.zeros not_cell).symm ▸ nat.zero_le recval),
  rec_eq_left := λ _ _ cell h_eq, false.rec _ $ ne_of_lt (h_lt _ _ cell) h_eq }

def ssyt.rec_cert.next_cert
  {μ : young_diagram} {R B : ssyt μ} (rcert : ssyt.rec_cert R B)
  (recval' bumpval' : ℕ)
  (h : rcert.recval < recval' ∨
       (rcert.recval = recval' ∧ rcert.bumpval ≤ bumpval')) :
ssyt.rec_cert rcert.rec_step (B.row_bump rcert.bumpval).2 :=
{ bumpval := bumpval', recval := recval',
  rec_le := λ i j, begin
    apply @le_trans _ _ _ rcert.recval,
      rw ssyt.rec_cert.rec_entry,
      split_ifs, refl, apply rcert.rec_le,
    cases h, exact le_of_lt h, exact le_of_eq h.1,
  end,
  rec_eq_left := λ i j cell h_eq, begin
    cases h,
      { exfalso, apply ne_of_lt (lt_of_le_of_lt _ h) h_eq,
        rw rcert.rec_entry, split_ifs, refl, apply rcert.rec_le },
      { cases h.1,
        apply lt_of_le_of_lt _,
        apply ssyt.rbs_cert.rbwf_pieri _ _, refl, exact h.2,
        rw rcert.rec_entry at h_eq, split_ifs at h_eq,
          { cases h_1, refl },
          { apply le_of_lt (rcert.rec_eq_left i j _ h_eq),
            rw young_diagram.outer_corner.mem_add at cell,
            exact cell.resolve_left h_1 }
      }
  end
}

end rec_step

end recording_tableau


import data.set.basic
import logic.embedding
import pfun_to_fun
import polytime

open ptree (pencodable)
open ptree.pencodable (encode decode)

def polytime_fun {α β : Type*} [pencodable α] [pencodable β] (f : α → β) :=
∃ (c : code) (pc : polytime c), ∀ x, c.eval (encode x) = part.some (encode (f x))

section
variables {α β γ δ ε : Type*} [pencodable α] [pencodable β] [pencodable γ]
  [pencodable δ] [pencodable ε]

lemma polytime_fun.encode {α : Type*} [pencodable α] : polytime_fun (@encode α _) :=
⟨code.id, polytime_id, λ x, by simp⟩

lemma polytime_fun.decode {f : α → β} (hf : polytime_fun (encode ∘ f)) : polytime_fun f := hf

lemma polytime_fun.id : polytime_fun (@id α) := ⟨code.id, polytime_id, λ x, by simp⟩

lemma polytime_fun.const (x : α) : polytime_fun (function.const β x) := ⟨code.const (encode x), polytime_const _, λ x, by simp⟩

lemma polytime_fun.comp {f : β → γ} {g : α → β} : polytime_fun f → polytime_fun g → polytime_fun (f ∘ g)
| ⟨c₁, pc₁, s₁⟩ ⟨c₂, pc₂, s₂⟩ := ⟨c₁.comp c₂, polytime_comp pc₁ pc₂, λ x, by simp [s₁, s₂]⟩

section pair

lemma polytime_fun.fst : polytime_fun (@prod.fst α β) :=
⟨code.left, polytime_left, λ ⟨a, b⟩, by simp [ptree.pencodable.encode_pair_def]⟩

lemma polytime_fun.snd : polytime_fun (@prod.snd α β) :=
⟨code.right, polytime_left, λ ⟨a, b⟩, by simp [ptree.pencodable.encode_pair_def]⟩

lemma polytime_fun.pair {f : α → β} {g : α → γ} : polytime_fun f → polytime_fun g → polytime_fun (λ x, (f x, g x))
| ⟨c₁, pc₁, s₁⟩ ⟨c₂, pc₂, s₂⟩ := ⟨code.node c₁ c₂, polytime_node pc₁ pc₂, λ x, by { simp [s₁, s₂], refl, }⟩

def polytime_fun₂ (f : α → β → γ) : Prop := polytime_fun (function.uncurry f)

def polytime_fun₃ (f : α → β → γ → δ) : Prop :=
polytime_fun (λ x : α × β × γ, f x.1 x.2.1 x.2.2)

lemma polytime_fun.comp₂ {f : α → β → γ} {g : δ → α} {h : δ → β}
  (hf : polytime_fun₂ f) (hg : polytime_fun g) (hh : polytime_fun h) :
  polytime_fun (λ x, f (g x) (h x)) :=
polytime_fun.comp hf (polytime_fun.pair hg hh)

lemma polytime_fun.comp₃ {f : α → β → γ → δ} {g₁ : ε → α} {g₂ : ε → β} {g₃ : ε -> γ}
  (hf : polytime_fun₃ f) (hg₁ : polytime_fun g₁) (hg₂ : polytime_fun g₂) (hg₃ : polytime_fun g₃) :
  polytime_fun (λ x, f (g₁ x) (g₂ x) (g₃ x)) :=
polytime_fun.comp hf (polytime_fun.pair hg₁ (polytime_fun.pair hg₂ hg₃))

end pair

end

class polycodable (α : Type*) extends ptree.pencodable α :=
(polytime_decode [] : polytime_fun (λ x : ptree, encode (decode x)))

instance : polycodable ptree :=
{ polytime_decode := ⟨_, polytime_id, λ x, by simp⟩ }

variables {α β γ : Type*} [polycodable α] [polycodable β] [polycodable γ]

lemma polytime_fun_iff (f : α → β) :
  polytime_fun f ↔ ∃ (c : code) (pc : polytime c), ∀ x, c.eval x = part.some (encode (f (decode x))) :=
begin
  split,
  { rintro ⟨c, pc, s⟩, rcases polycodable.polytime_decode α with ⟨c₂, pc₂, s₂⟩,
    use [c.comp c₂, polytime_comp pc pc₂], intro x, simp at s₂, simp [s₂, s], },
  rintro ⟨c, pc, s⟩, use [c, pc], intro x, simp [s],
end

lemma polytime_fun_iff' (f : α → β) :
  polytime_fun f ↔ ∃ (c : code) (pc : polytime c), ∀ x, (c.eval (encode x)).map decode = part.some (f x) :=
begin
  split, { rintro ⟨c, pc, s⟩, use [c, pc], simp [s], },
  rintro ⟨c, pc, s⟩, rcases polycodable.polytime_decode β with ⟨c₂, pc₂, s₂⟩,
  use [c₂.comp c, polytime_comp pc₂ pc], intro x, specialize s x,
  simp [part.eq_some_iff] at s ⊢, rcases s with ⟨a, h₁, h₂⟩, use [a, h₁],
  simp at s₂, simp [s₂, h₂],
end

lemma polytime_fun.decode' : polytime_fun (@decode α _) :=
by { rw polytime_fun_iff, exact polycodable.polytime_decode _, }

lemma polytime_fun.ptree_left : polytime_fun ptree.left := ⟨code.left, polytime_left, λ x, by simp⟩
lemma polytime_fun.ptree_right : polytime_fun ptree.right := ⟨code.right, polytime_right, λ x, by simp⟩

lemma polytime_fun.polytime_code {c : code} (pc : polytime c) : polytime_fun pc.to_fun := ⟨c, pc, λ x, by simp⟩

private lemma polytime_fun.node_aux {f : ptree → ptree} {g : ptree → ptree} : polytime_fun f → polytime_fun g → polytime_fun (λ x, (f x).node (g x))
| ⟨cf, pf, sf⟩ ⟨cg, pg, sg⟩ := ⟨cf.node cg, polytime_node pf pg, λ x, by { simp at sf sg, simp [sf, sg], }⟩

instance : polycodable (α × β) :=
{ polytime_decode :=
begin
  simp only [ptree.pencodable.decode_pair_def, ptree.pencodable.encode_pair_def],
  apply polytime_fun.node_aux,
  all_goals { apply polytime_fun.comp polytime_fun.encode, apply polytime_fun.comp polytime_fun.decode', },
  exacts [polytime_fun.ptree_left, polytime_fun.ptree_right],
end }

lemma polytime_fun.node : polytime_fun₂ ptree.node := polytime_fun.id


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import tactic.pi_instances
import algebra.group.pi
import algebra.ring.basic

/-!
# Pi instances for ring

This file defines instances for ring, semiring and related structures on Pi Types
-/

namespace pi
universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances
variables (x y : Π i, f i) (i : I)

instance distrib [Π i, distrib $ f i] : distrib (Π i : I, f i) :=
by refine_struct { add := (+), mul := (*), .. }; tactic.pi_instance_derive_field

instance non_unital_non_assoc_semiring [∀ i, non_unital_non_assoc_semiring $ f i] :
  non_unital_non_assoc_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance non_unital_semiring [∀ i, non_unital_semiring $ f i] :
  non_unital_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance non_assoc_semiring [∀ i, non_assoc_semiring $ f i] :
  non_assoc_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*), .. };
  tactic.pi_instance_derive_field

instance semiring [∀ i, semiring $ f i] : semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := add_monoid.nsmul, npow := monoid.npow };
tactic.pi_instance_derive_field

instance comm_semiring [∀ i, comm_semiring $ f i] : comm_semiring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  nsmul := add_monoid.nsmul, npow := monoid.npow };
tactic.pi_instance_derive_field

instance ring [∀ i, ring $ f i] : ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul,
  npow := monoid.npow };
tactic.pi_instance_derive_field

instance comm_ring [∀ i, comm_ring $ f i] : comm_ring (Π i : I, f i) :=
by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*),
  neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul,
  npow := monoid.npow };
tactic.pi_instance_derive_field

/-- A family of ring homomorphisms `f a : γ →+* β a` defines a ring homomorphism
`pi.ring_hom f : γ →+* Π a, β a` given by `pi.ring_hom f x b = f b x`. -/
@[simps]
protected def ring_hom {γ : Type w} [Π i, non_assoc_semiring (f i)] [non_assoc_semiring γ]
  (g : Π i, γ →+* f i) : γ →+* Π i, f i :=
{ to_fun := λ x b, g b x,
  map_add' := λ x y, funext $ λ z, (g z).map_add x y,
  map_mul' := λ x y, funext $ λ z, (g z).map_mul x y,
  map_one' := funext $ λ z, (g z).map_one,
  map_zero' := funext $ λ z, (g z).map_zero }

lemma ring_hom_injective {γ : Type w} [nonempty I] [Π i, non_assoc_semiring (f i)]
  [non_assoc_semiring γ] (g : Π i, γ →+* f i) (hg : ∀ i, function.injective (g i)) :
  function.injective (pi.ring_hom g) :=
λ x y h, let ⟨i⟩ := ‹nonempty I› in hg i ((function.funext_iff.mp h : _) i)

end pi

section ring_hom

universes u v
variable {I : Type u}

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism. This is `function.eval` as a `ring_hom`. -/
@[simps]
def pi.eval_ring_hom (f : I → Type v) [Π i, non_assoc_semiring (f i)] (i : I) :
  (Π i, f i) →+* f i :=
{ ..(pi.eval_monoid_hom f i),
  ..(pi.eval_add_monoid_hom f i) }

/-- `function.const` as a `ring_hom`. -/
@[simps]
def pi.const_ring_hom (α β : Type*) [non_assoc_semiring β] : β →+* (α → β) :=
{ to_fun := function.const _,
  .. pi.ring_hom (λ _, ring_hom.id β) }

/-- Ring homomorphism between the function spaces `I → α` and `I → β`, induced by a ring
homomorphism `f` between `α` and `β`. -/
@[simps] protected def ring_hom.comp_left {α β : Type*} [non_assoc_semiring α]
  [non_assoc_semiring β] (f : α →+* β) (I : Type*) :
  (I → α) →+* (I → β) :=
{ to_fun := λ h, f ∘ h,
  .. f.to_monoid_hom.comp_left I,
  .. f.to_add_monoid_hom.comp_left I }

end ring_hom


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.dynamics.fixed_points.basic
import Mathlib.data.set.lattice
import Mathlib.data.pnat.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Periodic points

A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.

## Main definitions

* `is_periodic_pt f n x` : `x` is a periodic point of `f` of period `n`, i.e. `f^[n] x = x`.
  We do not require `n > 0` in the definition.
* `pts_of_period f n` : the set `{x | is_periodic_pt f n x}`. Note that `n` is not required to
  be the minimal period of `x`.
* `periodic_pts f` : the set of all periodic points of `f`.
* `minimal_period f x` : the minimal period of a point `x` under an endomorphism `f` or zero
  if `x` is not a periodic point of `f`.

## Main statements

We provide “dot syntax”-style operations on terms of the form `h : is_periodic_pt f n x` including
arithmetic operations on `n` and `h.map (hg : semiconj_by g f f')`. We also prove that `f`
is bijective on each set `pts_of_period f n` and on `periodic_pts f`. Finally, we prove that `x`
is a periodic point of `f` of period `n` if and only if `minimal_period f x | n`.

## References

* https://en.wikipedia.org/wiki/Periodic_point

-/

namespace function

/-- A point `x` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.
Note that we do not require `0 < n` in this definition. Many theorems about periodic points
need this assumption. -/
def is_periodic_pt {α : Type u_1} (f : α → α) (n : ℕ) (x : α) := is_fixed_pt (nat.iterate f n) x

/-- A fixed point of `f` is a periodic point of `f` of any prescribed period. -/
theorem is_fixed_pt.is_periodic_pt {α : Type u_1} {f : α → α} {x : α} (hf : is_fixed_pt f x)
    (n : ℕ) : is_periodic_pt f n x :=
  is_fixed_pt.iterate hf n

/-- For the identity map, all points are periodic. -/
theorem is_periodic_id {α : Type u_1} (n : ℕ) (x : α) : is_periodic_pt id n x :=
  is_fixed_pt.is_periodic_pt (is_fixed_pt_id x) n

/-- Any point is a periodic point of period `0`. -/
theorem is_periodic_pt_zero {α : Type u_1} (f : α → α) (x : α) : is_periodic_pt f 0 x :=
  is_fixed_pt_id x

namespace is_periodic_pt

protected instance decidable {α : Type u_1} [DecidableEq α] {f : α → α} {n : ℕ} {x : α} :
    Decidable (is_periodic_pt f n x) :=
  is_fixed_pt.decidable

protected theorem is_fixed_pt {α : Type u_1} {f : α → α} {x : α} {n : ℕ}
    (hf : is_periodic_pt f n x) : is_fixed_pt (nat.iterate f n) x :=
  hf

protected theorem map {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β} {x : α} {n : ℕ}
    (hx : is_periodic_pt fa n x) {g : α → β} (hg : semiconj g fa fb) : is_periodic_pt fb n (g x) :=
  is_fixed_pt.map hx (semiconj.iterate_right hg n)

theorem apply_iterate {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x)
    (m : ℕ) : is_periodic_pt f n (nat.iterate f m x) :=
  is_periodic_pt.map hx (commute.iterate_self f m)

protected theorem apply {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hx : is_periodic_pt f n x) :
    is_periodic_pt f n (f x) :=
  apply_iterate hx 1

protected theorem add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hn : is_periodic_pt f n x)
    (hm : is_periodic_pt f m x) : is_periodic_pt f (n + m) x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_periodic_pt f (n + m) x)) (equations._eqn_1 f (n + m) x)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_fixed_pt (nat.iterate f (n + m)) x)) (iterate_add f n m)))
      (is_fixed_pt.comp hn hm))

theorem left_of_add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ}
    (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f m x) : is_periodic_pt f n x :=
  sorry

theorem right_of_add {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ}
    (hn : is_periodic_pt f (n + m) x) (hm : is_periodic_pt f n x) : is_periodic_pt f m x :=
  left_of_add (eq.mp (Eq._oldrec (Eq.refl (is_periodic_pt f (n + m) x)) (add_comm n m)) hn) hm

protected theorem sub {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x)
    (hn : is_periodic_pt f n x) : is_periodic_pt f (m - n) x :=
  sorry

protected theorem mul_const {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x)
    (n : ℕ) : is_periodic_pt f (m * n) x :=
  sorry

protected theorem const_mul {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x)
    (n : ℕ) : is_periodic_pt f (n * m) x :=
  sorry

theorem trans_dvd {α : Type u_1} {f : α → α} {x : α} {m : ℕ} (hm : is_periodic_pt f m x) {n : ℕ}
    (hn : m ∣ n) : is_periodic_pt f n x :=
  sorry

protected theorem iterate {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hf : is_periodic_pt f n x)
    (m : ℕ) : is_periodic_pt (nat.iterate f m) n x :=
  sorry

protected theorem mod {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x)
    (hn : is_periodic_pt f n x) : is_periodic_pt f (m % n) x :=
  left_of_add
    (eq.mp (Eq._oldrec (Eq.refl (is_periodic_pt f m x)) (Eq.symm (nat.mod_add_div m n))) hm)
    (is_periodic_pt.mul_const hn (m / n))

protected theorem gcd {α : Type u_1} {f : α → α} {x : α} {m : ℕ} {n : ℕ} (hm : is_periodic_pt f m x)
    (hn : is_periodic_pt f n x) : is_periodic_pt f (nat.gcd m n) x :=
  sorry

/-- If `f` sends two periodic points `x` and `y` of the same positive period to the same point,
then `x = y`. For a similar statement about points of different periods see `eq_of_apply_eq`. -/
theorem eq_of_apply_eq_same {α : Type u_1} {f : α → α} {x : α} {y : α} {n : ℕ}
    (hx : is_periodic_pt f n x) (hy : is_periodic_pt f n y) (hn : 0 < n) (h : f x = f y) : x = y :=
  sorry

/-- If `f` sends two periodic points `x` and `y` of positive periods to the same point,
then `x = y`. -/
theorem eq_of_apply_eq {α : Type u_1} {f : α → α} {x : α} {y : α} {m : ℕ} {n : ℕ}
    (hx : is_periodic_pt f m x) (hy : is_periodic_pt f n y) (hm : 0 < m) (hn : 0 < n)
    (h : f x = f y) : x = y :=
  eq_of_apply_eq_same (is_periodic_pt.mul_const hx n) (is_periodic_pt.const_mul hy m)
    (mul_pos hm hn) h

end is_periodic_pt

/-- The set of periodic points of a given (possibly non-minimal) period. -/
def pts_of_period {α : Type u_1} (f : α → α) (n : ℕ) : set α :=
  set_of fun (x : α) => is_periodic_pt f n x

@[simp] theorem mem_pts_of_period {α : Type u_1} {f : α → α} {x : α} {n : ℕ} :
    x ∈ pts_of_period f n ↔ is_periodic_pt f n x :=
  iff.rfl

theorem semiconj.maps_to_pts_of_period {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β}
    {g : α → β} (h : semiconj g fa fb) (n : ℕ) :
    set.maps_to g (pts_of_period fa n) (pts_of_period fb n) :=
  semiconj.maps_to_fixed_pts (semiconj.iterate_right h n)

theorem bij_on_pts_of_period {α : Type u_1} (f : α → α) {n : ℕ} (hn : 0 < n) :
    set.bij_on f (pts_of_period f n) (pts_of_period f n) :=
  sorry

theorem directed_pts_of_period_pnat {α : Type u_1} (f : α → α) :
    directed has_subset.subset fun (n : ℕ+) => pts_of_period f ↑n :=
  sorry

/-- The set of periodic points of a map `f : α → α`. -/
def periodic_pts {α : Type u_1} (f : α → α) : set α :=
  set_of fun (x : α) => ∃ (n : ℕ), ∃ (H : n > 0), is_periodic_pt f n x

theorem mk_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n)
    (hx : is_periodic_pt f n x) : x ∈ periodic_pts f :=
  Exists.intro n (Exists.intro hn hx)

theorem mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} :
    x ∈ periodic_pts f ↔ ∃ (n : ℕ), ∃ (H : n > 0), is_periodic_pt f n x :=
  iff.rfl

theorem bUnion_pts_of_period {α : Type u_1} (f : α → α) :
    (set.Union fun (n : ℕ) => set.Union fun (H : n > 0) => pts_of_period f n) = periodic_pts f :=
  sorry

theorem Union_pnat_pts_of_period {α : Type u_1} (f : α → α) :
    (set.Union fun (n : ℕ+) => pts_of_period f ↑n) = periodic_pts f :=
  Eq.trans supr_subtype (bUnion_pts_of_period f)

theorem bij_on_periodic_pts {α : Type u_1} (f : α → α) :
    set.bij_on f (periodic_pts f) (periodic_pts f) :=
  Union_pnat_pts_of_period f ▸
    set.bij_on_Union_of_directed (directed_pts_of_period_pnat f)
      fun (i : ℕ+) => bij_on_pts_of_period f (pnat.pos i)

theorem semiconj.maps_to_periodic_pts {α : Type u_1} {β : Type u_2} {fa : α → α} {fb : β → β}
    {g : α → β} (h : semiconj g fa fb) : set.maps_to g (periodic_pts fa) (periodic_pts fb) :=
  sorry

/-- Minimal period of a point `x` under an endomorphism `f`. If `x` is not a periodic point of `f`,
then `minimal_period f x = 0`. -/
def minimal_period {α : Type u_1} (f : α → α) (x : α) : ℕ :=
  dite (x ∈ periodic_pts f) (fun (h : x ∈ periodic_pts f) => nat.find h)
    fun (h : ¬x ∈ periodic_pts f) => 0

theorem is_periodic_pt_minimal_period {α : Type u_1} (f : α → α) (x : α) :
    is_periodic_pt f (minimal_period f x) x :=
  sorry

theorem minimal_period_pos_of_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α}
    (hx : x ∈ periodic_pts f) : 0 < minimal_period f x :=
  sorry

theorem is_periodic_pt.minimal_period_pos {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n)
    (hx : is_periodic_pt f n x) : 0 < minimal_period f x :=
  minimal_period_pos_of_mem_periodic_pts (mk_mem_periodic_pts hn hx)

theorem minimal_period_pos_iff_mem_periodic_pts {α : Type u_1} {f : α → α} {x : α} :
    0 < minimal_period f x ↔ x ∈ periodic_pts f :=
  sorry

theorem is_periodic_pt.minimal_period_le {α : Type u_1} {f : α → α} {x : α} {n : ℕ} (hn : 0 < n)
    (hx : is_periodic_pt f n x) : minimal_period f x ≤ n :=
  sorry

theorem is_periodic_pt.eq_zero_of_lt_minimal_period {α : Type u_1} {f : α → α} {x : α} {n : ℕ}
    (hx : is_periodic_pt f n x) (hn : n < minimal_period f x) : n = 0 :=
  Eq.symm
    (or.resolve_right (eq_or_lt_of_le (nat.zero_le n))
      fun (hn0 : 0 < n) => iff.mpr not_lt (is_periodic_pt.minimal_period_le hn0 hx) hn)

theorem is_periodic_pt.minimal_period_dvd {α : Type u_1} {f : α → α} {x : α} {n : ℕ}
    (hx : is_periodic_pt f n x) : minimal_period f x ∣ n :=
  sorry

theorem is_periodic_pt_iff_minimal_period_dvd {α : Type u_1} {f : α → α} {x : α} {n : ℕ} :
    is_periodic_pt f n x ↔ minimal_period f x ∣ n :=
  { mp := is_periodic_pt.minimal_period_dvd,
    mpr :=
      fun (h : minimal_period f x ∣ n) =>
        is_periodic_pt.trans_dvd (is_periodic_pt_minimal_period f x) h }

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.limits
import Mathlib.category_theory.limits.functor_category
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Limit properties relating to the (co)yoneda embedding.

We calculate the colimit of `Y ↦ (X ⟶ Y)`, which is just `punit`.
(This is used in characterising cofinal functors.)

We also show the (co)yoneda embeddings preserve limits and jointly reflect them.
-/

namespace category_theory

namespace coyoneda

/--
The colimit cocone over `coyoneda.obj X`, with cocone point `punit`.
-/
@[simp] theorem colimit_cocone_ι_app {C : Type v} [small_category C] (X : Cᵒᵖ) (X_1 : C) : ∀ (ᾰ : functor.obj (functor.obj coyoneda X) X_1),
  nat_trans.app (limits.cocone.ι (colimit_cocone X)) X_1 ᾰ =
    id
      (fun (ᾰ : functor.obj (functor.obj coyoneda X) X_1) =>
        id (fun (X : Cᵒᵖ) (X_1 : C) (ᾰ : opposite.unop X ⟶ X_1) => PUnit.unit) X X_1 ᾰ)
      ᾰ :=
  fun (ᾰ : functor.obj (functor.obj coyoneda X) X_1) => Eq.refl (nat_trans.app (limits.cocone.ι (colimit_cocone X)) X_1 ᾰ)

/--
The proposed colimit cocone over `coyoneda.obj X` is a colimit cocone.
-/
def colimit_cocone_is_colimit {C : Type v} [small_category C] (X : Cᵒᵖ) : limits.is_colimit (colimit_cocone X) :=
  limits.is_colimit.mk
    fun (s : limits.cocone (functor.obj coyoneda X)) (x : limits.cocone.X (colimit_cocone X)) =>
      nat_trans.app (limits.cocone.ι s) (opposite.unop X) 𝟙

protected instance obj.category_theory.limits.has_colimit {C : Type v} [small_category C] (X : Cᵒᵖ) : limits.has_colimit (functor.obj coyoneda X) :=
  limits.has_colimit.mk (limits.colimit_cocone.mk (colimit_cocone X) (colimit_cocone_is_colimit X))

/--
The colimit of `coyoneda.obj X` is isomorphic to `punit`.
-/
def colimit_coyoneda_iso {C : Type v} [small_category C] (X : Cᵒᵖ) : limits.colimit (functor.obj coyoneda X) ≅ PUnit :=
  limits.colimit.iso_colimit_cocone (limits.colimit_cocone.mk (colimit_cocone X) (colimit_cocone_is_colimit X))

end coyoneda

/-- The yoneda embedding `yoneda.obj X : Cᵒᵖ ⥤ Type v` for `X : C` preserves limits. -/
protected instance yoneda_preserves_limits {C : Type u} [category C] (X : C) : limits.preserves_limits (functor.obj yoneda X) :=
  limits.preserves_limits.mk
    fun (J : Type v) (𝒥 : small_category J) =>
      limits.preserves_limits_of_shape.mk
        fun (K : J ⥤ (Cᵒᵖ)) =>
          limits.preserves_limit.mk
            fun (c : limits.cone K) (t : limits.is_limit c) =>
              limits.is_limit.mk
                fun (s : limits.cone (K ⋙ functor.obj yoneda X)) (x : limits.cone.X s) =>
                  has_hom.hom.unop
                    (limits.is_limit.lift t
                      (limits.cone.mk (opposite.op X)
                        (nat_trans.mk fun (j : J) => has_hom.hom.op (nat_trans.app (limits.cone.π s) j x))))

/-- The coyoneda embedding `coyoneda.obj X : C ⥤ Type v` for `X : Cᵒᵖ` preserves limits. -/
protected instance coyoneda_preserves_limits {C : Type u} [category C] (X : Cᵒᵖ) : limits.preserves_limits (functor.obj coyoneda X) :=
  limits.preserves_limits.mk
    fun (J : Type v) (𝒥 : small_category J) =>
      limits.preserves_limits_of_shape.mk
        fun (K : J ⥤ C) =>
          limits.preserves_limit.mk
            fun (c : limits.cone K) (t : limits.is_limit c) =>
              limits.is_limit.mk
                fun (s : limits.cone (K ⋙ functor.obj coyoneda X)) (x : limits.cone.X s) =>
                  limits.is_limit.lift t
                    (limits.cone.mk (opposite.unop X) (nat_trans.mk fun (j : J) => nat_trans.app (limits.cone.π s) j x))

/-- The yoneda embeddings jointly reflect limits. -/
def yoneda_jointly_reflects_limits {C : Type u} [category C] (J : Type v) [small_category J] (K : J ⥤ (Cᵒᵖ)) (c : limits.cone K) (t : (X : C) → limits.is_limit (functor.map_cone (functor.obj yoneda X) c)) : limits.is_limit c :=
  let s' : (s : limits.cone K) → limits.cone (K ⋙ functor.obj yoneda (opposite.unop (limits.cone.X s))) :=
    fun (s : limits.cone K) =>
      limits.cone.mk PUnit
        (nat_trans.mk
          fun (j : J) (_x : functor.obj (functor.obj (functor.const J) PUnit) j) =>
            has_hom.hom.unop (nat_trans.app (limits.cone.π s) j));
  limits.is_limit.mk
    fun (s : limits.cone K) =>
      has_hom.hom.op (limits.is_limit.lift (t (opposite.unop (limits.cone.X s))) (s' s) PUnit.unit)

/-- The coyoneda embeddings jointly reflect limits. -/
def coyoneda_jointly_reflects_limits {C : Type u} [category C] (J : Type v) [small_category J] (K : J ⥤ C) (c : limits.cone K) (t : (X : Cᵒᵖ) → limits.is_limit (functor.map_cone (functor.obj coyoneda X) c)) : limits.is_limit c :=
  let s' : (s : limits.cone K) → limits.cone (K ⋙ functor.obj coyoneda (opposite.op (limits.cone.X s))) :=
    fun (s : limits.cone K) =>
      limits.cone.mk PUnit
        (nat_trans.mk
          fun (j : J) (_x : functor.obj (functor.obj (functor.const J) PUnit) j) => nat_trans.app (limits.cone.π s) j);
  limits.is_limit.mk fun (s : limits.cone K) => limits.is_limit.lift (t (opposite.op (limits.cone.X s))) (s' s) PUnit.unit