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

! This file was ported from Lean 3 source module ring_theory.prime
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Associated
import Mathbin.Algebra.BigOperators.Basic

/-!
# Prime elements in rings

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
This file contains lemmas about prime elements of commutative rings.
-/

section CancelCommMonoidWithZero

variable {R : Type _} [CancelCommMonoidWithZero R]

open Finset

open BigOperators

/- warning: mul_eq_mul_prime_prod -> mul_eq_mul_prime_prod is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} R] {α : Type.{u2}} [_inst_2 : DecidableEq.{succ u2} α] {x : R} {y : R} {a : R} {s : Finset.{u2} α} {p : α -> R}, (forall (i : α), (Membership.Mem.{u2, u2} α (Finset.{u2} α) (Finset.hasMem.{u2} α) i s) -> (Prime.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1) (p i))) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) x y) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) a (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) s (fun (i : α) => p i)))) -> (Exists.{succ u2} (Finset.{u2} α) (fun (t : Finset.{u2} α) => Exists.{succ u2} (Finset.{u2} α) (fun (u : Finset.{u2} α) => Exists.{succ u1} R (fun (b : R) => Exists.{succ u1} R (fun (c : R) => And (Eq.{succ u2} (Finset.{u2} α) (Union.union.{u2} (Finset.{u2} α) (Finset.hasUnion.{u2} α (fun (a : α) (b : α) => _inst_2 a b)) t u) s) (And (Disjoint.{u2} (Finset.{u2} α) (Finset.partialOrder.{u2} α) (Finset.orderBot.{u2} α) t u) (And (Eq.{succ u1} R a (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b c)) (And (Eq.{succ u1} R x (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) t (fun (i : α) => p i)))) (Eq.{succ u1} R y (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) c (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) u (fun (i : α) => p i))))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} R] {α : Type.{u2}} [_inst_2 : DecidableEq.{succ u2} α] {x : R} {y : R} {a : R} {s : Finset.{u2} α} {p : α -> R}, (forall (i : α), (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) i s) -> (Prime.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1) (p i))) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) x y) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) a (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) s (fun (i : α) => p i)))) -> (Exists.{succ u2} (Finset.{u2} α) (fun (t : Finset.{u2} α) => Exists.{succ u2} (Finset.{u2} α) (fun (u : Finset.{u2} α) => Exists.{succ u1} R (fun (b : R) => Exists.{succ u1} R (fun (c : R) => And (Eq.{succ u2} (Finset.{u2} α) (Union.union.{u2} (Finset.{u2} α) (Finset.instUnionFinset.{u2} α (fun (a : α) (b : α) => _inst_2 a b)) t u) s) (And (Disjoint.{u2} (Finset.{u2} α) (Finset.partialOrder.{u2} α) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u2} α) t u) (And (Eq.{succ u1} R a (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b c)) (And (Eq.{succ u1} R x (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) t (fun (i : α) => p i)))) (Eq.{succ u1} R y (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) c (Finset.prod.{u1, u2} R α (CommMonoidWithZero.toCommMonoid.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)) u (fun (i : α) => p i))))))))))))
Case conversion may be inaccurate. Consider using '#align mul_eq_mul_prime_prod mul_eq_mul_prime_prodₓ'. -/
/-- If `x * y = a * ∏ i in s, p i` where `p i` is always prime, then
  `x` and `y` can both be written as a divisor of `a` multiplied by
  a product over a subset of `s`  -/
theorem mul_eq_mul_prime_prod {α : Type _} [DecidableEq α] {x y a : R} {s : Finset α} {p : α → R}
    (hp : ∀ i ∈ s, Prime (p i)) (hx : x * y = a * ∏ i in s, p i) :
    ∃ (t u : Finset α)(b c : R),
      t ∪ u = s ∧ Disjoint t u ∧ a = b * c ∧ (x = b * ∏ i in t, p i) ∧ y = c * ∏ i in u, p i :=
  by
  induction' s using Finset.induction with i s his ih generalizing x y a
  · exact ⟨∅, ∅, x, y, by simp [hx]⟩
  · rw [prod_insert his, ← mul_assoc] at hx
    have hpi : Prime (p i) := hp i (mem_insert_self _ _)
    rcases ih (fun i hi => hp i (mem_insert_of_mem hi)) hx with
      ⟨t, u, b, c, htus, htu, hbc, rfl, rfl⟩
    have hit : i ∉ t := fun hit => his (htus ▸ mem_union_left _ hit)
    have hiu : i ∉ u := fun hiu => his (htus ▸ mem_union_right _ hiu)
    obtain ⟨d, rfl⟩ | ⟨d, rfl⟩ : p i ∣ b ∨ p i ∣ c
    exact hpi.dvd_or_dvd ⟨a, by rw [← hbc, mul_comm]⟩
    · rw [mul_assoc, mul_comm a, mul_right_inj' hpi.ne_zero] at hbc
      exact
        ⟨insert i t, u, d, c, by rw [insert_union, htus], disjoint_insert_left.2 ⟨hiu, htu⟩, by
          simp [hbc, prod_insert hit, mul_assoc, mul_comm, mul_left_comm]⟩
    · rw [← mul_assoc, mul_right_comm b, mul_left_inj' hpi.ne_zero] at hbc
      exact
        ⟨t, insert i u, b, d, by rw [union_insert, htus], disjoint_insert_right.2 ⟨hit, htu⟩, by
          simp [← hbc, prod_insert hiu, mul_assoc, mul_comm, mul_left_comm]⟩
#align mul_eq_mul_prime_prod mul_eq_mul_prime_prod

/- warning: mul_eq_mul_prime_pow -> mul_eq_mul_prime_pow is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} R] {x : R} {y : R} {a : R} {p : R} {n : Nat}, (Prime.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1) p) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) x y) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) a (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p n))) -> (Exists.{1} Nat (fun (i : Nat) => Exists.{1} Nat (fun (j : Nat) => Exists.{succ u1} R (fun (b : R) => Exists.{succ u1} R (fun (c : R) => And (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) i j) n) (And (Eq.{succ u1} R a (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b c)) (And (Eq.{succ u1} R x (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p i))) (Eq.{succ u1} R y (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toHasMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) c (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p j))))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CancelCommMonoidWithZero.{u1} R] {x : R} {y : R} {a : R} {p : R} {n : Nat}, (Prime.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1) p) -> (Eq.{succ u1} R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) x y) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) a (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p n))) -> (Exists.{1} Nat (fun (i : Nat) => Exists.{1} Nat (fun (j : Nat) => Exists.{succ u1} R (fun (b : R) => Exists.{succ u1} R (fun (c : R) => And (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) i j) n) (And (Eq.{succ u1} R a (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b c)) (And (Eq.{succ u1} R x (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) b (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p i))) (Eq.{succ u1} R y (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (MulZeroClass.toMul.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1)))))) c (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R (MonoidWithZero.toMonoid.{u1} R (CommMonoidWithZero.toMonoidWithZero.{u1} R (CancelCommMonoidWithZero.toCommMonoidWithZero.{u1} R _inst_1))))) p j))))))))))
Case conversion may be inaccurate. Consider using '#align mul_eq_mul_prime_pow mul_eq_mul_prime_powₓ'. -/
/-- If ` x * y = a * p ^ n` where `p` is prime, then `x` and `y` can both be written
  as the product of a power of `p` and a divisor of `a`. -/
theorem mul_eq_mul_prime_pow {x y a p : R} {n : ℕ} (hp : Prime p) (hx : x * y = a * p ^ n) :
    ∃ (i j : ℕ)(b c : R), i + j = n ∧ a = b * c ∧ x = b * p ^ i ∧ y = c * p ^ j :=
  by
  rcases mul_eq_mul_prime_prod (fun _ _ => hp)
      (show x * y = a * (range n).Prod fun _ => p by simpa) with
    ⟨t, u, b, c, htus, htu, rfl, rfl, rfl⟩
  exact ⟨t.card, u.card, b, c, by rw [← card_disjoint_union htu, htus, card_range], by simp⟩
#align mul_eq_mul_prime_pow mul_eq_mul_prime_pow

end CancelCommMonoidWithZero

section CommRing

variable {α : Type _} [CommRing α]

/- warning: prime.neg -> Prime.neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CommRing.{u1} α] {p : α}, (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) p) -> (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) (Neg.neg.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (CommRing.toRing.{u1} α _inst_1)))))) p))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CommRing.{u1} α] {p : α}, (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) p) -> (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) (Neg.neg.{u1} α (Ring.toNeg.{u1} α (CommRing.toRing.{u1} α _inst_1)) p))
Case conversion may be inaccurate. Consider using '#align prime.neg Prime.negₓ'. -/
theorem Prime.neg {p : α} (hp : Prime p) : Prime (-p) :=
  by
  obtain ⟨h1, h2, h3⟩ := hp
  exact ⟨neg_ne_zero.mpr h1, by rwa [IsUnit.neg_iff], by simpa [neg_dvd] using h3⟩
#align prime.neg Prime.neg

/- warning: prime.abs -> Prime.abs is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CommRing.{u1} α] [_inst_2 : LinearOrder.{u1} α] {p : α}, (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) p) -> (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) (Abs.abs.{u1} α (Neg.toHasAbs.{u1} α (SubNegMonoid.toHasNeg.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (CommRing.toRing.{u1} α _inst_1)))))) (SemilatticeSup.toHasSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (LinearOrder.toLattice.{u1} α _inst_2)))) p))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CommRing.{u1} α] [_inst_2 : LinearOrder.{u1} α] {p : α}, (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) p) -> (Prime.{u1} α (CommSemiring.toCommMonoidWithZero.{u1} α (CommRing.toCommSemiring.{u1} α _inst_1)) (Abs.abs.{u1} α (Neg.toHasAbs.{u1} α (Ring.toNeg.{u1} α (CommRing.toRing.{u1} α _inst_1)) (SemilatticeSup.toSup.{u1} α (Lattice.toSemilatticeSup.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_2))))) p))
Case conversion may be inaccurate. Consider using '#align prime.abs Prime.absₓ'. -/
theorem Prime.abs [LinearOrder α] {p : α} (hp : Prime p) : Prime (abs p) :=
  by
  obtain h | h := abs_choice p <;> rw [h]
  · exact hp
  · exact hp.neg
#align prime.abs Prime.abs

end CommRing


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

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

import tactic.cache
import category.applicative

open function (hiding comp)

universes u v w

section applicative_transformation

variables (F : Type u → Type v) [applicative F] [is_lawful_applicative F]
variables (G : Type u → Type w) [applicative G] [is_lawful_applicative G]

structure applicative_transformation : Type (max (u+1) v w) :=
(app : ∀ α : Type u, F α → G α)
(preserves_pure' : ∀ {α : Type u} (x : α), app _ (pure x) = pure x)
(preserves_seq' : ∀ {α β : Type u} (x : F (α → β)) (y : F α), app _ (x <*> y) = app _ x <*> app _ y)

end applicative_transformation

namespace applicative_transformation

variables (F : Type u → Type v) [applicative F] [is_lawful_applicative F]
variables (G : Type u → Type w) [applicative G] [is_lawful_applicative G]

instance : has_coe_to_fun (applicative_transformation F G) :=
{ F := λ _, Π {α}, F α → G α,
  coe := λ a, a.app }

variables {F G}
variables (η : applicative_transformation F G)

@[functor_norm]
lemma preserves_pure : ∀ {α} (x : α), η (pure x) = pure x := η.preserves_pure'

@[functor_norm]
lemma preserves_seq :
  ∀ {α β : Type u} (x : F (α → β)) (y : F α), η (x <*> y) = η x <*> η y :=
η.preserves_seq'

@[functor_norm]
lemma preserves_map {α β} (x : α → β) (y : F α) : η (x <$> y) = x <$> η y :=
by rw [← pure_seq_eq_map, η.preserves_seq]; simp with functor_norm

end applicative_transformation

open applicative_transformation

class traversable (t : Type u → Type u) extends functor t :=
(traverse : Π {m : Type u → Type u} [applicative m] {α β},
   (α → m β) → t α → m (t β))

open functor

export traversable (traverse)

section functions

variables {t : Type u → Type u}
variables {m : Type u → Type v} [applicative m]
variables {α β : Type u}

variables {f : Type u → Type u} [applicative f]

def sequence [traversable t] : t (f α) → f (t α) := traverse id

end functions

class is_lawful_traversable (t : Type u → Type u) [traversable t]
  extends is_lawful_functor t : Type (u+1) :=
(id_traverse : ∀ {α} (x : t α), traverse id.mk x = x )
(comp_traverse : ∀ {F G} [applicative F] [applicative G]
    [is_lawful_applicative F] [is_lawful_applicative G]
    {α β γ} (f : β → F γ) (g : α → G β) (x : t α),
  traverse (comp.mk ∘ map f ∘ g) x =
  comp.mk (map (traverse f) (traverse g x)))
(traverse_eq_map_id : ∀ {α β} (f : α → β) (x : t α),
  traverse (id.mk ∘ f) x = id.mk (f <$> x))
(naturality : ∀ {F G} [applicative F] [applicative G]
    [is_lawful_applicative F] [is_lawful_applicative G]
    (η : applicative_transformation F G) {α β} (f : α → F β) (x : t α),
  η (traverse f x) = traverse (@η _ ∘ f) x)

instance : traversable id := ⟨λ _ _ _ _, id⟩
instance : is_lawful_traversable id := by refine {..}; intros; refl

section

variables {F : Type u → Type v} [applicative F]

instance : traversable option := ⟨@option.traverse⟩

instance : traversable list := ⟨@list.traverse⟩

end

namespace sum

variables {σ : Type u}
variables {F : Type u → Type u}
variables [applicative F]

protected def traverse {α β} (f : α → F β) : σ ⊕ α → F (σ ⊕ β)
| (sum.inl x) := pure (sum.inl x)
| (sum.inr x) := sum.inr <$> f x

end sum

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


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.preserves.basic

open category_theory category_theory.limits

noncomputable theory

namespace category_theory

universes w' w v₁ v₂ v₃ u₁ u₂ u₃

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

section creates
variables {D : Type u₂} [category.{v₂} D]

variables {J : Type w} [category.{w'} J] {K : J ⥤ C}

/--
Define the lift of a cone: For a cone `c` for `K ⋙ F`, give a cone for `K`
which is a lift of `c`, i.e. the image of it under `F` is (iso) to `c`.

We will then use this as part of the definition of creation of limits:
every limit cone has a lift.

Note this definition is really only useful when `c` is a limit already.
-/
structure liftable_cone (K : J ⥤ C) (F : C ⥤ D) (c : cone (K ⋙ F)) :=
(lifted_cone : cone K)
(valid_lift : F.map_cone lifted_cone ≅ c)

/--
Define the lift of a cocone: For a cocone `c` for `K ⋙ F`, give a cocone for
`K` which is a lift of `c`, i.e. the image of it under `F` is (iso) to `c`.

We will then use this as part of the definition of creation of colimits:
every limit cocone has a lift.

Note this definition is really only useful when `c` is a colimit already.
-/
structure liftable_cocone (K : J ⥤ C) (F : C ⥤ D) (c : cocone (K ⋙ F)) :=
(lifted_cocone : cocone K)
(valid_lift : F.map_cocone lifted_cocone ≅ c)

/--
Definition 3.3.1 of [Riehl].
We say that `F` creates limits of `K` if, given any limit cone `c` for `K ⋙ F`
(i.e. below) we can lift it to a cone "above", and further that `F` reflects
limits for `K`.

If `F` reflects isomorphisms, it suffices to show only that the lifted cone is
a limit - see `creates_limit_of_reflects_iso`.
-/
class creates_limit (K : J ⥤ C) (F : C ⥤ D) extends reflects_limit K F :=
(lifts : Π c, is_limit c → liftable_cone K F c)

/--
`F` creates limits of shape `J` if `F` creates the limit of any diagram
`K : J ⥤ C`.
-/
class creates_limits_of_shape (J : Type w) [category.{w'} J] (F : C ⥤ D) :=
(creates_limit : Π {K : J ⥤ C}, creates_limit K F . tactic.apply_instance)

/-- `F` creates limits if it creates limits of shape `J` for any `J`. -/
@[nolint check_univs] -- This should be used with explicit universe variables.
class creates_limits_of_size (F : C ⥤ D) :=
(creates_limits_of_shape : Π {J : Type w} [category.{w'} J],
  creates_limits_of_shape J F . tactic.apply_instance)

/-- `F` creates small limits if it creates limits of shape `J` for any small `J`. -/
abbreviation creates_limits (F : C ⥤ D) := creates_limits_of_size.{v₂ v₂} F

/--
Dual of definition 3.3.1 of [Riehl].
We say that `F` creates colimits of `K` if, given any limit cocone `c` for
`K ⋙ F` (i.e. below) we can lift it to a cocone "above", and further that `F`
reflects limits for `K`.

If `F` reflects isomorphisms, it suffices to show only that the lifted cocone is
a limit - see `creates_limit_of_reflects_iso`.
-/
class creates_colimit (K : J ⥤ C) (F : C ⥤ D) extends reflects_colimit K F :=
(lifts : Π c, is_colimit c → liftable_cocone K F c)

/--
`F` creates colimits of shape `J` if `F` creates the colimit of any diagram
`K : J ⥤ C`.
-/
class creates_colimits_of_shape (J : Type w) [category.{w'} J] (F : C ⥤ D) :=
(creates_colimit : Π {K : J ⥤ C}, creates_colimit K F . tactic.apply_instance)

/-- `F` creates colimits if it creates colimits of shape `J` for any small `J`. -/
@[nolint check_univs] -- This should be used with explicit universe variables.
class creates_colimits_of_size (F : C ⥤ D) :=
(creates_colimits_of_shape : Π {J : Type w} [category.{w'} J],
  creates_colimits_of_shape J F . tactic.apply_instance)

/-- `F` creates small colimits if it creates colimits of shape `J` for any small `J`. -/
abbreviation creates_colimits (F : C ⥤ D) := creates_colimits_of_size.{v₂ v₂} F

attribute [instance, priority 100] -- see Note [lower instance priority]
  creates_limits_of_shape.creates_limit creates_limits_of_size.creates_limits_of_shape
  creates_colimits_of_shape.creates_colimit creates_colimits_of_size.creates_colimits_of_shape

/- Interface to the `creates_limit` class. -/

/-- `lift_limit t` is the cone for `K` given by lifting the limit `t` for `K ⋙ F`. -/
def lift_limit {K : J ⥤ C} {F : C ⥤ D} [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  cone K :=
(creates_limit.lifts c t).lifted_cone

/-- The lifted cone has an image isomorphic to the original cone. -/
def lifted_limit_maps_to_original {K : J ⥤ C} {F : C ⥤ D}
  [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  F.map_cone (lift_limit t) ≅ c :=
(creates_limit.lifts c t).valid_lift

/-- The lifted cone is a limit. -/
def lifted_limit_is_limit {K : J ⥤ C} {F : C ⥤ D}
  [creates_limit K F] {c : cone (K ⋙ F)} (t : is_limit c) :
  is_limit (lift_limit t) :=
reflects_limit.reflects (is_limit.of_iso_limit t (lifted_limit_maps_to_original t).symm)

/-- If `F` creates the limit of `K` and `K ⋙ F` has a limit, then `K` has a limit. -/
lemma has_limit_of_created (K : J ⥤ C) (F : C ⥤ D)
  [has_limit (K ⋙ F)] [creates_limit K F] : has_limit K :=
has_limit.mk { cone := lift_limit (limit.is_limit (K ⋙ F)),
  is_limit := lifted_limit_is_limit _ }

/--
If `F` creates limits of shape `J`, and `D` has limits of shape `J`, then
`C` has limits of shape `J`.
-/
lemma has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape (F : C ⥤ D)
  [has_limits_of_shape J D] [creates_limits_of_shape J F] : has_limits_of_shape J C :=
⟨λ G, has_limit_of_created G F⟩

/-- If `F` creates limits, and `D` has all limits, then `C` has all limits. -/
lemma has_limits_of_has_limits_creates_limits (F : C ⥤ D) [has_limits_of_size.{w w'} D]
  [creates_limits_of_size.{w w'} F] : has_limits_of_size.{w w'} C :=
⟨λ J I, by exactI has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape F⟩

/- Interface to the `creates_colimit` class. -/

/-- `lift_colimit t` is the cocone for `K` given by lifting the colimit `t` for `K ⋙ F`. -/
def lift_colimit {K : J ⥤ C} {F : C ⥤ D} [creates_colimit K F] {c : cocone (K ⋙ F)}
  (t : is_colimit c) :
  cocone K :=
(creates_colimit.lifts c t).lifted_cocone

/-- The lifted cocone has an image isomorphic to the original cocone. -/
def lifted_colimit_maps_to_original {K : J ⥤ C} {F : C ⥤ D}
  [creates_colimit K F] {c : cocone (K ⋙ F)} (t : is_colimit c) :
  F.map_cocone (lift_colimit t) ≅ c :=
(creates_colimit.lifts c t).valid_lift

/-- The lifted cocone is a colimit. -/
def lifted_colimit_is_colimit {K : J ⥤ C} {F : C ⥤ D}
  [creates_colimit K F] {c : cocone (K ⋙ F)} (t : is_colimit c) :
  is_colimit (lift_colimit t) :=
reflects_colimit.reflects (is_colimit.of_iso_colimit t (lifted_colimit_maps_to_original t).symm)

/-- If `F` creates the limit of `K` and `K ⋙ F` has a limit, then `K` has a limit. -/
lemma has_colimit_of_created (K : J ⥤ C) (F : C ⥤ D)
  [has_colimit (K ⋙ F)] [creates_colimit K F] : has_colimit K :=
has_colimit.mk { cocone := lift_colimit (colimit.is_colimit (K ⋙ F)),
  is_colimit := lifted_colimit_is_colimit _ }

/--
If `F` creates colimits of shape `J`, and `D` has colimits of shape `J`, then
`C` has colimits of shape `J`.
-/
lemma has_colimits_of_shape_of_has_colimits_of_shape_creates_colimits_of_shape (F : C ⥤ D)
  [has_colimits_of_shape J D] [creates_colimits_of_shape J F] : has_colimits_of_shape J C :=
⟨λ G, has_colimit_of_created G F⟩

/-- If `F` creates colimits, and `D` has all colimits, then `C` has all colimits. -/
lemma has_colimits_of_has_colimits_creates_colimits (F : C ⥤ D) [has_colimits_of_size.{w w'} D]
  [creates_colimits_of_size.{w w'} F] : has_colimits_of_size.{w w'} C :=
⟨λ J I, by exactI has_colimits_of_shape_of_has_colimits_of_shape_creates_colimits_of_shape F⟩

@[priority 10] instance reflects_limits_of_shape_of_creates_limits_of_shape (F : C ⥤ D)
  [creates_limits_of_shape J F] : reflects_limits_of_shape J F := {}
@[priority 10] instance reflects_limits_of_creates_limits (F : C ⥤ D)
  [creates_limits_of_size.{w w'} F] : reflects_limits_of_size.{w w'} F := {}
@[priority 10] instance reflects_colimits_of_shape_of_creates_colimits_of_shape (F : C ⥤ D)
  [creates_colimits_of_shape J F] : reflects_colimits_of_shape J F := {}
@[priority 10] instance reflects_colimits_of_creates_colimits (F : C ⥤ D)
  [creates_colimits_of_size.{w w'} F] : reflects_colimits_of_size.{w w'} F := {}

/--
A helper to show a functor creates limits. In particular, if we can show
that for any limit cone `c` for `K ⋙ F`, there is a lift of it which is
a limit and `F` reflects isomorphisms, then `F` creates limits.
Usually, `F` creating limits says that _any_ lift of `c` is a limit, but
here we only need to show that our particular lift of `c` is a limit.
-/
structure lifts_to_limit (K : J ⥤ C) (F : C ⥤ D) (c : cone (K ⋙ F)) (t : is_limit c)
  extends liftable_cone K F c :=
(makes_limit : is_limit lifted_cone)

/--
A helper to show a functor creates colimits. In particular, if we can show
that for any limit cocone `c` for `K ⋙ F`, there is a lift of it which is
a limit and `F` reflects isomorphisms, then `F` creates colimits.
Usually, `F` creating colimits says that _any_ lift of `c` is a colimit, but
here we only need to show that our particular lift of `c` is a colimit.
-/
structure lifts_to_colimit (K : J ⥤ C) (F : C ⥤ D) (c : cocone (K ⋙ F)) (t : is_colimit c)
  extends liftable_cocone K F c :=
(makes_colimit : is_colimit lifted_cocone)

/--
If `F` reflects isomorphisms and we can lift any limit cone to a limit cone,
then `F` creates limits.
In particular here we don't need to assume that F reflects limits.
-/
def creates_limit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomorphisms F]
  (h : Π c t, lifts_to_limit K F c t) :
  creates_limit K F :=
{ lifts := λ c t, (h c t).to_liftable_cone,
  to_reflects_limit :=
  { reflects := λ (d : cone K) (hd : is_limit (F.map_cone d)),
    begin
      let d' : cone K := (h (F.map_cone d) hd).to_liftable_cone.lifted_cone,
      let i : F.map_cone d' ≅ F.map_cone d := (h (F.map_cone d) hd).to_liftable_cone.valid_lift,
      let hd' : is_limit d' := (h (F.map_cone d) hd).makes_limit,
      let f : d ⟶ d' := hd'.lift_cone_morphism d,
      have : (cones.functoriality K F).map f = i.inv := (hd.of_iso_limit i.symm).uniq_cone_morphism,
      haveI : is_iso ((cones.functoriality K F).map f) := (by { rw this, apply_instance }),
      haveI : is_iso f := is_iso_of_reflects_iso f (cones.functoriality K F),
      exact is_limit.of_iso_limit hd' (as_iso f).symm,
    end } }

/--
When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K`
it suffices to exhibit a lift of the chosen limit cone for `K ⋙ F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cone maps,
-- so the constructed limits may not be ideal, definitionally.
def creates_limit_of_fully_faithful_of_lift {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_limit (K ⋙ F)]
  (c : cone K) (i : F.map_cone c ≅ limit.cone (K ⋙ F)) : creates_limit K F :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone := c,
  valid_lift := i.trans (is_limit.unique_up_to_iso (limit.is_limit _) t),
  makes_limit := is_limit.of_faithful F (is_limit.of_iso_limit (limit.is_limit _) i.symm)
    (λ s, F.preimage _) (λ s, F.image_preimage _) })

/--
When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K`
it suffices to show that the chosen limit point is in the essential image of `F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cone maps,
-- so the constructed limits may not be ideal, definitionally.
def creates_limit_of_fully_faithful_of_iso {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_limit (K ⋙ F)]
  (X : C) (i : F.obj X ≅ limit (K ⋙ F)) : creates_limit K F :=
creates_limit_of_fully_faithful_of_lift
({ X := X,
  π :=
  { app := λ j, F.preimage (i.hom ≫ limit.π (K ⋙ F) j),
    naturality' := λ Y Z f, F.map_injective (by { dsimp, simp, erw limit.w (K ⋙ F), }) }} : cone K)
(by { fapply cones.ext, exact i, tidy, })

/-- `F` preserves the limit of `K` if it creates the limit and `K ⋙ F` has the limit. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limit_of_creates_limit_and_has_limit (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] [has_limit (K ⋙ F)] :
  preserves_limit K F :=
{ preserves := λ c t, is_limit.of_iso_limit (limit.is_limit _)
    ((lifted_limit_maps_to_original (limit.is_limit _)).symm ≪≫
      ((cones.functoriality K F).map_iso
        ((lifted_limit_is_limit (limit.is_limit _)).unique_up_to_iso t))) }

/-- `F` preserves the limit of shape `J` if it creates these limits and `D` has them. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limit_of_shape_of_creates_limits_of_shape_and_has_limits_of_shape (F : C ⥤ D)
  [creates_limits_of_shape J F] [has_limits_of_shape J D] :
  preserves_limits_of_shape J F := {}

/-- `F` preserves limits if it creates limits and `D` has limits. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_limits_of_creates_limits_and_has_limits (F : C ⥤ D)
  [creates_limits_of_size.{w w'} F]
  [has_limits_of_size.{w w'} D] :
  preserves_limits_of_size.{w w'} F := {}

/--
If `F` reflects isomorphisms and we can lift any colimit cocone to a colimit cocone,
then `F` creates colimits.
In particular here we don't need to assume that F reflects colimits.
-/
def creates_colimit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomorphisms F]
  (h : Π c t, lifts_to_colimit K F c t) :
  creates_colimit K F :=
{ lifts := λ c t, (h c t).to_liftable_cocone,
  to_reflects_colimit :=
  { reflects := λ (d : cocone K) (hd : is_colimit (F.map_cocone d)),
    begin
      let d' : cocone K := (h (F.map_cocone d) hd).to_liftable_cocone.lifted_cocone,
      let i : F.map_cocone d' ≅ F.map_cocone d :=
        (h (F.map_cocone d) hd).to_liftable_cocone.valid_lift,
      let hd' : is_colimit d' := (h (F.map_cocone d) hd).makes_colimit,
      let f : d' ⟶ d := hd'.desc_cocone_morphism d,
      have : (cocones.functoriality K F).map f = i.hom :=
        (hd.of_iso_colimit i.symm).uniq_cocone_morphism,
      haveI : is_iso ((cocones.functoriality K F).map f) := (by { rw this, apply_instance }),
      haveI := is_iso_of_reflects_iso f (cocones.functoriality K F),
      exact is_colimit.of_iso_colimit hd' (as_iso f),
    end } }

/--
When `F` is fully faithful, and `has_colimit (K ⋙ F)`, to show that `F` creates the colimit for `K`
it suffices to exhibit a lift of the chosen colimit cocone for `K ⋙ F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cocone maps,
-- so the constructed colimits may not be ideal, definitionally.
def creates_colimit_of_fully_faithful_of_lift {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_colimit (K ⋙ F)]
  (c : cocone K) (i : F.map_cocone c ≅ colimit.cocone (K ⋙ F)) : creates_colimit K F :=
creates_colimit_of_reflects_iso (λ c' t,
{ lifted_cocone := c,
  valid_lift := i.trans (is_colimit.unique_up_to_iso (colimit.is_colimit _) t),
  makes_colimit := is_colimit.of_faithful F
    (is_colimit.of_iso_colimit (colimit.is_colimit _) i.symm)
    (λ s, F.preimage _) (λ s, F.image_preimage _) })

/--
When `F` is fully faithful, and `has_colimit (K ⋙ F)`, to show that `F` creates the colimit for `K`
it suffices to show that the chosen colimit point is in the essential image of `F`.
-/
-- Notice however that even if the isomorphism is `iso.refl _`,
-- this construction will insert additional identity morphisms in the cocone maps,
-- so the constructed colimits may not be ideal, definitionally.
def creates_colimit_of_fully_faithful_of_iso {K : J ⥤ C} {F : C ⥤ D}
  [full F] [faithful F] [has_colimit (K ⋙ F)]
  (X : C) (i : F.obj X ≅ colimit (K ⋙ F)) : creates_colimit K F :=
creates_colimit_of_fully_faithful_of_lift
({ X := X,
  ι :=
  { app := λ j, F.preimage (colimit.ι (K ⋙ F) j ≫ i.inv : _),
    naturality' := λ Y Z f, F.map_injective
      (by { erw category.comp_id, simp only [functor.map_comp, functor.image_preimage],
        erw colimit.w_assoc (K ⋙ F) }) }} : cocone K)
(by { fapply cocones.ext, exact i, tidy, })

/-- `F` preserves the colimit of `K` if it creates the colimit and `K ⋙ F` has the colimit. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimit_of_creates_colimit_and_has_colimit (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] [has_colimit (K ⋙ F)] :
  preserves_colimit K F :=
{ preserves := λ c t, is_colimit.of_iso_colimit (colimit.is_colimit _)
    ((lifted_colimit_maps_to_original (colimit.is_colimit _)).symm ≪≫
      ((cocones.functoriality K F).map_iso
        ((lifted_colimit_is_colimit (colimit.is_colimit _)).unique_up_to_iso t))) }

/-- `F` preserves the colimit of shape `J` if it creates these colimits and `D` has them. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimit_of_shape_of_creates_colimits_of_shape_and_has_colimits_of_shape
  (F : C ⥤ D) [creates_colimits_of_shape J F] [has_colimits_of_shape J D] :
  preserves_colimits_of_shape J F := {}

/-- `F` preserves limits if it creates limits and `D` has limits. -/
@[priority 100] -- see Note [lower instance priority]
instance preserves_colimits_of_creates_colimits_and_has_colimits (F : C ⥤ D)
  [creates_colimits_of_size.{w w'} F] [has_colimits_of_size.{w w'} D] :
  preserves_colimits_of_size.{w w'} F := {}

/-- Transfer creation of limits along a natural isomorphism in the diagram. -/
def creates_limit_of_iso_diagram {K₁ K₂ : J ⥤ C} (F : C ⥤ D) (h : K₁ ≅ K₂)
  [creates_limit K₁ F] : creates_limit K₂ F :=
{ lifts := λ c t,
  let t' := (is_limit.postcompose_inv_equiv (iso_whisker_right h F : _) c).symm t in
  { lifted_cone := (cones.postcompose h.hom).obj (lift_limit t'),
    valid_lift :=
        F.map_cone_postcompose ≪≫
        (cones.postcompose (iso_whisker_right h F).hom).map_iso
            (lifted_limit_maps_to_original t') ≪≫
        cones.ext (iso.refl _) (λ j, by { dsimp, rw [category.assoc, ←F.map_comp], simp }) }
  ..reflects_limit_of_iso_diagram F h }

/-- If `F` creates the limit of `K` and `F ≅ G`, then `G` creates the limit of `K`. -/
def creates_limit_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limit K F] :
  creates_limit K G :=
{ lifts := λ c t,
  { lifted_cone :=
      lift_limit ((is_limit.postcompose_inv_equiv (iso_whisker_left K h : _) c).symm t),
    valid_lift :=
    begin
      refine (is_limit.map_cone_equiv h _).unique_up_to_iso t,
      apply is_limit.of_iso_limit _ ((lifted_limit_maps_to_original _).symm),
      apply (is_limit.postcompose_inv_equiv _ _).symm t,
    end },
  to_reflects_limit := reflects_limit_of_nat_iso _ h }

/-- If `F` creates limits of shape `J` and `F ≅ G`, then `G` creates limits of shape `J`. -/
def creates_limits_of_shape_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limits_of_shape J F] :
  creates_limits_of_shape J G :=
{ creates_limit := λ K, creates_limit_of_nat_iso h }

/-- If `F` creates limits and `F ≅ G`, then `G` creates limits. -/
def creates_limits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_limits_of_size.{w w'} F] :
  creates_limits_of_size.{w w'} G :=
{ creates_limits_of_shape := λ J 𝒥₁, by exactI creates_limits_of_shape_of_nat_iso h }

/-- Transfer creation of colimits along a natural isomorphism in the diagram. -/
def creates_colimit_of_iso_diagram {K₁ K₂ : J ⥤ C} (F : C ⥤ D) (h : K₁ ≅ K₂)
  [creates_colimit K₁ F] : creates_colimit K₂ F :=
{ lifts := λ c t,
  let t' := (is_colimit.precompose_hom_equiv (iso_whisker_right h F : _) c).symm t in
  { lifted_cocone := (cocones.precompose h.inv).obj (lift_colimit t'),
    valid_lift :=
        F.map_cocone_precompose ≪≫
        (cocones.precompose (iso_whisker_right h F).inv).map_iso
            (lifted_colimit_maps_to_original t') ≪≫
        cocones.ext (iso.refl _) (λ j, by { dsimp, rw ←F.map_comp_assoc, simp }) },
  ..reflects_colimit_of_iso_diagram F h }

/-- If `F` creates the colimit of `K` and `F ≅ G`, then `G` creates the colimit of `K`. -/
def creates_colimit_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_colimit K F] :
  creates_colimit K G :=
{ lifts := λ c t,
  { lifted_cocone :=
      lift_colimit ((is_colimit.precompose_hom_equiv (iso_whisker_left K h : _) c).symm t),
    valid_lift :=
    begin
      refine (is_colimit.map_cocone_equiv h _).unique_up_to_iso t,
      apply is_colimit.of_iso_colimit _ ((lifted_colimit_maps_to_original _).symm),
      apply (is_colimit.precompose_hom_equiv _ _).symm t,
    end },
  to_reflects_colimit := reflects_colimit_of_nat_iso _ h }

/-- If `F` creates colimits of shape `J` and `F ≅ G`, then `G` creates colimits of shape `J`. -/
def creates_colimits_of_shape_of_nat_iso {F G : C ⥤ D} (h : F ≅ G)
  [creates_colimits_of_shape J F] : creates_colimits_of_shape J G :=
{ creates_colimit := λ K, creates_colimit_of_nat_iso h }

/-- If `F` creates colimits and `F ≅ G`, then `G` creates colimits. -/
def creates_colimits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [creates_colimits_of_size.{w w'} F] :
  creates_colimits_of_size.{w w'} G :=
{ creates_colimits_of_shape := λ J 𝒥₁, by exactI creates_colimits_of_shape_of_nat_iso h }

-- For the inhabited linter later.
/-- If F creates the limit of K, any cone lifts to a limit. -/
def lifts_to_limit_of_creates (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] (c : cone (K ⋙ F)) (t : is_limit c) :
  lifts_to_limit K F c t :=
{ lifted_cone := lift_limit t,
  valid_lift := lifted_limit_maps_to_original t,
  makes_limit := lifted_limit_is_limit t }

-- For the inhabited linter later.
/-- If F creates the colimit of K, any cocone lifts to a colimit. -/
def lifts_to_colimit_of_creates (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] (c : cocone (K ⋙ F)) (t : is_colimit c) :
  lifts_to_colimit K F c t :=
{ lifted_cocone := lift_colimit t,
  valid_lift := lifted_colimit_maps_to_original t,
  makes_colimit := lifted_colimit_is_colimit t }

/-- Any cone lifts through the identity functor. -/
def id_lifts_cone (c : cone (K ⋙ 𝟭 C)) : liftable_cone K (𝟭 C) c :=
{ lifted_cone :=
  { X := c.X,
    π := c.π ≫ K.right_unitor.hom },
  valid_lift := cones.ext (iso.refl _) (by tidy) }

/-- The identity functor creates all limits. -/
instance id_creates_limits : creates_limits_of_size.{w w'} (𝟭 C) :=
{ creates_limits_of_shape := λ J 𝒥, by exactI
  { creates_limit := λ F, { lifts := λ c t, id_lifts_cone c } } }

/-- Any cocone lifts through the identity functor. -/
def id_lifts_cocone (c : cocone (K ⋙ 𝟭 C)) : liftable_cocone K (𝟭 C) c :=
{ lifted_cocone :=
  { X := c.X,
    ι := K.right_unitor.inv ≫ c.ι },
  valid_lift := cocones.ext (iso.refl _) (by tidy) }

/-- The identity functor creates all colimits. -/
instance id_creates_colimits : creates_colimits_of_size.{w w'} (𝟭 C) :=
{ creates_colimits_of_shape := λ J 𝒥, by exactI
  { creates_colimit := λ F, { lifts := λ c t, id_lifts_cocone c } } }

/-- Satisfy the inhabited linter -/
instance inhabited_liftable_cone (c : cone (K ⋙ 𝟭 C)) :
  inhabited (liftable_cone K (𝟭 C) c) :=
⟨id_lifts_cone c⟩
instance inhabited_liftable_cocone (c : cocone (K ⋙ 𝟭 C)) :
  inhabited (liftable_cocone K (𝟭 C) c) :=
⟨id_lifts_cocone c⟩

/-- Satisfy the inhabited linter -/
instance inhabited_lifts_to_limit (K : J ⥤ C) (F : C ⥤ D)
  [creates_limit K F] (c : cone (K ⋙ F)) (t : is_limit c) :
  inhabited (lifts_to_limit _ _ _ t) :=
⟨lifts_to_limit_of_creates K F c t⟩
instance inhabited_lifts_to_colimit (K : J ⥤ C) (F : C ⥤ D)
  [creates_colimit K F] (c : cocone (K ⋙ F)) (t : is_colimit c) :
  inhabited (lifts_to_colimit _ _ _ t) :=
⟨lifts_to_colimit_of_creates K F c t⟩

section comp

variables {E : Type u₃} [ℰ : category.{v₃} E]
variables (F : C ⥤ D) (G : D ⥤ E)

instance comp_creates_limit [creates_limit K F] [creates_limit (K ⋙ F) G] :
  creates_limit K (F ⋙ G) :=
{ lifts := λ c t,
  { lifted_cone := lift_limit (lifted_limit_is_limit t),
    valid_lift := (cones.functoriality (K ⋙ F) G).map_iso
      (lifted_limit_maps_to_original (lifted_limit_is_limit t)) ≪≫
      (lifted_limit_maps_to_original t) } }

instance comp_creates_limits_of_shape [creates_limits_of_shape J F] [creates_limits_of_shape J G] :
  creates_limits_of_shape J (F ⋙ G) :=
{ creates_limit := infer_instance }

instance comp_creates_limits [creates_limits_of_size.{w w'} F] [creates_limits_of_size.{w w'} G] :
  creates_limits_of_size.{w w'} (F ⋙ G) :=
{ creates_limits_of_shape := infer_instance }

instance comp_creates_colimit [creates_colimit K F] [creates_colimit (K ⋙ F) G] :
  creates_colimit K (F ⋙ G) :=
{ lifts := λ c t,
  { lifted_cocone := lift_colimit (lifted_colimit_is_colimit t),
    valid_lift := (cocones.functoriality (K ⋙ F) G).map_iso
      (lifted_colimit_maps_to_original (lifted_colimit_is_colimit t)) ≪≫
      (lifted_colimit_maps_to_original t) } }

instance comp_creates_colimits_of_shape
  [creates_colimits_of_shape J F] [creates_colimits_of_shape J G] :
  creates_colimits_of_shape J (F ⋙ G) :=
{ creates_colimit := infer_instance }

instance comp_creates_colimits [creates_colimits_of_size.{w w'} F]
  [creates_colimits_of_size.{w w'} G] : creates_colimits_of_size.{w w'} (F ⋙ G) :=
{ creates_colimits_of_shape := infer_instance }

end comp

end creates

end category_theory


import minimal_sub_pq
import sub_pq_normal

universe u

section pq_like_normal

variables {Q : Type u} [power_quandle Q]

theorem pq_like_normal : sub_pq_normal (gen_group_sub_pq (@of_gen_group_sub_pq Q _)) :=
begin
  intros x y,
  cases y with y hy,
  simp only [subtype.coe_mk],
  cases hy with z hz,
  rw hz,
  rw set.mem_def,
  unfold gen_group_sub_pq,
  simp only,
  unfold of_gen_group_sub_pq,
  simp only,
  unfold of_gen,
  sorry,
  --use ((counit x) ▷ z : Q),

end

end pq_like_normal


import o_minimal.sheaf.yoneda
import o_minimal.order

namespace o_minimal

variables {R : Type*} [preorder R] {S : struc R} [is_definable_le S R]

lemma definable_Ioo : definable S (set.Ioo : R → R → set R) :=
begin [defin]
  intro a,
  intro b,
  intro x,
  app, app, exact definable.and.definable _,
  { app, app, exact (definable_iff_def_rel₂.mpr definable_lt').definable _,
    var, var },
  { app, app, exact (definable_iff_def_rel₂.mpr definable_lt').definable _,
    var, var }
end

lemma definable_Iio : definable S (set.Iio : R → set R) :=
begin [defin]
  intro b,
  intro x,
  app, app, exact (definable_iff_def_rel₂.mpr definable_lt').definable _,
  var, var
end

end o_minimal


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta, Adam Topaz
-/
import category_theory.functor.category
import category_theory.functor.fully_faithful
import category_theory.functor.reflects_isomorphisms

/-!
# Monads

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

We construct the categories of monads and comonads, and their forgetful functors to endofunctors.

(Note that these are the category theorist's monads, not the programmers monads.
For the translation, see the file `category_theory.monad.types`.)

For the fact that monads are "just" monoids in the category of endofunctors, see the file
`category_theory.monad.equiv_mon`.
-/

namespace category_theory
open category

universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes].

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

/--
The data of a monad on C consists of an endofunctor T together with natural transformations
η : 𝟭 C ⟶ T and μ : T ⋙ T ⟶ T satisfying three equations:
- T μ_X ≫ μ_X = μ_(TX) ≫ μ_X (associativity)
- η_(TX) ≫ μ_X = 1_X (left unit)
- Tη_X ≫ μ_X = 1_X (right unit)
-/
structure monad extends C ⥤ C :=
(η' [] : 𝟭 _ ⟶ to_functor)
(μ' [] : to_functor ⋙ to_functor ⟶ to_functor)
(assoc' : ∀ X, to_functor.map (nat_trans.app μ' X) ≫ μ'.app _ = μ'.app _ ≫ μ'.app _ . obviously)
(left_unit' : ∀ X : C, η'.app (to_functor.obj X) ≫ μ'.app _ = 𝟙 _ . obviously)
(right_unit' : ∀ X : C, to_functor.map (η'.app X) ≫ μ'.app _ = 𝟙 _ . obviously)

/--
The data of a comonad on C consists of an endofunctor G together with natural transformations
ε : G ⟶ 𝟭 C and δ : G ⟶ G ⋙ G satisfying three equations:
- δ_X ≫ G δ_X = δ_X ≫ δ_(GX) (coassociativity)
- δ_X ≫ ε_(GX) = 1_X (left counit)
- δ_X ≫ G ε_X = 1_X (right counit)
-/
structure comonad extends C ⥤ C :=
(ε' [] : to_functor ⟶ 𝟭 _)
(δ' [] : to_functor ⟶ to_functor ⋙ to_functor)
(coassoc' : ∀ X, nat_trans.app δ' _ ≫ to_functor.map (δ'.app X) = δ'.app _ ≫ δ'.app _ . obviously)
(left_counit' : ∀ X : C, δ'.app X ≫ ε'.app (to_functor.obj X) = 𝟙 _ . obviously)
(right_counit' : ∀ X : C, δ'.app X ≫ to_functor.map (ε'.app X) = 𝟙 _ . obviously)

variables {C} (T : monad C) (G : comonad C)

instance coe_monad : has_coe (monad C) (C ⥤ C) := ⟨λ T, T.to_functor⟩
instance coe_comonad : has_coe (comonad C) (C ⥤ C) := ⟨λ G, G.to_functor⟩

@[simp] lemma monad_to_functor_eq_coe : T.to_functor = T := rfl
@[simp] lemma comonad_to_functor_eq_coe : G.to_functor = G := rfl

/-- The unit for the monad `T`. -/
def monad.η : 𝟭 _ ⟶ (T : C ⥤ C) := T.η'
/-- The multiplication for the monad `T`. -/
def monad.μ : (T : C ⥤ C) ⋙ (T : C ⥤ C) ⟶ T := T.μ'

/-- The counit for the comonad `G`. -/
def comonad.ε : (G : C ⥤ C) ⟶ 𝟭 _  := G.ε'
/-- The comultiplication for the comonad `G`. -/
def comonad.δ : (G : C ⥤ C) ⟶ (G : C ⥤ C) ⋙ G := G.δ'

/-- A custom simps projection for the functor part of a monad, as a coercion. -/
def monad.simps.coe := (T : C ⥤ C)
/-- A custom simps projection for the unit of a monad, in simp normal form. -/
def monad.simps.η : 𝟭 _ ⟶ (T : C ⥤ C) := T.η
/-- A custom simps projection for the multiplication of a monad, in simp normal form. -/
def monad.simps.μ : (T : C ⥤ C) ⋙ (T : C ⥤ C) ⟶ (T : C ⥤ C) := T.μ

/-- A custom simps projection for the functor part of a comonad, as a coercion. -/
def comonad.simps.coe := (G : C ⥤ C)
/-- A custom simps projection for the counit of a comonad, in simp normal form. -/
def comonad.simps.ε : (G : C ⥤ C) ⟶ 𝟭 _ := G.ε
/-- A custom simps projection for the comultiplication of a comonad, in simp normal form. -/
def comonad.simps.δ : (G : C ⥤ C) ⟶ (G : C ⥤ C) ⋙ (G : C ⥤ C) := G.δ

initialize_simps_projections category_theory.monad (to_functor → coe, η' → η, μ' → μ)
initialize_simps_projections category_theory.comonad (to_functor → coe, ε' → ε, δ' → δ)

@[reassoc]
lemma monad.assoc (T : monad C) (X : C) :
  (T : C ⥤ C).map (T.μ.app X) ≫ T.μ.app _ = T.μ.app _ ≫ T.μ.app _ :=
T.assoc' X

@[simp, reassoc] lemma monad.left_unit (T : monad C) (X : C) :
  T.η.app ((T : C ⥤ C).obj X) ≫ T.μ.app X = 𝟙 ((T : C ⥤ C).obj X) :=
T.left_unit' X

@[simp, reassoc] lemma monad.right_unit (T : monad C) (X : C) :
  (T : C ⥤ C).map (T.η.app X) ≫ T.μ.app X = 𝟙 ((T : C ⥤ C).obj X) :=
T.right_unit' X

@[reassoc]
lemma comonad.coassoc (G : comonad C) (X : C) :
  G.δ.app _ ≫ (G : C ⥤ C).map (G.δ.app X) = G.δ.app _ ≫ G.δ.app _ :=
G.coassoc' X

@[simp, reassoc] lemma comonad.left_counit (G : comonad C) (X : C) :
  G.δ.app X ≫ G.ε.app ((G : C ⥤ C).obj X) = 𝟙 ((G : C ⥤ C).obj X) :=
G.left_counit' X

@[simp, reassoc] lemma comonad.right_counit (G : comonad C) (X : C) :
  G.δ.app X ≫ (G : C ⥤ C).map (G.ε.app X) = 𝟙 ((G : C ⥤ C).obj X) :=
G.right_counit' X

/-- A morphism of monads is a natural transformation compatible with η and μ. -/
@[ext]
structure monad_hom (T₁ T₂ : monad C) extends nat_trans (T₁ : C ⥤ C) T₂ :=
(app_η' : ∀ X, T₁.η.app X ≫ app X = T₂.η.app X . obviously)
(app_μ' : ∀ X, T₁.μ.app X ≫ app X = ((T₁ : C ⥤ C).map (app X) ≫ app _) ≫ T₂.μ.app X . obviously)

/-- A morphism of comonads is a natural transformation compatible with ε and δ. -/
@[ext]
structure comonad_hom (M N : comonad C) extends nat_trans (M : C ⥤ C) N :=
(app_ε' : ∀ X, app X ≫ N.ε.app X = M.ε.app X . obviously)
(app_δ' : ∀ X, app X ≫ N.δ.app X = M.δ.app X ≫ app _ ≫ (N : C ⥤ C).map (app X) . obviously)

restate_axiom monad_hom.app_η'
restate_axiom monad_hom.app_μ'
attribute [simp, reassoc] monad_hom.app_η monad_hom.app_μ

restate_axiom comonad_hom.app_ε'
restate_axiom comonad_hom.app_δ'
attribute [simp, reassoc] comonad_hom.app_ε comonad_hom.app_δ

instance : category (monad C) :=
{ hom := monad_hom,
  id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) },
  comp := λ _ _ _ f g,
  { to_nat_trans :=
    { app := λ X, f.app X ≫ g.app X,
      naturality' := λ X Y h, by rw [assoc, f.1.naturality_assoc, g.1.naturality] } },
  id_comp' := λ _ _ _, by {ext, apply id_comp},
  comp_id' := λ _ _ _, by {ext, apply comp_id},
  assoc' := λ _ _ _ _ _ _ _, by {ext, apply assoc} }

instance : category (comonad C) :=
{ hom := comonad_hom,
  id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) },
  comp := λ _ _ _ f g,
  { to_nat_trans :=
    { app := λ X, f.app X ≫ g.app X,
      naturality' := λ X Y h, by rw [assoc, f.1.naturality_assoc, g.1.naturality] } },
  id_comp' := λ _ _ _, by {ext, apply id_comp},
  comp_id' := λ _ _ _, by {ext, apply comp_id},
  assoc' := λ _ _ _ _ _ _ _, by {ext, apply assoc} }

instance {T : monad C} : inhabited (monad_hom T T) := ⟨𝟙 T⟩

@[simp]

instance {G : comonad C} : inhabited (comonad_hom G G) := ⟨𝟙 G⟩

@[simp] lemma comonad_hom.id_to_nat_trans (T : comonad C) :
  (𝟙 T : T ⟶ T).to_nat_trans = 𝟙 (T : C ⥤ C) :=
rfl
@[simp] lemma comp_to_nat_trans {T₁ T₂ T₃ : comonad C} (f : T₁ ⟶ T₂) (g : T₂ ⟶ T₃) :
  (f ≫ g).to_nat_trans =
    ((f.to_nat_trans : _ ⟶ (T₂ : C ⥤ C)) ≫ g.to_nat_trans : (T₁ : C ⥤ C) ⟶ T₃) :=
rfl

/-- Construct a monad isomorphism from a natural isomorphism of functors where the forward
direction is a monad morphism. -/
@[simps]
def monad_iso.mk {M N : monad C} (f : (M : C ⥤ C) ≅ N) (f_η f_μ) :
  M ≅ N :=
{ hom := { to_nat_trans := f.hom, app_η' := f_η, app_μ' := f_μ },
  inv :=
  { to_nat_trans := f.inv,
    app_η' := λ X, by simp [←f_η],
    app_μ' := λ X,
    begin
      rw ←nat_iso.cancel_nat_iso_hom_right f,
      simp only [nat_trans.naturality, iso.inv_hom_id_app, assoc, comp_id, f_μ,
        nat_trans.naturality_assoc, iso.inv_hom_id_app_assoc, ←functor.map_comp_assoc],
      simp,
    end } }

/-- Construct a comonad isomorphism from a natural isomorphism of functors where the forward
direction is a comonad morphism. -/
@[simps]
def comonad_iso.mk {M N : comonad C} (f : (M : C ⥤ C) ≅ N) (f_ε f_δ) :
  M ≅ N :=
{ hom := { to_nat_trans := f.hom, app_ε' := f_ε, app_δ' := f_δ },
  inv :=
  { to_nat_trans := f.inv,
    app_ε' := λ X, by simp [←f_ε],
    app_δ' := λ X,
    begin
      rw ←nat_iso.cancel_nat_iso_hom_left f,
      simp only [reassoc_of (f_δ X), iso.hom_inv_id_app_assoc, nat_trans.naturality_assoc],
      rw [←functor.map_comp, iso.hom_inv_id_app, functor.map_id],
      apply (comp_id _).symm
    end } }

variable (C)

/--
The forgetful functor from the category of monads to the category of endofunctors.
-/
@[simps]
def monad_to_functor : monad C ⥤ (C ⥤ C) :=
{ obj := λ T, T,
  map := λ M N f, f.to_nat_trans }

instance : faithful (monad_to_functor C) := {}.

@[simp]
lemma monad_to_functor_map_iso_monad_iso_mk {M N : monad C} (f : (M : C ⥤ C) ≅ N) (f_η f_μ) :
  (monad_to_functor _).map_iso (monad_iso.mk f f_η f_μ) = f :=
by { ext, refl }

instance : reflects_isomorphisms (monad_to_functor C) :=
{ reflects := λ M N f i,
  begin
    resetI,
    convert is_iso.of_iso (monad_iso.mk (as_iso ((monad_to_functor C).map f)) f.app_η f.app_μ),
    ext; refl,
  end }

/--
The forgetful functor from the category of comonads to the category of endofunctors.
-/
@[simps]
def comonad_to_functor : comonad C ⥤ (C ⥤ C) :=
{ obj := λ G, G,
  map := λ M N f, f.to_nat_trans }

instance : faithful (comonad_to_functor C) := {}.

@[simp]
lemma comonad_to_functor_map_iso_comonad_iso_mk {M N : comonad C} (f : (M : C ⥤ C) ≅ N) (f_ε f_δ) :
  (comonad_to_functor _).map_iso (comonad_iso.mk f f_ε f_δ) = f :=
by { ext, refl }

instance : reflects_isomorphisms (comonad_to_functor C) :=
{ reflects := λ M N f i,
  begin
    resetI,
    convert is_iso.of_iso (comonad_iso.mk (as_iso ((comonad_to_functor C).map f)) f.app_ε f.app_δ),
    ext; refl,
  end }

variable {C}

/--
An isomorphism of monads gives a natural isomorphism of the underlying functors.
-/
@[simps {rhs_md := semireducible}]
def monad_iso.to_nat_iso {M N : monad C} (h : M ≅ N) : (M : C ⥤ C) ≅ N :=
(monad_to_functor C).map_iso h

/--
An isomorphism of comonads gives a natural isomorphism of the underlying functors.
-/
@[simps {rhs_md := semireducible}]
def comonad_iso.to_nat_iso {M N : comonad C} (h : M ≅ N) : (M : C ⥤ C) ≅ N :=
(comonad_to_functor C).map_iso h

variable (C)

namespace monad

/-- The identity monad. -/
@[simps]
def id : monad C :=
{ to_functor := 𝟭 C,
  η' := 𝟙 (𝟭 C),
  μ' := 𝟙 (𝟭 C) }

instance : inhabited (monad C) := ⟨monad.id C⟩

end monad

namespace comonad

/-- The identity comonad. -/
@[simps]
def id : comonad C :=
{ to_functor := 𝟭 _,
  ε' := 𝟙 (𝟭 C),
  δ' := 𝟙 (𝟭 C) }

instance : inhabited (comonad C) := ⟨comonad.id C⟩

end comonad

end category_theory


theorem bad : ∀ (m n : Nat), (if m = n then Ordering.eq else Ordering.gt) = Ordering.lt → False := by
  intros m n
  cases (Nat.decEq m n) with -- an error as expected: "alternative `isFalse` has not bee provided"
  | isTrue h =>
    set_option trace.Meta.Tactic.simp true in
    simp [h]

theorem bad' : ∀ (m n : Nat), (if m = n then Ordering.eq else Ordering.gt) = Ordering.lt → False := by
  intros m n
  cases (Nat.decEq m n) with
  | isTrue h =>
    simp [h]
  | isFalse h =>
    simp [h]


import thm95.double_complex
import pseudo_normed_group.homotopy
import rescale.FiltrationPow

/-!
# A complex canonically isomorphic to `row 1` of the double complex

We have
```
lemma double_complex.row_one :
  (double_complex BD κ r r' V Λ M N).row 1 =
  BD.system κ r V r' (Hom ((cosimplicial Λ N).obj (mk 0)) M) := rfl
```

We want to "rewrite" this row in such a way that it is the target
of the homotopies that will be constructed formally from `BD.homotopy`.

Concretely, we want:
```
(((data.mul N).obj BD.data).system (rescale_constants κ N) r V r').obj (op (Hom Λ M)) ≅
  (thm95.double_complex BD.data κ r r' V Λ M N).row 1
```

This means that we need to multiply `BD` by `N`,
and then take the system associated with `rescale N (Hom Λ M)`.

We need the following isomorphisms

* `BD.system M^N = (BD.mul N).system M`
* `Hom (rescale N (Λ^N)) M = (rescale N (Hom Λ M)^N` (2 steps?)
* `(cosimplicial Λ N).obj (mk 0) = rescale N (Λ^N)`

-/

universes u v

noncomputable theory

open_locale nnreal big_operators kronecker

local attribute [instance] type_pow

local attribute [reducible] CLCFPTinv₂ CLCFPTinv₂.res
  breen_deligne.universal_map.eval_CLCFPTinv₂

-- move this
namespace category_theory

namespace arrow

variables {C : Type*} [category C] {X Y Z X' Y' Z' : C}
variables (f : X ⟶ Y) (g : Y ⟶ Z) (f' : X' ⟶ Y') (g' : Y' ⟶ Z')

lemma mk_comp_congr (hf : arrow.mk f = arrow.mk f') (hg : arrow.mk g = arrow.mk g') :
  arrow.mk (f ≫ g) = arrow.mk (f' ≫ g') :=
by { cases hf, cases hg, refl }

end arrow

end category_theory

open category_theory

section rescale

variables {BD : breen_deligne.data}
variables (κ : ℕ → ℝ≥0)
variables [BD.suitable κ]
variables (r : ℝ≥0) (V : SemiNormedGroup.{v}) [normed_with_aut r V] [fact (0 < r)]
variables {r' : ℝ≥0} [fact (0 < r')] [fact (r' ≤ 1)] (c : ℝ≥0)
variables (M : ProFiltPseuNormGrpWithTinv.{u} r')

-- move this
instance rescale_constants_suitable (N : ℝ≥0) :
  BD.suitable (rescale_constants κ N) :=
by { delta rescale_constants, apply_instance }

variables (BD)

open breen_deligne opposite ProFiltPseuNormGrpWithTinv (of)

section

def FiltrationPow_rescale_iso (n : ℕ) (N : ℝ≥0) :
  ((Filtration r').obj c).obj ((ProFiltPseuNormGrpWithTinv.Pow r' n).obj (of r' (rescale N M))) ≅
    ((Filtration r').obj (c * N⁻¹)).obj ((ProFiltPseuNormGrpWithTinv.Pow r' n).obj M) :=
iso.refl _

def complex_rescale_iso (N : ℝ≥0) :
  (BD.complex (rescale_constants κ N) r V r' c).obj (op M) ≅
  (BD.complex κ r V r' c).obj (op $ of r' $ rescale N M) :=
homological_complex.hom.iso_of_components
begin
  intro i,
  refine CLCTinv.map_iso r V _ _ _ _ _ _ _ _,
  { refine (FiltrationPow_rescale_iso _ _ _ _ ≪≫
      Filtration_cast_eq r' _ _ (mul_assoc c (κ i) (N⁻¹)) _).op, },
  { refine (FiltrationPow_rescale_iso _ _ _ _ ≪≫
      Filtration_cast_eq _ (r' * (c * κ i) * N⁻¹) (r' * (c * (κ i * N⁻¹)))
      (by simp only [mul_assoc]) _).op, },
  { refl },
  { refl }
end
begin
  intros i j hij,
  apply arrow.mk_injective,
  dsimp only [data.complex_obj_d, universal_map.eval_CLCFPTinv, universal_map.eval_CLCFPTinv₂,
    _root_.id, SemiNormedGroup.equalizer.map_nat_app, CLCTinv.map_iso_hom, CLCTinv.map, unop_op,
    Filtration_cast_eq, iso.op_hom],
  simp only [SemiNormedGroup.equalizer.map_comp_map, universal_map.eval_CLCFP_rescale,
    ← CLCFP.res_def', nat_iso.app_hom, functor.map_iso_hom, Filtration_map_app,
    FiltrationPow_rescale_iso, iso.refl_trans],
  apply SemiNormedGroup.equalizer.map_congr,
  { have := @universal_map.res_comp_eval_CLCFP V r'
      (c * (κ i * N⁻¹)) (c * κ i * N⁻¹) (c * (κ j * N⁻¹)) (c * κ j * N⁻¹)
      (BD.X j) (BD.X i) (BD.d j i) ⟨(mul_assoc _ _ _).le⟩ _ _ ⟨(mul_assoc _ _ _).le⟩,
    replace := nat_trans.congr_app this.symm (op M),
    replace := congr_arg arrow.mk this,
    refine (this.trans _).symm,
    apply arrow.mk_comp_congr, { refl }, { rw universal_map.eval_CLCFP_rescale } },
  { have := @universal_map.res_comp_eval_CLCFP V r'
      (r' * (c * (κ i * N⁻¹))) (r' * (c * κ i) * N⁻¹) (r' * (c * (κ j * N⁻¹))) (r' * (c * κ j) * N⁻¹)
      (BD.X j) (BD.X i) (BD.d j i) ⟨le_of_eq $ by simp only [mul_assoc]⟩ _ _ ⟨le_of_eq $ by simp only [mul_assoc]⟩,
    replace := nat_trans.congr_app this.symm (op M),
    replace := congr_arg arrow.mk this,
    refine (this.trans _).symm,
    apply arrow.mk_comp_congr, { refl }, { rw universal_map.eval_CLCFP_rescale } },
  any_goals { refl },
end
.

noncomputable
def system_rescale_iso (N : ℝ≥0) :
  (BD.system (rescale_constants κ N) r V r').obj (op M) ≅
  (BD.system κ r V r').obj (op $ of r' $ rescale N M) :=
nat_iso.of_components (λ c, complex_rescale_iso BD κ r V c.unop _ _)
begin
  intros c₁ c₂ h,
  ext i : 2,
  apply arrow.mk_injective,
  erw [homological_complex.comp_f, homological_complex.comp_f],
  dsimp only [data.system_obj, CLCFPTinv₂.res, complex_rescale_iso,
    homological_complex.hom.iso_of_components, CLCTinv.map_iso_hom, CLCTinv.map_nat_app],
  simp only [CLCTinv.map_comp_map],
  refl,
end

end

end rescale

namespace thm95

open breen_deligne polyhedral_lattice opposite

variables (BD : breen_deligne.data) (κ : ℕ → ℝ≥0) [BD.suitable κ]
variables (r : ℝ≥0) (V : SemiNormedGroup.{v}) [normed_with_aut r V] [fact (0 < r)]
variables {r' : ℝ≥0} [fact (0 < r')] [fact (r < r')] [fact (r' ≤ 1)] (c : ℝ≥0)

section

variables {m n : ℕ} (ϕ : universal_map m n) (g : basic_universal_map m n)
variables (c₁ c₂ : ℝ≥0) (N : ℕ) [fact (0 < N)]
variables (M : ProFiltPseuNormGrpWithTinv.{u} r')

lemma eval_FP_mul [g.suitable c₂ c₁] :
  (CLC V).map (FiltrationPow.mul_iso.{u u} r' c₁ M N n).hom.op ≫
    (CLC V).map ((basic_universal_map.eval_FP r' c₂ c₁ g).app (ProFiltPseuNormGrpWithTinv.of r' (M ^ N))).op =
  (CLC V).map ((basic_universal_map.eval_FP r' c₂ c₁ ((basic_universal_map.mul N) g)).app M).op ≫
    (CLC V).map (FiltrationPow.mul_iso.{u u} r' c₂ M N m).hom.op :=
begin
  simp only [← (CLC V).map_comp, ← op_comp], congr' 2,
  rw [← iso.inv_comp_eq, ← category.assoc, ← iso.eq_comp_inv],
  exact basic_universal_map.mul_iso_eval_FP r' c₁ c₂ g N M
end

lemma eval_CLCFP_mul [ϕ.suitable c₂ c₁] {_ : (universal_map.mul N ϕ).suitable c₂ c₁} :
  (((universal_map.mul N ϕ).eval_CLCFP V r' c₁ c₂).app (op M) ≫
    (CLC V).map (FiltrationPow.mul_iso.{u u} r' c₂ M N m).op.hom) =
  ((CLC V).map (FiltrationPow.mul_iso.{u u} r' c₁ M N n).op.hom ≫
   ((ϕ.eval_CLCFP V r' c₁ c₂).app (op (ProFiltPseuNormGrpWithTinv.of r' (M ^ N))) : _)) :=
begin
  dsimp only [universal_map.eval_CLCFP, whisker_right_app],
  simp only [universal_map.eval_LCFP_eq_eval_LCFP', universal_map.eval_LCFP',
    ← nat_trans.app_hom_apply, ← functor.map_add_hom_apply,
    add_monoid_hom.map_sum, add_monoid_hom.map_zsmul],
  rw [preadditive.sum_comp, preadditive.comp_sum],
  symmetry, have hN : 0 < N := fact.out _,
  apply finset.sum_bij (λ g hg, basic_universal_map.mul N g),
  { intros g hg, rw universal_map.mem_support_mul N hN, refine ⟨g, hg, rfl⟩ },
  { intros g hg,
    simp only [preadditive.comp_zsmul, preadditive.zsmul_comp, universal_map.coeff_mul N hN],
    congr' 1,
    have : g.suitable c₂ c₁ := universal_map.suitable_of_mem_support _ _ _ _ hg, resetI,
    rw [← basic_universal_map.eval_LCFP_eq_eval_LCFP' _ _ _ _ g this,
        ← basic_universal_map.eval_LCFP_eq_eval_LCFP'],
    swap, { apply basic_universal_map.mul_suitable },
    dsimp only [basic_universal_map.eval_LCFP, nat_trans.app_hom_apply, functor.map_add_hom_apply,
      whisker_right_app, nat_trans.op_app, unop_op],
    simp only [← functor.comp_map],
    apply eval_FP_mul },
  { intros g₁ g₂ hg₁ hg₂ H, exact basic_universal_map.mul_injective N hN H },
  { intro g, rw universal_map.mem_support_mul N hN, rintro ⟨g', h1, h2⟩, exact ⟨g', h1, h2⟩ }
end

def mul_complex_iso (c : ℝ≥0) :
  (((data.mul N).obj BD).complex κ r V r' c).obj (op M) ≅
  (BD.complex κ r V r' c).obj (op (ProFiltPseuNormGrpWithTinv.of r' $ M^N)) :=
homological_complex.hom.iso_of_components
begin
  intro i,
  refine CLCTinv.map_iso r V _ _ _ _ _ _ _ _,
  { exact (FiltrationPow.mul_iso.{u u} r' (c * κ i) M N (BD.X i)).op },
  { exact (FiltrationPow.mul_iso.{u u} r' (r' * (c * κ i)) M N (BD.X i)).op },
  { refl },
  { refl }
end
begin
  intros i j hij,
  apply arrow.mk_injective,
  dsimp only [data.complex_obj_d, universal_map.eval_CLCFPTinv, universal_map.eval_CLCFPTinv₂,
    _root_.id, SemiNormedGroup.equalizer.map_nat_app, CLCTinv.map_iso_hom, CLCTinv.map,
    data.mul_obj_d],
  simp only [SemiNormedGroup.equalizer.map_comp_map],
  apply SemiNormedGroup.equalizer.map_congr,
  { rw eval_CLCFP_mul },
  { rw eval_CLCFP_mul },
  all_goals { refl }
end

end

def mul_system_iso (N : ℕ) [fact (0 < N)] (M : ProFiltPseuNormGrpWithTinv.{u} r') :
  (((data.mul N).obj BD).system κ r V r').obj (op M) ≅
  (BD.system κ r V r').obj (op (ProFiltPseuNormGrpWithTinv.of r' $ M^N)) :=
nat_iso.of_components (λ c, mul_complex_iso BD κ r V N M c.unop)
begin
  intros c₁ c₂ hc,
  ext i : 2,
  apply arrow.mk_injective,
  erw [homological_complex.comp_f, homological_complex.comp_f],
  dsimp only [data.system_obj, CLCFPTinv₂.res, mul_complex_iso,
    homological_complex.hom.iso_of_components, CLCTinv.map_iso_hom, CLCTinv.map_nat_app],
  simp only [CLCTinv.map_comp_map],
  refl,
end

def mul_rescale_iso_row_one
  (N : ℕ) [fact (0 < N)] (N' : ℝ≥0) (h : N' = N)
  (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r') :
  (((data.mul N).obj BD).system (rescale_constants κ N') r V r').obj (op (Hom Λ M)) ≅
    ((thm95.double_complex BD κ r r' V Λ M N).row 1) :=
(mul_system_iso _ _ r V N _) ≪≫
(system_rescale_iso _ κ r V _ _) ≪≫
((BD.system κ r V r').map_iso $
  (PolyhedralLattice.Hom_cosimplicial_zero_iso Λ N r' M N' h).op)

lemma mul_rescale_iso_row_one_strict
  (N : ℕ) [fact (0 < N)] (N' : ℝ≥0) (h : N' = N)
  (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r')
  (c : ℝ≥0) (i : ℕ)
  (x : (((data.mul N).obj BD).system (rescale_constants κ N') r V r').obj (op (Hom Λ M)) c i) :
  ∥(mul_rescale_iso_row_one BD κ r V N N' h Λ M).hom x∥ = ∥x∥ :=
begin
  apply normed_add_group_hom.norm_eq_of_isometry,
  refine isometry.comp (isometry.comp _ _) _,
  { apply data.system_map_iso_isometry, },
  { dsimp only, apply CLCTinv.map_iso_isometry, },
  { apply CLCTinv.map_iso_isometry, },
end
.

lemma quux (N : ℕ) [fact (0 < N)] (M : ProFiltPseuNormGrpWithTinv.{u} r') (c₁ c₂ : ℝ≥0) (i : ℕ)
  [(universal_map.sum i N).suitable c₂ c₁] {_ : ((finset.univ : finset (fin N)).sum (basic_universal_map.proj i)).suitable c₂ c₁} :
  (universal_map.eval_CLCFP V r' c₁ c₂ (universal_map.sum i N)).app (op M) =
  (CLC V).map ((basic_universal_map.eval_FP r' c₂ c₁ ((finset.univ : finset (fin N)).sum (basic_universal_map.proj i))).app M).op :=
by { dsimp only [universal_map.sum], rw [universal_map.eval_CLCFP_of], refl }

lemma bar (N : ℕ) [fact (0 < N)] (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r')
  (c₁ c₂ : ℝ≥0) (hc : c₁ * N⁻¹ = c₂) (n : ℕ)
  {_ : ((finset.univ : finset (fin N)).sum (basic_universal_map.proj n)).suitable c₂ c₁} :
  (FiltrationPow_rescale_iso c₁ (ProFiltPseuNormGrpWithTinv.of r' ((Hom Λ M) ^ N)) n N ≪≫
     ((Filtration r').map_iso (eq_to_iso hc)).app
       ((ProFiltPseuNormGrpWithTinv.Pow r' n).obj (ProFiltPseuNormGrpWithTinv.of r' ((Hom Λ M) ^ N)))).inv ≫
  ((Filtration r').obj c₁).map ((ProFiltPseuNormGrpWithTinv.Pow r' n).map (Λ.Hom_sum N r' M)) =
  (FiltrationPow.mul_iso.{u u} r' c₂ (Hom.{u u} Λ M) N n).hom ≫
    (basic_universal_map.eval_FP.{u} r' c₂ c₁ (finset.univ.sum (basic_universal_map.proj n))).app (Hom.{u u} Λ M) :=
begin
  dsimp only [FiltrationPow_rescale_iso], rw [iso.refl_trans],
  dsimp only [FiltrationPow.mul_iso_hom, nat_iso.app_inv, functor.map_iso_inv,
    Pow_obj, ProFiltPseuNormGrpWithTinv.coe_of, Filtration_map_app],
  ext x i : 3,
  erw [comp_apply, comp_apply],
  dsimp only [Filtration_obj_map_apply, Pow_Pow_X_hom_apply, continuous_map.coe_mk,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.level_coe, subtype.coe_mk,
    Filtration.cast_le_apply, pseudo_normed_group.coe_cast_le,
    basic_universal_map.eval_FP, basic_universal_map.eval_png₀,
    ProFiltPseuNormGrpWithTinv.Pow_map,
    profinitely_filtered_pseudo_normed_group_with_Tinv.pi_map_to_fun],
  rw [← comphaus_filtered_pseudo_normed_group_hom.coe_to_add_monoid_hom,
    ← comphaus_filtered_pseudo_normed_group_hom.to_add_monoid_hom_hom_apply],
  simp only [PolyhedralLattice.Hom_sum_apply, add_monoid_hom.map_sum,
    add_monoid_hom.finset_sum_apply, finset.sum_apply],
  apply fintype.sum_congr,
  intro j,
  simp only [comphaus_filtered_pseudo_normed_group_hom.coe_to_add_monoid_hom,
    comphaus_filtered_pseudo_normed_group_hom.to_add_monoid_hom_hom_apply,
    basic_universal_map.eval_png_apply, ProFiltPseuNormGrpWithTinv.Pow_Pow_X_hom_to_fun,
    ProFiltPseuNormGrpWithTinv.Pow_Pow_X_equiv_symm_apply,
    equiv.inv_fun_as_coe, equiv.symm_symm, equiv.trans_apply, equiv.symm_trans_apply,
    equiv.arrow_congr_apply, function.comp, equiv.refl_apply, equiv.curry_symm_apply,
    function.uncurry, equiv.prod_comm_symm, equiv.prod_comm_apply, prod.fst_swap, prod.snd_swap],
  rw [← fin_prod_fin_equiv.sum_comp], swap, { apply_instance },
  simp only [basic_universal_map.proj,
    matrix.reindex_linear_equiv_apply, matrix.reindex_apply, matrix.submatrix_apply,
    equiv.punit_prod_symm_apply, matrix.kronecker, matrix.one_apply,
    basic_universal_map.proj_aux, equiv.symm_apply_apply,
    boole_mul, ← ite_and, @eq_comm _ i, boole_mul, matrix.kronecker_map, subtype.val_eq_coe],
  simp_rw [ite_smul, one_smul, zero_smul],
  convert (finset.sum_ite_eq' finset.univ (j, i) (λ p, x.val p.2 p.1)).symm using 2,
  { simp only [finset.mem_univ, if_true, subtype.val_eq_coe] },
  { ext ⟨a, b⟩,
    split_ifs,
    any_goals {refl},
    all_goals { rw [← prod.mk.inj_iff, prod.mk.eta] at h, tauto } },
end

lemma foo (N : ℕ) [fact (0 < N)] (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r')
  (c₁ c₂ : ℝ≥0) (hc : c₁ * N⁻¹ = c₂) (i : ℕ) [H : universal_map.suitable c₂ c₁ (universal_map.sum i N)] :
  (CLC V).map ((FiltrationPow r' c₁ i).op.map (Λ.Hom_sum N r' M).op) ≫
    (CLC V).map (FiltrationPow_rescale_iso c₁ ((ProFiltPseuNormGrpWithTinv.of r' ((Hom Λ M) ^ N))) i N ≪≫
      Filtration_cast_eq r' (c₁ * N⁻¹) c₂ hc ((ProFiltPseuNormGrpWithTinv.Pow r' i).obj ((ProFiltPseuNormGrpWithTinv.of r' ((Hom Λ M) ^ N))))).op.inv =
  ((universal_map.eval_CLCFP V r' c₁ c₂ (universal_map.sum i N)).app (op (Hom Λ M)) ≫ (CLC V).map (FiltrationPow.mul_iso.{u u} r' c₂ (Hom Λ M) N i).op.hom) :=
begin
  rw [← (CLC V).map_comp],
  dsimp only [FiltrationPow, category_theory.functor.op_map, category_theory.functor.comp_map,
    Filtration_cast_eq, quiver.hom.unop_op],
  rw [iso.op_inv, quux, ← (CLC V).map_comp, iso.op_hom, ← op_comp, ← op_comp],
  swap, { exact @basic_universal_map.suitable_of_suitable_of _ _ _ _ _ H },
  congr' 2,
  apply bar,
end

lemma row_map_eq_sum_comp
  (N : ℕ) [fact (0 < N)] (N' : ℝ≥0) (h : N' = N)
  [∀ (i : ℕ), universal_map.suitable (rescale_constants κ N' i) (κ i) ((BD.sum N).f i)]
  (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r') :
  (thm95.double_complex BD κ r r' V Λ M N).row_map 0 1 =
    (iso.refl ((BD.system κ r V r').obj (op (Hom Λ M)))).inv ≫
    (BD_system_map (BD.sum N) κ
      (rescale_constants κ N') r V).app (op (Hom Λ M)) ≫
    (thm95.mul_rescale_iso_row_one BD κ r V N N' h Λ M).hom :=
begin
  unfreezingI { subst h },
  dsimp only [iso.refl_inv],
  erw category.id_comp,
  rw [← iso.comp_inv_eq],
  rw [thm95.double_complex.row_map_zero_one],
  dsimp only [mul_rescale_iso_row_one, iso.trans_inv, nat_trans.comp_app, functor.map_iso_inv],
  simp only [← category.assoc, ← (BD.system κ r V r').map_comp, ← nat_trans.comp_app,
    iso.op_inv, ← op_comp, PolyhedralLattice.Cech_augmentation_map_eq_Hom_sum],
  rw [iso.comp_inv_eq],
  ext c i : 4,
  apply arrow.mk_injective,
  erw [nat_trans.comp_app, nat_trans.comp_app,
    homological_complex.comp_f, homological_complex.comp_f],
  dsimp only [BD_system_map_app_app, BD_map_app_f, data.sum_f, data.system_map, data.complex,
    data.complex₂_map_f, mul_system_iso, system_rescale_iso, complex_rescale_iso, mul_complex_iso],
  erw [nat_iso.of_components_hom_app, nat_iso.of_components_inv_app],
  dsimp only [homological_complex.hom.iso_of_components_hom_f,
    homological_complex.hom.iso_of_components_inv_f],
  dsimp only [CLCFPTinv₂, universal_map.eval_CLCFPTinv₂, CLCTinv.map_iso_hom, CLCTinv.map_iso_inv,
    CLCTinv.F_map, _root_.id, CLCTinv.map, SemiNormedGroup.equalizer.map_nat_app, unop_op],
  rw [SemiNormedGroup.equalizer.map_comp_map, SemiNormedGroup.equalizer.map_comp_map],
  apply SemiNormedGroup.equalizer.map_congr,
  { rw foo, refl },
  { rw foo, refl },
  all_goals { refl },
end

end thm95


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default

universes u v w

namespace Mathlib

def stream (α : Type u) :=
  ℕ → α

namespace stream

def cons {α : Type u} (a : α) (s : stream α) : stream α :=
  fun (i : ℕ) => sorry

infixr:67 " :: " => Mathlib.stream.cons

def head {α : Type u} (s : stream α) : α :=
  s 0

def tail {α : Type u} (s : stream α) : stream α :=
  fun (i : ℕ) => s (i + 1)

def drop {α : Type u} (n : ℕ) (s : stream α) : stream α :=
  fun (i : ℕ) => s (i + n)

def nth {α : Type u} (n : ℕ) (s : stream α) : α :=
  s n

protected theorem eta {α : Type u} (s : stream α) : head s :: tail s = s :=
  funext
    fun (i : ℕ) =>
      nat.cases_on i (Eq.refl (cons (head s) (tail s) 0)) fun (i : ℕ) => Eq.refl (cons (head s) (tail s) (Nat.succ i))

theorem nth_zero_cons {α : Type u} (a : α) (s : stream α) : nth 0 (a :: s) = a :=
  rfl

theorem head_cons {α : Type u} (a : α) (s : stream α) : head (a :: s) = a :=
  rfl

theorem tail_cons {α : Type u} (a : α) (s : stream α) : tail (a :: s) = s :=
  rfl

theorem tail_drop {α : Type u} (n : ℕ) (s : stream α) : tail (drop n s) = drop n (tail s) := sorry

theorem nth_drop {α : Type u} (n : ℕ) (m : ℕ) (s : stream α) : nth n (drop m s) = nth (n + m) s :=
  rfl

theorem tail_eq_drop {α : Type u} (s : stream α) : tail s = drop 1 s :=
  rfl

theorem drop_drop {α : Type u} (n : ℕ) (m : ℕ) (s : stream α) : drop n (drop m s) = drop (n + m) s := sorry

theorem nth_succ {α : Type u} (n : ℕ) (s : stream α) : nth (Nat.succ n) s = nth n (tail s) :=
  rfl

theorem drop_succ {α : Type u} (n : ℕ) (s : stream α) : drop (Nat.succ n) s = drop n (tail s) :=
  rfl

protected theorem ext {α : Type u} {s₁ : stream α} {s₂ : stream α} : (∀ (n : ℕ), nth n s₁ = nth n s₂) → s₁ = s₂ :=
  fun (h : ∀ (n : ℕ), nth n s₁ = nth n s₂) => funext h

def all {α : Type u} (p : α → Prop) (s : stream α) :=
  ∀ (n : ℕ), p (nth n s)

def any {α : Type u} (p : α → Prop) (s : stream α) :=
  ∃ (n : ℕ), p (nth n s)

theorem all_def {α : Type u} (p : α → Prop) (s : stream α) : all p s = ∀ (n : ℕ), p (nth n s) :=
  rfl

theorem any_def {α : Type u} (p : α → Prop) (s : stream α) : any p s = ∃ (n : ℕ), p (nth n s) :=
  rfl

protected def mem {α : Type u} (a : α) (s : stream α) :=
  any (fun (b : α) => a = b) s

protected instance has_mem {α : Type u} : has_mem α (stream α) :=
  has_mem.mk stream.mem

theorem mem_cons {α : Type u} (a : α) (s : stream α) : a ∈ a :: s :=
  exists.intro 0 rfl

theorem mem_cons_of_mem {α : Type u} {a : α} {s : stream α} (b : α) : a ∈ s → a ∈ b :: s := sorry

theorem eq_or_mem_of_mem_cons {α : Type u} {a : α} {b : α} {s : stream α} : a ∈ b :: s → a = b ∨ a ∈ s := sorry

theorem mem_of_nth_eq {α : Type u} {n : ℕ} {s : stream α} {a : α} : a = nth n s → a ∈ s :=
  fun (h : a = nth n s) => exists.intro n h

def map {α : Type u} {β : Type v} (f : α → β) (s : stream α) : stream β :=
  fun (n : ℕ) => f (nth n s)

theorem drop_map {α : Type u} {β : Type v} (f : α → β) (n : ℕ) (s : stream α) : drop n (map f s) = map f (drop n s) :=
  stream.ext fun (i : ℕ) => rfl

theorem nth_map {α : Type u} {β : Type v} (f : α → β) (n : ℕ) (s : stream α) : nth n (map f s) = f (nth n s) :=
  rfl

theorem tail_map {α : Type u} {β : Type v} (f : α → β) (s : stream α) : tail (map f s) = map f (tail s) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (tail (map f s) = map f (tail s))) (tail_eq_drop (map f s))))
    (Eq.refl (drop 1 (map f s)))

theorem head_map {α : Type u} {β : Type v} (f : α → β) (s : stream α) : head (map f s) = f (head s) :=
  rfl

theorem map_eq {α : Type u} {β : Type v} (f : α → β) (s : stream α) : map f s = f (head s) :: map f (tail s) := sorry

theorem map_cons {α : Type u} {β : Type v} (f : α → β) (a : α) (s : stream α) : map f (a :: s) = f a :: map f s := sorry

theorem map_id {α : Type u} (s : stream α) : map id s = s :=
  rfl

theorem map_map {α : Type u} {β : Type v} {δ : Type w} (g : β → δ) (f : α → β) (s : stream α) : map g (map f s) = map (g ∘ f) s :=
  rfl

theorem map_tail {α : Type u} {β : Type v} (f : α → β) (s : stream α) : map f (tail s) = tail (map f s) :=
  rfl

theorem mem_map {α : Type u} {β : Type v} (f : α → β) {a : α} {s : stream α} : a ∈ s → f a ∈ map f s := sorry

theorem exists_of_mem_map {α : Type u} {β : Type v} {f : α → β} {b : β} {s : stream α} : b ∈ map f s → ∃ (a : α), a ∈ s ∧ f a = b := sorry

def zip {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (s₁ : stream α) (s₂ : stream β) : stream δ :=
  fun (n : ℕ) => f (nth n s₁) (nth n s₂)

theorem drop_zip {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (n : ℕ) (s₁ : stream α) (s₂ : stream β) : drop n (zip f s₁ s₂) = zip f (drop n s₁) (drop n s₂) :=
  stream.ext fun (i : ℕ) => rfl

theorem nth_zip {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (n : ℕ) (s₁ : stream α) (s₂ : stream β) : nth n (zip f s₁ s₂) = f (nth n s₁) (nth n s₂) :=
  rfl

theorem head_zip {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (s₁ : stream α) (s₂ : stream β) : head (zip f s₁ s₂) = f (head s₁) (head s₂) :=
  rfl

theorem tail_zip {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (s₁ : stream α) (s₂ : stream β) : tail (zip f s₁ s₂) = zip f (tail s₁) (tail s₂) :=
  rfl

theorem zip_eq {α : Type u} {β : Type v} {δ : Type w} (f : α → β → δ) (s₁ : stream α) (s₂ : stream β) : zip f s₁ s₂ = f (head s₁) (head s₂) :: zip f (tail s₁) (tail s₂) := sorry

def const {α : Type u} (a : α) : stream α :=
  fun (n : ℕ) => a

theorem mem_const {α : Type u} (a : α) : a ∈ const a :=
  exists.intro 0 rfl

theorem const_eq {α : Type u} (a : α) : const a = a :: const a :=
  stream.ext fun (n : ℕ) => nat.cases_on n (Eq.refl (nth 0 (const a))) fun (n : ℕ) => Eq.refl (nth (Nat.succ n) (const a))

theorem tail_const {α : Type u} (a : α) : tail (const a) = const a :=
  (fun (this : tail (a :: const a) = const a) =>
      eq.mp (Eq._oldrec (Eq.refl (tail (a :: const a) = const a)) (Eq.symm (const_eq a))) this)
    rfl

theorem map_const {α : Type u} {β : Type v} (f : α → β) (a : α) : map f (const a) = const (f a) :=
  rfl

theorem nth_const {α : Type u} (n : ℕ) (a : α) : nth n (const a) = a :=
  rfl

theorem drop_const {α : Type u} (n : ℕ) (a : α) : drop n (const a) = const a :=
  stream.ext fun (i : ℕ) => rfl

def iterate {α : Type u} (f : α → α) (a : α) : stream α :=
  fun (n : ℕ) => nat.rec_on n a fun (n : ℕ) (r : α) => f r

theorem head_iterate {α : Type u} (f : α → α) (a : α) : head (iterate f a) = a :=
  rfl

theorem tail_iterate {α : Type u} (f : α → α) (a : α) : tail (iterate f a) = iterate f (f a) := sorry

theorem iterate_eq {α : Type u} (f : α → α) (a : α) : iterate f a = a :: iterate f (f a) := sorry

theorem nth_zero_iterate {α : Type u} (f : α → α) (a : α) : nth 0 (iterate f a) = a :=
  rfl

theorem nth_succ_iterate {α : Type u} (n : ℕ) (f : α → α) (a : α) : nth (Nat.succ n) (iterate f a) = nth n (iterate f (f a)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nth (Nat.succ n) (iterate f a) = nth n (iterate f (f a)))) (nth_succ n (iterate f a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth n (tail (iterate f a)) = nth n (iterate f (f a)))) (tail_iterate f a)))
      (Eq.refl (nth n (iterate f (f a)))))

def is_bisimulation {α : Type u} (R : stream α → stream α → Prop) :=
  ∀ {s₁ s₂ : stream α}, R s₁ s₂ → head s₁ = head s₂ ∧ R (tail s₁) (tail s₂)

theorem nth_of_bisim {α : Type u} (R : stream α → stream α → Prop) (bisim : is_bisimulation R) {s₁ : stream α} {s₂ : stream α} (n : ℕ) : R s₁ s₂ → nth n s₁ = nth n s₂ ∧ R (drop (n + 1) s₁) (drop (n + 1) s₂) := sorry

theorem eq_of_bisim {α : Type u} (R : stream α → stream α → Prop) (bisim : is_bisimulation R) {s₁ : stream α} {s₂ : stream α} : R s₁ s₂ → s₁ = s₂ :=
  fun (r : R s₁ s₂) => stream.ext fun (n : ℕ) => and.elim_left (nth_of_bisim R bisim n r)

theorem bisim_simple {α : Type u} (s₁ : stream α) (s₂ : stream α) : head s₁ = head s₂ → s₁ = tail s₁ → s₂ = tail s₂ → s₁ = s₂ := sorry

theorem coinduction {α : Type u} {s₁ : stream α} {s₂ : stream α} : head s₁ = head s₂ → (∀ (β : Type u) (fr : stream α → β), fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂)) → s₁ = s₂ := sorry

theorem iterate_id {α : Type u} (a : α) : iterate id a = const a := sorry

theorem map_iterate {α : Type u} (f : α → α) (a : α) : iterate f (f a) = map f (iterate f a) := sorry

def corec {α : Type u} {β : Type v} (f : α → β) (g : α → α) : α → stream β :=
  fun (a : α) => map f (iterate g a)

def corec_on {α : Type u} {β : Type v} (a : α) (f : α → β) (g : α → α) : stream β :=
  corec f g a

theorem corec_def {α : Type u} {β : Type v} (f : α → β) (g : α → α) (a : α) : corec f g a = map f (iterate g a) :=
  rfl

theorem corec_eq {α : Type u} {β : Type v} (f : α → β) (g : α → α) (a : α) : corec f g a = f a :: corec f g (g a) := sorry

theorem corec_id_id_eq_const {α : Type u} (a : α) : corec id id a = const a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (corec id id a = const a)) (corec_def id id a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (map id (iterate id a) = const a)) (map_id (iterate id a))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (iterate id a = const a)) (iterate_id a))) (Eq.refl (const a))))

theorem corec_id_f_eq_iterate {α : Type u} (f : α → α) (a : α) : corec id f a = iterate f a :=
  rfl

def corec' {α : Type u} {β : Type v} (f : α → β × α) : α → stream β :=
  corec (prod.fst ∘ f) (prod.snd ∘ f)

theorem corec'_eq {α : Type u} {β : Type v} (f : α → β × α) (a : α) : corec' f a = prod.fst (f a) :: corec' f (prod.snd (f a)) :=
  corec_eq (prod.fst ∘ f) (prod.snd ∘ f) a

-- corec is also known as unfold

def unfolds {α : Type u} {β : Type v} (g : α → β) (f : α → α) (a : α) : stream β :=
  corec g f a

theorem unfolds_eq {α : Type u} {β : Type v} (g : α → β) (f : α → α) (a : α) : unfolds g f a = g a :: unfolds g f (f a) := sorry

theorem nth_unfolds_head_tail {α : Type u} (n : ℕ) (s : stream α) : nth n (unfolds head tail s) = nth n s := sorry

theorem unfolds_head_eq {α : Type u} (s : stream α) : unfolds head tail s = s :=
  stream.ext fun (n : ℕ) => nth_unfolds_head_tail n s

def interleave {α : Type u} (s₁ : stream α) (s₂ : stream α) : stream α :=
  corec_on (s₁, s₂) (fun (_x : stream α × stream α) => sorry) fun (_x : stream α × stream α) => sorry

infixl:65 "⋈" => Mathlib.stream.interleave

theorem interleave_eq {α : Type u} (s₁ : stream α) (s₂ : stream α) : s₁⋈s₂ = head s₁ :: head s₂ :: (tail s₁⋈tail s₂) := sorry

theorem tail_interleave {α : Type u} (s₁ : stream α) (s₂ : stream α) : tail (s₁⋈s₂) = s₂⋈tail s₁ := sorry

theorem interleave_tail_tail {α : Type u} (s₁ : stream α) (s₂ : stream α) : tail s₁⋈tail s₂ = tail (tail (s₁⋈s₂)) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (tail s₁⋈tail s₂ = tail (tail (s₁⋈s₂)))) (interleave_eq s₁ s₂)))
    (Eq.refl (tail s₁⋈tail s₂))

theorem nth_interleave_left {α : Type u} (n : ℕ) (s₁ : stream α) (s₂ : stream α) : nth (bit0 1 * n) (s₁⋈s₂) = nth n s₁ := sorry

theorem nth_interleave_right {α : Type u} (n : ℕ) (s₁ : stream α) (s₂ : stream α) : nth (bit0 1 * n + 1) (s₁⋈s₂) = nth n s₂ := sorry

theorem mem_interleave_left {α : Type u} {a : α} {s₁ : stream α} (s₂ : stream α) : a ∈ s₁ → a ∈ s₁⋈s₂ := sorry

theorem mem_interleave_right {α : Type u} {a : α} {s₁ : stream α} (s₂ : stream α) : a ∈ s₂ → a ∈ s₁⋈s₂ := sorry

def even {α : Type u} (s : stream α) : stream α :=
  corec (fun (s : stream α) => head s) (fun (s : stream α) => tail (tail s)) s

def odd {α : Type u} (s : stream α) : stream α :=
  even (tail s)

theorem odd_eq {α : Type u} (s : stream α) : odd s = even (tail s) :=
  rfl

theorem head_even {α : Type u} (s : stream α) : head (even s) = head s :=
  rfl

theorem tail_even {α : Type u} (s : stream α) : tail (even s) = even (tail (tail s)) := sorry

theorem even_cons_cons {α : Type u} (a₁ : α) (a₂ : α) (s : stream α) : even (a₁ :: a₂ :: s) = a₁ :: even s := sorry

theorem even_tail {α : Type u} (s : stream α) : even (tail s) = odd s :=
  rfl

theorem even_interleave {α : Type u} (s₁ : stream α) (s₂ : stream α) : even (s₁⋈s₂) = s₁ := sorry

theorem interleave_even_odd {α : Type u} (s₁ : stream α) : even s₁⋈odd s₁ = s₁ := sorry

theorem nth_even {α : Type u} (n : ℕ) (s : stream α) : nth n (even s) = nth (bit0 1 * n) s := sorry

theorem nth_odd {α : Type u} (n : ℕ) (s : stream α) : nth n (odd s) = nth (bit0 1 * n + 1) s :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nth n (odd s) = nth (bit0 1 * n + 1) s)) (odd_eq s)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (nth n (even (tail s)) = nth (bit0 1 * n + 1) s)) (nth_even n (tail s))))
      (Eq.refl (nth (bit0 1 * n) (tail s))))

theorem mem_of_mem_even {α : Type u} (a : α) (s : stream α) : a ∈ even s → a ∈ s := sorry

theorem mem_of_mem_odd {α : Type u} (a : α) (s : stream α) : a ∈ odd s → a ∈ s := sorry

def append_stream {α : Type u} : List α → stream α → stream α :=
  sorry

theorem nil_append_stream {α : Type u} (s : stream α) : append_stream [] s = s :=
  rfl

theorem cons_append_stream {α : Type u} (a : α) (l : List α) (s : stream α) : append_stream (a :: l) s = a :: append_stream l s :=
  rfl

infixl:65 "++ₛ" => Mathlib.stream.append_stream

theorem append_append_stream {α : Type u} (l₁ : List α) (l₂ : List α) (s : stream α) : l₁ ++ l₂++ₛs = l₁++ₛ(l₂++ₛs) := sorry

theorem map_append_stream {α : Type u} {β : Type v} (f : α → β) (l : List α) (s : stream α) : map f (l++ₛs) = list.map f l++ₛmap f s := sorry

theorem drop_append_stream {α : Type u} (l : List α) (s : stream α) : drop (list.length l) (l++ₛs) = s := sorry

theorem append_stream_head_tail {α : Type u} (s : stream α) : [head s]++ₛtail s = s :=
  eq.mpr (id (Eq._oldrec (Eq.refl ([head s]++ₛtail s = s)) (cons_append_stream (head s) [] (tail s))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (head s :: ([]++ₛtail s) = s)) (nil_append_stream (tail s))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (head s :: tail s = s)) (stream.eta s))) (Eq.refl s)))

theorem mem_append_stream_right {α : Type u} {a : α} (l : List α) {s : stream α} : a ∈ s → a ∈ l++ₛs := sorry

theorem mem_append_stream_left {α : Type u} {a : α} {l : List α} (s : stream α) : a ∈ l → a ∈ l++ₛs := sorry

def approx {α : Type u} : ℕ → stream α → List α :=
  sorry

theorem approx_zero {α : Type u} (s : stream α) : approx 0 s = [] :=
  rfl

theorem approx_succ {α : Type u} (n : ℕ) (s : stream α) : approx (Nat.succ n) s = head s :: approx n (tail s) :=
  rfl

theorem nth_approx {α : Type u} (n : ℕ) (s : stream α) : list.nth (approx (Nat.succ n) s) n = some (nth n s) := sorry

theorem append_approx_drop {α : Type u} (n : ℕ) (s : stream α) : approx n s++ₛdrop n s = s := sorry

-- Take theorem reduces a proof of equality of infinite streams to an

-- induction over all their finite approximations.

theorem take_theorem {α : Type u} (s₁ : stream α) (s₂ : stream α) : (∀ (n : ℕ), approx n s₁ = approx n s₂) → s₁ = s₂ := sorry

-- auxiliary def for cycle corecursive def

-- auxiliary def for cycle corecursive def

def cycle {α : Type u} (l : List α) : l ≠ [] → stream α :=
  sorry

theorem cycle_eq {α : Type u} (l : List α) (h : l ≠ []) : cycle l h = l++ₛcycle l h := sorry

theorem mem_cycle {α : Type u} {a : α} {l : List α} (h : l ≠ []) : a ∈ l → a ∈ cycle l h :=
  fun (ainl : a ∈ l) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (a ∈ cycle l h)) (cycle_eq l h))) (mem_append_stream_left (cycle l h) ainl)

theorem cycle_singleton {α : Type u} (a : α) (h : [a] ≠ []) : cycle [a] h = const a := sorry

def tails {α : Type u} (s : stream α) : stream (stream α) :=
  corec id tail (tail s)

theorem tails_eq {α : Type u} (s : stream α) : tails s = tail s :: tails (tail s) := sorry

theorem nth_tails {α : Type u} (n : ℕ) (s : stream α) : nth n (tails s) = drop n (tail s) := sorry

theorem tails_eq_iterate {α : Type u} (s : stream α) : tails s = iterate tail (tail s) :=
  rfl

def inits_core {α : Type u} (l : List α) (s : stream α) : stream (List α) :=
  corec_on (l, s) (fun (_x : List α × stream α) => sorry) fun (p : List α × stream α) => sorry

def inits {α : Type u} (s : stream α) : stream (List α) :=
  inits_core [head s] (tail s)

theorem inits_core_eq {α : Type u} (l : List α) (s : stream α) : inits_core l s = l :: inits_core (l ++ [head s]) (tail s) := sorry

theorem tail_inits {α : Type u} (s : stream α) : tail (inits s) = inits_core [head s, head (tail s)] (tail (tail s)) := sorry

theorem inits_tail {α : Type u} (s : stream α) : inits (tail s) = inits_core [head (tail s)] (tail (tail s)) :=
  rfl

theorem cons_nth_inits_core {α : Type u} (a : α) (n : ℕ) (l : List α) (s : stream α) : a :: nth n (inits_core l s) = nth n (inits_core (a :: l) s) := sorry

theorem nth_inits {α : Type u} (n : ℕ) (s : stream α) : nth n (inits s) = approx (Nat.succ n) s := sorry

theorem inits_eq {α : Type u} (s : stream α) : inits s = [head s] :: map (List.cons (head s)) (inits (tail s)) := sorry

theorem zip_inits_tails {α : Type u} (s : stream α) : zip append_stream (inits s) (tails s) = const s := sorry

def pure {α : Type u} (a : α) : stream α :=
  const a

def apply {α : Type u} {β : Type v} (f : stream (α → β)) (s : stream α) : stream β :=
  fun (n : ℕ) => nth n f (nth n s)

infixl:75 "⊛" => Mathlib.stream.apply

theorem identity {α : Type u} (s : stream α) : pure id⊛s = s :=
  rfl

theorem composition {α : Type u} {β : Type v} {δ : Type w} (g : stream (β → δ)) (f : stream (α → β)) (s : stream α) : pure function.comp⊛g⊛f⊛s = g⊛(f⊛s) :=
  rfl

theorem homomorphism {α : Type u} {β : Type v} (f : α → β) (a : α) : pure f⊛pure a = pure (f a) :=
  rfl

theorem interchange {α : Type u} {β : Type v} (fs : stream (α → β)) (a : α) : fs⊛pure a = (pure fun (f : α → β) => f a)⊛fs :=
  rfl

theorem map_eq_apply {α : Type u} {β : Type v} (f : α → β) (s : stream α) : map f s = pure f⊛s :=
  rfl

def nats : stream ℕ :=
  fun (n : ℕ) => n

theorem nth_nats (n : ℕ) : nth n nats = n :=
  rfl

theorem nats_eq : nats = 0 :: map Nat.succ nats := sorry