/-
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 data.lazy_list.basic
! leanprover-community/mathlib commit 1f0096e6caa61e9c849ec2adbd227e960e9dff58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Control.Traversable.Equiv
import Mathlib.Control.Traversable.Instances
import Mathlib.Data.LazyList

/-!
## Definitions on lazy lists

This file contains various definitions and proofs on lazy lists.

TODO: move the `LazyList.lean` file from core to mathlib.
-/

universe u

namespace Thunk

-- Porting note: `Thunk.pure` appears to do the same thing.
#align thunk.mk Thunk.pure

-- Porting note: Added `Thunk.ext` to get `ext` tactic to work.
@[ext]

instance {α : Type u} [DecidableEq α] : DecidableEq (Thunk α) := by
  intro a b
  have : a = b ↔ a.get = b.get := ⟨by intro x; rw [x], by intro; ext; assumption⟩
  rw [this]
  infer_instance

end Thunk

namespace LazyList

open Function

/-- Isomorphism between strict and lazy lists. -/
def listEquivLazyList (α : Type _) : List α ≃ LazyList α
    where
  toFun := LazyList.ofList
  invFun := LazyList.toList
  right_inv := by
    intro xs
    induction' xs using LazyList.rec with _ _ _ _ ih
    rfl
    simpa only [toList, ofList, cons.injEq, true_and]
    rw [Thunk.get, ih]
  left_inv := by
    intro xs
    induction xs
    rfl
    simpa [ofList, toList]
#align lazy_list.list_equiv_lazy_list LazyList.listEquivLazyList

-- Porting note: Added a name to make the recursion work.
instance decidableEq {α : Type u} [DecidableEq α] : DecidableEq (LazyList α)
  | nil, nil => isTrue rfl
  | cons x xs, cons y ys =>
    if h : x = y then
      match decidableEq xs.get ys.get with
      | isFalse h2 => by
        apply isFalse; simp only [cons.injEq, not_and]; intro _ xs_ys; apply h2; rw [xs_ys]
      | isTrue h2 => by apply isTrue; congr; ext; exact h2
    else by apply isFalse; simp only [cons.injEq, not_and]; intro; contradiction
  | nil, cons _ _ => by apply isFalse; simp
  | cons _ _, nil => by apply isFalse; simp

/-- Traversal of lazy lists using an applicative effect. -/
protected def traverse {m : Type u → Type u} [Applicative m] {α β : Type u} (f : α → m β) :
    LazyList α → m (LazyList β)
  | LazyList.nil => pure LazyList.nil
  | LazyList.cons x xs => LazyList.cons <$> f x <*> Thunk.pure <$> xs.get.traverse f
#align lazy_list.traverse LazyList.traverse

instance : Traversable LazyList
    where
  map := @LazyList.traverse Id _
  traverse := @LazyList.traverse

instance : IsLawfulTraversable LazyList := by
  apply Equiv.isLawfulTraversable' listEquivLazyList <;> intros <;> ext <;> rename_i f xs
  · induction' xs using LazyList.rec with _ _ _ _ ih
    rfl
    simpa only [Equiv.map, Functor.map, listEquivLazyList, Equiv.coe_fn_symm_mk, Equiv.coe_fn_mk,
      LazyList.traverse, Seq.seq, toList, ofList, cons.injEq, true_and]
    ext; apply ih
  · simp only [Equiv.map, listEquivLazyList, Equiv.coe_fn_symm_mk, Equiv.coe_fn_mk, comp,
      Functor.mapConst]
    induction' xs using LazyList.rec with _ _ _ _ ih
    rfl
    simpa only [toList, ofList, LazyList.traverse, Seq.seq, Functor.map, cons.injEq, true_and]
    congr; apply ih
  · simp only [traverse, Equiv.traverse, listEquivLazyList, Equiv.coe_fn_mk, Equiv.coe_fn_symm_mk]
    induction' xs using LazyList.rec with _ tl ih _ ih
    simp only [List.traverse, map_pure]; rfl
    have : tl.get.traverse f = ofList <$> tl.get.toList.traverse f := ih
    simp only [traverse._eq_2, ih, Functor.map_map, seq_map_assoc, toList, List.traverse, map_seq]
    . rfl
    . apply ih

/-- `init xs`, if `xs` non-empty, drops the last element of the list.
Otherwise, return the empty list. -/
def init {α} : LazyList α → LazyList α
  | LazyList.nil => LazyList.nil
  | LazyList.cons x xs =>
    let xs' := xs.get
    match xs' with
    | LazyList.nil => LazyList.nil
    | LazyList.cons _ _ => LazyList.cons x (init xs')
#align lazy_list.init LazyList.init

/-- Return the first object contained in the list that satisfies
predicate `p` -/
def find {α} (p : α → Prop) [DecidablePred p] : LazyList α → Option α
  | nil => none
  | cons h t => if p h then some h else t.get.find p
#align lazy_list.find LazyList.find

/-- `interleave xs ys` creates a list where elements of `xs` and `ys` alternate. -/
def interleave {α} : LazyList α → LazyList α → LazyList α
  | LazyList.nil, xs => xs
  | a@(LazyList.cons _ _), LazyList.nil => a
  | LazyList.cons x xs, LazyList.cons y ys =>
    LazyList.cons x (LazyList.cons y (interleave xs.get ys.get))
#align lazy_list.interleave LazyList.interleave

/-- `interleaveAll (xs::ys::zs::xss)` creates a list where elements of `xs`, `ys`
and `zs` and the rest alternate. Every other element of the resulting list is taken from
`xs`, every fourth is taken from `ys`, every eighth is taken from `zs` and so on. -/
def interleaveAll {α} : List (LazyList α) → LazyList α
  | [] => LazyList.nil
  | x :: xs => interleave x (interleaveAll xs)
#align lazy_list.interleave_all LazyList.interleaveAll

/-- Monadic bind operation for `LazyList`. -/
protected def bind {α β} : LazyList α → (α → LazyList β) → LazyList β
  | LazyList.nil, _ => LazyList.nil
  | LazyList.cons x xs, f => (f x).append (xs.get.bind f)
#align lazy_list.bind LazyList.bind

/-- Reverse the order of a `LazyList`.
It is done by converting to a `List` first because reversal involves evaluating all
the list and if the list is all evaluated, `List` is a better representation for
it than a series of thunks. -/
def reverse {α} (xs : LazyList α) : LazyList α :=
  ofList xs.toList.reverse
#align lazy_list.reverse LazyList.reverse

instance : Monad LazyList where
  pure := @LazyList.singleton
  bind := @LazyList.bind

-- Porting note: Added `Thunk.pure` to definition.
theorem append_nil {α} (xs : LazyList α) : xs.append (Thunk.pure LazyList.nil) = xs := by
  induction' xs using LazyList.rec with _ _ _ _ ih
  . rfl
  . simpa only [append, cons.injEq, true_and]
  . ext; apply ih
#align lazy_list.append_nil LazyList.append_nil

theorem append_assoc {α} (xs ys zs : LazyList α) :
    (xs.append ys).append zs = xs.append (ys.append zs) := by
  induction' xs using LazyList.rec with _ _ _ _ ih
  . rfl
  . simpa only [append, cons.injEq, true_and]
  . ext; apply ih
#align lazy_list.append_assoc LazyList.append_assoc

-- Porting note: Rewrote proof of `append_bind`.
theorem append_bind {α β} (xs : LazyList α) (ys : Thunk (LazyList α)) (f : α → LazyList β) :
    (xs.append ys).bind f = (xs.bind f).append (ys.get.bind f) := by
  match xs with
  | LazyList.nil => rfl
  | LazyList.cons x xs =>
    simp only [append, Thunk.get, LazyList.bind]
    have := append_bind xs.get ys f
    simp only [Thunk.get] at this
    rw [this, append_assoc]
#align lazy_list.append_bind LazyList.append_bind

instance : LawfulMonad LazyList := LawfulMonad.mk'
  (bind_pure_comp := by
    intro _ _ f xs
    simp only [bind, Functor.map, pure, singleton]
    induction' xs using LazyList.rec with _ _ _ _ ih
    . rfl
    . simp only [bind._eq_2, append, traverse._eq_2, Id.map_eq, cons.injEq, true_and]; congr
    . ext; apply ih)
  (pure_bind := by
    intros
    simp only [bind, pure, singleton, LazyList.bind]
    apply append_nil)
  (bind_assoc := by
    intro _ _ _ xs _ _
    induction' xs using LazyList.rec with _ _ _ _ ih
    . rfl
    . simp only [bind, LazyList.bind, append_bind]; congr
    . congr; funext; apply ih)
  (id_map := by
    intro _ xs
    induction' xs using LazyList.rec with _ _ _ _ ih
    . rfl
    . simpa only [Functor.map, traverse._eq_2, id_eq, Id.map_eq, Seq.seq, cons.injEq, true_and]
    . ext; apply ih)

-- Porting note: This is a dubious translation. In the warning, u1 and u3 are swapped.
/-- Try applying function `f` to every element of a `LazyList` and
return the result of the first attempt that succeeds. -/
def mfirst {m} [Alternative m] {α β} (f : α → m β) : LazyList α → m β
  | nil => failure
  | cons x xs => f x <|> xs.get.mfirst f
#align lazy_list.mfirst LazyList.mfirstₓ

/-- Membership in lazy lists -/
protected def Mem {α} (x : α) : LazyList α → Prop
  | nil => False
  | cons y ys => x = y ∨ ys.get.Mem x
#align lazy_list.mem LazyList.Mem

instance {α} : Membership α (LazyList α) :=
  ⟨LazyList.Mem⟩

instance Mem.decidable {α} [DecidableEq α] (x : α) : ∀ xs : LazyList α, Decidable (x ∈ xs)
  | LazyList.nil => by
    apply Decidable.isFalse
    simp [Membership.mem, LazyList.Mem]
  | LazyList.cons y ys =>
    if h : x = y then by
      apply Decidable.isTrue
      simp only [Membership.mem, LazyList.Mem]
      exact Or.inl h
    else by
      have := Mem.decidable x ys.get
      have : (x ∈ ys.get) ↔ (x ∈ cons y ys) := by simp [(· ∈ ·), LazyList.Mem, h]
      exact decidable_of_decidable_of_iff this
#align lazy_list.mem.decidable LazyList.Mem.decidable

@[simp]
theorem mem_nil {α} (x : α) : x ∈ @LazyList.nil α ↔ False :=
  Iff.rfl
#align lazy_list.mem_nil LazyList.mem_nil

@[simp]
theorem mem_cons {α} (x y : α) (ys : Thunk (LazyList α)) :
    x ∈ @LazyList.cons α y ys ↔ x = y ∨ x ∈ ys.get := by
  simp [Membership.mem, LazyList.Mem]
#align lazy_list.mem_cons LazyList.mem_cons

theorem forall_mem_cons {α} {p : α → Prop} {a : α} {l : Thunk (LazyList α)} :
    (∀ x ∈ @LazyList.cons _ a l, p x) ↔ p a ∧ ∀ x ∈ l.get, p x := by
  simp only [Membership.mem, LazyList.Mem, or_imp, forall_and, forall_eq]
#align lazy_list.forall_mem_cons LazyList.forall_mem_cons

/-! ### map for partial functions -/

/-- Partial map. If `f : ∀ a, p a → β` is a partial function defined on
  `a : α` satisfying `p`, then `pmap f l h` is essentially the same as `map f l`
  but is defined only when all members of `l` satisfy `p`, using the proof
  to apply `f`. -/
@[simp]
def pmap {α β} {p : α → Prop} (f : ∀ a, p a → β) : ∀ l : LazyList α, (∀ a ∈ l, p a) → LazyList β
  | LazyList.nil, _ => LazyList.nil
  | LazyList.cons x xs, H =>
    LazyList.cons (f x (forall_mem_cons.1 H).1) (xs.get.pmap f (forall_mem_cons.1 H).2)
#align lazy_list.pmap LazyList.pmap

/-- "Attach" the proof that the elements of `l` are in `l` to produce a new `LazyList`
  with the same elements but in the type `{x // x ∈ l}`. -/
def attach {α} (l : LazyList α) : LazyList { x // x ∈ l } :=
  pmap Subtype.mk l fun _ ↦ id
#align lazy_list.attach LazyList.attach

instance {α} [Repr α] : Repr (LazyList α) :=
  ⟨fun xs _ ↦ repr xs.toList⟩

end LazyList


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

/-!
# The `alias` command

This file defines an `alias` command, which can be used to create copies
of a theorem or definition with different names.

Syntax:

```lean
/-- doc string -/
alias my_theorem ← alias1 alias2 ...
```

This produces defs or theorems of the form:

```lean
/-- doc string -/
@[alias] theorem alias1 : <type of my_theorem> := my_theorem

/-- doc string -/
@[alias] theorem alias2 : <type of my_theorem> := my_theorem
```

Iff alias syntax:

```lean
alias A_iff_B ↔ B_of_A A_of_B
alias A_iff_B ↔ ..
```

This gets an existing biconditional theorem `A_iff_B` and produces
the one-way implications `B_of_A` and `A_of_B` (with no change in
implicit arguments). A blank `_` can be used to avoid generating one direction.
The `..` notation attempts to generate the 'of'-names automatically when the
input theorem has the form `A_iff_B` or `A_iff_B_left` etc.
-/

open lean.parser tactic interactive

namespace tactic.alias

/-- An alias can be in one of three forms -/
@[derive has_reflect]
meta inductive target
| plain : name -> target
| forward : name -> target
| backwards : name -> target

/-- The name underlying an alias target -/
meta def target.to_name : target → name
| (target.plain n) := n
| (target.forward n) := n
| (target.backwards n) := n

/-- The docstring for an alias. Used by `alias` _and_ by `to_additive` -/
meta def target.to_string : target → string
| (target.plain n) := sformat!"**Alias** of {n}`."
| (target.forward n) := sformat!"**Alias** of the forward direction of {n}`."
| (target.backwards n) := sformat!"**Alias** of the reverse direction of {n}`."

@[user_attribute] meta def alias_attr : user_attribute unit target :=
{ name := `alias, descr := "This definition is an alias of another.", parser := failed }

meta def alias_direct (d : declaration) (al : name) : tactic unit :=
do updateex_env $ λ env,
  env.add (match d.to_definition with
  | declaration.defn n ls t _ _ _ :=
    declaration.defn al ls t (expr.const n (level.param <$> ls))
      reducibility_hints.abbrev tt
  | declaration.thm n ls t _ :=
    declaration.thm al ls t $ task.pure $ expr.const n (level.param <$> ls)
  | _ := undefined
  end),
  let target := target.plain d.to_name,
  alias_attr.set al target tt,
  add_doc_string al target.to_string

meta def mk_iff_mp_app (iffmp : name) : expr → (ℕ → expr) → tactic expr
| (expr.pi n bi e t) f := expr.lam n bi e <$> mk_iff_mp_app t (λ n, f (n+1) (expr.var n))
| `(%%a ↔ %%b) f := pure $ @expr.const tt iffmp [] a b (f 0)
| _ f := fail "Target theorem must have the form `Π x y z, a ↔ b`"

meta def alias_iff (d : declaration) (al : name) (is_forward : bool) : tactic unit :=
(if al = `_ then skip else get_decl al >> skip) <|> do
  let ls := d.univ_params,
  let t := d.type,
  let target := if is_forward then target.forward d.to_name else target.backwards d.to_name,
  let iffmp := if is_forward then `iff.mp else `iff.mpr,
  v ← mk_iff_mp_app iffmp t (λ_, expr.const d.to_name (level.param <$> ls)),
  t' ← infer_type v,
  updateex_env $ λ env, env.add (declaration.thm al ls t' $ task.pure v),
  alias_attr.set al target tt,
  add_doc_string al target.to_string

meta def make_left_right : name → tactic (name × name)
| (name.mk_string s p) := do
  let buf : char_buffer := s.to_char_buffer,
  let parts := s.split_on '_',
  (left, _::right) ← pure $ parts.span (≠ "iff"),
  let pfx (a b : string) := a.to_list.is_prefix_of b.to_list,
  (suffix', right') ← pure $ right.reverse.span (λ s, pfx "left" s ∨ pfx "right" s),
  let right := right'.reverse,
  let suffix := suffix'.reverse,
  pure (p <.> "_".intercalate (right ++ "of" :: left ++ suffix),
        p <.> "_".intercalate (left ++ "of" :: right ++ suffix))
| _ := failed

/--
The `alias` command can be used to create copies
of a theorem or definition with different names.

Syntax:

```lean
/-- doc string -/
alias my_theorem ← alias1 alias2 ...
```

This produces defs or theorems of the form:

```lean
/-- doc string -/
@[alias] theorem alias1 : <type of my_theorem> := my_theorem

/-- doc string -/
@[alias] theorem alias2 : <type of my_theorem> := my_theorem
```

Iff alias syntax:

```lean
alias A_iff_B ↔ B_of_A A_of_B
alias A_iff_B ↔ ..
```

This gets an existing biconditional theorem `A_iff_B` and produces
the one-way implications `B_of_A` and `A_of_B` (with no change in
implicit arguments). A blank `_` can be used to avoid generating one direction.
The `..` notation attempts to generate the 'of'-names automatically when the
input theorem has the form `A_iff_B` or `A_iff_B_left` etc.
-/
@[user_command] meta def alias_cmd (meta_info : decl_meta_info)
  (_ : parse $ tk "alias") : lean.parser unit :=
do old ← ident,
  d ← (do old ← resolve_constant old, get_decl old) <|>
    fail ("declaration " ++ to_string old ++ " not found"),
  let doc := λ (al : name) (inf : string), meta_info.doc_string.get_or_else $
    sformat!"**Alias** of {inf}`{old}`.",
  do
  { tk "←" <|> tk "<-",
    aliases ← many ident,
    ↑(aliases.mmap' $ λ al, alias_direct d al) } <|>
  do
  { tk "↔" <|> tk "<->",
    (left, right) ←
      mcond ((tk ".." >> pure tt) <|> pure ff)
        (make_left_right old <|> fail "invalid name for automatic name generation")
        (prod.mk <$> types.ident_ <*> types.ident_),
    alias_iff d left tt,
    alias_iff d right ff }

add_tactic_doc
{ name                     := "alias",
  category                 := doc_category.cmd,
  decl_names               := [`tactic.alias.alias_cmd],
  tags                     := ["renaming"] }

meta def get_lambda_body : expr → expr
| (expr.lam _ _ _ b) := get_lambda_body b
| a                  := a

meta def get_alias_target (n : name) : tactic (option target) :=
do tt ← has_attribute' `alias n | pure none,
   v ← alias_attr.get_param n,
   pure $ some v

end tactic.alias


import tactic.tidy

import evaluation

namespace baseline

section tidy_proof_search

meta def tidy_default_tactics : list string := [
     "refl"
  ,  "exact dec_trivial"
  ,  "assumption"
  ,  "tactic.intros1"
  ,  "tactic.auto_cases"
  ,  "apply_auto_param"
  ,  "dsimp at *"
  ,  "simp at *"
  ,  "ext1"
  ,  "fsplit"
  ,  "injections_and_clear"
  ,  "solve_by_elim"
  ,  "norm_cast"
]

@[inline]
meta def tidy_default_tactics_json : json :=
json.array $ json.of_string <$> tidy_default_tactics

@[inline]
meta def tidy_default_tactics_scores : json :=
json.array $ json.of_float <$> list.repeat (0.0 : native.float) tidy_default_tactics.length

meta def tidy_api : ModelAPI := -- simulates logic of tidy, baseline (deterministic) model
let fn : json → io json := λ msg, do {
  pure $ json.array $ [tidy_default_tactics_json, tidy_default_tactics_scores]
} in ⟨fn⟩

-- TODO(jesse): pass and set max_width
meta def tidy_bfs_proof_search_core
   (fuel : ℕ := 1000)
   (verbose := ff)
   : state_t BFSState tactic unit :=
bfs_core
  tidy_api
    (λ _, pure json.null)
      (λ msg n, run_all_beam_candidates (unwrap_lm_response_logprobs $ some "[tidy_bfs_proof_search]") msg n)
        fuel

meta def tidy_bfs_proof_search
  (fuel : ℕ := 1000)
  (verbose := ff)
  (max_width := 25)
  (max_depth := 50)
  : tactic unit :=
  bfs tidy_api (λ _, pure json.null)
    (λ msg n, run_all_beam_candidates (unwrap_lm_response_logprobs $ (some "[tidy_bfs_proof_search]")) msg n)
      fuel verbose max_width max_depth

end tidy_proof_search

section playground

-- example : true :=
-- begin
--   tidy_bfs_proof_search 5 tt,
-- end

-- open nat
-- universe u
-- example : ∀ {α : Type u} {s₁ s₂ t₁ t₂ : list α},
--   s₁ ++ t₁ = s₂ ++ t₂ → s₁.length = s₂.length → s₁ = s₂ ∧ t₁ = t₂ :=
-- begin
--   intros, -- tidy_bfs_proof_search
-- end
-- open nat

-- example {p q r : Prop} (h₁ : p) (h₂ : q) : p ∧ q :=
-- begin
--   tidy_bfs_proof_search 3 tt
-- end
-- run_cmd do {set_show_eval_trace tt *> do env ← tactic.get_env, tactic.set_env_core env}

-- example {p q r : Prop} (h₁ : p) (h₂ : q) : p ∧ q :=
-- begin
--   tidy_bfs_proof_search 2 ff -- should only try one iteration before halting

end playground

end baseline


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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.compatibility
! leanprover-community/mathlib commit 160f568dcf772b2477791c844fc605f2f91f73d1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Equivalence

/-! Tools for compatibilities between Dold-Kan equivalences

The purpose of this file is to introduce tools which will enable the
construction of the Dold-Kan equivalence `simplicial_object C ≌ chain_complex C ℕ`
for a pseudoabelian category `C` from the equivalence
`karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)` and the two
equivalences `simplicial_object C ≅ karoubi (simplicial_object C)` and
`chain_complex C ℕ ≅ karoubi (chain_complex C ℕ)`.

It is certainly possible to get an equivalence `simplicial_object C ≌ chain_complex C ℕ`
using a compositions of the three equivalences above, but then neither the functor
nor the inverse would have good definitional properties. For example, it would be better
if the inverse functor of the equivalence was exactly the functor
`Γ₀ : simplicial_object C ⥤ chain_complex C ℕ` which was constructed in `functor_gamma.lean`.

In this file, given four categories `A`, `A'`, `B`, `B'`, equivalences `eA : A ≅ A'`,
`eB : B ≅ B'`, `e' : A' ≅ B'`, functors `F : A ⥤ B'`, `G : B ⥤ A` equipped with certain
compatibilities, we construct successive equivalences:
- `equivalence₀` from `A` to `B'`, which is the composition of `eA` and `e'`.
- `equivalence₁` from `A` to `B'`, with the same inverse functor as `equivalence₀`,
but whose functor is `F`.
- `equivalence₂` from `A` to `B`, which is the composition of `equivalence₁` and the
inverse of `eB`:
- `equivalence` from `A` to `B`, which has the same functor `F ⋙ eB.inverse` as `equivalence₂`,
but whose inverse functor is `G`.

When extra assumptions are given, we shall also provide simplification lemmas for the
unit and counit isomorphisms of `equivalence`. (TODO)

-/

open CategoryTheory CategoryTheory.Category

namespace AlgebraicTopology

namespace DoldKan

namespace Compatibility

variable {A A' B B' : Type _} [Category A] [Category A'] [Category B] [Category B'] (eA : A ≌ A')
  (eB : B ≌ B') (e' : A' ≌ B') {F : A ⥤ B'} (hF : eA.Functor ⋙ e'.Functor ≅ F) {G : B ⥤ A}
  (hG : eB.Functor ⋙ e'.inverse ≅ G ⋙ eA.Functor)

/-- A basic equivalence `A ≅ B'` obtained by composing `eA : A ≅ A'` and `e' : A' ≅ B'`. -/
@[simps Functor inverse unit_iso_hom_app]
def equivalence₀ : A ≌ B' :=
  eA.trans e'
#align algebraic_topology.dold_kan.compatibility.equivalence₀ AlgebraicTopology.DoldKan.Compatibility.equivalence₀

include hF

variable {eA} {e'}

/-- An intermediate equivalence `A ≅ B'` whose functor is `F` and whose inverse is
`e'.inverse ⋙ eA.inverse`. -/
@[simps Functor]
def equivalence₁ : A ≌ B' :=
  letI : is_equivalence F :=
    is_equivalence.of_iso hF (is_equivalence.of_equivalence (equivalence₀ eA e'))
  F.as_equivalence
#align algebraic_topology.dold_kan.compatibility.equivalence₁ AlgebraicTopology.DoldKan.Compatibility.equivalence₁

theorem equivalence₁_inverse : (equivalence₁ hF).inverse = e'.inverse ⋙ eA.inverse :=
  rfl
#align algebraic_topology.dold_kan.compatibility.equivalence₁_inverse AlgebraicTopology.DoldKan.Compatibility.equivalence₁_inverse

/-- The counit isomorphism of the equivalence `equivalence₁` between `A` and `B'`. -/
@[simps]
def equivalence₁CounitIso : (e'.inverse ⋙ eA.inverse) ⋙ F ≅ 𝟭 B' :=
  calc
    (e'.inverse ⋙ eA.inverse) ⋙ F ≅ (e'.inverse ⋙ eA.inverse) ⋙ eA.Functor ⋙ e'.Functor :=
      isoWhiskerLeft _ hF.symm
    _ ≅ e'.inverse ⋙ (eA.inverse ⋙ eA.Functor) ⋙ e'.Functor := (Iso.refl _)
    _ ≅ e'.inverse ⋙ 𝟭 _ ⋙ e'.Functor := (isoWhiskerLeft _ (isoWhiskerRight eA.counitIso _))
    _ ≅ e'.inverse ⋙ e'.Functor := (Iso.refl _)
    _ ≅ 𝟭 B' := e'.counitIso

#align algebraic_topology.dold_kan.compatibility.equivalence₁_counit_iso AlgebraicTopology.DoldKan.Compatibility.equivalence₁CounitIso

theorem equivalence₁CounitIso_eq : (equivalence₁ hF).counitIso = equivalence₁CounitIso hF :=
  by
  ext Y
  dsimp [equivalence₀, equivalence₁, is_equivalence.inverse, is_equivalence.of_equivalence]
  simp only [equivalence₁_counit_iso_hom_app, CategoryTheory.Functor.map_id, comp_id]
#align algebraic_topology.dold_kan.compatibility.equivalence₁_counit_iso_eq AlgebraicTopology.DoldKan.Compatibility.equivalence₁CounitIso_eq

/-- The unit isomorphism of the equivalence `equivalence₁` between `A` and `B'`. -/
@[simps]
def equivalence₁UnitIso : 𝟭 A ≅ F ⋙ e'.inverse ⋙ eA.inverse :=
  calc
    𝟭 A ≅ eA.Functor ⋙ eA.inverse := eA.unitIso
    _ ≅ eA.Functor ⋙ 𝟭 A' ⋙ eA.inverse := (Iso.refl _)
    _ ≅ eA.Functor ⋙ (e'.Functor ⋙ e'.inverse) ⋙ eA.inverse :=
      (isoWhiskerLeft _ (isoWhiskerRight e'.unitIso _))
    _ ≅ (eA.Functor ⋙ e'.Functor) ⋙ e'.inverse ⋙ eA.inverse := (Iso.refl _)
    _ ≅ F ⋙ e'.inverse ⋙ eA.inverse := isoWhiskerRight hF _

#align algebraic_topology.dold_kan.compatibility.equivalence₁_unit_iso AlgebraicTopology.DoldKan.Compatibility.equivalence₁UnitIso

theorem equivalence₁UnitIso_eq : (equivalence₁ hF).unitIso = equivalence₁UnitIso hF :=
  by
  ext X
  dsimp [equivalence₀, equivalence₁, nat_iso.hcomp, is_equivalence.of_equivalence]
  simp only [id_comp, assoc, equivalence₁_unit_iso_hom_app]
#align algebraic_topology.dold_kan.compatibility.equivalence₁_unit_iso_eq AlgebraicTopology.DoldKan.Compatibility.equivalence₁UnitIso_eq

include eB

/-- An intermediate equivalence `A ≅ B` obtained as the composition of `equivalence₁` and
the inverse of `eB : B ≌ B'`. -/
@[simps Functor]
def equivalence₂ : A ≌ B :=
  (equivalence₁ hF).trans eB.symm
#align algebraic_topology.dold_kan.compatibility.equivalence₂ AlgebraicTopology.DoldKan.Compatibility.equivalence₂

theorem equivalence₂_inverse :
    (equivalence₂ eB hF).inverse = eB.Functor ⋙ e'.inverse ⋙ eA.inverse :=
  rfl
#align algebraic_topology.dold_kan.compatibility.equivalence₂_inverse AlgebraicTopology.DoldKan.Compatibility.equivalence₂_inverse

/-- The counit isomorphism of the equivalence `equivalence₂` between `A` and `B`. -/
@[simps]
def equivalence₂CounitIso : (eB.Functor ⋙ e'.inverse ⋙ eA.inverse) ⋙ F ⋙ eB.inverse ≅ 𝟭 B :=
  calc
    (eB.Functor ⋙ e'.inverse ⋙ eA.inverse) ⋙ F ⋙ eB.inverse ≅
        eB.Functor ⋙ (e'.inverse ⋙ eA.inverse ⋙ F) ⋙ eB.inverse :=
      Iso.refl _
    _ ≅ eB.Functor ⋙ 𝟭 _ ⋙ eB.inverse :=
      (isoWhiskerLeft _ (isoWhiskerRight (equivalence₁CounitIso hF) _))
    _ ≅ eB.Functor ⋙ eB.inverse := (Iso.refl _)
    _ ≅ 𝟭 B := eB.unitIso.symm

#align algebraic_topology.dold_kan.compatibility.equivalence₂_counit_iso AlgebraicTopology.DoldKan.Compatibility.equivalence₂CounitIso

theorem equivalence₂CounitIso_eq : (equivalence₂ eB hF).counitIso = equivalence₂CounitIso eB hF :=
  by
  ext Y'
  dsimp [equivalence₂, iso.refl]
  simp only [equivalence₁_counit_iso_eq, equivalence₂_counit_iso_hom_app,
    equivalence₁_counit_iso_hom_app, functor.map_comp, assoc]
#align algebraic_topology.dold_kan.compatibility.equivalence₂_counit_iso_eq AlgebraicTopology.DoldKan.Compatibility.equivalence₂CounitIso_eq

/-- The unit isomorphism of the equivalence `equivalence₂` between `A` and `B`. -/
@[simps]
def equivalence₂UnitIso : 𝟭 A ≅ (F ⋙ eB.inverse) ⋙ eB.Functor ⋙ e'.inverse ⋙ eA.inverse :=
  calc
    𝟭 A ≅ F ⋙ e'.inverse ⋙ eA.inverse := equivalence₁UnitIso hF
    _ ≅ F ⋙ 𝟭 B' ⋙ e'.inverse ⋙ eA.inverse := (Iso.refl _)
    _ ≅ F ⋙ (eB.inverse ⋙ eB.Functor) ⋙ e'.inverse ⋙ eA.inverse :=
      (isoWhiskerLeft _ (isoWhiskerRight eB.counitIso.symm _))
    _ ≅ (F ⋙ eB.inverse) ⋙ eB.Functor ⋙ e'.inverse ⋙ eA.inverse := Iso.refl _

#align algebraic_topology.dold_kan.compatibility.equivalence₂_unit_iso AlgebraicTopology.DoldKan.Compatibility.equivalence₂UnitIso

theorem equivalence₂UnitIso_eq : (equivalence₂ eB hF).unitIso = equivalence₂UnitIso eB hF :=
  by
  ext X
  dsimp [equivalence₂]
  simpa only [equivalence₂_unit_iso_hom_app, equivalence₁_unit_iso_eq,
    equivalence₁_unit_iso_hom_app, assoc, nat_iso.cancel_nat_iso_hom_left]
#align algebraic_topology.dold_kan.compatibility.equivalence₂_unit_iso_eq AlgebraicTopology.DoldKan.Compatibility.equivalence₂UnitIso_eq

variable {eB}

include hG

/-- The equivalence `A ≅ B` whose functor is `F ⋙ eB.inverse` and
whose inverse is `G : B ≅ A`. -/
@[simps inverse]
def equivalence : A ≌ B :=
  letI : is_equivalence G :=
    by
    refine' is_equivalence.of_iso _ (is_equivalence.of_equivalence (equivalence₂ eB hF).symm)
    calc
      eB.functor ⋙ e'.inverse ⋙ eA.inverse ≅ (eB.functor ⋙ e'.inverse) ⋙ eA.inverse := iso.refl _
      _ ≅ (G ⋙ eA.functor) ⋙ eA.inverse := (iso_whisker_right hG _)
      _ ≅ G ⋙ 𝟭 A := (iso_whisker_left _ eA.unit_iso.symm)
      _ ≅ G := functor.right_unitor G

  G.as_equivalence.symm
#align algebraic_topology.dold_kan.compatibility.equivalence AlgebraicTopology.DoldKan.Compatibility.equivalence

theorem equivalence_functor : (equivalence hF hG).Functor = F ⋙ eB.inverse :=
  rfl
#align algebraic_topology.dold_kan.compatibility.equivalence_functor AlgebraicTopology.DoldKan.Compatibility.equivalence_functor

end Compatibility

end DoldKan

end AlgebraicTopology