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

! This file was ported from Lean 3 source module algebra.char_p.quotient
! leanprover-community/mathlib commit 85e3c05a94b27c84dc6f234cf88326d5e0096ec3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Basic
import Mathbin.RingTheory.Ideal.Quotient

/-!
# Characteristic of quotients rings
-/

universe u v

namespace CharP

/- warning: char_p.quotient -> CharP.quotient is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : CommRing.{u1} R] (p : Nat) [hp1 : Fact (Nat.Prime p)], (Membership.Mem.{u1, u1} R (Set.{u1} R) (Set.hasMem.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p) (nonunits.{u1} R (Ring.toMonoid.{u1} R (CommRing.toRing.{u1} R _inst_1)))) -> (CharP.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))) (AddGroupWithOne.toAddMonoidWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))) (AddCommGroupWithOne.toAddGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))) (Ring.toAddCommGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))) (Ideal.Quotient.commRing.{u1} R _inst_1 (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) p)))))))) p)
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : CommRing.{u1} R] (p : Nat) [hp1 : Fact (Nat.Prime p)], (Membership.mem.{u1, u1} R (Set.{u1} R) (Set.instMembershipSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p) (nonunits.{u1} R (MonoidWithZero.toMonoid.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) -> (CharP.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p)))) (AddGroupWithOne.toAddMonoidWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p)))) (Ring.toAddGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p)))) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p)))) (Ideal.Quotient.commRing.{u1} R _inst_1 (Ideal.span.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) p))))))) p)
Case conversion may be inaccurate. Consider using '#align char_p.quotient CharP.quotientₓ'. -/
theorem quotient (R : Type u) [CommRing R] (p : ℕ) [hp1 : Fact p.Prime] (hp2 : ↑p ∈ nonunits R) :
    CharP (R ⧸ (Ideal.span {p} : Ideal R)) p :=
  have hp0 : (p : R ⧸ (Ideal.span {p} : Ideal R)) = 0 :=
    map_natCast (Ideal.Quotient.mk (Ideal.span {p} : Ideal R)) p ▸
      Ideal.Quotient.eq_zero_iff_mem.2 (Ideal.subset_span <| Set.mem_singleton _)
  ringChar.of_eq <|
    Or.resolve_left ((Nat.dvd_prime hp1.1).1 <| ringChar.dvd hp0) fun h1 =>
      hp2 <|
        isUnit_iff_dvd_one.2 <|
          Ideal.mem_span_singleton.1 <|
            Ideal.Quotient.eq_zero_iff_mem.1 <|
              @Subsingleton.elim (@CharP.subsingleton _ <| ringChar.of_eq h1) _ _
#align char_p.quotient CharP.quotient

/- warning: char_p.quotient' -> CharP.quotient' is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (p : Nat) [_inst_2 : CharP.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))) p] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (forall (x : Nat), (Membership.Mem.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SetLike.hasMem.{u1, u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) R (Submodule.setLike.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) x) I) -> (Eq.{succ u1} R ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1)))))))) x) (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))))) -> (CharP.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (AddGroupWithOne.toAddMonoidWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (AddCommGroupWithOne.toAddGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Ring.toAddCommGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Ideal.Quotient.commRing.{u1} R _inst_1 I))))) p)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (p : Nat) [_inst_2 : CharP.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (Ring.toAddGroupWithOne.{u1} R (CommRing.toRing.{u1} R _inst_1))) p] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (forall (x : Nat), (Membership.mem.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SetLike.instMembership.{u1, u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) R (Submodule.setLike.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) x) I) -> (Eq.{succ u1} R (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))) x) (OfNat.ofNat.{u1} R 0 (Zero.toOfNat0.{u1} R (CommMonoidWithZero.toZero.{u1} R (CommSemiring.toCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1))))))) -> (CharP.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (AddGroupWithOne.toAddMonoidWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Ring.toAddGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Ideal.Quotient.commRing.{u1} R _inst_1 I)))) p)
Case conversion may be inaccurate. Consider using '#align char_p.quotient' CharP.quotient'ₓ'. -/
/-- If an ideal does not contain any coercions of natural numbers other than zero, then its quotient
inherits the characteristic of the underlying ring. -/
theorem quotient' {R : Type _} [CommRing R] (p : ℕ) [CharP R p] (I : Ideal R)
    (h : ∀ x : ℕ, (x : R) ∈ I → (x : R) = 0) : CharP (R ⧸ I) p :=
  ⟨fun x => by
    rw [← cast_eq_zero_iff R p x, ← map_natCast (Ideal.Quotient.mk I)]
    refine' ideal.quotient.eq.trans (_ : ↑x - 0 ∈ I ↔ _)
    rw [sub_zero]
    exact ⟨h x, fun h' => h'.symm ▸ I.zero_mem⟩⟩
#align char_p.quotient' CharP.quotient'

end CharP

/- warning: ideal.quotient.index_eq_zero -> Ideal.Quotient.index_eq_zero is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), Eq.{succ u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (HasLiftT.mk.{1, succ u1} Nat (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (CoeTCₓ.coe.{1, succ u1} Nat (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Nat.castCoe.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (AddMonoidWithOne.toNatCast.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (AddGroupWithOne.toAddMonoidWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (AddCommGroupWithOne.toAddGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Ring.toAddCommGroupWithOne.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Ideal.Quotient.commRing.{u1} R _inst_1 I))))))))) (AddSubgroup.index.{u1} R (AddCommGroup.toAddGroup.{u1} R (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Submodule.toAddSubgroup.{u1, u1} R R (CommRing.toRing.{u1} R _inst_1) (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I))) (OfNat.ofNat.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) 0 (OfNat.mk.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) 0 (Zero.zero.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasQuotient.{u1} R _inst_1) I) (Submodule.Quotient.HasQuotient.Quotient.hasZero.{u1, u1} R R (CommRing.toRing.{u1} R _inst_1) (NonUnitalNonAssocRing.toAddCommGroup.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), Eq.{succ u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Nat.cast.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (NonAssocRing.toNatCast.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Ring.toNonAssocRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (CommRing.toRing.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Ideal.Quotient.commRing.{u1} R _inst_1 I)))) (AddSubgroup.index.{u1} R (AddCommGroup.toAddGroup.{u1} R (Ring.toAddCommGroup.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Submodule.toAddSubgroup.{u1, u1} R R (CommRing.toRing.{u1} R _inst_1) (Ring.toAddCommGroup.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I))) (OfNat.ofNat.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) 0 (Zero.toOfNat0.{u1} (HasQuotient.Quotient.{u1, u1} R (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instHasQuotientIdealToSemiringToRing.{u1} R _inst_1) I) (Submodule.Quotient.instZeroQuotientSubmoduleToSemiringToAddCommMonoidHasQuotient.{u1, u1} R R (CommRing.toRing.{u1} R _inst_1) (Ring.toAddCommGroup.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I)))
Case conversion may be inaccurate. Consider using '#align ideal.quotient.index_eq_zero Ideal.Quotient.index_eq_zeroₓ'. -/
theorem Ideal.Quotient.index_eq_zero {R : Type _} [CommRing R] (I : Ideal R) :
    (I.toAddSubgroup.index : R ⧸ I) = 0 :=
  by
  rw [AddSubgroup.index, Nat.card_eq]
  split_ifs with hq; swap; simp
  by_contra h
  -- TODO: can we avoid rewriting the `I.to_add_subgroup` here?
  letI : Fintype (R ⧸ I) := @Fintype.ofFinite _ hq
  have h : (Fintype.card (R ⧸ I) : R ⧸ I) ≠ 0 := h
  simpa using h
#align ideal.quotient.index_eq_zero Ideal.Quotient.index_eq_zero


import mll

def sequent := list Form

instance : has_append sequent := ⟨list.append⟩
instance : has_mem Form sequent := ⟨list.mem⟩

inductive proof : sequent → Type
| ax (A)                   : proof [~A, A]
| cut (A) {Γ Γ' Δ Δ'}      : proof (Γ ++ [A] ++ Γ') → proof (Δ ++ [~A] ++ Δ') → proof (Γ++Γ'++Δ++Δ')
| tensor {A B} {Γ Γ' Δ Δ'} : proof (Γ ++ [A] ++ Γ') → proof (Δ ++ [B] ++ Δ') → proof (Γ++Γ'++ [A ⊗ B] ++Δ++Δ')
| par {A B} {Γ Γ'}         : proof (Γ ++ [A,B] ++ Γ') → proof (Γ ++ [A ⅋ B] ++ Γ')
| ex {A B} {Γ Γ'}          : proof (Γ ++ [A,B] ++ Γ') → proof (Γ ++ [B,A] ++ Γ')

inductive proof_net : sequent → Type
| mk {Γ : sequent} (ps : proof_structure) : (Π A ∈ Γ, { i : ℕ // (A,i) ∈ ps ∧ ∀ Δ ∈ ps.links, ¬premise (A,i) Δ }) → proof_net Γ

instance {Γ : sequent} : has_coe (proof_net Γ) proof_structure := ⟨by rintro ⟨Γ,ps,_⟩; exact ps⟩

def relabel_Link (f : ℕ → ℕ) : Link → Link
| (Link.ax pi ni A) := Link.ax (f pi) (f ni) A
| (Link.cut pi ni A) := Link.cut (f pi) (f ni) A
| (Link.tensor ai bi ci A B) := Link.tensor (f ai) (f bi) (f ci) A B
| (Link.par ai bi ci A B) := Link.par (f ai) (f bi) (f ci) A B

lemma relabel_valid {l f} (hf : function.injective f): valid_link l → valid_link (relabel_Link f l) :=
begin
  cases l,
  case Link.ax : pi ni A { rintro ⟨_⟩, constructor, },
  case Link.cut : pi ni A { rintro ⟨_⟩, constructor, },
  case Link.tensor : ai bi ci A B {
    rintro ⟨_⟩, constructor, rintro e, injection e with e₁ e₂, apply ᾰ_ᾰ, congr, assumption, exact hf e₂, },
  case Link.par : ai bi ci A B {
    rintro ⟨_⟩, constructor, rintro e, injection e with e₁ e₂, apply ᾰ_ᾰ, congr, assumption, exact hf e₂, },
end

lemma relabel_injective {f} (hf : function.injective f) : function.injective (relabel_Link f) :=
by rintros ⟨l₁⟩ ⟨l₂⟩; intros h; injection h; congr; repeat {refl <|> assumption <|> apply hf}

lemma relabel_premise {l f D i } (hf : function.injective f) : premise (D,i) (relabel_Link f l) → ∃ j, f j = i ∧ premise (D,j) l :=
begin
  cases l,
  case Link.ax : pi ni A { rintro ⟨_⟩ },
  case Link.cut : pi ni A { rintro ⟨_⟩, exact ⟨pi,rfl,premise.cut_pos⟩, exact ⟨ni,rfl,premise.cut_neg⟩, },
  case Link.tensor : ai bi ci A B {
    rintro ⟨_⟩, exact ⟨ai,rfl,premise.tensor_left⟩, exact ⟨bi,rfl,premise.tensor_right⟩, },
  case Link.par : ai bi ci A B {
    rintro ⟨_⟩, exact ⟨ai,rfl,premise.par_left⟩, exact ⟨bi,rfl,premise.par_right⟩, },
end

lemma relabel_conclusion {l f D i } (hf : function.injective f) : conclusion (D,i) (relabel_Link f l) → ∃j, f j = i ∧ conclusion (D,j) l :=
begin
  cases l,
  case Link.ax : pi ni A {
    rintro ⟨_⟩, exact ⟨pi,rfl,conclusion.ax_pos⟩, exact ⟨ni,rfl,conclusion.ax_neg⟩, },
  case Link.cut : pi ni A { rintro ⟨_⟩ },
  case Link.tensor : ai bi ci A B { rintro ⟨_⟩, exact ⟨ci,rfl,conclusion.tensor⟩ },
  case Link.par : ai bi ci A B { rintro ⟨_⟩, exact ⟨ci,rfl,conclusion.par⟩ },
end

lemma relabel_mem {Δ f A i} (hf : function.injective f) : (A,i) ∈ (relabel_Link f Δ) → ∃ j, f j = i ∧ (A,j) ∈ Δ :=
begin
  intro h, cases h with h h,
  rcases (relabel_premise hf h) with ⟨j, ⟨fji,pΔ⟩⟩, refine ⟨j,fji,mem_Link.prem pΔ⟩,
  rcases (relabel_conclusion hf h) with ⟨j, ⟨fji,pΔ⟩⟩, refine ⟨j,fji,mem_Link.con pΔ⟩,
end

def proof_structure.relabel (ps : proof_structure) (f : ℕ → ℕ) (hf : function.injective f) : proof_structure :=
⟨set.image (relabel_Link f) ps.links,
  by rintros l ⟨l', ⟨hl',⟨_⟩⟩⟩; exact relabel_valid hf (ps.valid l' hl'),
begin
  rintros ⟨A,i⟩ _ _ ⟨k₁, ⟨hk₁,⟨_⟩⟩⟩ ⟨k₂, ⟨hk₂,⟨_⟩⟩⟩,
  intros pk₁ pk₂,
  congr,
  rcases relabel_premise hf pk₁ with ⟨j,hfj,u₁⟩,
  rcases relabel_premise hf pk₂ with ⟨j',hfj',u₂⟩,
  have : j' = j, rw ←hfj at hfj', exact hf hfj', rw this at u₂,
  exact ps.prem_unique (A,j) _ _ hk₁ hk₂ u₁ u₂
end
,
begin
  rintros ⟨A,i⟩ _ _ ⟨k₁, ⟨hk₁,⟨_⟩⟩⟩ ⟨k₂, ⟨hk₂,⟨_⟩⟩⟩,
  intros pk₁ pk₂,
  congr,
  rcases relabel_conclusion hf pk₁ with ⟨j,hfj,u₁⟩,
  rcases relabel_conclusion hf pk₂ with ⟨j',hfj',u₂⟩,
  have : j' = j, rw ←hfj at hfj', exact hf hfj', rw this at u₂,
  exact ps.con_unique (A,j) _ _ hk₁ hk₂ u₁ u₂
end⟩

def separators {α β} (f g : α → β) : Prop := ∀ x y, f x ≠ g y

lemma sep_even_odd : separators (λ x, 2 * x) (λ x, 2 * x + 1) :=
  λ x y, nat.two_mul_ne_two_mul_add_one

def disjoint_of_separators {ps₁ ps₂ : proof_structure} {f g} (hf hg) : separators f g → disjoint { Ai | Ai ∈ (ps₁.relabel f hf) } { Ai | Ai ∈ (ps₂.relabel g hg) } :=
begin
  rintros s ⟨A,i⟩ ⟨⟨Δ₁,⟨Δ₁', hΔ₁', ⟨_⟩⟩,h₁⟩,⟨Δ₂,⟨Δ₂', hΔ₂', ⟨_⟩⟩,h₂⟩⟩,
  rcases (relabel_mem hf h₁) with ⟨j₁,hfg,h₁⟩,
  rcases (relabel_mem hg h₂) with ⟨j₂,⟨_⟩,h₂⟩,
  exact s j₁ j₂ hfg,
end

def proof_net.disjoint {Γ Δ} : proof_net Γ → proof_net Δ → Prop :=
  by rintro ⟨_,ps₁,_⟩ ⟨_,ps₂,_⟩; exact disjoint {Ai | Ai ∈ ps₁} {Ai | Ai ∈ ps₂}

def net_links_ax (pi ni A) : set Link :=
  {Link.ax pi ni A}

def net_links_tensor (ai bi ci A B) (sA sB : set Link) : set Link :=
  {Link.tensor ai bi ci A B} ∪ sA ∪ sB

def net_links_par (ai bi ci A B) (s : set Link) : set Link :=
  {Link.par ai bi ci A B} ∪ s

def net_links_cut (pi ni A) (sA snA : set Link) : set Link :=
  {Link.cut pi ni A} ∪ sA ∪ snA

def proof_net_ax (A) : proof_net [~A,A] :=
⟨
  ⟨{Link.ax 0 0 A},
  by rintro l ⟨h⟩; exact valid_link.ax,
  by rintro Ai Δ₁ Δ₂ ⟨_⟩ ⟨_⟩; finish,
  by rintro Ai Δ₁ Δ₂ ⟨_⟩ ⟨_⟩; finish ⟩
,
  begin
    rintro B Bmem,
    refine ⟨0,_,_⟩, rcases Bmem with ⟨_,_⟩, use Link.ax 0 0 A, simp, exact mem_Link.con conclusion.ax_neg,

      -- exact ⟨0,Link.ax 0 0 A,by simp,conclusion.ax_neg,_⟩, rintro Δ' ⟨_⟩ ⟨_⟩,
    rcases H with ⟨⟨_⟩⟩,
      exact ⟨0,Link.ax 0 0 A,by simp,conclusion.ax_pos,_⟩, rintro Δ' ⟨_⟩ ⟨_⟩,
    cases H,
  end
⟩

def proof_net_tensor {Γ Γ' A B Δ Δ'} (pnA : proof_net (Γ ++ [A] ++ Γ')) (pnB : proof_net (Δ ++ [B] ++ Δ')) : pnA.disjoint pnB → proof_net (Γ ++ Γ' ++ [A ⊗ B] ++ Δ ++ Δ') :=
begin
  rcases pnA with ⟨_,psA, hA⟩,
  rcases pnB with ⟨_,psB, hB⟩,
  intro dAB,
  specialize hA A (by refine list.mem_append_left _ (list.mem_append_right _ (list.mem_cons_self A list.nil))),
  specialize hB B,
  cases hA with ai ΔA hA,

end


import mcl
import parlang.lemmas_memory

open mcl

namespace coarsening

def sigc : signature_core
| "tid" := { scope := scope.tlocal, type := ⟨1, type.int⟩ }
| "i" := { scope := scope.tlocal, type := ⟨1, type.int⟩ }
| "j" := { scope := scope.tlocal, type := ⟨1, type.int⟩ }
| _ := { scope := scope.shared, type := ⟨1, type.float⟩ }

def sig : signature := ⟨sigc, ⟨rfl, rfl, rfl⟩⟩

open mcl.expression
open parlang

/-- Copies the *j*-th element from a to b -/
def copy : mclk sig := mclk.shared_assign "b" v[@tlocal_var sig _ _ "j" (λ_, 0) rfl rfl rfl] rfl rfl (@shared_var sig _ _ "a" (v[@tlocal_var sig _ _ "j" (λ_, 0) rfl rfl rfl]).nth rfl rfl rfl)

def e₁ := 10
def f₁ := 10
def p₁ : mclp sig := mclp.intro (λ m, e₁) (
    mclk.for "i" rfl rfl (literal_int 0 rfl) (@tlocal_var sig _ _ "i" (λ_, 0) rfl rfl rfl < literal_int f₁ rfl) (mclk.tlocal_assign "i" v[0] rfl rfl $ tlocal_var "i" (λ_, 0) rfl rfl rfl + literal_int 1 rfl) (
        mclk.tlocal_assign "j" v[literal_int 0 rfl] rfl rfl (@tlocal_var sig _ _ "tid" (λ_, 0) rfl rfl rfl * literal_int e₁ rfl + @tlocal_var sig _ _ "i" (λ_, 0) rfl rfl rfl) ;;
        copy
    )
)

def e₂ := 5
def f₂ := 20
def p₂ : mclp sig := mclp.intro (λ m, e₂) (
    mclk.for "i" rfl rfl (literal_int 0 rfl) (@tlocal_var sig _ _ "i" (λ_, 0) rfl rfl rfl < literal_int f₂ rfl) (mclk.tlocal_assign "i" v[0] rfl rfl $ @tlocal_var sig _ _ "i" (λ_, 0) rfl rfl rfl + literal_int 1 rfl) (
        mclk.tlocal_assign "j" v[literal_int 0 rfl] rfl rfl (@tlocal_var sig _ _ "tid" (λ_, 0) rfl rfl rfl * literal_int e₂ rfl + @tlocal_var sig _ _ "i" (λ_, 0) rfl rfl rfl) ;;
        copy
    )
)

def read_tid {sig : signature} := @tlocal_var sig _ _ "tid" (λ_, 0) sig.property.left sig.property.right.left sig.property.right.right

def coarsen_kernel_assertion {sig : signature}
(P : memory (parlang_mcl_shared sig) → memory (parlang_mcl_shared sig) → Prop)
(f₁ : memory (parlang_mcl_shared sig) → ℕ) (f₂ : memory (parlang_mcl_shared sig) → ℕ)
(m₁ : memory (parlang_mcl_shared sig)) (m₂ : memory (parlang_mcl_shared sig))
(n₁) (s₁ : state n₁ (memory $ parlang_mcl_tlocal sig) $ parlang_mcl_shared sig)
(ac₁ : vector bool n₁) (n₂) (s₂ : state n₂ (memory $ parlang_mcl_tlocal sig) $ parlang_mcl_shared sig)
(ac₂ : vector bool n₂) :=
s₁.syncable m₁ ∧ s₂.syncable m₂ ∧ n₁ = f₁ m₁ ∧ n₂ = f₂ m₂ ∧
(∀ i : fin n₁, s₁.threads.nth i = { tlocal := mcl_init i, shared := m₁, stores := ∅, loads := ∅ }) ∧
(∀ i : fin n₂, s₂.threads.nth i = { tlocal := mcl_init i, shared := m₂, stores := ∅, loads := ∅ }) ∧
P m₁ m₂ ∧ all_threads_active ac₁ ∧ all_threads_active ac₂

/-- only works with constant number of threads -/
theorem coarsen (e₁ e₂)
(sig) (k₁ : mclk sig) (k₂ : mclk sig) (h₁ : type_of (sig.val "k") = type.int) (h₂ : ((sig.val "k").type).dim = 1) (h₃) (Q : parlang.memory (parlang_mcl_shared sig) → parlang.memory (parlang_mcl_shared sig) → Prop)
(h : rhl.mclk_rel (λn₁ (s₁ : state n₁ (memory (parlang_mcl_tlocal sig)) (parlang_mcl_shared sig)) ac₁ n₂ s₂ ac₂, ∃ m₁ m₂,
parlang.initial_kernel_assertion mcl_init mcl_init eq (λm, e₁) (λm, e₂) m₁ m₂ n₁
(s₁.map_active_threads ac₁ $ λts, ts.compute $ λm, m.update ⟨"k", by rw h₂; exact v[0]⟩ (eq.mpr (show _ = ℕ, from begin unfold parlang_mcl_tlocal, simp, unfold signature.lean_type_of lean_type_of, rw h₁, end) 0)) ac₁ n₂
(s₂.map_active_threads ac₂ $ λts, ts.compute $ λm, m.update ⟨"k", by rw h₂; exact v[0]⟩ (eq.mpr (show _ = ℕ, from begin unfold parlang_mcl_tlocal, simp, unfold signature.lean_type_of lean_type_of, rw h₁, end) 0)) ac₂)
    k₁ k₂
  (λn₁ s₁ ac₁ n₂ s₂ ac₂, ∃ m₁ m₂, s₁.syncable m₁ ∧ s₂.syncable m₂ ∧ Q m₁ m₂)) :
rhl.mclp_rel eq
(mclp.intro (λ m, e₁) (
    @mclk.tlocal_assign sig type.int _ "k" v[literal_int 0 rfl] h₁ h₂ read_tid ;;
    k₁
))
(mclp.intro (λ m, e₂) (
    mclk.for "k" h₁ h₂ read_tid ((@tlocal_var sig _ _ "k" (λ_, 0) h₁ h₂ h₃) < literal_int e₂ rfl) (mclk.tlocal_assign "k" v[0] h₁ h₂ $ tlocal_var "k" (λ_, 0) h₁ h₂ h₃ + literal_int e₂ rfl)
        k₂
)) Q := begin
    apply rhl.rel_mclk_to_mclp,
    intros n₁ n₂ s₁ s₁' s₂ ac₁ ac₂ hp he₁,
    cases hp with m₁ hp,
    cases hp with m₂ hp,
    specialize h n₁ n₂ (state.map_active_threads ac₁ (thread_state.compute $ λm, m.update ⟨"k", by rw h₂; exact v[0]⟩ (eq.mpr _ $ m.get ⟨"tid", begin rw sig.property.right.left, exact v[0], end⟩)) s₁) s₁' s₂ ac₁ ac₂,
    swap 2, {
        unfold parlang_mcl_tlocal signature.lean_type_of lean_type_of,
        rw h₁,
        rw sig.property.left,
    },
    specialize h _,
    swap 2,
    {
        use m₁,
        use m₂,
        unfold initial_kernel_assertion,
        unfold initial_kernel_assertion at hp,
        delta thread_state.compute,
        rw ← state.syncable_tlocal,
        rw ← state.syncable_tlocal,
        rw ← state.syncable_tlocal,
        split, {
            exact hp.left,
        },
        split, {
            exact hp.right.left,
        },
        split, {
            exact hp.right.right.left,
        },
        split, {
            exact hp.right.right.right.left,
        },
        split, {
            intros i,
            have : vector.nth ac₁ i = tt := sorry,
            simp only [state.map_active_threads_nth_ac this],
            rw memory.update_update_eq,
            rw hp.right.right.right.right.left i,
            simp [mcl_init],
            funext i,
            cases i,
            by_cases a : i_fst = "k",
            {
                subst a,
                sorry,
            },
            sorry,
        },
        sorry,
    },
    sorry,
    sorry,
end

example : rhl.mclp_rel eq p₁ p₂ eq := begin
    sorry,
    -- apply main transformation rule
end

end coarsening


import Preloaded Solution

theorem task_1 : TASK_1 := immediate
#print axioms task_1

theorem task_2 : TASK_2 := plus_comm
#print axioms task_2

theorem task_3 : TASK_3 := excluded_middle
#print axioms task_3

theorem task_4 : TASK_4 := one_plus_one_is_three
#print axioms task_4


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hAcover : A ⊆ ⋃₀ A),
  have h1 : ∀ (x : ℝ^(fin n)), ∃ (m : ℕ), ∀ (y : ℝ^(fin n)), (∥ x ∥ ≤ m) → (∥ y ∥ ≤ m + 1) → (y ∈ A), from
    assume x : ℝ^(fin n),
    have h1_1 : ∃ (m : ℕ), ∀ (y : ℝ^(fin n)), (∥ x ∥ ≤ m) → (∥ y ∥ ≤ m + 1) → (y ∈ A), from
      begin
        have h1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) → (∥ x ∥ ≤ m + 1), from
          begin
            have h1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m), from
              begin
                have h1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1), from
                  begin
                    have h1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2), from
                      begin
                        have h1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3), from
                          begin
                            have h1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4), from
                              begin
                                have h1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5), from
                                  begin
                                    have h1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6), from
                                      begin
                                        have h1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7), from
                                          begin
                                            have h1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7) ∧ (∥ x ∥ ≤ m + 8), from
                                              begin
                                                have h1_1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7) ∧ (∥ x ∥ ≤ m + 8) ∧ (∥ x ∥ ≤ m + 9), from
                                                begin
                                                  have h1_1_1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7) ∧ (∥ x ∥ ≤ m + 8) ∧ (∥ x ∥ ≤ m + 9) ∧ (∥ x ∥ ≤ m + 10), from
                                                    begin
                                                      have h1_1_1_1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7) ∧ (∥ x ∥ ≤ m + 8) ∧ (∥ x ∥ ≤ m + 9) ∧ (∥ x ∥ ≤ m + 10) ∧ (∥ x ∥ ≤ m + 11), from
                                                        begin
                                                          have h1_1_1_1_1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x ∥ ≤ m + 5) ∧ (∥ x ∥ ≤ m + 6) ∧ (∥ x ∥ ≤ m + 7) ∧ (∥ x ∥ ≤ m + 8) ∧ (∥ x ∥ ≤ m + 9) ∧ (∥ x ∥ ≤ m + 10) ∧ (∥ x ∥ ≤ m + 11) ∧ (∥ x ∥ ≤ m + 12), from
                                                            begin
                                                              have h1_1_1_1_1_1_1_1_1_1_1_1_1_1_1_1_1 : ∃ (m : ℕ), (∥ x ∥ ≤ m) ∧ (∥ x ∥ ≤ m + 1) ∧ (∥ x ∥ ≤ m + 2) ∧ (∥ x ∥ ≤ m + 3) ∧ (∥ x ∥ ≤ m + 4) ∧ (∥ x
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : A.is_open,
  assume hA2 : A.is_cover,
  have hA3 : ∀ a : euclidean_space ℝ (fin n), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
    assume a : euclidean_space ℝ (fin n),
    have hA4 : A ≠ ∅, from by {
      assume hA5 : A = ∅,
      have hA6 : a ∉ A, from by {
        assume hA7 : a ∈ A,
        have hA8 : A = ∅, from by {
          assume hA9 : A ≠ ∅,
          have hA10 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
            assume hA11 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
            have hA12 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
              assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA13 : a ∈ U),
              have hA14 : U ≠ ∅, from by {
                assume hA15 : U = ∅,
                have hA16 : a ∉ U, from by {
                  assume hA17 : a ∈ U,
                  have hA18 : U = ∅, from by {
                    assume hA19 : U ≠ ∅,
                    have hA20 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                      assume hA21 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                      have hA22 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                        assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA23 : a ∈ U),
                        have hA24 : U ≠ ∅, from by {
                          assume hA25 : U = ∅,
                          have hA26 : a ∉ U, from by {
                            assume hA27 : a ∈ U,
                            have hA28 : U = ∅, from by {
                              assume hA29 : U ≠ ∅,
                              have hA30 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                                assume hA31 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                                have hA32 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                                  assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA33 : a ∈ U),
                                  have hA34 : U ≠ ∅, from by {
                                    assume hA35 : U = ∅,
                                    have hA36 : a ∉ U, from by {
                                      assume hA37 : a ∈ U,
                                      have hA38 : U = ∅, from by {
                                        assume hA39 : U ≠ ∅,
                                        have hA40 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                                          assume hA41 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                                          have hA42 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                                            assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA43 : a ∈ U),
                                            have hA44 : U ≠ ∅, from by {
                                              assume hA45 : U = ∅,
                                              have hA46 : a ∉ U, from by {
                                                assume hA47 : a ∈ U,
                                                have hA48 : U = ∅, from by {
                                                  assume hA49 : U ≠ ∅,
                                                  have hA50 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                                                    assume hA51 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                                                    have hA52 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                                                      assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA53 : a ∈ U),
                                                      have hA54 : U ≠ ∅, from by {
                                                        assume hA55 : U = ∅,
                                                        have hA56 : a ∉ U, from by {
                                                          assume hA57 : a ∈ U,
                                                          have hA58 : U = ∅, from by {
                                                            assume hA59 : U ≠ ∅,
                                                            have hA60 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                                                              assume hA61 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                                                              have hA62 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                                                                assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA63 : a ∈ U),
                                                                have hA64 : U ≠ ∅, from by {
                                                                  assume hA65 : U = ∅,
                                                                  have hA66 : a ∉ U, from by {
                                                                    assume hA67 : a ∈ U,
                                                                    have hA68 : U = ∅, from by {
                                                                      assume hA69 : U ≠ ∅,
                                                                      have hA70 : ∃ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U, from by {
                                                                        assume hA71 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∉ U,
                                                                        have hA72 : ∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), a ∈ U → false, from by {
                                                                          assume (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A) (hA73 : a
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hAcover : ⋃₀ A = univ),
  have h1 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, ∀ y : euclidean_space ℝ (fin n), (∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ y ∈ z) → dist x y ≤ m, from
    begin
      assume (x : euclidean_space ℝ (fin n)),
      have h1 : ∀ m : ℕ, ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
        begin
          assume (m : ℕ),
          have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
            begin
              have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                begin
                  have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                    begin
                      have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                        begin
                          have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                            begin
                              have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                begin
                                  have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                    begin
                                      have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                        begin
                                          have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                            begin
                                              have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                begin
                                                  have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                    begin
                                                      have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                        begin
                                                          have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                            begin
                                                              have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                begin
                                                                  have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                    begin
                                                                      have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                        begin
                                                                          have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                            begin
                                                                              have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist x z ≤ m, from
                                                                                begin
                                                                                have h1 : ∃ z : euclidean_space ℝ (fin n), z ∈ A ∧ dist
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hAcover : A ⊃ univ),
  have h1 : ∀ (m : ℕ), is_compact (set.closure (ball (0 : ℝ^n) m)), from by {
    assume (m : ℕ),
    have h2 : is_open (set.compl (ball (0 : ℝ^n) m)), from by {
      rw set.compl_eq_univ_diff,
      apply is_open_ball,
    },
    have h3 : is_closed (ball (0 : ℝ^n) m), from by {
      apply is_closed_ball,
    },
    have h4 : is_compact (ball (0 : ℝ^n) m), from by {
      apply is_compact_of_is_closed_of_is_open h3 h2,
    },
    have h5 : (set.closure (ball (0 : ℝ^n) m)) ⊆ (ball (0 : ℝ^n) m), from by {
      apply set.closure_mono,
      apply set.subset_univ,
    },
    have h6 : (set.closure (ball (0 : ℝ^n) m)) ⊆ univ, from by {
      apply set.subset.trans h5,
      apply set.subset_univ,
    },
    have h7 : (set.closure (ball (0 : ℝ^n) m)) ∈ 𝒞 (ball (0 : ℝ^n) m), from by {
      apply set.mem_closure,
      apply set.mem_univ,
    },
    have h8 : (set.closure (ball (0 : ℝ^n) m)) ∈ 𝒞 univ, from by {
      apply set.mem_closure,
      apply set.mem_univ,
    },
    show is_compact (set.closure (ball (0 : ℝ^n) m)), from by {
      apply is_compact_of_is_closed_of_is_open h4 h2,
    },
  },
  have h2 : ∀ (m : ℕ), is_open (set.compl (set.closure (ball (0 : ℝ^n) m))), from by {
    assume (m : ℕ),
    have h3 : is_closed (set.closure (ball (0 : ℝ^n) m)), from by {
      apply is_closed_closure,
    },
    have h4 : is_open (set.compl (ball (0 : ℝ^n) m)), from by {
      rw set.compl_eq_univ_diff,
      apply is_open_ball,
    },
    have h5 : (set.compl (set.closure (ball (0 : ℝ^n) m))) ⊆ (set.compl (ball (0 : ℝ^n) m)), from by {
      apply set.compl_mono,
    },
    have h6 : (set.compl (set.closure (ball (0 : ℝ^n) m))) ⊆ univ, from by {
      apply set.subset.trans h5,
      apply set.subset_univ,
    },
    have h7 : (set.compl (set.closure (ball (0 : ℝ^n) m))) ∈ 𝒞 (set.compl (ball (0 : ℝ^n) m)), from by {
      apply set.mem_compl,
      apply set.mem_univ,
    },
    have h8 : (set.compl (set.closure (ball (0 : ℝ^n) m))) ∈ 𝒞 univ, from by {
      apply set.mem_compl,
      apply set.mem_univ,
    },
    show is_open (set.compl (set.closure (ball (0 : ℝ^n) m))), from by {
      apply is_open_of_is_closed_of_is_open h3 h4,
    },
  },
  have h3 : ∀ (m : ℕ), is_open (set.compl (ball (0 : ℝ^n) (m - 1))), from by {
    assume (m : ℕ),
    rw set.compl_eq_univ_diff,
    apply is_open_ball,
  },
  have h4 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), Cm ⊆ A ∧ Cm ⊆ (set.compl (ball (0 : ℝ^n) (m - 1))) ∧ Cm ⊆ (set.compl (set.closure (ball (0 : ℝ^n) m))) ∧ Cm ⊃ (set.closure (ball (0 : ℝ^n) m)), from by {
    assume (m : ℕ),
    have h5 : (set.closure (ball (0 : ℝ^n) m)) ⊆ univ, from by {
      apply set.subset_univ,
    },
    have h6 : (set.closure (ball (0 : ℝ^n) m)) ∈ 𝒞 univ, from by {
      apply set.mem_closure,
      apply set.mem_univ,
    },
    have h7 : (set.closure (ball (0 : ℝ^n) m)) ∈ 𝒞 (set.compl (ball (0 : ℝ^n) (m - 1))), from by {
      apply set.mem_closure,
      apply set.mem_compl,
      apply set.mem_univ,
    },
    have h8 : (set.closure (ball (0 : ℝ^n) m)) ∈ 𝒞 (set.compl (set.closure (ball (0 : ℝ^n) m))), from by {
      apply set.mem_closure,
      apply set.mem_compl,
      apply set.mem_univ,
    },
    have h9 : (set.closure (ball (0 : ℝ^n) m)) ⊆ A, from by {
      apply hAcover,
    },
    have h10 : (set.closure (ball (0 : ℝ^n) m)) ⊆ (set.compl (ball (0 : ℝ^n) (m - 1))), from by {
      apply set.subset.trans h9,
      apply set.subset_compl_iff.mpr,
      have h11 : (ball (0 : ℝ^n) m) ⊆ (ball (0 : ℝ^n) (m - 1)), from by {
        apply set.subset_ball,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.norm_eq_zero,
        rw real.
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (hU : is_open U) (hcover : ∀ x : euclidean_space ℝ (fin n), x ∈ U),
  have h1 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open Cm ∧ ∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ (A : set (euclidean_space ℝ (fin n))), x ∈ A ∧ A ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ A → y ∈ U ∧ ∀ z : euclidean_space ℝ (fin n), z ∈ A → ∃ (B : set (euclidean_space ℝ (fin n))), z ∈ B ∧ B ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y ∈ U ∧ ∀ y : euclidean_space ℝ (fin n), y ∈ B → y
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open A,
  assume hA2 : is_covering A,
  have h1 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (m : ℕ), ∀ (y : euclidean_space ℝ (fin n)), dist x y < m → y ∈ A, from
    assume x : euclidean_space ℝ (fin n),
    have h2 : ∀ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A, from
      assume m : ℕ,
      have h3 : ∃ (y : euclidean_space ℝ (fin n)), dist x y < m, from
        by {exact exists_ball x m},
      have h4 : ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A, from
        by {exact classical.by_contradiction (hA2 (exists.elim h3 (assume y h5, h5.left)) x)},
      exact h4,
    have h5 : ∃ (m : ℕ), ∀ (y : euclidean_space ℝ (fin n)), dist x y < m → y ∈ A, from
      by {exact exists.intro 1 (assume y h6, h2 1)},
    exact h5,
  have h6 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A, from
    assume x : euclidean_space ℝ (fin n),
    have h7 : ∃ (m : ℕ), ∀ (y : euclidean_space ℝ (fin n)), dist x y < m → y ∈ A, from h1 x,
    have h8 : ∃ (y : euclidean_space ℝ (fin n)), dist x y < (exists.elim h7 (assume m h9, m)), from
      by {exact exists_ball x (exists.elim h7 (assume m h9, m))},
    have h9 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A, from
      by {exact exists.intro (exists.elim h7 (assume m h10, m)) (exists.elim h8 (assume y h11, h11))},
    exact h9,
  have h10 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A, from
    assume x : euclidean_space ℝ (fin n),
    have h11 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A, from h6 x,
    have h12 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A, from
      by {exact exists.intro (exists.elim h11 (assume m h13, m)) (exists.elim h11 (assume m h13, exists.elim h13 (assume y h14, exists.intro y (exists.intro (exists.elim h14 (assume h15 h16, h15)) (exists.elim h14 (assume h15 h16, h16))))))},
    exact h12,
  have h13 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → ∃ (w : euclidean_space ℝ (fin n)), dist x w < m ∧ w ∈ A, from
    assume x : euclidean_space ℝ (fin n),
    have h14 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A, from h10 x,
    have h15 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → ∃ (w : euclidean_space ℝ (fin n)), dist x w < m ∧ w ∈ A, from
      by {exact exists.intro (exists.elim h14 (assume m h16, m)) (exists.elim h14 (assume m h16, exists.elim h16 (assume y h17, exists.intro y (exists.intro (exists.elim h17 (assume h18 h19, h18)) (exists.intro (exists.elim h17 (assume h18 h19, h19)) (exists.elim h17 (assume h18 h19, h1)))))))},
    exact h15,
  have h16 : ∀ (x : euclidean_space ℝ (fin n)), ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → ∃ (w : euclidean_space ℝ (fin n)), dist x w < m ∧ w ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → ∃ (w : euclidean_space ℝ (fin n)), dist x w < m ∧ w ∈ A, from
    assume x : euclidean_space ℝ (fin n),
    have h17 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → ∃ (w : euclidean_space ℝ (fin n)), dist x w < m ∧ w ∈ A, from h13 x,
    have h18 : ∃ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), dist x y < m ∧ y ∈ A ∧ ∀ (z : euclidean_space ℝ (fin n)), dist x z < m → z ∈ A ∧ ∀ (z
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import for_mathlib.category_theory.localization.derived_functor
import for_mathlib.category_theory.localization.triangulated
import for_mathlib.category_theory.triangulated.pretriangulated_misc
import for_mathlib.category_theory.triangulated.shift_triangle
import for_mathlib.category_theory.triangulated.triangulated
import for_mathlib.category_theory.preadditive_subcategory
import for_mathlib.category_theory.triangulated.coproducts
import for_mathlib.category_theory.limits.products
import for_mathlib.category_theory.triangulated.is_triangulated_subcategory
import category_theory.limits.full_subcategory
import data.int.order.units

noncomputable theory

universes v₁ v₂ u₁ u₂

open_locale zero_object

open category_theory

namespace category_theory

open limits category preadditive category_theory

namespace functor

@[simps]
def map_arrow_nat_trans_of_nat_trans {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D]
  {F G : C ⥤ D} (τ : F ⟶ G) : F.map_arrow ⟶ G.map_arrow :=
{ app := λ f,
  { left := τ.app _,
    right := τ.app _, }, }

@[simps]
def map_arrow_nat_iso_of_nat_iso {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D]
  {F G : C ⥤ D} (e : F ≅ G) : F.map_arrow ≅ G.map_arrow :=
{ hom := map_arrow_nat_trans_of_nat_trans e.hom,
  inv := map_arrow_nat_trans_of_nat_trans e.inv, }

end functor

namespace triangulated

open pretriangulated

variables (C : Type*) [category C] [has_zero_object C] [has_shift C ℤ]
  [preadditive C] [∀ (n : ℤ), functor.additive (shift_functor C n)]
  [pretriangulated C]

/-structure subcategory :=
(set : set C)
(zero : (0 : C) ∈ set)
(shift : ∀ (X : C) (n : ℤ) (hX : X ∈ set), (shift_functor C n).obj X ∈ set)
(ext₂ : ∀ (T : triangle C) (hT : T ∈ dist_triang C) (h₁ : T.obj₁ ∈ set) (h₃ : T.obj₃ ∈ set), T.obj₂ ∈ set)-/

variable {C}

namespace subcategory

variables (S : set C) [is_triangulated_subcategory S]

def W : morphism_property C :=
λ X Y f, ∃ (Z : C) (g : Y ⟶ Z) (h : Z ⟶ (shift_functor C (1 : ℤ)).obj X)
  (H : triangle.mk f g h ∈ dist_triang C), Z ∈ S

def W' : morphism_property C :=
λ Y Z g, ∃ (X : C) (f : X ⟶ Y) (h : Z ⟶ X⟦(1 : ℤ)⟧) (H : triangle.mk f g h ∈ dist_triang C),
    X ∈ S

variable {S}

def W.mk {T : triangle C} (hT : T ∈ dist_triang C) (h : T.obj₃ ∈ S) :
  (W S) T.mor₁ :=
⟨T.obj₃, T.mor₂, T.mor₃, (by { cases T, exact hT, }), h⟩

def W'.mk {T : triangle C} (hT : T ∈ dist_triang C) (h : T.obj₁ ∈ S) :
  (W' S) T.mor₂ :=
⟨T.obj₁, T.mor₁, T.mor₃, (by { cases T, exact hT, }), h⟩

def W.triangle {X Y : C} (f : X ⟶ Y) (hf : (W S) f) : triangle C :=
triangle.mk f hf.some_spec.some hf.some_spec.some_spec.some

lemma W.triangle_distinguished {X Y : C} (f : X ⟶ Y) (hf : (W S) f) :
  W.triangle f hf ∈ dist_triang C := hf.some_spec.some_spec.some_spec.some

lemma W.triangle_obj₃_mem {X Y : C} (f : X ⟶ Y) (hf : (W S) f) :
  (W.triangle f hf).obj₃ ∈ S :=
hf.some_spec.some_spec.some_spec.some_spec

variable (S)

lemma W_eq_W' : W S = W' S :=
begin
  ext X Y f,
  split,
  { rintro ⟨Z, g, h, H, mem⟩,
    exact ⟨_, _, _, inv_rot_of_dist_triangle C _ H,
      is_triangulated_subcategory.shift _ _ mem⟩, },
  { rintro ⟨Z, g, h, H, mem⟩,
    refine ⟨_, _, _, rot_of_dist_triangle C _ H,
      is_triangulated_subcategory.shift _ _ mem⟩, },
end

variable {S}

def W.mk' {T : triangle C} (hT : T ∈ dist_triang C) (h : T.obj₁ ∈ S) :
  (W S) T.mor₂ :=
by simpa only [W_eq_W'] using W'.mk hT h

instance W_contains_identities : (W S).contains_identities :=
⟨λ X, ⟨0, 0, 0, pretriangulated.contractible_distinguished X,
  is_triangulated_subcategory.zero S⟩⟩

variable (S)

lemma W_stable_under_composition [is_triangulated C] : (W S).stable_under_composition :=
λ X₁ X₂ X₃ u₁₂ u₂₃ h₁₂ h₂₃,
begin
  rcases h₁₂ with ⟨Z₁₂, v₁₂, w₁₂, H₁₂, mem₁₂⟩,
  rcases h₂₃ with ⟨Z₂₃, v₂₃, w₂₃, H₂₃, mem₂₃⟩,
  rcases pretriangulated.distinguished_cocone_triangle _ _ (u₁₂ ≫ u₂₃) with ⟨Z₁₃, v₁₃, w₁₃, H₁₃⟩,
  refine ⟨_, _, _, H₁₃, _⟩,
  exact is_triangulated_subcategory.ext₂ _
    (is_triangulated.octahedron_axiom rfl H₁₂ H₂₃ H₁₃).some.mem mem₁₂ mem₂₃,
end

instance W_multiplicative [is_triangulated C] : (W S).multiplicative :=
{ contains_identities := infer_instance,
  comp := W_stable_under_composition S, }

lemma W_respects_iso : (W S).respects_iso :=
begin
  split,
  { rintro X' X Y e f ⟨Z, g, h, mem, mem'⟩,
    refine ⟨Z, g, h ≫ (shift_functor C 1).map e.inv, _, mem'⟩,
    refine pretriangulated.isomorphic_distinguished _ mem _ _,
    refine triangle.mk_iso _ _ e (iso.refl _) (iso.refl _) (by tidy) (by tidy) _,
    dsimp,
    simp only [assoc, ← functor.map_comp, e.inv_hom_id, functor.map_id, comp_id, id_comp], },
  { rintro X Y Y' e f ⟨Z, g, h, mem, mem'⟩,
    refine ⟨Z, e.inv ≫ g, h, _, mem'⟩,
    refine pretriangulated.isomorphic_distinguished _ mem _ _,
    refine triangle.mk_iso _ _ (iso.refl _) e.symm (iso.refl _) (by tidy) (by tidy) (by tidy), },
end

instance [is_triangulated C] : left_calculus_of_fractions (W S) :=
{ id := infer_instance,
  comp := W_stable_under_composition S,
  ex := λ X' X Y s hs u, begin
    obtain ⟨Z, f, g, H, mem⟩ := hs,
    obtain ⟨Y', s', f', mem'⟩ := pretriangulated.distinguished_cocone_triangle₂ (g ≫ u⟦1⟧'),
    obtain ⟨b, ⟨hb₁, hb₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism₂ _ _
      H mem' u (𝟙 Z) (by { dsimp, rw id_comp, }),
    exact nonempty.intro ⟨Y', b, s', ⟨Z, f', g ≫ u⟦1⟧', mem', mem⟩, hb₁.symm⟩,
  end,
  ext := λ X' X Y f₁ f₂ s hs hf₁, begin
    let f := f₁ - f₂,
    have hf₂ : s ≫ f = 0 := by { dsimp [f], rw [comp_sub, hf₁, sub_self], },
    obtain ⟨Z, g, h, H, mem⟩ := hs,
    obtain ⟨q, hq⟩ := contravariant_yoneda_exact₂ _ H f hf₂,
    dsimp at q hq,
    obtain ⟨Y', r, t, mem'⟩ := pretriangulated.distinguished_cocone_triangle _ _ q,
    refine ⟨Y', r, _, _⟩,
    { exact ⟨_, _, _, rot_of_dist_triangle C _ mem',
        is_triangulated_subcategory.shift _ _ mem⟩, },
    { rw [← sub_eq_zero, ← sub_comp],
      change f ≫ r = 0,
      have eq := comp_dist_triangle_mor_zero₁₂ C _ mem',
      dsimp at eq,
      rw [hq, assoc, eq, comp_zero], },
  end, }

instance [is_triangulated C] : right_calculus_of_fractions (W S) :=
{ id := infer_instance,
  comp := W_stable_under_composition S,
  ex := λ X Y Y' s hs u, begin
    obtain ⟨Z, f, g, H, mem⟩ := hs,
    obtain ⟨X', f', h', mem'⟩ := pretriangulated.distinguished_cocone_triangle₁ (u ≫ f),
    obtain ⟨a, ⟨ha₁, ha₂⟩⟩ := pretriangulated.complete_distinguished_triangle_morphism₁ _ _ mem' H u (𝟙 Z)
      (comp_id _),
    exact nonempty.intro ⟨X', a, f', ⟨Z, u ≫ f, h', mem', mem⟩, ha₁⟩,
  end,
  ext := λ Y Z Z' f₁ f₂ s hs hf₁, begin
    let f := f₁ - f₂,
    have hf₂ : f ≫ s = 0 := by { dsimp [f], rw [sub_comp, hf₁, sub_self], },
    rw W_eq_W' at hs,
    obtain ⟨X, g, h, H, mem⟩ := hs,
    obtain ⟨q, hq⟩ := covariant_yoneda_exact₂ _ H f hf₂,
    dsimp at q hq,
    obtain ⟨Y', r, t, mem'⟩ := pretriangulated.distinguished_cocone_triangle₁ q,
    refine ⟨Y', r, _, _⟩,
    { exact ⟨_, _, _, mem', mem⟩, },
    { rw [← sub_eq_zero, ← comp_sub],
    change r ≫ f = 0,
    have eq := comp_dist_triangle_mor_zero₁₂ C _ mem',
    dsimp at eq,
    rw [hq, ← assoc, eq, zero_comp], },
  end, }

lemma mul_mem_W_iff {X Y : C} (f : X ⟶ Y) (n : ℤ) :
  (W S) ((↑((-1 : units ℤ) ^ n) : ℤ) • f) ↔ (W S) f :=
(W_respects_iso S).arrow_mk_iso_iff
begin
  let e : X ≅ X :=
  { hom := (↑((-1 : units ℤ) ^ n) : ℤ) • 𝟙 X,
    inv := (↑((-1 : units ℤ) ^ n) : ℤ) • 𝟙 X,
    hom_inv_id' := by simp only [zsmul_comp, id_comp, smul_smul, int.units_coe_mul_self, one_smul],
    inv_hom_id' := by simp only [zsmul_comp, id_comp, smul_smul, int.units_coe_mul_self, one_smul], },
  refine arrow.iso_mk e (iso.refl _) _,
  dsimp,
  rw [comp_id, zsmul_comp, id_comp],
end

instance W_compatible_with_shift : (W S).compatible_with_shift ℤ :=
⟨begin
  have h : ∀ (X Y : C) (f : X ⟶ Y) (hf : (W S) f) (n : ℤ), (W S) (f⟦n⟧'),
  { rintro X Y f ⟨Z, g, h, H, mem⟩ n,
    rw ← mul_mem_W_iff S _ n,
    exact ⟨_, _, _, triangle.shift_distinguished C _ H n,
      is_triangulated_subcategory.shift Z n mem⟩, },
  intro n,
  ext X Y f,
  refine ⟨λ hf, _, λ hf, h _ _ f hf n⟩,
   exact ((W_respects_iso S).arrow_mk_iso_iff
    ((functor.map_arrow_nat_iso_of_nat_iso
    (shift_functor_comp_shift_functor_neg C n)).app (arrow.mk f))).mp (h _ _ _ hf (-n)),
end⟩

variable {S}

lemma W.shift {X₁ X₂ : C} {f : X₁ ⟶ X₂} (hf : (W S) f) (n : ℤ) :
  (W S) ((shift_functor C n).map f) :=
by simpa only [(morphism_property.compatible_with_shift.iff (W S) f n)] using hf

lemma W.unshift {X₁ X₂ : C} {f : X₁ ⟶ X₂} (n : ℤ) (hf : (W S) ((shift_functor C n).map f)) :
  (W S) f :=
by simpa only [← (morphism_property.compatible_with_shift.iff (W S) f n)] using hf

variable (S)

lemma binary_product_stable (X₁ X₂ : C) (hX₁ : X₁ ∈ S)
  (hX₂ : X₂ ∈ S) : (X₁ ⨯ X₂) ∈ S :=
is_triangulated_subcategory.ext₂ _ (binary_product_triangle_distinguished X₁ X₂) hX₁ hX₂

lemma pi_finite_stable {J : Type} [finite J]
  (X : J → C) (hX : ∀ j, X j ∈ S) : (∏ X) ∈ S :=
begin
  revert hX X,
  let P : Type → Prop := λ J,
    ∀ [hJ : finite J] (X : J → C) (hX : ∀ j, X j ∈ S),
      by { haveI := hJ, exact (∏ X) ∈ S, },
  suffices : P J,
  { exact this, },
  refine finite.induction_empty_option _ _ _ J,
  { intros J₁ J₂ e hJ₁, introI, intros X hX,
    haveI : finite J₁ := finite.of_equiv _ e.symm,
    haveI := has_product_of_equiv X e,
    exact set.respects_iso.condition S (product_iso_of_equiv X e)
      (hJ₁ (X ∘ e) (λ j₁, hX _)), },
  { introI, intros X hX,
    refine set.respects_iso.condition S  _ (is_triangulated_subcategory.zero S),
    refine (limits.is_zero.iso_zero _).symm,
    haveI : mono (0 : ∏ X ⟶ 0),
    { constructor,
      intros Z f₁ f₂ hf,
      ext,
      discrete_cases,
      induction j, },
    exact limits.is_zero.of_mono (0 : ∏ X ⟶ 0) (is_zero_zero C), },
  { intro J,
    introI,
    intros hJ hJ' X hX,
    exact set.respects_iso.condition _ (product_iso_option X).symm
      (binary_product_stable S _ _ (hJ (λ j, X (some j)) (λ j, hX _)) (hX none)), },
end

instance W_stable_under_finite_products : (W S).stable_under_finite_products :=
⟨λ J, begin
  introI,
  refine morphism_property.stable_under_products_of_shape.mk _ _ (W_respects_iso S) _,
  intros X₁ X₂ f hf,
  let T := λ j, W.triangle _ (hf j),
  exact W.mk (triangle.product_distinghished T (λ j, W.triangle_distinguished _ (hf j)))
    (pi_finite_stable S (λ j, (T j).obj₃) (λ j, W.triangle_obj₃_mem _ (hf j))),
end⟩

instance W_compatible_with_triangulation [is_triangulated C] :
  (W S).compatible_with_triangulation :=
⟨λ T₁ T₃ hT₁ hT₃ a b ha hb comm, begin
  let T'₁ := triangle.mk T₁.mor₁ T₁.mor₂ T₁.mor₃,
  let T'₃ := triangle.mk T₃.mor₁ T₃.mor₂ T₃.mor₃,
  have mem₁ : T'₁ ∈ dist_triang C := by { cases T₁, exact hT₁, },
  have mem₃ : T'₃ ∈ dist_triang C := by { cases T₃, exact hT₃, },
  rcases pretriangulated.distinguished_cocone_triangle _ _ (T₁.mor₁ ≫ b) with ⟨Z₂, g₂, h₂, mem₂⟩,
  let T'₂ := triangle.mk (T₁.mor₁ ≫ b) g₂ h₂,
  change T'₂ ∈ dist_triang C at mem₂,
  rcases hb with ⟨Z₄, g₄, h₄, mem₄, mem₄'⟩,
  let H := (is_triangulated.octahedron_axiom rfl mem₁ mem₄ mem₂).some,
  let φ₁₂ : T'₁ ⟶ T'₂ := H.triangle_morphism₁,
  have hφ₁₂ : (W S) φ₁₂.hom₃ := W.mk H.mem mem₄',
  rcases ha with ⟨Z₅, g₅, h₅, mem₅, mem₅'⟩,
  let H' := (is_triangulated.octahedron_axiom comm.symm mem₅ mem₃ mem₂).some,
  let φ₂₃ : T'₂ ⟶ T'₃ := H'.triangle_morphism₂,
  have hφ₂₃ : (W S) φ₂₃.hom₃ := W.mk' H'.mem mem₅',
  refine ⟨(φ₁₂ ≫ φ₂₃).hom₃, W_stable_under_composition S _ _ hφ₁₂ hφ₂₃, ⟨_, _⟩⟩,
  { have h := (φ₁₂ ≫ φ₂₃).comm₂,
    dsimp at h,
    simpa only [comp_id] using h, },
  { have h := (φ₁₂ ≫ φ₂₃).comm₃,
    dsimp at h,
    simpa only [triangle_category_comp, triangle_morphism.comp_hom₃, id_comp] using h, },
end⟩

instance W_is_saturated [saturated S] [is_triangulated C] : (W S).is_saturated :=
⟨λ X₁ X₂ X₃ X₄ f₁₂ f₂₃ f₃₄ h₁₃ h₂₄, begin
  obtain ⟨Y₁₃, g₁₃, h₁₃, H₁₃, mem₁₃⟩ := h₁₃,
  obtain ⟨Y₂₄, g₂₄, h₂₄, H₂₄, mem₂₄⟩ := h₂₄,
  obtain ⟨Y₁₂, g₁₂, h₁₂, H₁₂⟩ := pretriangulated.distinguished_cocone_triangle _ _ f₁₂,
  obtain ⟨Y₂₃, g₂₃, h₂₃, H₂₃⟩ := pretriangulated.distinguished_cocone_triangle _ _ f₂₃,
  obtain ⟨Y₃₄, g₃₄, h₃₄, H₃₄⟩ := pretriangulated.distinguished_cocone_triangle _ _ f₃₄,
  refine ⟨Y₂₃, g₂₃, h₂₃, H₂₃, _⟩,
  have H₁₂₃ := (is_triangulated.octahedron_axiom rfl H₁₂ H₂₃ H₁₃).some,
  have H₂₃₄ := (is_triangulated.octahedron_axiom rfl H₂₃ H₃₄ H₂₄).some,
  let s := h₂₃ ≫ g₁₂⟦1⟧',
  let t := h₃₄ ≫ g₂₃⟦1⟧',
  have hs : (W S) s := W.mk (rot_of_dist_triangle _ _
    (rot_of_dist_triangle _ _ H₁₂₃.mem)) (set.is_stable_by_shift.condition 1 _ mem₁₃),
  have ht : (W S) t := W.mk (rot_of_dist_triangle _ _
    (rot_of_dist_triangle _ _ H₂₃₄.mem)) (set.is_stable_by_shift.condition 1 _ mem₂₄),
  let st := t ≫ s⟦1⟧',
  have hst : st = 0,
  { dsimp [st],
    have eq : g₂₃ ≫ h₂₃ = 0 := triangle.comp_zero₂₃ _ H₂₃,
    simp only [assoc, ← functor.map_comp, reassoc_of eq,
      zero_comp, functor.map_zero, comp_zero], },
  have hst' := W_stable_under_composition S t (s⟦1⟧') ht (hs.shift 1),
  obtain ⟨Z, g, h, H, mem⟩ := hst',
  let i := (triangle.mk (t ≫ (shift_functor C 1).map s) g h).mor₂,
  haveI : mono i := mono_of_dist_triang₂ _ H hst,
  haveI : is_split_mono i := is_split_mono_of_mono i,
  have mem₁₂ := saturated.condition i mem,
  dsimp [triangle.mk] at mem₁₂,
  rw [← is_triangulated_subcategory.shift_iff, ← is_triangulated_subcategory.shift_iff] at mem₁₂,
  exact is_triangulated_subcategory.ext₃ _ H₁₂₃.mem mem₁₂ mem₁₃,
end⟩

lemma category_closed_under_finite_products (J : Type) [finite J] :
  closed_under_limits_of_shape (discrete J) S :=
λ F c hc mem, begin
  let X := λ j, F.obj ⟨j⟩,
  refine set.respects_iso.condition S _ (pi_finite_stable S X (λ j, mem ⟨j⟩)),
  exact
  { hom := hc.lift (cone.mk (∏ X) (discrete.nat_trans (by { rintro ⟨i⟩, exact pi.π _ i,}))),
    inv := pi.lift (λ i, c.π.app ⟨i⟩),
    hom_inv_id' := begin
      ext i,
      discrete_cases,
      simp only [assoc, limit.lift_π, fan.mk_π_app, is_limit.fac, discrete.nat_trans_app, id_comp],
    end,
    inv_hom_id' := hc.hom_ext begin
      rintro ⟨i⟩,
      simp only [assoc, is_limit.fac, discrete.nat_trans_app, limit.lift_π, fan.mk_π_app, id_comp],
    end, },
end

--instance category_has_finite_products : has_finite_products (full_subcategory S) :=
--infer_instance

--instance shift_functor_additive (n : ℤ) : (shift_functor (full_subcategory S) n).additive :=
--  infer_instance

--instance full_subcategory_inclusion_has_comm_shift :
--  A.inclusion.has_comm_shift ℤ := infer_instance

--instance category_inclusion_additive : A.inclusion.additive := infer_instance

--instance : pretriangulated (full_subcategory S) := infer_instance

lemma dist_triang_iff {X Y Z : full_subcategory S} (f : X ⟶ Y) (g : Y ⟶ Z) (h : Z ⟶ X⟦(1 : ℤ)⟧) :
  (triangle.mk f g h ∈ dist_triang (full_subcategory S)) ↔
    (@triangle.mk C _ _ _ _ _ f g h ∈ dist_triang C) :=
begin
  change (_ ∈ dist_triang C) ↔ _,
  let e : (full_subcategory_inclusion S).map_triangle.obj (triangle.mk f g h) ≅
    @triangle.mk C _ _ _ _ _ f g h,
  { refine triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (iso.refl _) (by tidy) (by tidy) _,
    dsimp,
    erw [id_comp, functor.map_id, comp_id, comp_id], },
  split,
  { exact λ h, pretriangulated.isomorphic_distinguished _ h _ e.symm, },
  { exact λ h, pretriangulated.isomorphic_distinguished _ h _ e, },
end

instance is_triangulated_full_subcategory [is_triangulated C] :
  is_triangulated (full_subcategory S) := infer_instance

--instance inclusion_is_triangulated : (full_subcategory_inclusion S).is_triangulated :=
--infer_instance

def Q [is_triangulated C] : C ⥤ (W S).localization :=
begin
  let F := localization_functor (W S).Q (W S),
  exact F,
end

instance Q_has_comm_shift [is_triangulated C] : (Q S).has_comm_shift ℤ :=
(infer_instance : (localization_functor (W S).Q (W S)).has_comm_shift ℤ)

instance Q_is_triangulated [is_triangulated C] : (Q S).is_triangulated :=
(infer_instance : (localization_functor (W S).Q (W S)).is_triangulated)

/- TODO :
1) show a universal property for the triangulated functor `L` : if
`G : D ⥤ E` is a functor which lifts a triangulated functor `F : C ⥤ E`
then `G` is a triangulated functor.
 -/

instance Q_to_functor_is_localization [is_triangulated C] : (Q S).is_localization (W S) :=
(infer_instance : (W S).Q.is_localization (W S))

lemma is_iso_map_iff [saturated S] [is_triangulated C] {D : Type*} [category D] (L : C ⥤ D)
  [L.is_localization (W S)] {X Y : C} (f : X ⟶ Y) : is_iso (L.map f) ↔ (W S) f :=
localization.is_iso_map_iff_of_calculus_of_fractions L (W S) f

lemma is_zero_obj_iff' [is_triangulated C] (X : C) :
  is_zero ((Q S).obj X) ↔ ∃ (Y : C) (i : X ⟶ Y) [is_split_mono i], Y ∈ S :=
begin
  rw limits.is_zero.iff_id_eq_zero,
  split,
  { intro h,
    have h' : (W S).Q.map (𝟙 X) = (W S).Q.map 0 :=
      by simpa only [functor.map_id, functor.map_zero] using h,
    rw right_calculus_of_fractions.L_map_eq_iff (W S).Q (W S) at h',
    obtain ⟨Z, s, hs, eq⟩ := h',
    rw [comp_id, comp_zero] at eq,
    obtain ⟨Y, i, p, H, mem⟩ := hs,
    haveI : mono i := mono_of_dist_triang₂ _ H eq,
    exact ⟨Y, i, is_split_mono_of_mono i, mem⟩, },
  { rintro ⟨Y, i, hi, mem⟩,
    haveI : is_iso ((W S).Q.map (0 : Y ⟶ 0)) := localization.inverts (W S).Q (W S) _
      (W.mk' (contractible_distinguished Y) mem),
    rw [← cancel_mono ((W S).Q.map i), id_comp, zero_comp,
      ← cancel_mono ((W S).Q.map (0 : Y ⟶ 0)), functor.map_zero, comp_zero, comp_zero], },
end

lemma is_zero_obj_iff [saturated S] [is_triangulated C] (X : C) :
  is_zero ((Q S).obj X) ↔ X ∈ S :=
begin
  rw is_zero_obj_iff',
  split,
  { intro h,
    obtain ⟨Y, i, hi, mem⟩ := h,
    haveI := hi,
    exact saturated.condition i mem, },
  { exact λ h, ⟨X, 𝟙 X, infer_instance, h⟩, },
end

lemma left_orthogonal_comp_W_bijective (X : C) (hX : X ∈ left_orthogonal S)
  {Y Z : C} (w : Y ⟶ Z) (hw : (W S) w) :
  function.bijective (λ (f : X ⟶ Y), f ≫ w) :=
begin
  rw W_eq_W' at hw,
  obtain ⟨U, f, g, H, mem⟩ := hw,
  split,
  { intros y₁ y₂ hy,
    let y := y₁ - y₂,
    suffices : y = 0,
    { rw ← sub_eq_zero,
      exact this, },
    dsimp at hy,
    obtain ⟨u, hu⟩ := covariant_yoneda_exact₂ _ H y
      (by { dsimp [y], rw [sub_comp, hy, sub_self], }),
    rw [hu, hX u mem, zero_comp], },
  { intro z,
    obtain ⟨y, hy⟩ := covariant_yoneda_exact₃ _ H z
      (hX _ (is_triangulated_subcategory.shift _ _ mem)),
    exact ⟨y, hy.symm⟩, },
end

lemma left_orthogonal_bijective_L_map [is_triangulated C] {D : Type*} [category D]
  (L : C ⥤ D) [L.is_localization (W S)] (X Y : C) (hX : X ∈ left_orthogonal S) :
  function.bijective (λ (f : X ⟶ Y), L.map f) :=
begin
  split,
  { intros f₁ f₂ hf,
    dsimp at hf,
    rw left_calculus_of_fractions.L_map_eq_iff L (W S) at hf,
    rcases hf with ⟨Z, s, hs, eq⟩,
    exact (left_orthogonal_comp_W_bijective S _ hX s hs).1 eq, },
  { intro g,
    obtain ⟨z, hz⟩ := left_calculus_of_fractions.L_map_fac L (W S) g,
    dsimp [left_calculus_of_fractions.map_roof] at hz,
    obtain ⟨f, hf⟩ := (left_orthogonal_comp_W_bijective S _ hX z.s z.hs).2 z.f,
    refine ⟨f, _⟩,
    dsimp at hf ⊢,
    rw [hz, ← hf, L.map_comp, assoc, is_iso.hom_inv_id, comp_id], },
end

lemma left_orthogonal_bijective_Q_map [is_triangulated C]
  (X Y : C) (hX : X ∈ left_orthogonal S) :
  function.bijective (λ (f : X ⟶ Y), (Q S).map f) :=
left_orthogonal_bijective_L_map S (Q S) _ _ hX

lemma right_orthogonal_comp_W_bijective (Z : C) (hZ : Z ∈ right_orthogonal S)
  {X Y : C} (w : X ⟶ Y) (hw : (W S) w) :
  function.bijective (λ (f : Y ⟶ Z), w ≫ f) :=
begin
  split,
  { intros y₁ y₂ hy,
    let y := y₁ - y₂,
    suffices : y = 0,
    { rw ← sub_eq_zero,
      exact this, },
    dsimp at hy,
    obtain ⟨U, f, g, H, mem⟩ := hw,
    obtain ⟨u, hu⟩ := contravariant_yoneda_exact₂ _ H y
      (by { dsimp [y], rw [comp_sub, hy, sub_self], }),
    rw [hu, hZ u mem, comp_zero], },
  { intro z,
    rw W_eq_W' at hw,
    obtain ⟨U, f, g, H, mem⟩ := hw,
    obtain ⟨y, hy⟩ := contravariant_yoneda_exact₂ _ H z (hZ _ mem),
    exact ⟨y, hy.symm⟩, },
end

lemma right_orthogonal_bijective_L_map [is_triangulated C] {D : Type*} [category D]
  (L : C ⥤ D) [L.is_localization (W S)] (X Y : C) (hY : Y ∈ right_orthogonal S) :
  function.bijective (λ (f : X ⟶ Y), L.map f) :=
begin
  split,
  { intros f₁ f₂ hf,
    dsimp at hf,
    rw right_calculus_of_fractions.L_map_eq_iff L (W S) at hf,
    rcases hf with ⟨Z, s, hs, eq⟩,
    exact (right_orthogonal_comp_W_bijective S _ hY s hs).1 eq, },
  { intro g,
    obtain ⟨z, hz⟩ := right_calculus_of_fractions.L_map_fac L (W S) g,
    dsimp [right_calculus_of_fractions.map_roof] at hz,
    obtain ⟨f, hf⟩ := (right_orthogonal_comp_W_bijective S _ hY z.s z.hs).2 z.f,
    refine ⟨f, _⟩,
    dsimp at hf ⊢,
    rw [hz, ← hf, L.map_comp, is_iso.inv_hom_id_assoc], },
end

lemma right_orthogonal_bijective_Q_map
  [is_triangulated C] (X Y : C) (hY : Y ∈ right_orthogonal S) :
  function.bijective (λ (f : X ⟶ Y), (Q S).map f) :=
right_orthogonal_bijective_L_map S (Q S) _ _ hY

end subcategory

end triangulated

end category_theory


import init.meta.tactic
import system.io
import assignment

open tactic

meta def in_import (env : environment) (n : name) (path : string) : bool :=
(env.decl_olean n = path) && env.contains n && (n ∉ [``quot, ``quot.mk, ``quot.lift, ``quot.ind])

meta def exact_list : list name → tactic unit
| [] := failed
| (H :: Hs) := do
                  e ← mk_const H,
                  exact e <|> exact_list Hs

meta def check_solutions : tactic unit :=
do env <- get_env,
   let decls := env.fold [] list.cons,
   cwd ← unsafe_run_io io.env.get_cwd,
   let names := decls.map declaration.to_name,
   let assignment_names := names.filter
     (λ x, in_import env x (cwd ++ "/src/assignment.lean") && not x.is_internal),
   exact_list assignment_names

theorem check_problem1 : ∀ (x : Type), x = x :=
begin
  check_solutions,
end

#print "Problem 1"
#print axioms check_problem1
#print "---"

theorem check_problem2 : 1 + 1 = 2 :=
begin
  sorry
end

#print "Problem 2"
#print axioms check_problem2
#print "---"

/-
theorem check_problem2 : 0 = 1 :=
begin
  check_solutions,
end

#print "Problem 2"
#print axioms check_problem2
#print "---"

theorem check_problem3 : ℕ × ℕ × ℕ :=
begin
  check_solutions,
end

#print "Problem 3"
#print axioms check_problem3
#print "---"

theorem check_problem4 : bool :=
begin
  check_solutions,
end

#print "Problem 4"
#print axioms check_problem4
#print "---"

-/


import breen_deligne.apply_Pow

noncomputable theory

universes v

namespace breen_deligne

open category_theory category_theory.category category_theory.limits universal_map
  category_theory.preadditive

variables  {A₁ A₂ : Type*} [category.{v} A₁] [category.{v} A₂]
  [preadditive A₁] [preadditive A₂] [has_finite_biproducts A₁] [has_finite_biproducts A₂]
  (BD : data)
  (F₁ : A₁ ⥤ A₁) (F₂ : A₂ ⥤ A₂) {G G' : A₁ ⥤ A₂} [functor.additive G] [functor.additive G']
  (τ : G ⟶ G')
  (e : F₁ ⋙ G ≅ G ⋙ F₂) (e' : F₁ ⋙ G' ≅ G' ⋙ F₂)

lemma eval_Pow_functor_nat_trans_compatibility
  (h : e.hom ≫ whisker_right τ F₂ = whisker_left F₁ τ ≫ e'.hom) (M : A₁) (n : FreeMat) :
  τ.app (((eval_Pow_functor F₁).obj n).obj M) ≫ e'.hom.app _ ≫
    F₂.map ((apply_Pow G' n).hom.app M) =
  e.hom.app _ ≫ F₂.map ((apply_Pow G n).hom.app M) ≫
    ((eval_Pow_functor F₂).obj n).map (τ.app M) :=
begin
  dsimp only [eval_Pow_functor],
  have h₁ := nat_trans.congr_app h ((Pow n).obj M),
  simp only [nat_trans.comp_app, whisker_right_app, whisker_left] at h₁,
  slice_lhs 1 2 { erw ← h₁, },
  simp only [category.assoc],
  erw [← F₂.map_comp, ← F₂.map_comp],
  congr' 2,
  apply apply_Pow_naturality,
end

end breen_deligne