/-
Copyright (c) 2018 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/
import algebra.module.pi
import algebra.big_operators.basic

/-!
# Basic properties of holors

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

Holors are indexed collections of tensor coefficients. Confusingly,
they are often called tensors in physics and in the neural network
community.

A holor is simply a multidimensional array of values. The size of a
holor is specified by a `list ℕ`, whose length is called the dimension
of the holor.

The tensor product of `x₁ : holor α ds₁` and `x₂ : holor α ds₂` is the
holor given by `(x₁ ⊗ x₂) (i₁ ++ i₂) = x₁ i₁ * x₂ i₂`. A holor is "of
rank at most 1" if it is a tensor product of one-dimensional holors.
The CP rank of a holor `x` is the smallest N such that `x` is the sum
of N holors of rank at most 1.

Based on the tensor library found in <https://www.isa-afp.org/entries/Deep_Learning.html>

## References

* <https://en.wikipedia.org/wiki/Tensor_rank_decomposition>
-/

universes u

open list

open_locale big_operators

/-- `holor_index ds` is the type of valid index tuples used to identify an entry of a holor
of dimensions `ds`. -/
def holor_index (ds : list ℕ) : Type := {is : list ℕ // forall₂ (<) is ds}

namespace holor_index
variables {ds₁ ds₂ ds₃ : list ℕ}

def take : Π {ds₁ : list ℕ}, holor_index (ds₁ ++ ds₂) → holor_index ds₁
| ds is := ⟨ list.take (length ds) is.1, forall₂_take_append is.1 ds ds₂ is.2 ⟩

def drop : Π {ds₁ : list ℕ}, holor_index (ds₁ ++ ds₂) → holor_index ds₂
| ds is := ⟨ list.drop (length ds) is.1, forall₂_drop_append is.1 ds ds₂ is.2 ⟩

lemma cast_type (is : list ℕ) (eq : ds₁ = ds₂) (h : forall₂ (<) is ds₁) :
  (cast (congr_arg holor_index eq) ⟨is, h⟩).val = is :=
by subst eq; refl

def assoc_right :
  holor_index (ds₁ ++ ds₂ ++ ds₃) → holor_index (ds₁ ++ (ds₂ ++ ds₃)) :=
cast (congr_arg holor_index (append_assoc ds₁ ds₂ ds₃))

def assoc_left :
  holor_index (ds₁ ++ (ds₂ ++ ds₃)) → holor_index (ds₁ ++ ds₂ ++ ds₃) :=
cast (congr_arg holor_index (append_assoc ds₁ ds₂ ds₃).symm)

lemma take_take :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.take = t.take.take
| ⟨ is , h ⟩ := subtype.eq $ by simp [assoc_right,take, cast_type, list.take_take,
                                     nat.le_add_right, min_eq_left]

lemma drop_take :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.drop.take = t.take.drop
| ⟨ is , h ⟩ := subtype.eq (by simp [assoc_right, take, drop, cast_type, list.drop_take])

lemma drop_drop :
  ∀ t : holor_index (ds₁ ++ ds₂ ++ ds₃),
  t.assoc_right.drop.drop = t.drop
| ⟨ is , h ⟩ := subtype.eq (by simp [add_comm, assoc_right, drop, cast_type, list.drop_drop])

end holor_index

/-- Holor (indexed collections of tensor coefficients) -/
def holor (α : Type u) (ds : list ℕ) := holor_index ds → α

namespace holor

variables {α : Type} {d : ℕ} {ds : list ℕ} {ds₁ : list ℕ} {ds₂ : list ℕ} {ds₃ : list ℕ}

instance [inhabited α] : inhabited (holor α ds) := ⟨λ t, default⟩
instance [has_zero α] : has_zero (holor α ds) := ⟨λ t, 0⟩
instance [has_add α] : has_add (holor α ds) := ⟨λ x y t, x t + y t⟩
instance [has_neg α] : has_neg (holor α ds) :=  ⟨λ a t, - a t⟩

instance [add_semigroup α] : add_semigroup (holor α ds) :=
by refine_struct { add := (+), .. }; tactic.pi_instance_derive_field

instance [add_comm_semigroup α] : add_comm_semigroup (holor α ds) :=
by refine_struct { add := (+), .. }; tactic.pi_instance_derive_field

instance [add_monoid α] : add_monoid (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := λ n x i, n • (x i) };
tactic.pi_instance_derive_field

instance [add_comm_monoid α] : add_comm_monoid (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := add_monoid.nsmul };
tactic.pi_instance_derive_field

instance [add_group α] : add_group (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := add_monoid.nsmul,
  zsmul := λ n x i, n • (x i) };
tactic.pi_instance_derive_field

instance [add_comm_group α] : add_comm_group (holor α ds) :=
by refine_struct { zero := (0 : holor α ds), add := (+), nsmul := add_monoid.nsmul,
  zsmul := sub_neg_monoid.zsmul };
tactic.pi_instance_derive_field

/- scalar product -/

instance [has_mul α] : has_smul α (holor α ds) :=
  ⟨λ a x, λ t, a * x t⟩

instance [semiring α] : module α (holor α ds) := pi.module _ _ _

/-- The tensor product of two holors. -/
def mul [s : has_mul α] (x : holor α ds₁) (y : holor α ds₂) : holor α (ds₁ ++ ds₂) :=
  λ t, x (t.take) * y (t.drop)

local infix ` ⊗ ` : 70 := mul

lemma cast_type (eq : ds₁ = ds₂) (a : holor α ds₁) :
  cast (congr_arg (holor α) eq) a = (λ t, a (cast (congr_arg holor_index eq.symm) t)) :=
by subst eq; refl

def assoc_right :
  holor α (ds₁ ++ ds₂ ++ ds₃) → holor α (ds₁ ++ (ds₂ ++ ds₃)) :=
cast (congr_arg (holor α) (append_assoc ds₁ ds₂ ds₃))

def assoc_left :
  holor α (ds₁ ++ (ds₂ ++ ds₃)) → holor α (ds₁ ++ ds₂ ++ ds₃) :=
cast (congr_arg (holor α) (append_assoc ds₁ ds₂ ds₃).symm)

lemma mul_assoc0 [semigroup α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₃) :
  x ⊗ y ⊗ z = (x ⊗ (y ⊗ z)).assoc_left :=
funext (assume t : holor_index (ds₁ ++ ds₂ ++ ds₃),
begin
  rw assoc_left,
  unfold mul,
  rw mul_assoc,
  rw [←holor_index.take_take, ←holor_index.drop_take, ←holor_index.drop_drop],
  rw cast_type,
  refl,
  rw append_assoc
end)

lemma mul_assoc [semigroup α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₃) :
  mul (mul x y) z == (mul x (mul y z)) :=
by simp [cast_heq, mul_assoc0, assoc_left].

lemma mul_left_distrib [distrib α] (x : holor α ds₁) (y : holor α ds₂) (z : holor α ds₂) :
  x ⊗ (y + z) = x ⊗ y + x ⊗ z :=
funext (λt, left_distrib (x (holor_index.take t)) (y (holor_index.drop t)) (z (holor_index.drop t)))

lemma mul_right_distrib [distrib α] (x : holor α ds₁) (y : holor α ds₁) (z : holor α ds₂) :
  (x + y) ⊗ z = x ⊗ z + y ⊗ z :=
funext $ λt, add_mul (x (holor_index.take t)) (y (holor_index.take t)) (z (holor_index.drop t))

@[simp] lemma zero_mul {α : Type} [ring α] (x : holor α ds₂) :
  (0 : holor α ds₁) ⊗ x = 0 :=
funext (λ t, zero_mul (x (holor_index.drop t)))

@[simp] lemma mul_zero {α : Type} [ring α] (x : holor α ds₁) :
  x ⊗ (0 :holor α ds₂) = 0 :=
funext (λ t, mul_zero (x (holor_index.take t)))

lemma mul_scalar_mul [monoid α] (x : holor α []) (y : holor α ds) :
  x ⊗ y = x ⟨[], forall₂.nil⟩ • y :=
by simp [mul, has_smul.smul, holor_index.take, holor_index.drop]

/- holor slices -/

/-- A slice is a subholor consisting of all entries with initial index i. -/
def slice (x : holor α (d :: ds)) (i : ℕ) (h : i < d) : holor α ds :=
  (λ is : holor_index ds, x ⟨ i :: is.1, forall₂.cons h is.2⟩)

/-- The 1-dimensional "unit" holor with 1 in the `j`th position. -/
def unit_vec [monoid α] [add_monoid α] (d : ℕ) (j : ℕ) : holor α [d] :=
  λ ti, if ti.1 = [j] then 1 else 0

lemma holor_index_cons_decomp (p: holor_index (d :: ds) → Prop) :
  Π (t : holor_index (d :: ds)),
    (∀ i is, Π h : t.1 = i :: is, p ⟨ i :: is, begin rw [←h], exact t.2 end ⟩ ) → p t
| ⟨[], hforall₂⟩        hp := absurd (forall₂_nil_left_iff.1 hforall₂) (cons_ne_nil d ds)
| ⟨(i :: is), hforall₂⟩ hp := hp i is rfl

/-- Two holors are equal if all their slices are equal. -/
lemma slice_eq (x : holor α (d :: ds)) (y : holor α (d :: ds))
  (h : slice x = slice y) : x = y :=
funext $ λ t : holor_index (d :: ds), holor_index_cons_decomp (λ t, x t = y t) t $ λ i is hiis,
have hiisdds: forall₂ (<) (i :: is) (d :: ds), begin rw [←hiis], exact t.2 end,
have hid:     i<d,                             from (forall₂_cons.1 hiisdds).1,
have hisds:   forall₂ (<) is ds,               from (forall₂_cons.1 hiisdds).2,
calc
  x ⟨i :: is, _⟩ = slice x i hid ⟨is, hisds⟩  : congr_arg (λ t, x t) (subtype.eq rfl)
              ... = slice y i hid ⟨is, hisds⟩  : by rw h
              ... = y ⟨i :: is, _⟩             : congr_arg (λ t, y t) (subtype.eq rfl)

lemma slice_unit_vec_mul [ring α] {i : ℕ} {j : ℕ}
  (hid : i < d) (x : holor α ds) :
  slice (unit_vec d j ⊗ x) i hid = if i=j then x else 0 :=
funext $ λ t : holor_index ds, if h : i = j
  then by simp [slice, mul, holor_index.take, unit_vec, holor_index.drop, h]
  else by simp [slice, mul, holor_index.take, unit_vec, holor_index.drop, h]; refl

lemma slice_add [has_add α] (i : ℕ) (hid : i < d)  (x : holor α (d :: ds)) (y : holor α (d :: ds)) :
  slice x i hid + slice y i hid = slice (x + y) i hid := funext (λ t, by simp [slice,(+)])

lemma slice_zero [has_zero α] (i : ℕ) (hid : i < d)  :
  slice (0 : holor α (d :: ds)) i hid = 0 := rfl

lemma slice_sum [add_comm_monoid α] {β : Type}
  (i : ℕ) (hid : i < d) (s : finset β) (f : β → holor α (d :: ds)) :
  ∑ x in s, slice (f x) i hid = slice (∑ x in s, f x) i hid :=
begin
  letI := classical.dec_eq β,
  refine finset.induction_on s _ _,
  { simp [slice_zero] },
  { intros _ _ h_not_in ih,
    rw [finset.sum_insert h_not_in, ih, slice_add, finset.sum_insert h_not_in] }
end

/-- The original holor can be recovered from its slices by multiplying with unit vectors and
summing up. -/
@[simp] lemma sum_unit_vec_mul_slice [ring α] (x : holor α (d :: ds)) :
  ∑ i in (finset.range d).attach,
    unit_vec d i ⊗ slice x i (nat.succ_le_of_lt (finset.mem_range.1 i.prop)) = x :=
begin
  apply slice_eq _ _ _,
  ext i hid,
  rw [←slice_sum],
  simp only [slice_unit_vec_mul hid],
  rw finset.sum_eq_single (subtype.mk i $ finset.mem_range.2 hid),
  { simp },
  { assume (b : {x // x ∈ finset.range d}) (hb : b ∈ (finset.range d).attach) (hbi : b ≠ ⟨i, _⟩),
    have hbi' : i ≠ b,
    { simpa only [ne.def, subtype.ext_iff, subtype.coe_mk] using hbi.symm },
    simp [hbi'] },
  { assume hid' : subtype.mk i _ ∉ finset.attach (finset.range d),
    exfalso,
    exact absurd (finset.mem_attach _ _) hid' }
end

/- CP rank -/

/-- `cprank_max1 x` means `x` has CP rank at most 1, that is,
  it is the tensor product of 1-dimensional holors. -/
inductive cprank_max1 [has_mul α]: Π {ds}, holor α ds → Prop
| nil (x : holor α []) :
    cprank_max1 x
| cons {d} {ds} (x : holor α [d]) (y : holor α ds) :
    cprank_max1 y → cprank_max1 (x ⊗ y)

/-- `cprank_max N x` means `x` has CP rank at most `N`, that is,
  it can be written as the sum of N holors of rank at most 1. -/
inductive cprank_max [has_mul α] [add_monoid α] : ℕ → Π {ds}, holor α ds → Prop
| zero {ds} :
    cprank_max 0 (0 : holor α ds)
| succ n {ds} (x : holor α ds) (y : holor α ds) :
    cprank_max1 x → cprank_max n y →  cprank_max (n+1) (x + y)

lemma cprank_max_nil [monoid α] [add_monoid α] (x : holor α nil) : cprank_max 1 x :=
  have h : _, from cprank_max.succ 0 x 0 (cprank_max1.nil x) (cprank_max.zero),
  by rwa [add_zero x, zero_add] at h

lemma cprank_max_1 [monoid α] [add_monoid α] {x : holor α ds}
  (h : cprank_max1 x) : cprank_max 1 x :=
have h' : _, from cprank_max.succ 0 x 0 h cprank_max.zero,
by rwa [zero_add, add_zero] at h'

lemma cprank_max_add [monoid α] [add_monoid α]:
  ∀ {m : ℕ} {n : ℕ} {x : holor α ds} {y : holor α ds},
  cprank_max m x → cprank_max n y → cprank_max (m + n) (x + y)
| 0     n x y (cprank_max.zero) hy := by simp [hy]
| (m+1) n _ y (cprank_max.succ k x₁ x₂ hx₁ hx₂) hy :=
begin
  simp only [add_comm, add_assoc],
  apply cprank_max.succ,
  { assumption },
  { exact cprank_max_add hx₂ hy }
end

lemma cprank_max_mul [ring α] :
  ∀ (n : ℕ) (x : holor α [d]) (y : holor α ds), cprank_max n y → cprank_max n (x ⊗ y)
| 0 x _ (cprank_max.zero) := by simp [mul_zero x, cprank_max.zero]
| (n+1) x _ (cprank_max.succ k y₁ y₂ hy₁ hy₂) :=
begin
  rw mul_left_distrib,
  rw nat.add_comm,
  apply cprank_max_add,
  { exact cprank_max_1 (cprank_max1.cons _ _ hy₁) },
  { exact cprank_max_mul k x y₂ hy₂ }
end

lemma cprank_max_sum [ring α] {β} {n : ℕ} (s : finset β) (f : β → holor α ds) :
  (∀ x ∈ s, cprank_max n (f x)) → cprank_max (s.card * n) (∑ x in s, f x) :=
by letI := classical.dec_eq β;
exact finset.induction_on s
  (by simp [cprank_max.zero])
  (begin
    assume x s (h_x_notin_s : x ∉ s) ih h_cprank,
    simp only [finset.sum_insert h_x_notin_s, finset.card_insert_of_not_mem h_x_notin_s],
    rw nat.right_distrib,
    simp only [nat.one_mul, nat.add_comm],
    have ih' : cprank_max (finset.card s * n) (∑ x in s, f x),
    { apply ih,
      assume (x : β) (h_x_in_s: x ∈ s),
      simp only [h_cprank, finset.mem_insert_of_mem, h_x_in_s] },
    exact (cprank_max_add (h_cprank x (finset.mem_insert_self x s)) ih')
  end)

lemma cprank_max_upper_bound [ring α] : Π {ds}, ∀ x : holor α ds, cprank_max ds.prod x
| [] x := cprank_max_nil x
| (d :: ds) x :=
have h_summands : Π (i : {x // x ∈ finset.range d}),
  cprank_max ds.prod (unit_vec d i.1 ⊗ slice x i.1 (mem_range.1 i.2)),
  from λ i, cprank_max_mul _ _ _ (cprank_max_upper_bound (slice x i.1 (mem_range.1 i.2))),
have h_dds_prod : (list.cons d ds).prod = finset.card (finset.range d) * prod ds,
  by simp [finset.card_range],
have cprank_max (finset.card (finset.attach (finset.range d)) * prod ds)
  (∑ i in finset.attach (finset.range d), unit_vec d (i.val)⊗slice x (i.val) (mem_range.1 i.2)),
  from cprank_max_sum (finset.range d).attach _ (λ i _, h_summands i),
have h_cprank_max_sum : cprank_max (finset.card (finset.range d) * prod ds)
  (∑ i in finset.attach (finset.range d), unit_vec d (i.val)⊗slice x (i.val) (mem_range.1 i.2)),
  by rwa [finset.card_attach] at this,
begin
  rw [←sum_unit_vec_mul_slice x],
  rw [h_dds_prod],
  exact h_cprank_max_sum,
end

/-- The CP rank of a holor `x`: the smallest N such that
  `x` can be written as the sum of N holors of rank at most 1. -/
noncomputable def cprank [ring α] (x : holor α ds) : nat :=
@nat.find (λ n, cprank_max n x) (classical.dec_pred _) ⟨ds.prod, cprank_max_upper_bound x⟩

lemma cprank_upper_bound [ring α] :
  Π {ds}, ∀ x : holor α ds, cprank x ≤ ds.prod :=
λ ds (x : holor α ds),
  by letI := classical.dec_pred (λ (n : ℕ), cprank_max n x);
  exact nat.find_min'
    ⟨ds.prod, show (λ n, cprank_max n x) ds.prod, from cprank_max_upper_bound x⟩
    (cprank_max_upper_bound x)

end holor


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

namespace Fin

@[simp] theorem ofNat'_zero_val : (Fin.ofNat' 0 h).val = 0 := Nat.zero_mod _

@[simp] theorem mod_val (a b : Fin n) : (a % b).val = a.val % b.val :=
  Nat.mod_eq_of_lt (Nat.lt_of_le_of_lt (Nat.mod_le ..) a.2)

@[simp] theorem div_val (a b : Fin n) : (a / b).val = a.val / b.val :=
  Nat.mod_eq_of_lt (Nat.lt_of_le_of_lt (Nat.div_le_self ..) a.2)

@[simp] theorem modn_val (a : Fin n) (b : Nat) : (a.modn b).val = a.val % b :=
  Nat.mod_eq_of_lt (Nat.lt_of_le_of_lt (Nat.mod_le ..) a.2)

end Fin

namespace USize

@[simp] theorem lt_def {a b : USize} : a < b ↔ a.toNat < b.toNat := .rfl

@[simp] theorem le_def {a b : USize} : a ≤ b ↔ a.toNat ≤ b.toNat := .rfl

@[simp] theorem zero_toNat : (0 : USize).toNat = 0 := Nat.zero_mod _

@[simp] theorem mod_toNat (a b : USize) : (a % b).toNat = a.toNat % b.toNat :=
  Fin.mod_val ..

@[simp] theorem div_toNat (a b : USize) : (a / b).toNat = a.toNat / b.toNat :=
  Fin.div_val ..

@[simp] theorem modn_toNat (a : USize) (b : Nat) : (a.modn b).toNat = a.toNat % b :=
  Fin.modn_val ..

theorem mod_lt (a b : USize) (h : 0 < b) : a % b < b := USize.modn_lt _ (by simp at h; exact h)

theorem toNat.inj : ∀ {a b : USize}, a.toNat = b.toNat → a = b
  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

end USize


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

! This file was ported from Lean 3 source module algebra.algebra.pi
! leanprover-community/mathlib commit 832f7b9162039c28b9361289c8681f155cae758f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Equiv

/-!
# The R-algebra structure on families of R-algebras

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

The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra.

## Main defintions

* `pi.algebra`
* `pi.eval_alg_hom`
* `pi.const_alg_hom`
-/

universe u v w

namespace Pi

variable {I : Type u}

-- The indexing type
variable {R : Type _}

-- The scalar type
variable {f : I → Type v}

-- The family of types already equipped with instances
variable (x y : ∀ i, f i) (i : I)

variable (I f)

#print Pi.algebra /-
instance algebra {r : CommSemiring R} [s : ∀ i, Semiring (f i)] [∀ i, Algebra R (f i)] :
    Algebra R (∀ i : I, f i) :=
  {
    (Pi.ringHom fun i => algebraMap R (f i) :
      R →+* ∀ i : I,
          f i) with
    commutes' := fun a f => by ext; simp [Algebra.commutes]
    smul_def' := fun a f => by ext; simp [Algebra.smul_def] }
#align pi.algebra Pi.algebra
-/

/- warning: pi.algebra_map_def -> Pi.algebraMap_def is a dubious translation:
lean 3 declaration is
  forall (I : Type.{u1}) {R : Type.{u3}} (f : I -> Type.{u2}) {r : CommSemiring.{u3} R} [s : forall (i : I), Semiring.{u2} (f i)] [_inst_1 : forall (i : I), Algebra.{u3, u2} R (f i) r (s i)] (a : R), Eq.{max (succ u1) (succ u2)} (forall (i : I), f i) (coeFn.{max (succ u3) (succ (max u1 u2)), max (succ u3) (succ (max u1 u2))} (RingHom.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) (fun (_x : RingHom.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) => R -> (forall (i : I), f i)) (RingHom.hasCoeToFun.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) (algebraMap.{u3, max u1 u2} R (forall (i : I), f i) r (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)) (Pi.algebra.{u1, u2, u3} I R (fun (i : I) => f i) r (fun (i : I) => s i) (fun (i : I) => _inst_1 i))) a) (fun (i : I) => coeFn.{max (succ u3) (succ u2), max (succ u3) (succ u2)} (RingHom.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) (fun (_x : RingHom.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) => R -> (f i)) (RingHom.hasCoeToFun.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) (algebraMap.{u3, u2} R (f i) r (s i) (_inst_1 i)) a)
but is expected to have type
  forall (I : Type.{u2}) {R : Type.{u1}} (f : I -> Type.{u3}) {r : CommSemiring.{u1} R} [s : forall (i : I), Semiring.{u3} (f i)] [_inst_1 : forall (i : I), Algebra.{u1, u3} R (f i) r (s i)] (a : R), Eq.{max (succ u2) (succ u3)} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => forall (i : I), f i) a) (FunLike.coe.{max (max (succ u2) (succ u3)) (succ u1), succ u1, max (succ u2) (succ u3)} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => forall (i : I), f i) _x) (MulHomClass.toFunLike.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)))) (NonUnitalNonAssocSemiring.toMul.{max u2 u3} (forall (i : I), f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))))) (NonUnitalRingHomClass.toMulHomClass.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) (RingHomClass.toNonUnitalRingHomClass.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))) (RingHom.instRingHomClassRingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))))))) (algebraMap.{u1, max u2 u3} R (forall (i : I), f i) r (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)) (Pi.algebra.{u2, u3, u1} I R (fun (i : I) => f i) r (fun (i : I) => s i) (fun (i : I) => _inst_1 i))) a) (fun (i : I) => FunLike.coe.{max (succ u3) (succ u1), succ u1, succ u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => f i) _x) (MulHomClass.toFunLike.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)))) (NonUnitalNonAssocSemiring.toMul.{u3} (f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} (f i) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)))) (NonUnitalRingHomClass.toMulHomClass.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} (f i) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) (RingHomClass.toNonUnitalRingHomClass.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)) (RingHom.instRingHomClassRingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)))))) (algebraMap.{u1, u3} R (f i) r (s i) (_inst_1 i)) a)
Case conversion may be inaccurate. Consider using '#align pi.algebra_map_def Pi.algebraMap_defₓ'. -/
theorem algebraMap_def {r : CommSemiring R} [s : ∀ i, Semiring (f i)] [∀ i, Algebra R (f i)]
    (a : R) : algebraMap R (∀ i, f i) a = fun i => algebraMap R (f i) a :=
  rfl
#align pi.algebra_map_def Pi.algebraMap_def

/- warning: pi.algebra_map_apply -> Pi.algebraMap_apply is a dubious translation:
lean 3 declaration is
  forall (I : Type.{u1}) {R : Type.{u3}} (f : I -> Type.{u2}) {r : CommSemiring.{u3} R} [s : forall (i : I), Semiring.{u2} (f i)] [_inst_1 : forall (i : I), Algebra.{u3, u2} R (f i) r (s i)] (a : R) (i : I), Eq.{succ u2} (f i) (coeFn.{max (succ u3) (succ (max u1 u2)), max (succ u3) (succ (max u1 u2))} (RingHom.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) (fun (_x : RingHom.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) => R -> (forall (i : I), f i)) (RingHom.hasCoeToFun.{u3, max u1 u2} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{max u1 u2} (forall (i : I), f i) (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)))) (algebraMap.{u3, max u1 u2} R (forall (i : I), f i) r (Pi.semiring.{u1, u2} I (fun (i : I) => f i) (fun (i : I) => s i)) (Pi.algebra.{u1, u2, u3} I R (fun (i : I) => f i) r (fun (i : I) => s i) (fun (i : I) => _inst_1 i))) a i) (coeFn.{max (succ u3) (succ u2), max (succ u3) (succ u2)} (RingHom.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) (fun (_x : RingHom.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) => R -> (f i)) (RingHom.hasCoeToFun.{u3, u2} R (f i) (Semiring.toNonAssocSemiring.{u3} R (CommSemiring.toSemiring.{u3} R r)) (Semiring.toNonAssocSemiring.{u2} (f i) (s i))) (algebraMap.{u3, u2} R (f i) r (s i) (_inst_1 i)) a)
but is expected to have type
  forall (I : Type.{u2}) {R : Type.{u1}} (f : I -> Type.{u3}) {r : CommSemiring.{u1} R} [s : forall (i : I), Semiring.{u3} (f i)] [_inst_1 : forall (i : I), Algebra.{u1, u3} R (f i) r (s i)] (a : R) (i : I), Eq.{succ u3} (f i) (FunLike.coe.{max (max (succ u2) (succ u3)) (succ u1), succ u1, max (succ u2) (succ u3)} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => forall (i : I), f i) _x) (MulHomClass.toFunLike.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)))) (NonUnitalNonAssocSemiring.toMul.{max u2 u3} (forall (i : I), f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))))) (NonUnitalRingHomClass.toMulHomClass.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) (RingHomClass.toNonUnitalRingHomClass.{max (max u2 u3) u1, u1, max u2 u3} (RingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)))) R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))) (RingHom.instRingHomClassRingHom.{u1, max u2 u3} R (forall (i : I), f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{max u2 u3} (forall (i : I), f i) (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i))))))) (algebraMap.{u1, max u2 u3} R (forall (i : I), f i) r (Pi.semiring.{u2, u3} I (fun (i : I) => f i) (fun (i : I) => s i)) (Pi.algebra.{u2, u3, u1} I R (fun (i : I) => f i) r (fun (i : I) => s i) (fun (i : I) => _inst_1 i))) a i) (FunLike.coe.{max (succ u3) (succ u1), succ u1, succ u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => f i) _x) (MulHomClass.toFunLike.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)))) (NonUnitalNonAssocSemiring.toMul.{u3} (f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} (f i) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)))) (NonUnitalRingHomClass.toMulHomClass.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r))) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} (f i) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) (RingHomClass.toNonUnitalRingHomClass.{max u3 u1, u1, u3} (RingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i))) R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)) (RingHom.instRingHomClassRingHom.{u1, u3} R (f i) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R r)) (Semiring.toNonAssocSemiring.{u3} (f i) (s i)))))) (algebraMap.{u1, u3} R (f i) r (s i) (_inst_1 i)) a)
Case conversion may be inaccurate. Consider using '#align pi.algebra_map_apply Pi.algebraMap_applyₓ'. -/
@[simp]
theorem algebraMap_apply {r : CommSemiring R} [s : ∀ i, Semiring (f i)] [∀ i, Algebra R (f i)]
    (a : R) (i : I) : algebraMap R (∀ i, f i) a i = algebraMap R (f i) a :=
  rfl
#align pi.algebra_map_apply Pi.algebraMap_apply

-- One could also build a `Π i, R i`-algebra structure on `Π i, A i`,
-- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful.
variable {I} (R) (f)

#print Pi.evalAlgHom /-
/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`,
etc. -/
@[simps]
def evalAlgHom {r : CommSemiring R} [∀ i, Semiring (f i)] [∀ i, Algebra R (f i)] (i : I) :
    (∀ i, f i) →ₐ[R] f i :=
  { Pi.evalRingHom f i with
    toFun := fun f => f i
    commutes' := fun r => rfl }
#align pi.eval_alg_hom Pi.evalAlgHom
-/

variable (A B : Type _) [CommSemiring R] [Semiring B] [Algebra R B]

#print Pi.constAlgHom /-
/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`,
etc. -/
@[simps]
def constAlgHom : B →ₐ[R] A → B :=
  { Pi.constRingHom A B with
    toFun := Function.const _
    commutes' := fun r => rfl }
#align pi.const_alg_hom Pi.constAlgHom
-/

/- warning: pi.const_ring_hom_eq_algebra_map -> Pi.constRingHom_eq_algebraMap is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) (A : Type.{u2}) [_inst_1 : CommSemiring.{u1} R], Eq.{max (succ u1) (succ (max u2 u1))} (RingHom.{u1, max u2 u1} R (A -> R) (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)) (Pi.nonAssocSemiring.{u2, u1} A (fun (ᾰ : A) => R) (fun (i : A) => Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1)))) (Pi.constRingHom.{u2, u1} A R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_1))) (algebraMap.{u1, max u2 u1} R (A -> R) _inst_1 (Pi.semiring.{u2, u1} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1)) (Pi.algebra.{u2, u1, u1} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1) (fun (i : A) => Algebra.id.{u1} R _inst_1)))
but is expected to have type
  forall (R : Type.{u2}) (A : Type.{u1}) [_inst_1 : CommSemiring.{u2} R], Eq.{max (succ u2) (succ u1)} (RingHom.{u2, max u1 u2} R (A -> R) (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)) (Pi.nonAssocSemiring.{u1, u2} A (fun (ᾰ : A) => R) (fun (i : A) => Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1)))) (Pi.constRingHom.{u1, u2} A R (Semiring.toNonAssocSemiring.{u2} R (CommSemiring.toSemiring.{u2} R _inst_1))) (algebraMap.{u2, max u2 u1} R (A -> R) _inst_1 (Pi.semiring.{u1, u2} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1)) (Pi.algebra.{u1, u2, u2} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1) (fun (i : A) => Algebra.id.{u2} R _inst_1)))
Case conversion may be inaccurate. Consider using '#align pi.const_ring_hom_eq_algebra_map Pi.constRingHom_eq_algebraMapₓ'. -/
/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that
map. -/
@[simp]
theorem constRingHom_eq_algebraMap : constRingHom A R = algebraMap R (A → R) :=
  rfl
#align pi.const_ring_hom_eq_algebra_map Pi.constRingHom_eq_algebraMap

/- warning: pi.const_alg_hom_eq_algebra_of_id -> Pi.constAlgHom_eq_algebra_ofId is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) (A : Type.{u2}) [_inst_1 : CommSemiring.{u1} R], Eq.{max (succ u1) (succ (max u2 u1))} (AlgHom.{u1, u1, max u2 u1} R R (A -> R) _inst_1 (CommSemiring.toSemiring.{u1} R _inst_1) (Pi.semiring.{u2, u1} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1)) (Algebra.id.{u1} R _inst_1) (Pi.algebra.{u2, u1, u1} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1) (fun (i : A) => Algebra.id.{u1} R _inst_1))) (Pi.constAlgHom.{u1, u2, u1} R A R _inst_1 (CommSemiring.toSemiring.{u1} R _inst_1) (Algebra.id.{u1} R _inst_1)) (Algebra.ofId.{u1, max u2 u1} R (A -> R) _inst_1 (Pi.semiring.{u2, u1} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1)) (Pi.algebra.{u2, u1, u1} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u1} R _inst_1) (fun (i : A) => Algebra.id.{u1} R _inst_1)))
but is expected to have type
  forall (R : Type.{u2}) (A : Type.{u1}) [_inst_1 : CommSemiring.{u2} R], Eq.{max (succ u2) (succ u1)} (AlgHom.{u2, u2, max u1 u2} R R (A -> R) _inst_1 (CommSemiring.toSemiring.{u2} R _inst_1) (Pi.semiring.{u1, u2} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1)) (Algebra.id.{u2} R _inst_1) (Pi.algebra.{u1, u2, u2} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1) (fun (i : A) => Algebra.id.{u2} R _inst_1))) (Pi.constAlgHom.{u2, u1, u2} R A R _inst_1 (CommSemiring.toSemiring.{u2} R _inst_1) (Algebra.id.{u2} R _inst_1)) (Algebra.ofId.{u2, max u2 u1} R (A -> R) _inst_1 (Pi.semiring.{u1, u2} A (fun (ᾰ : A) => R) (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1)) (Pi.algebra.{u1, u2, u2} A R (fun (ᾰ : A) => R) _inst_1 (fun (i : A) => CommSemiring.toSemiring.{u2} R _inst_1) (fun (i : A) => Algebra.id.{u2} R _inst_1)))
Case conversion may be inaccurate. Consider using '#align pi.const_alg_hom_eq_algebra_of_id Pi.constAlgHom_eq_algebra_ofIdₓ'. -/
@[simp]
theorem constAlgHom_eq_algebra_ofId : constAlgHom R A R = Algebra.ofId R (A → R) :=
  rfl
#align pi.const_alg_hom_eq_algebra_of_id Pi.constAlgHom_eq_algebra_ofId

end Pi

#print Function.algebra /-
/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate
definitions elsewhere in the library without this, -/
instance Function.algebra {R : Type _} (I : Type _) (A : Type _) [CommSemiring R] [Semiring A]
    [Algebra R A] : Algebra R (I → A) :=
  Pi.algebra _ _
#align function.algebra Function.algebra
-/

namespace AlgHom

variable {R : Type u} {A : Type v} {B : Type w} {I : Type _}

variable [CommSemiring R] [Semiring A] [Semiring B]

variable [Algebra R A] [Algebra R B]

#print AlgHom.compLeft /-
/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an
`R`-algebra homomorphism `f` between `A` and `B`. -/
@[simps]
protected def compLeft (f : A →ₐ[R] B) (I : Type _) : (I → A) →ₐ[R] I → B :=
  { f.toRingHom.compLeft I with
    toFun := fun h => f ∘ h
    commutes' := fun c => by
      ext
      exact f.commutes' c }
#align alg_hom.comp_left AlgHom.compLeft
-/

end AlgHom

namespace AlgEquiv

#print AlgEquiv.piCongrRight /-
/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a
multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`.

This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
`alg_equiv.arrow_congr`.
-/
@[simps apply]
def piCongrRight {R ι : Type _} {A₁ A₂ : ι → Type _} [CommSemiring R] [∀ i, Semiring (A₁ i)]
    [∀ i, Semiring (A₂ i)] [∀ i, Algebra R (A₁ i)] [∀ i, Algebra R (A₂ i)]
    (e : ∀ i, A₁ i ≃ₐ[R] A₂ i) : (∀ i, A₁ i) ≃ₐ[R] ∀ i, A₂ i :=
  {
    @RingEquiv.piCongrRight ι A₁ A₂ _ _ fun i =>
      (e i).toRingEquiv with
    toFun := fun x j => e j (x j)
    invFun := fun x j => (e j).symm (x j)
    commutes' := fun r => by
      ext i
      simp }
#align alg_equiv.Pi_congr_right AlgEquiv.piCongrRight
-/

/- warning: alg_equiv.Pi_congr_right_refl -> AlgEquiv.piCongrRight_refl is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {ι : Type.{u2}} {A : ι -> Type.{u3}} [_inst_1 : CommSemiring.{u1} R] [_inst_2 : forall (i : ι), Semiring.{u3} (A i)] [_inst_3 : forall (i : ι), Algebra.{u1, u3} R (A i) _inst_1 (_inst_2 i)], Eq.{succ (max u2 u3)} (AlgEquiv.{u1, max u2 u3, max u2 u3} R (forall (i : ι), A i) (forall (i : ι), A i) _inst_1 (Pi.semiring.{u2, u3} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u2, u3} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i))) (AlgEquiv.piCongrRight.{u1, u2, u3, u3} R ι (fun (i : ι) => A i) (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => AlgEquiv.refl.{u1, u3} R (A i) _inst_1 (_inst_2 i) (_inst_3 i))) (AlgEquiv.refl.{u1, max u2 u3} R (forall (i : ι), A i) _inst_1 (Pi.semiring.{u2, u3} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)))
but is expected to have type
  forall {R : Type.{u3}} {ι : Type.{u2}} {A : ι -> Type.{u1}} [_inst_1 : CommSemiring.{u3} R] [_inst_2 : forall (i : ι), Semiring.{u1} (A i)] [_inst_3 : forall (i : ι), Algebra.{u3, u1} R (A i) _inst_1 (_inst_2 i)], Eq.{max (succ u2) (succ u1)} (AlgEquiv.{u3, max u2 u1, max u2 u1} R (forall (i : ι), A i) (forall (i : ι), A i) _inst_1 (Pi.semiring.{u2, u1} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u2, u1} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u2, u1, u3} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)) (Pi.algebra.{u2, u1, u3} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i))) (AlgEquiv.piCongrRight.{u3, u2, u1, u1} R ι (fun (i : ι) => A i) (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => AlgEquiv.refl.{u3, u1} R (A i) _inst_1 (_inst_2 i) (_inst_3 i))) (AlgEquiv.refl.{u3, max u2 u1} R (forall (i : ι), A i) _inst_1 (Pi.semiring.{u2, u1} ι (fun (i : ι) => A i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u2, u1, u3} ι R (fun (i : ι) => A i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i)))
Case conversion may be inaccurate. Consider using '#align alg_equiv.Pi_congr_right_refl AlgEquiv.piCongrRight_reflₓ'. -/
@[simp]
theorem piCongrRight_refl {R ι : Type _} {A : ι → Type _} [CommSemiring R] [∀ i, Semiring (A i)]
    [∀ i, Algebra R (A i)] :
    (piCongrRight fun i => (AlgEquiv.refl : A i ≃ₐ[R] A i)) = AlgEquiv.refl :=
  rfl
#align alg_equiv.Pi_congr_right_refl AlgEquiv.piCongrRight_refl

/- warning: alg_equiv.Pi_congr_right_symm -> AlgEquiv.piCongrRight_symm is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {ι : Type.{u2}} {A₁ : ι -> Type.{u3}} {A₂ : ι -> Type.{u4}} [_inst_1 : CommSemiring.{u1} R] [_inst_2 : forall (i : ι), Semiring.{u3} (A₁ i)] [_inst_3 : forall (i : ι), Semiring.{u4} (A₂ i)] [_inst_4 : forall (i : ι), Algebra.{u1, u3} R (A₁ i) _inst_1 (_inst_2 i)] [_inst_5 : forall (i : ι), Algebra.{u1, u4} R (A₂ i) _inst_1 (_inst_3 i)] (e : forall (i : ι), AlgEquiv.{u1, u3, u4} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i)), Eq.{max (succ (max u2 u4)) (succ (max u2 u3))} (AlgEquiv.{u1, max u2 u4, max u2 u3} R (forall (i : ι), A₂ i) (forall (i : ι), A₁ i) _inst_1 (Pi.semiring.{u2, u4} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.semiring.{u2, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u2, u4, u1} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i))) (AlgEquiv.symm.{u1, max u2 u3, max u2 u4} R (forall (i : ι), A₁ i) (forall (i : ι), A₂ i) _inst_1 (Pi.semiring.{u2, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u2, u4} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u2, u4, u1} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i)) (AlgEquiv.piCongrRight.{u1, u2, u3, u4} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_5 i) e)) (AlgEquiv.piCongrRight.{u1, u2, u4, u3} R ι (fun (i : ι) => A₂ i) (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => AlgEquiv.symm.{u1, u3, u4} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i) (e i)))
but is expected to have type
  forall {R : Type.{u4}} {ι : Type.{u3}} {A₁ : ι -> Type.{u2}} {A₂ : ι -> Type.{u1}} [_inst_1 : CommSemiring.{u4} R] [_inst_2 : forall (i : ι), Semiring.{u2} (A₁ i)] [_inst_3 : forall (i : ι), Semiring.{u1} (A₂ i)] [_inst_4 : forall (i : ι), Algebra.{u4, u2} R (A₁ i) _inst_1 (_inst_2 i)] [_inst_5 : forall (i : ι), Algebra.{u4, u1} R (A₂ i) _inst_1 (_inst_3 i)] (e : forall (i : ι), AlgEquiv.{u4, u2, u1} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i)), Eq.{max (max (succ u3) (succ u2)) (succ u1)} (AlgEquiv.{u4, max u3 u1, max u3 u2} R (forall (i : ι), A₂ i) (forall (i : ι), A₁ i) _inst_1 (Pi.semiring.{u3, u1} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.semiring.{u3, u2} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.algebra.{u3, u1, u4} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u3, u2, u4} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i))) (AlgEquiv.symm.{u4, max u3 u2, max u3 u1} R (forall (i : ι), A₁ i) (forall (i : ι), A₂ i) _inst_1 (Pi.semiring.{u3, u2} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u3, u1} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.algebra.{u3, u2, u4} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u3, u1, u4} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i)) (AlgEquiv.piCongrRight.{u4, u3, u2, u1} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_5 i) e)) (AlgEquiv.piCongrRight.{u4, u3, u1, u2} R ι (fun (i : ι) => A₂ i) (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => AlgEquiv.symm.{u4, u2, u1} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i) (e i)))
Case conversion may be inaccurate. Consider using '#align alg_equiv.Pi_congr_right_symm AlgEquiv.piCongrRight_symmₓ'. -/
@[simp]
theorem piCongrRight_symm {R ι : Type _} {A₁ A₂ : ι → Type _} [CommSemiring R]
    [∀ i, Semiring (A₁ i)] [∀ i, Semiring (A₂ i)] [∀ i, Algebra R (A₁ i)] [∀ i, Algebra R (A₂ i)]
    (e : ∀ i, A₁ i ≃ₐ[R] A₂ i) : (piCongrRight e).symm = piCongrRight fun i => (e i).symm :=
  rfl
#align alg_equiv.Pi_congr_right_symm AlgEquiv.piCongrRight_symm

/- warning: alg_equiv.Pi_congr_right_trans -> AlgEquiv.piCongrRight_trans is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {ι : Type.{u2}} {A₁ : ι -> Type.{u3}} {A₂ : ι -> Type.{u4}} {A₃ : ι -> Type.{u5}} [_inst_1 : CommSemiring.{u1} R] [_inst_2 : forall (i : ι), Semiring.{u3} (A₁ i)] [_inst_3 : forall (i : ι), Semiring.{u4} (A₂ i)] [_inst_4 : forall (i : ι), Semiring.{u5} (A₃ i)] [_inst_5 : forall (i : ι), Algebra.{u1, u3} R (A₁ i) _inst_1 (_inst_2 i)] [_inst_6 : forall (i : ι), Algebra.{u1, u4} R (A₂ i) _inst_1 (_inst_3 i)] [_inst_7 : forall (i : ι), Algebra.{u1, u5} R (A₃ i) _inst_1 (_inst_4 i)] (e₁ : forall (i : ι), AlgEquiv.{u1, u3, u4} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_5 i) (_inst_6 i)) (e₂ : forall (i : ι), AlgEquiv.{u1, u4, u5} R (A₂ i) (A₃ i) _inst_1 (_inst_3 i) (_inst_4 i) (_inst_6 i) (_inst_7 i)), Eq.{max (succ (max u2 u3)) (succ (max u2 u5))} (AlgEquiv.{u1, max u2 u3, max u2 u5} R (forall (i : ι), A₁ i) (forall (i : ι), A₃ i) _inst_1 (Pi.semiring.{u2, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u2, u5} ι (fun (i : ι) => A₃ i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u2, u5, u1} ι R (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_7 i))) (AlgEquiv.trans.{u1, max u2 u3, max u2 u4, max u2 u5} R (forall (i : ι), A₁ i) (forall (i : ι), A₂ i) (forall (i : ι), A₃ i) _inst_1 (Pi.semiring.{u2, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u2, u4} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.semiring.{u2, u5} ι (fun (i : ι) => A₃ i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u2, u3, u1} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u2, u4, u1} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_6 i)) (Pi.algebra.{u2, u5, u1} ι R (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_7 i)) (AlgEquiv.piCongrRight.{u1, u2, u3, u4} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_6 i) e₁) (AlgEquiv.piCongrRight.{u1, u2, u4, u5} R ι (fun (i : ι) => A₂ i) (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_6 i) (fun (i : ι) => _inst_7 i) e₂)) (AlgEquiv.piCongrRight.{u1, u2, u3, u5} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_7 i) (fun (i : ι) => AlgEquiv.trans.{u1, u3, u4, u5} R (A₁ i) (A₂ i) (A₃ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i) (_inst_6 i) (_inst_7 i) (e₁ i) (e₂ i)))
but is expected to have type
  forall {R : Type.{u5}} {ι : Type.{u4}} {A₁ : ι -> Type.{u3}} {A₂ : ι -> Type.{u2}} {A₃ : ι -> Type.{u1}} [_inst_1 : CommSemiring.{u5} R] [_inst_2 : forall (i : ι), Semiring.{u3} (A₁ i)] [_inst_3 : forall (i : ι), Semiring.{u2} (A₂ i)] [_inst_4 : forall (i : ι), Semiring.{u1} (A₃ i)] [_inst_5 : forall (i : ι), Algebra.{u5, u3} R (A₁ i) _inst_1 (_inst_2 i)] [_inst_6 : forall (i : ι), Algebra.{u5, u2} R (A₂ i) _inst_1 (_inst_3 i)] [_inst_7 : forall (i : ι), Algebra.{u5, u1} R (A₃ i) _inst_1 (_inst_4 i)] (e₁ : forall (i : ι), AlgEquiv.{u5, u3, u2} R (A₁ i) (A₂ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_5 i) (_inst_6 i)) (e₂ : forall (i : ι), AlgEquiv.{u5, u2, u1} R (A₂ i) (A₃ i) _inst_1 (_inst_3 i) (_inst_4 i) (_inst_6 i) (_inst_7 i)), Eq.{max (max (succ u4) (succ u3)) (succ u1)} (AlgEquiv.{u5, max u4 u3, max u4 u1} R (forall (i : ι), A₁ i) (forall (i : ι), A₃ i) _inst_1 (Pi.semiring.{u4, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u4, u1} ι (fun (i : ι) => A₃ i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u4, u3, u5} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u4, u1, u5} ι R (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_7 i))) (AlgEquiv.trans.{u5, max u4 u3, max u4 u2, max u4 u1} R (forall (i : ι), A₁ i) (forall (i : ι), A₂ i) (forall (i : ι), A₃ i) _inst_1 (Pi.semiring.{u4, u3} ι (fun (i : ι) => A₁ i) (fun (i : ι) => _inst_2 i)) (Pi.semiring.{u4, u2} ι (fun (i : ι) => A₂ i) (fun (i : ι) => _inst_3 i)) (Pi.semiring.{u4, u1} ι (fun (i : ι) => A₃ i) (fun (i : ι) => _inst_4 i)) (Pi.algebra.{u4, u3, u5} ι R (fun (i : ι) => A₁ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_5 i)) (Pi.algebra.{u4, u2, u5} ι R (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_6 i)) (Pi.algebra.{u4, u1, u5} ι R (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_7 i)) (AlgEquiv.piCongrRight.{u5, u4, u3, u2} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₂ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_6 i) e₁) (AlgEquiv.piCongrRight.{u5, u4, u2, u1} R ι (fun (i : ι) => A₂ i) (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_3 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_6 i) (fun (i : ι) => _inst_7 i) e₂)) (AlgEquiv.piCongrRight.{u5, u4, u3, u1} R ι (fun (i : ι) => A₁ i) (fun (i : ι) => A₃ i) _inst_1 (fun (i : ι) => _inst_2 i) (fun (i : ι) => _inst_4 i) (fun (i : ι) => _inst_5 i) (fun (i : ι) => _inst_7 i) (fun (i : ι) => AlgEquiv.trans.{u5, u3, u2, u1} R (A₁ i) (A₂ i) (A₃ i) _inst_1 (_inst_2 i) (_inst_3 i) (_inst_4 i) (_inst_5 i) (_inst_6 i) (_inst_7 i) (e₁ i) (e₂ i)))
Case conversion may be inaccurate. Consider using '#align alg_equiv.Pi_congr_right_trans AlgEquiv.piCongrRight_transₓ'. -/
@[simp]
theorem piCongrRight_trans {R ι : Type _} {A₁ A₂ A₃ : ι → Type _} [CommSemiring R]
    [∀ i, Semiring (A₁ i)] [∀ i, Semiring (A₂ i)] [∀ i, Semiring (A₃ i)] [∀ i, Algebra R (A₁ i)]
    [∀ i, Algebra R (A₂ i)] [∀ i, Algebra R (A₃ i)] (e₁ : ∀ i, A₁ i ≃ₐ[R] A₂ i)
    (e₂ : ∀ i, A₂ i ≃ₐ[R] A₃ i) :
    (piCongrRight e₁).trans (piCongrRight e₂) = piCongrRight fun i => (e₁ i).trans (e₂ i) :=
  rfl
#align alg_equiv.Pi_congr_right_trans AlgEquiv.piCongrRight_trans

end AlgEquiv


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.products.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
The hom functor, sending `(X, Y)` to the type `X ⟶ Y`.
-/

namespace category_theory.functor

/-- `functor.hom` is the hom-pairing, sending (X,Y) to X → Y, contravariant in X and covariant in Y. -/
def hom (C : Type u) [category C] : Cᵒᵖ × C ⥤ Type v :=
  mk (fun (p : Cᵒᵖ × C) => opposite.unop (prod.fst p) ⟶ prod.snd p)
    fun (X Y : Cᵒᵖ × C) (f : X ⟶ Y) (h : opposite.unop (prod.fst X) ⟶ prod.snd X) =>
      has_hom.hom.unop (prod.fst f) ≫ h ≫ prod.snd f

@[simp] theorem hom_obj (C : Type u) [category C] (X : Cᵒᵖ × C) :
    obj (hom C) X = (opposite.unop (prod.fst X) ⟶ prod.snd X) :=
  rfl

@[simp] theorem hom_pairing_map (C : Type u) [category C] {X : Cᵒᵖ × C} {Y : Cᵒᵖ × C} (f : X ⟶ Y) :
    map (hom C) f = fun (h : obj (hom C) X) => has_hom.hom.unop (prod.fst f) ≫ h ≫ prod.snd f :=
  rfl

end Mathlib


import pseudo_normed_group.CLC
import prop_92.concrete

noncomputable theory

open_locale nnreal

namespace CLCFP

variables (r r' : ℝ≥0) (V : SemiNormedGroup) [normed_with_aut r V] (c c₁ c₂ : ℝ≥0) (n : ℕ)
variables [fact (0 < r)] [fact (0 < r')] [fact (r' ≤ 1)] [fact (c₂ ≤ r' * c₁)] [fact (c₂ ≤ c₁)]
variables (M : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ)

include r

def T_inv_sub_Tinv :=
CLCFP.res V r' c₁ c₂ n ≫ CLCFP.T_inv r V r' c₂ n - CLCFP.Tinv V r' c₁ c₂ n

lemma norm_T_inv_sub_Tinv_le : ∥(T_inv_sub_Tinv r r' V c₁ c₂ n).app M∥ ≤ (1 + r⁻¹) :=
begin
  rw [T_inv_sub_Tinv, sub_eq_neg_add],
  refine le_trans (norm_add_le _ _) (add_le_add _ _),
  { rw [category_theory.nat_trans.app_neg, norm_neg],
    refine le_trans (normed_add_group_hom.norm_completion _).le _,
    exact normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1
      (SemiNormedGroup.LocallyConstant_obj_map_norm_noninc _ _ _ _) },
  { refine normed_add_group_hom.norm_comp_le_of_le' 1 r⁻¹ r⁻¹ (mul_one _).symm _ _,
    { exact CLC.norm_T_inv_le r V _ },
    { exact normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1
      (res_norm_noninc V r' c₁ c₂ n M) } },
end

variables {V c n M}

open profinitely_filtered_pseudo_normed_group profinitely_filtered_pseudo_normed_group_with_Tinv
  comphaus_filtered_pseudo_normed_group
open locally_constant category_theory

/-- 9.2 of Analytic.pdf -/
lemma T_inv_sub_Tinv_exists_preimage [hr1 : fact (r < 1)]
  (f : (CLCFP V r' (r' * c) n).obj M) (ε : ℝ≥0) (hε : 0 < ε) :
  ∃ g : (CLCFP V r' c n).obj M, (T_inv_sub_Tinv r r' V c (r' * c) n).app M g = f ∧
    (∥g∥ ≤ (r / (1 - r) + ε) * ∥f∥) :=
begin
  obtain ⟨g, hg1, hg2⟩ := @concrete_92 _ _ _ _ _ _ _ _
    ((FiltrationPow.cast_le _ _ _ _).app _) (embedding_cast_le _ _)
    ((FiltrationPow.Tinv r' (r' * c) c _).app _) r V _ (Tinv₀_continuous _ _) hr1 _ f ε hε,
  refine ⟨g, _, hg2⟩,
  rw ← hg1, clear hg1,
  dsimp only [T_inv_sub_Tinv, CLC, T_inv, CLC.T_inv, Tinv, CLCFP.res,
    whisker_left_app, nat_trans.app_sub, nat_trans.comp_app, whisker_right_app,
    normed_add_group_hom.sub_apply, whisker_right_app, functor.comp_map],
  rw [← SemiNormedGroup.Completion.map_comp,
      ← normed_add_group_hom.sub_apply, ← functor.map_sub],
  refl
end

variables (V c n M)

lemma T_inv_sub_Tinv_surjective [fact (r < 1)] :
  function.surjective ((T_inv_sub_Tinv r r' V c (r' * c) n).app M) :=
begin
  intros f,
  obtain ⟨g, hg, -⟩ := T_inv_sub_Tinv_exists_preimage r r' f 1 zero_lt_one,
  exact ⟨g, hg⟩
end

end CLCFP


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/

import data.int.cast            -- used by clients
import tactic.norm_cast

/-!
# A tactic to shift `ℕ` goals to `ℤ`

It is often easier to work in `ℤ`, where subtraction is well behaved, than in `ℕ` where it isn't.
`zify` is a tactic that casts goals and hypotheses about natural numbers to ones about integers.
It makes use of `push_cast`, part of the `norm_cast` family, to simplify these goals.

## Implementation notes

`zify` is extensible, using the attribute `@[zify]` to label lemmas used for moving propositions
from `ℕ` to `ℤ`.
`zify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pz (a₁ : ℤ) ... (aₙ : ℤ) ↔ Pn a₁ ... aₙ`.
For example, `int.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `zify` lemma.

`zify` is very nearly just `simp only with zify push_cast`. There are a few minor differences:
* `zify` lemmas are used in the opposite order of the standard simp form.
  E.g. we will rewrite with `int.coe_nat_le_coe_nat_iff` from right to left.
* `zify` should fail if no `zify` lemma applies (i.e. it was unable to shift any proposition to ℤ).
  However, once this succeeds, it does not necessarily need to rewrite with any `push_cast` rules.
-/

open tactic

namespace zify

/--
The `zify` attribute is used by the `zify` tactic. It applies to lemmas that shift propositions
between `nat` and `int`.

`zify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pz (a₁ : ℤ) ... (aₙ : ℤ) ↔ Pn a₁ ... aₙ`.
For example, `int.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `zify` lemma.
-/
@[user_attribute]
meta def zify_attr : user_attribute simp_lemmas unit :=
{ name := `zify,
  descr := "Used to tag lemmas for use in the `zify` tactic",
  cache_cfg :=
    { mk_cache :=
        λ ns, mmap (λ n, do c ← mk_const n, return (c, tt)) ns >>= simp_lemmas.mk.append_with_symm,
      dependencies := [] } }

/--
Given an expression `e`, `lift_to_z e` looks for subterms of `e` that are propositions "about"
natural numbers and change them to propositions about integers.

Returns an expression `e'` and a proof that `e = e'`.

Includes `ge_iff_le` and `gt_iff_lt` in the simp set. These can't be tagged with `zify` as we
want to use them in the "forward", not "backward", direction.
-/
meta def lift_to_z (e : expr) : tactic (expr × expr) :=
do sl ← zify_attr.get_cache,
   sl ← sl.add_simp `ge_iff_le, sl ← sl.add_simp `gt_iff_lt,
   (e', prf, _) ← simplify sl [] e,
   return (e', prf)

attribute [zify] int.coe_nat_le_coe_nat_iff int.coe_nat_lt_coe_nat_iff int.coe_nat_eq_coe_nat_iff

end zify

@[zify] lemma int.coe_nat_ne_coe_nat_iff (a b : ℕ) : (a : ℤ) ≠ b ↔ a ≠ b :=
by simp

/--
`zify extra_lems e` is used to shift propositions in `e` from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.

The list of extra lemmas is used in the `push_cast` step.

Returns an expression `e'` and a proof that `e = e'`.-/
meta def tactic.zify (extra_lems : list simp_arg_type) : expr → tactic (expr × expr) := λ z,
do (z1, p1) ← zify.lift_to_z z <|> fail "failed to find an applicable zify lemma",
   (z2, p2) ← norm_cast.derive_push_cast extra_lems z1,
   prod.mk z2 <$> mk_eq_trans p1 p2

/--
A variant of `tactic.zify` that takes `h`, a proof of a proposition about natural numbers,
and returns a proof of the zified version of that propositon.
-/
meta def tactic.zify_proof (extra_lems : list simp_arg_type) (h : expr) : tactic expr :=
do (_, pf) ← infer_type h >>= tactic.zify extra_lems,
   mk_eq_mp pf h

section

setup_tactic_parser

/--
The `zify` tactic is used to shift propositions from `ℕ` to `ℤ`.
This is often useful since `ℤ` has well-behaved subtraction.

```lean
example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) : c < a + 3*b :=
begin
  zify,
  zify at h,
  /-
  h : ¬↑x * ↑y * ↑z < 0
  ⊢ ↑c < ↑a + 3 * ↑b
  -/
end
```

`zify` can be given extra lemmas to use in simplification. This is especially useful in the
presence of nat subtraction: passing `≤` arguments will allow `push_cast` to do more work.
```
example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : false :=
begin
  zify [hab] at h,
  /- h : ↑a - ↑b < ↑c -/
end
```

`zify` makes use of the `@[zify]` attribute to move propositions,
and the `push_cast` tactic to simplify the `ℤ`-valued expressions.

`zify` is in some sense dual to the `lift` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
meta def tactic.interactive.zify (sl : parse simp_arg_list) (l : parse location) : tactic unit :=
do locs ← l.get_locals,
replace_at (tactic.zify sl) locs l.include_goal >>= guardb

end

add_tactic_doc
{ name := "zify",
  category := doc_category.attr,
  decl_names := [`zify.zify_attr],
  tags := ["coercions", "transport"] }

add_tactic_doc
{ name := "zify",
  category := doc_category.tactic,
  decl_names := [`tactic.interactive.zify],
  tags := ["coercions", "transport"] }


theorem ex1 {α : Sort u} {a b : α} (h : a ≅ b) : a = b :=
  match h with
  | HEq.refl _ => rfl

theorem ex2 {α : Sort u2} {a : α} {motive : {β : Sort u2} → β → Sort u1} (m : motive a) {β : Sort u2} {b : β} (h : a ≅ b) : motive b :=
  match h, m with
  | HEq.refl _, m => m

theorem ex3 {α : Sort u} {a : α} {p : α → Sort v} {b : α} (h₁ : a ≅ b) (h₂ : p a) : p b :=
  match h₁, h₂ with
  | HEq.refl _, h₂ => h₂

theorem ex4 {α β : Sort u} {a : α} {b : β} (h : a ≅ b) : b ≅ a :=
  match h with
  | HEq.refl _ => HEq.refl _

theorem ex5 {α : Sort u} {a a' : α} (h : a = a') : a ≅ a' :=
  match h with
  | rfl => HEq.refl _

theorem ex6 {α β : Sort u} (h : α = β) (a : α) : cast h a ≅ a :=
  match h with
  | rfl => HEq.refl _

theorem ex7 {α β σ : Sort u} {a : α} {b : β} {c : σ} (h₁ : a ≅ b) (h₂ : b ≅ c) : a ≅ c :=
  match h₁, h₂ with
  | HEq.refl _, HEq.refl _ => HEq.refl _


import data.vect.basic
import tactic.csimp

universes u v

-- Tree of operators
inductive optree (op : ℕ → Type u) (α : Type v) : Type.{max u v}
| varleaf {} (a : α) : optree
| opnode {n : ℕ} (f : op n) : vect optree n → optree

notation `⦃`:1024 f ` | ` t:(foldr `, ` (e r, vect.cons e r) vect.nil `⦄`) := optree.opnode f t

prefix `◎`:100 := optree.varleaf

namespace optree

/-**********************************-
 - Well-founded recursion on optree
 -**********************************-/

-- Check if the second argument is a parent of the first
definition is_child {op : ℕ → Type*} {α : Type*} : optree op α → optree op α → Prop
| t (varleaf _) := false
| t (opnode f sub) := sub.mem t

-- Count the number of nods
mutual definition nnodes, nnodes_vec
with nnodes : Π{op : ℕ → Type*}, Π{α : Type*}, optree op α → ℕ
| _ _ (varleaf _) := 0
| _ _ (opnode f vect.nil) := 1
| _ _ (opnode f (vect.cons x xs)) := nnodes x + nnodes_vec xs + 1
with nnodes_vec : Π{op : ℕ → Type*}, Π {α : Type*}, Π {n : ℕ}, vect (optree op α) n → ℕ
| _ _ _ vect.nil := 0
| _ _ _ (vect.cons x xs) := nnodes x + nnodes_vec xs

-- Well-founded recursion based on the number of nodes
definition nnodes_wf {op : ℕ → Type*} {α : Type*} :=
  measure_wf (@nnodes op α)

lemma nnodes_vec_cons {op : ℕ → Type _} {α : Type _} (f : optree op α) {n : ℕ} {fs : vect (optree op α) n} : nnodes_vec (f∺fs) = nnodes f + nnodes_vec fs :=
begin
  unfold nnodes_vec
end

-- Auxiliary function to define nnodes_child
theorem nnodes_vec_mem {op : ℕ → Type*} {α : Type*} (tm : optree op α) {n : ℕ} (ts : vect (optree op α) n) : ts.mem tm → nnodes tm ≤ nnodes_vec ts:=
  begin
    induction ts with n ts_head ts_tail h_ind,
    case vect.nil {
      exact false.elim
    },
    case vect.cons {
      dsimp [vect.mem,nnodes_vec],
      rw [nnodes_vec_cons],
      intros h; cases h,
      case or.inl {
        rw [h],
        exact nat.le_add_right _ _
      },
      case or.inr {
        by calc
          tm.nnodes
              ≤ nnodes_vec ts_tail : h_ind h
          ... ≤ ts_head.nnodes + nnodes_vec ts_tail : nat.le_add_left _ _
      }
    }
  end

-- If a tree is a child of another, then the number of nodes decreases
theorem nnodes_child {op : ℕ → Type*} {α : Type*} (tc tp : optree op α) : is_child tc tp → nnodes tc < nnodes tp :=
  begin
    intros hchild,
    cases tp with _ n f ts,
    case optree.varleaf { exact false.elim hchild },
    unfold is_child at hchild,
    cases ts with n t ts,
    case vect.nil {
      exact false.elim hchild
    },
    case vect.cons {
      unfold nnodes,
      unfold vect.mem at hchild,
      cases hchild,
      case or.inl {
        rw [hchild],
        by calc
          tc.nnodes
              ≤ tc.nnodes + nnodes_vec ts : nat.le_add_right _ _
          ... < tc.nnodes + nnodes_vec ts + 1
                : nat.lt_add_of_pos_right (nat.succ_pos 0)
      },
      case or.inr {
        by calc
          tc.nnodes
              ≤ nnodes_vec ts : nnodes_vec_mem tc ts hchild
          ... ≤ t.nnodes + nnodes_vec ts : nat.le_add_left _ _
          ... < t.nnodes + nnodes_vec ts + 1
                : nat.lt_add_of_pos_right (nat.succ_pos 0)
      }
    }
  end

-- Accessibility for optree
theorem accessible {op : ℕ → Type*} {α : Type*}: ∀ {t : optree op α}, acc is_child t :=
  begin
    intro t,
    apply nnodes_wf.fix,
    intros x h_ind,
    clear t,
    dsimp [measure, inv_image] at h_ind,
    apply acc.intro,
    intros y hchild,
    exact h_ind y (nnodes_child y x hchild)
  end

-- Well-founded recursion based on the parent-children relation.
definition children_wf {op : ℕ → Type*} {α : Type*} : well_founded (@is_child op α) :=
  well_founded.intro (@accessible op α)

/-************************-
 - Basic operations
 -************************-/
-- Mapping on variables
mutual definition map , map_aux {op : ℕ → Type*} {α : Type*} {β : Type*} (f : α → β)
with map : optree op α → optree op β
| (varleaf a) := varleaf (f a)
| (opnode g vect.nil) := opnode g vect.nil
| (opnode g (vect.cons x xs)) := opnode g (vect.cons (map x) (map_aux xs))
with map_aux : Π{n : ℕ}, vect (optree op α) n → vect (optree op β) n
| _ vect.nil := vect.nil
| _ (vect.cons x xs) := vect.cons (map x) (map_aux xs)

-- Join 2-fold trees
mutual definition join, join_aux {op : ℕ → Type*} {α : Type*}
with join : optree op (optree op α) → optree op α
| (varleaf t) := t
| (opnode g vect.nil) := opnode g vect.nil
| (opnode g (vect.cons x xs)) := opnode g (vect.cons (join x) (join_aux xs))
with join_aux : Π{n : ℕ}, vect (optree op (optree op α)) n → vect (optree op α) n
| _ vect.nil := vect.nil
| _ (vect.cons t ts) := vect.cons (join t) (join_aux ts)

-- Eliminator
mutual definition elim, elim_aux {op : ℕ → Type*} {α : Type*} {β : Type*} (act : Π {n : ℕ}, op n → vect β n → β) (c : α → β)
with elim : optree op α → β
| (varleaf a) := c a
| (opnode f vect.nil) := act f vect.nil
| (opnode f (vect.cons t ts)) := act f (vect.cons (elim t) (elim_aux ts))
with elim_aux : Π{n : ℕ}, vect (optree op α) n → vect β n
| _ vect.nil := vect.nil
| _ (vect.cons t ts) := vect.cons (elim t) (elim_aux ts)

-- Unzipping pairs of variables into the same shape of trees
/-
definition unzip {op : ℕ → Type.{u}} {α : Type.{v}} {β : Type.{w}} : optree op (α×β) → optree op α × optree op β :=
  λ t, t.elim
    (λ _ f xs, (opnode f xs.unzip.fst, opnode f xs.unzip.snd))
    (λ (x : α×β), (optree.varleaf x.fst, optree.varleaf x.snd))
-/
mutual definition unzip, unzip_aux {op : ℕ → Type*} {α : Type*} {β : Type*}
with unzip : optree op (α×β) → optree op α × optree op β
| (varleaf t) := (varleaf t.fst, varleaf t.snd)
| (opnode f vect.nil) := (opnode f vect.nil, opnode f vect.nil)
| (opnode f (vect.cons t ts)) := (opnode f (vect.cons (unzip t).fst (unzip_aux ts).fst), opnode f (vect.cons (unzip t).snd (unzip_aux ts).snd))
with unzip_aux : Π{n : ℕ}, vect (optree op (α×β)) n → vect (optree op α) n × vect (optree op β) n
| _ vect.nil := (vect.nil, vect.nil)
| _ (vect.cons t ts) := (vect.cons (unzip t).fst (unzip_aux ts).fst, vect.cons (unzip t).snd (unzip_aux ts).snd)

/-***********************-
 - Basic properties
 -***********************-/
-- "Non-homogeneous" injectivity of opnode
theorem opnode_inj_nh {op : ℕ → Type*} {α : Type*} : Π {n : ℕ} {f1 f2 : op n} {t1 t2 : vect (optree op α) n}, opnode f1 t1 = opnode f2 t2 → f1=f2 ∧ t1=t2 :=
  begin
    intros n f1 f2 t1 t2 h,
    cases (opnode.inj h).right.left,
    cases (opnode.inj h).right.right,
    split; refl
  end

-- Differenti constructors produce different terms
theorem varleaf_neq_opnode {op : ℕ → Type*} {α : Type*} : ∀ {a : α} {n : ℕ} {f : op n} {t : vect (optree op α) n}, varleaf a ≠ opnode f t :=
  begin
    intros _ _ _ _ h,
    cases h
  end

-- Functoriality
mutual theorem map_comp, map_aux_comp {op : ℕ → Type*} {α : Type*} {β : Type*} {γ : Type*} {g : β → γ} {f : α → β}
with map_comp : ∀ (t : optree op α), map (g∘f) t = map g (map f t)
| (varleaf _) := by unfold map; refl
| (opnode _ vect.nil) := by unfold map
| (opnode _ (vect.cons t ts)) :=
  begin
    unfold map,
    rw [map_comp t, map_aux_comp ts]
  end
with map_aux_comp : ∀ {n : ℕ} (ts : vect (optree op α) n), map_aux (g∘f) ts = map_aux g (map_aux f ts)
| _ vect.nil := by unfold map_aux; refl
| _ (vect.cons t ts) :=
  begin
    unfold map_aux,
    rw [map_comp t, map_aux_comp ts]
  end

-- Left unitalities of join; i.e. eT = id
theorem join_unit_outer {op : ℕ → Type*} {α : Type*} : ∀ {t : optree op α}, join (varleaf t) = t :=
  λ t, by unfold join

-- Right unitality of join; i.e. Te = id
mutual theorem join_unit_inner, join_aux_unit_inner {op : ℕ → Type*} {α : Type*}
with join_unit_inner : ∀ {t : optree op α}, join (map optree.varleaf t) = t
| (varleaf a) := by unfold map; unfold join
| (opnode f vect.nil) := by unfold map; unfold join
| (opnode f (vect.cons t ts)) :=
  begin
    unfold map; unfold join,
    rw[join_unit_inner, join_aux_unit_inner],
    try {split; refl}
  end
with join_aux_unit_inner : ∀ {n : ℕ} {ts : vect (optree op α) n}, join_aux (map_aux optree.varleaf ts) = ts
| _ vect.nil := by unfold map_aux; unfold join_aux; refl
| _ (vect.cons t ts) :=
  begin
    unfold map_aux; unfold join_aux,
    apply congr (congr_arg vect.cons _) _,
    show (map varleaf t).join = t,
      from join_unit_inner,
    show join_aux (map_aux varleaf ts) = ts,
      from join_aux_unit_inner
  end

-- Associativity of join
mutual theorem join_assoc, join_aux_assoc {op : ℕ → Type*} {α : Type*}
with join_assoc : ∀ {t : optree op (optree op (optree op α))}, join (join t) = join (map join t)
| (varleaf _) := by unfold map; unfold join
| (opnode _ vect.nil) := by unfold map; unfold join; try {split; refl}
| (opnode _ (vect.cons t ts)) :=
  begin
    unfold map; unfold join,
    rw [join_assoc, join_aux_assoc],
    try {split; refl}
  end
with join_aux_assoc : ∀ {n : ℕ} {ts : vect (optree op (optree op (optree op α))) n}, join_aux (join_aux ts) = join_aux (map_aux join ts)
| _ vect.nil := by unfold map_aux; unfold join_aux; refl
| _ (vect.cons t ts) :=
  begin
    unfold map_aux; unfold join_aux,
    refine congr (congr_arg vect.cons _) _,
    show join (join t) = join (map join t),
      from join_assoc,
    show join_aux (join_aux ts) = join_aux (map_aux join ts),
      from join_aux_assoc
  end

-- elim_aux is equivalent to map elim
theorem elim_aux_map {op : ℕ → Type*} {α β : Type*} {act : Π {n : ℕ}, op n → vect β n → β} {c : α → β} : ∀ {n : ℕ} {ts : vect (optree op α) n}, elim_aux @act c ts = vect.map (elim @act c) ts
| _ vect.nil := by unfold elim_aux; unfold vect.map
| _ (vect.cons t ts) :=
  begin
    unfold elim_aux; unfold vect.map,
    rw [elim_aux_map]
  end

-- The eliminator at varleaf
theorem elim_varleaf {op : ℕ → Type*} {α β : Type*} {act : Π {n : ℕ}, op n → vect β n → β} {c : α → β} : ∀ {a : α}, elim @act c (varleaf a) = c a :=
  by intros; unfold elim; refl

-- The eliminator at opnode
theorem elim_opnode {op : ℕ → Type*} {α : Type*} {β : Type*} {act : Π {n : ℕ}, op n → vect β n → β} {c : α → β} : ∀ {n : ℕ} {f : op n} {ts : vect (optree op α) n}, elim @act c (opnode f ts) = act f (vect.map (elim @act c) ts)
| _ f vect.nil := by unfold elim; unfold vect.map
| _ f (vect.cons t ts) :=
  begin
    unfold elim; unfold vect.map,
    rw [elim_aux_map]
  end

--- `elim` followed by a function application equals `elim`.
mutual theorem elim_funap, elim_aux_funap {op : ℕ → Type*} {α β γ: Type*} {actb : Π {n : ℕ}, op n → vect β n → β} {actc : Π {n : ℕ}, op n → vect γ n → γ} {c : α → β} {f : β → γ} (hact : ∀ {n} (μ : op n) (bs : vect β n), f (actb μ bs) = actc μ (bs.map f))
with elim_funap : ∀ {t : optree op α}, f (t.elim @actb c) = t.elim @actc (f ∘ c)
| (varleaf x) := by unfold elim
| (opnode μ ⁅⁆) := by unfold elim; rw [hact]; dunfold vect.map; refl
| (opnode μ (t ∺ ts)) :=
  begin
    unfold elim,
    rw [hact],
    unfold vect.map,
    rw [elim_funap, elim_aux_funap]
  end
with elim_aux_funap : ∀ {n : ℕ} {ts : vect (optree op α) n}, vect.map f (elim_aux @actb c ts) = elim_aux @actc (f ∘ c) ts
| _ ⁅⁆ := by unfold elim_aux; unfold vect.map
| _ (t ∺ ts) := by unfold elim_aux; unfold vect.map; rw [elim_funap, elim_aux_funap]

-- The eliminator respects function extensionality
mutual theorem elim_funext, elim_aux_funext {op : ℕ → Type*} {α : Type*} {β : Type*} {act₁ act₂ : Π {n : ℕ}, op n → vect β n → β} {c₁ c₂ : α → β} (hact : ∀ {n : ℕ} {f : op n} {bs : vect β n}, act₁ f bs = act₂ f bs) (hc : ∀ {a : α}, c₁ a = c₂ a)
with elim_funext : ∀ {t : optree op α}, elim @act₁ c₁ t = elim @act₂ c₂ t
| (varleaf x) := by unfold elim; exact hc
| (opnode f vect.nil) := by unfold elim; exact hact
| (opnode f (vect.cons t ts)) :=
  by unfold elim; rw [elim_funext,elim_aux_funext, hact]
with elim_aux_funext : ∀ {n : ℕ} {ts : vect (optree op α) n}, elim_aux @act₁ c₁ ts = elim_aux @act₂ c₂ ts
| _ vect.nil := by unfold elim_aux
| _ (vect.cons t ts) :=
  begin
    unfold elim_aux,
    rw [elim_funext,elim_aux_funext],
  end

-- Elimination into pairs produces pairs of elimination
mutual theorem elim_prod, elim_aux_prod {op : ℕ → Type*} {α : Type*} {β₁ : Type _} {β₂ : Type _} {act₁ : Π {n : ℕ}, op n → vect β₁ n → β₁} {act₂ : Π {n : ℕ}, op n → vect β₂ n → β₂} (c : α → β₁×β₂)
with elim_prod : ∀ {t : optree op α}, t.elim (λ _ f, prod.map (act₁ f) (act₂ f) ∘ vect.unzip) c = (t.elim @act₁ (prod.fst∘c), t.elim @act₂ (prod.snd∘ c))
| (varleaf x) := by unfold elim; unfold function.comp; rw [prod.mk.eta]
| (opnode f vect.nil) := by unfold elim; unfold function.comp; unfold vect.unzip; unfold prod.map
| (opnode f (vect.cons t ts)) :=
  begin
    csimp [elim, vect.unzip, prod.map],
    rw [elim_prod, elim_aux_prod]
  end
with elim_aux_prod : ∀ {n : ℕ} {ts : vect (optree op α) n}, (@elim_aux op α (β₁×β₂) (λ _ f, prod.map (act₁ f) (act₂ f) ∘ vect.unzip) c n ts).unzip = (@elim_aux op α β₁ @act₁ (prod.fst∘c) n ts,@elim_aux op α β₂ @act₂ (prod.snd∘ c) n ts)
| _ vect.nil := by csimp [elim_aux, vect.unzip]
| _ (vect.cons t ts) :=
  begin
    csimp [elim_aux, vect.unzip, prod.map],
    rw [elim_prod, elim_aux_prod]
  end

-- theorem elim_ext {op : ℕ → Type.{u}} {α : Type.{v}} {β : Type _} {B : β → Type _} {act : Π {n : ℕ}, op n → vect (Π b, B b) n → Π b, B b} {c : α → Π b, B b} := sorry

-- Elimination into pi-types produces pi of elimination
mutual theorem elim_pi, elim_aux_pi {op : ℕ → Type*} {α : Type*} {β : Type _} {B : β → Type _} {act : Π (b : β) {n : ℕ}, op n → vect (B b) n → B b} {c : Π b, α → B b}
with elim_pi : ∀ {t : optree op α} {b : β}, t.elim (λ k f ts, λ (b : β), @act b k f (ts.unzip_fam b)) (λ a b, c b a) b = t.elim (@act b) (c b)
| (varleaf x) b := by unfold elim
| (opnode f vect.nil) b := by unfold elim; unfold vect.unzip_fam
| (opnode f (vect.cons t ts)) b :=
  by unfold elim; unfold vect.unzip_fam; rw [elim_pi, elim_aux_pi]
with elim_aux_pi : ∀ {n : ℕ} {ts : vect (optree op α) n} {b : β}, (elim_aux (λ k f ts, λ (b : β), @act b k f (ts.unzip_fam b)) (λ a b, c b a) ts).unzip_fam b = elim_aux (@act b) (c b) ts
| _ vect.nil b := by unfold elim_aux; refl
| _ (vect.cons t ts) b :=
  begin
    unfold elim_aux; unfold vect.unzip_fam,
    apply congr; try {apply congr}; try {refl},
    rw [elim_pi],
    rw [elim_aux_pi]
  end

mutual theorem elim_subtype, elim_aux_subtype {op : ℕ → Type*} {α : Type*} {β : Type _} {P : β → Prop} {act : Π {n : ℕ}, op n → vect β n → β} {hsub : ∀ {n : ℕ} (f : op n) (ts : vect (subtype P) n), P (act f (vect.map subtype.val ts))} {c : α → subtype P}
with elim_subtype : ∀ {t : optree op α}, subtype.val (elim (λ n k (rs : vect (subtype P) n), ⟨@act n k (vect.map subtype.val rs), hsub k rs⟩) c t) = elim @act (subtype.val ∘ c) t
| (varleaf x) := by unfold elim
| (opnode f vect.nil) := by unfold elim; unfold vect.map
| (opnode f (vect.cons t ts)) :=
  begin
    unfold elim; unfold vect.map; unfold subtype.val,
    rw [elim_subtype, elim_aux_subtype]
  end
with elim_aux_subtype : ∀ {n : ℕ} {ts : vect (optree op α) n}, vect.map subtype.val (elim_aux (λ n k (rs : vect (subtype P) n), ⟨@act n k (vect.map subtype.val rs), hsub k rs⟩) c ts) = elim_aux @act (subtype.val ∘ c) ts
| _ vect.nil := by unfold elim_aux; refl
| _ (vect.cons t ts) :=
  begin
    unfold elim_aux; unfold vect.map,
    rw [elim_subtype, elim_aux_subtype],
    try {split; refl}
  end

-- unzip is an injective function.
mutual theorem unzip_inj, unzip_aux_inj {op : ℕ → Type*} {α : Type*} {β : Type*}
with unzip_inj : ∀ {t1 t2 : optree op (α×β)}, t1.unzip = t2.unzip → t1 = t2
| (varleaf x) (varleaf y) heq :=
  begin
    suffices : x=y, by rw [this],
    cases x,
    cases y,
    unfold unzip at heq,
    unfold prod.fst at heq; unfold prod.snd at heq,
    let h := prod.mk.inj heq,
    rw [varleaf.inj h.left, varleaf.inj h.right]
  end
| (varleaf x) (opnode g vect.nil) heq :=
  begin
    unfold unzip at heq,
    have : varleaf x.fst = opnode g vect.nil,
      from (prod.mk.inj heq).left,
    cases this
  end
| (varleaf x) (opnode g (vect.cons y ys)) heq :=
  begin
    unfold unzip at heq,
    have : varleaf x.fst = opnode g _,
      from (prod.mk.inj heq).left,
    cases this
  end
| (opnode f vect.nil) (varleaf y) heq :=
  begin
    unfold unzip at heq,
    have : opnode f _ = varleaf y.fst,
      from (prod.mk.inj heq).left,
    cases this
  end
| (opnode f (vect.cons x xs)) (varleaf y) heq :=
  begin
    unfold unzip at heq,
    have : opnode f _ = varleaf y.fst,
      from (prod.mk.inj heq).left,
    cases this
  end
| (opnode f vect.nil) (opnode g vect.nil) heq :=
  begin
    unfold unzip at heq,
    have : f = g,
      from (opnode_inj_nh (prod.mk.inj heq).left).left,
    rw [this]
  end
| (opnode f vect.nil) (opnode g (vect.cons y ys)) heq :=
  by unfold unzip at heq; cases heq
| (opnode f (vect.cons x xs)) (opnode g vect.nil) heq :=
  by unfold unzip at heq; cases heq
| (opnode f (vect.cons x xs)) (opnode g (vect.cons y ys)) heq :=
  begin
    unfold unzip at heq,
    cases (opnode.inj ((prod.mk.inj heq).left)).left,
    cases (opnode_inj_nh ((prod.mk.inj heq).left)).left,
    have h_head : x = y, {
      apply unzip_inj,
      cases x.unzip with x_fst x_snd,
      cases y.unzip with y_fst y_snd,
      have h_fst : x_fst = y_fst,
        from (vect.cons.inj ((opnode_inj_nh ((prod.mk.inj heq).left)).right)).left,
      have h_snd : x_snd = y_snd,
        from (vect.cons.inj ((opnode_inj_nh ((prod.mk.inj heq).right)).right)).left,
      rw [h_fst,h_snd]
    },
    have h_tail : xs = ys, {
      apply unzip_aux_inj,
      cases unzip_aux xs with xs_fst xs_snd,
      cases unzip_aux ys with ys_fst ys_snd,
      have h_fst : xs_fst = ys_fst,
        from (vect.cons.inj ((opnode_inj_nh ((prod.mk.inj heq).left)).right)).right,
      have h_snd : xs_snd = ys_snd,
        from (vect.cons.inj ((opnode_inj_nh ((prod.mk.inj heq).right)).right)).right,
      rw [h_fst,h_snd]
    },
    rw [h_head, h_tail]
  end
with unzip_aux_inj : ∀{n : ℕ} {ts1 ts2 : vect (optree op (α×β)) n}, unzip_aux ts1 = unzip_aux ts2 → ts1 = ts2
| _ vect.nil vect.nil heq := by trivial
| _ (vect.cons t1 ts1) (vect.cons t2 ts2) heq :=
  begin
    unfold unzip_aux at heq,
    let h1 := vect.cons.inj ((prod.mk.inj heq).left),
    let h2 := vect.cons.inj ((prod.mk.inj heq).right),
    have ht : t1 = t2, {
      apply unzip_inj,
      cases t1.unzip with t1_fst t1_snd,
      cases t2.unzip with t2_fst t2_snd,
      unfold prod.fst at h1 h2,
      unfold prod.snd at h1 h2,
      rw [h1.left,h2.left]
    },
    have hts : ts1 = ts2, {
      apply unzip_aux_inj,
      cases unzip_aux ts1 with ts1_fst ts1_snd,
      cases unzip_aux ts2 with ts2_fst ts2_snd,
      dsimp [prod.fst,prod.snd] at h1 h2,
      rw [h1.right,h2.right]
    },
    rw [ht,hts]
  end

end optree


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

! This file was ported from Lean 3 source module category_theory.limits.constructions.binary_products
! leanprover-community/mathlib commit 3424a5932a77dcec2c177ce7d805acace6149299
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.Terminal
import Mathlib.CategoryTheory.Limits.Shapes.Pullbacks
import Mathlib.CategoryTheory.Limits.Shapes.BinaryProducts
import Mathlib.CategoryTheory.Limits.Preserves.Shapes.Pullbacks
import Mathlib.CategoryTheory.Limits.Preserves.Shapes.Terminal

/-!
# Constructing binary product from pullbacks and terminal object.

The product is the pullback over the terminal objects. In particular, if a category
has pullbacks and a terminal object, then it has binary products.

We also provide the dual.
-/

universe v v' u u'

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

variable {C : Type u} [Category.{v} C] {D : Type u'} [Category.{v'} D] (F : C ⥤ D)

/-- If a span is the pullback span over the terminal object, then it is a binary product. -/
def isBinaryProductOfIsTerminalIsPullback (F : Discrete WalkingPair ⥤ C) (c : Cone F) {X : C}
    (hX : IsTerminal X) (f : F.obj ⟨WalkingPair.left⟩ ⟶ X) (g : F.obj ⟨WalkingPair.right⟩ ⟶ X)
    (hc : IsLimit
      (PullbackCone.mk (c.π.app ⟨WalkingPair.left⟩) (c.π.app ⟨WalkingPair.right⟩ : _) <|
        hX.hom_ext (_ ≫ f) (_ ≫ g))) : IsLimit c where
  lift s :=
    hc.lift
      (PullbackCone.mk (s.π.app ⟨WalkingPair.left⟩) (s.π.app ⟨WalkingPair.right⟩) (hX.hom_ext _ _))
  fac s j :=
    Discrete.casesOn j fun j =>
      WalkingPair.casesOn j (hc.fac _ WalkingCospan.left) (hc.fac _ WalkingCospan.right)
  uniq s m J := by
    let c' :=
      PullbackCone.mk (m ≫ c.π.app ⟨WalkingPair.left⟩) (m ≫ c.π.app ⟨WalkingPair.right⟩ : _)
        (hX.hom_ext (_ ≫ f) (_ ≫ g))
    dsimp; rw [← J, ← J]
    apply hc.hom_ext
    rintro (_ | (_ | _)) <;> simp only [PullbackCone.mk_π_app_one, PullbackCone.mk_π_app]
    exacts[(Category.assoc _ _ _).symm.trans (hc.fac_assoc c' WalkingCospan.left f).symm,
      (hc.fac c' WalkingCospan.left).symm, (hc.fac c' WalkingCospan.right).symm]
#align is_binary_product_of_is_terminal_is_pullback isBinaryProductOfIsTerminalIsPullback

/-- The pullback over the terminal object is the product -/
def isProductOfIsTerminalIsPullback {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y)
    (H₁ : IsTerminal Z)
    (H₂ : IsLimit (PullbackCone.mk _ _ (show h ≫ f = k ≫ g from H₁.hom_ext _ _))) :
    IsLimit (BinaryFan.mk h k) := by
  apply isBinaryProductOfIsTerminalIsPullback _ _ H₁
  exact H₂
#align is_product_of_is_terminal_is_pullback isProductOfIsTerminalIsPullback

/-- The product is the pullback over the terminal object. -/
def isPullbackOfIsTerminalIsProduct {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y)
    (H₁ : IsTerminal Z) (H₂ : IsLimit (BinaryFan.mk h k)) :
    IsLimit (PullbackCone.mk _ _ (show h ≫ f = k ≫ g from H₁.hom_ext _ _)) := by
  apply PullbackCone.isLimitAux'
  intro s
  use H₂.lift (BinaryFan.mk s.fst s.snd)
  use H₂.fac (BinaryFan.mk s.fst s.snd) ⟨WalkingPair.left⟩
  use H₂.fac (BinaryFan.mk s.fst s.snd) ⟨WalkingPair.right⟩
  intro m h₁ h₂
  apply H₂.hom_ext
  rintro ⟨⟨⟩⟩
  · exact h₁.trans (H₂.fac (BinaryFan.mk s.fst s.snd) ⟨WalkingPair.left⟩).symm
  · exact h₂.trans (H₂.fac (BinaryFan.mk s.fst s.snd) ⟨WalkingPair.right⟩).symm
#align is_pullback_of_is_terminal_is_product isPullbackOfIsTerminalIsProduct

/-- Any category with pullbacks and a terminal object has a limit cone for each walking pair. -/
noncomputable def limitConeOfTerminalAndPullbacks [HasTerminal C] [HasPullbacks C]
    (F : Discrete WalkingPair ⥤ C) : LimitCone F
    where
  cone :=
    { pt :=
        pullback (terminal.from (F.obj ⟨WalkingPair.left⟩))
          (terminal.from (F.obj ⟨WalkingPair.right⟩))
      π :=
        Discrete.natTrans fun x =>
          Discrete.casesOn x fun x => WalkingPair.casesOn x pullback.fst pullback.snd }
  isLimit :=
    isBinaryProductOfIsTerminalIsPullback F _ terminalIsTerminal _ _ (pullbackIsPullback _ _)
#align limit_cone_of_terminal_and_pullbacks limitConeOfTerminalAndPullbacks

variable (C)

-- This is not an instance, as it is not always how one wants to construct binary products!
/-- Any category with pullbacks and terminal object has binary products. -/
theorem hasBinaryProducts_of_hasTerminal_and_pullbacks [HasTerminal C] [HasPullbacks C] :
    HasBinaryProducts C :=
  { has_limit := fun F => HasLimit.mk (limitConeOfTerminalAndPullbacks F) }
#align has_binary_products_of_has_terminal_and_pullbacks hasBinaryProducts_of_hasTerminal_and_pullbacks

variable {C}

/-- A functor that preserves terminal objects and pullbacks preserves binary products. -/
noncomputable def preservesBinaryProductsOfPreservesTerminalAndPullbacks [HasTerminal C]
    [HasPullbacks C] [PreservesLimitsOfShape (Discrete.{0} PEmpty) F]
    [PreservesLimitsOfShape WalkingCospan F] : PreservesLimitsOfShape (Discrete WalkingPair) F :=
  ⟨fun {K} =>
    preservesLimitOfPreservesLimitCone (limitConeOfTerminalAndPullbacks K).2
      (by
        apply
          isBinaryProductOfIsTerminalIsPullback _ _ (isLimitOfHasTerminalOfPreservesLimit F)
        apply isLimitOfHasPullbackOfPreservesLimit)⟩
#align preserves_binary_products_of_preserves_terminal_and_pullbacks preservesBinaryProductsOfPreservesTerminalAndPullbacks

/-- In a category with a terminal object and pullbacks,
a product of objects `X` and `Y` is isomorphic to a pullback. -/
noncomputable def prodIsoPullback [HasTerminal C] [HasPullbacks C] (X Y : C)
    [HasBinaryProduct X Y] : X ⨯ Y ≅ pullback (terminal.from X) (terminal.from Y) :=
  limit.isoLimitCone (limitConeOfTerminalAndPullbacks _)
#align prod_iso_pullback prodIsoPullback

/-- If a cospan is the pushout cospan under the initial object, then it is a binary coproduct. -/
def isBinaryCoproductOfIsInitialIsPushout (F : Discrete WalkingPair ⥤ C) (c : Cocone F) {X : C}
    (hX : IsInitial X) (f : X ⟶ F.obj ⟨WalkingPair.left⟩) (g : X ⟶ F.obj ⟨WalkingPair.right⟩)
    (hc :
      IsColimit
        (PushoutCocone.mk (c.ι.app ⟨WalkingPair.left⟩) (c.ι.app ⟨WalkingPair.right⟩ : _) <|
          hX.hom_ext (f ≫ _) (g ≫ _))) :
    IsColimit c
    where
  desc s :=
    hc.desc
      (PushoutCocone.mk (s.ι.app ⟨WalkingPair.left⟩) (s.ι.app ⟨WalkingPair.right⟩) (hX.hom_ext _ _))
  fac s j :=
    Discrete.casesOn j fun j =>
      WalkingPair.casesOn j (hc.fac _ WalkingSpan.left) (hc.fac _ WalkingSpan.right)
  uniq s m J :=
    by
    let c' :=
      PushoutCocone.mk (c.ι.app ⟨WalkingPair.left⟩ ≫ m) (c.ι.app ⟨WalkingPair.right⟩ ≫ m)
        (hX.hom_ext (f ≫ _) (g ≫ _))
    dsimp; rw [← J, ← J]
    apply hc.hom_ext
    rintro (_ | (_ | _)) <;>
      simp only [PushoutCocone.mk_ι_app_zero, PushoutCocone.mk_ι_app, Category.assoc]
    congr 1
    exacts[(hc.fac c' WalkingSpan.left).symm, (hc.fac c' WalkingSpan.left).symm,
      (hc.fac c' WalkingSpan.right).symm]
#align is_binary_coproduct_of_is_initial_is_pushout isBinaryCoproductOfIsInitialIsPushout

/-- The pushout under the initial object is the coproduct -/
def isCoproductOfIsInitialIsPushout {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y)
    (H₁ : IsInitial W)
    (H₂ : IsColimit (PushoutCocone.mk _ _ (show h ≫ f = k ≫ g from H₁.hom_ext _ _))) :
    IsColimit (BinaryCofan.mk f g) := by
  apply isBinaryCoproductOfIsInitialIsPushout _ _ H₁
  exact H₂
#align is_coproduct_of_is_initial_is_pushout isCoproductOfIsInitialIsPushout

/-- The coproduct is the pushout under the initial object. -/
def isPushoutOfIsInitialIsCoproduct {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y)
    (H₁ : IsInitial W) (H₂ : IsColimit (BinaryCofan.mk f g)) :
    IsColimit (PushoutCocone.mk _ _ (show h ≫ f = k ≫ g from H₁.hom_ext _ _)) := by
  apply PushoutCocone.isColimitAux'
  intro s
  use H₂.desc (BinaryCofan.mk s.inl s.inr)
  use H₂.fac (BinaryCofan.mk s.inl s.inr) ⟨WalkingPair.left⟩
  use H₂.fac (BinaryCofan.mk s.inl s.inr) ⟨WalkingPair.right⟩
  intro m h₁ h₂
  apply H₂.hom_ext
  rintro ⟨⟨⟩⟩
  · exact h₁.trans (H₂.fac (BinaryCofan.mk s.inl s.inr) ⟨WalkingPair.left⟩).symm
  · exact h₂.trans (H₂.fac (BinaryCofan.mk s.inl s.inr) ⟨WalkingPair.right⟩).symm
#align is_pushout_of_is_initial_is_coproduct isPushoutOfIsInitialIsCoproduct

/-- Any category with pushouts and an initial object has a colimit cocone for each walking pair. -/
noncomputable def colimitCoconeOfInitialAndPushouts [HasInitial C] [HasPushouts C]
    (F : Discrete WalkingPair ⥤ C) : ColimitCocone F where
  cocone :=
    { pt := pushout (initial.to (F.obj ⟨WalkingPair.left⟩)) (initial.to (F.obj ⟨WalkingPair.right⟩))
      ι :=
        Discrete.natTrans fun x =>
          Discrete.casesOn x fun x => WalkingPair.casesOn x pushout.inl pushout.inr }
  isColimit := isBinaryCoproductOfIsInitialIsPushout F _ initialIsInitial _ _ (pushoutIsPushout _ _)
#align colimit_cocone_of_initial_and_pushouts colimitCoconeOfInitialAndPushouts

variable (C)

-- This is not an instance, as it is not always how one wants to construct binary coproducts!
/-- Any category with pushouts and initial object has binary coproducts. -/
theorem hasBinaryCoproducts_of_hasInitial_and_pushouts [HasInitial C] [HasPushouts C] :
    HasBinaryCoproducts C :=
  { has_colimit := fun F => HasColimit.mk (colimitCoconeOfInitialAndPushouts F) }
#align has_binary_coproducts_of_has_initial_and_pushouts hasBinaryCoproducts_of_hasInitial_and_pushouts

variable {C}

/-- A functor that preserves initial objects and pushouts preserves binary coproducts. -/
noncomputable def preservesBinaryCoproductsOfPreservesInitialAndPushouts [HasInitial C]
    [HasPushouts C] [PreservesColimitsOfShape (Discrete.{0} PEmpty) F]
    [PreservesColimitsOfShape WalkingSpan F] : PreservesColimitsOfShape (Discrete WalkingPair) F :=
  ⟨fun {K} =>
    preservesColimitOfPreservesColimitCocone (colimitCoconeOfInitialAndPushouts K).2 (by
      apply
        isBinaryCoproductOfIsInitialIsPushout _ _
          (isColimitOfHasInitialOfPreservesColimit F)
      apply isColimitOfHasPushoutOfPreservesColimit)⟩
#align preserves_binary_coproducts_of_preserves_initial_and_pushouts preservesBinaryCoproductsOfPreservesInitialAndPushouts

/-- In a category with an initial object and pushouts,
a coproduct of objects `X` and `Y` is isomorphic to a pushout. -/
noncomputable def coprodIsoPushout [HasInitial C] [HasPushouts C] (X Y : C)
    [HasBinaryCoproduct X Y] : X ⨿ Y ≅ pushout (initial.to X) (initial.to Y) :=
  colimit.isoColimitCocone (colimitCoconeOfInitialAndPushouts _)
#align coprod_iso_pushout coprodIsoPushout